diff --git a/official/3.23/Dealers.rus.txt b/official/3.23/Dealers.rus.txt new file mode 100644 index 0000000..df6e733 --- /dev/null +++ b/official/3.23/Dealers.rus.txt @@ -0,0 +1,135 @@ +Дилеры + + Россия + +ЗАО "Софткей" + + Жители России, Украины, Белоруссии, Казахстана, Эстонии, Литвы, Латвии, Болгарии, Польши, Израиля могут приобретать лицензии у крупнейшего регистратора СНГ - ЗАО "Софткей" и оплатить их в местной валюте. + +129626, Россия, г. Москва, ул. Староалексеевская, д. 21, стр. 11, офис 411 Тел./факс (095) 775-1286 (многоканальный), (095) 991-7693 + +www.softkey.ru + + +ООО "Айбэйз", Москва + + ООО "Айбэйз" (iBase) +Россия, Москва, 1-ый Новокузнецкий переулок, д. 10, п. 2, к. 1. +тел (095) 953-13-34 +http://shop.ibase.ru/russia.htm +sales@ibase.ru + + +ООО "Сфера" + + ООО "Сфера" +Россия, Самара, ул. Арцыбушевская, 13, 4 этаж +тел (8462) 72-57-56 +http://www.sphere-ltd.ru +info@sphere-ltd.ru + + +компания "СофтЛайн", Москва + + Allsoft.ru +E-mail:info@allsoft.ru +119991, г. Москва, ул. Губкина, д. 8, компания "СофтЛайн" +Тел.: 8-800-200-2233 + + +ООО "Программ плюс" + + ООО "Программ плюс" +тел.: (0932) 41-18-53 +e-mail: plus@kodeks37.ru +сайт: www.vcl-soft.ru +Адрес: +153000, г. Иваново +ул. Почтовая,6-А, офис 105 + + + +ООО "ЮСК:Дистрибьюция" + +тел.: (863) 236-0483 +факс: (863) 236-8383 +e-mail: info@uskd.ru +сайт: www.uskd.ru www.softcatalog.ru +Адреса: +400000, Волгоград, Профсоюзная, 12 +350000, Краснодар, Селезнева, 84 +355000, Ставрополь, Доваторцев, 57/1 +344004, Ростов-на-Дону, 2-я Володарского, 76/23а + + +Украина + +"Десктоп-Софт" + +контактное лицо: Виталий Лысенко; +тел./факс: 0522-29-51-42 +e-mail: vlysenko@dswsoft.com + + +ООО "СОФТПРОМ" + +тел./факс (044)242-53-00, +zhdan@softprom.com +http://www.softprom.com + + +"I.T. Pro" Ltd. + + 03039, Kiev +av.40 let Oktyabrya 50 of.65 +tel.+380 44 258 0528 +tel.+380 44 264 0598 +tel.+380 44 264 4427 +tel.+380 67 502 4800 +tel.+380 97 936 2011 +http://www.itpro.kiev.ua/ + + +ЗАО "Софткей" + + Жители России, Украины, Белоруссии, Казахстана, Эстонии, Литвы, Латвии, Болгарии, Польши, Израиля могут приобретать лицензии у крупнейшего регистратора СНГ - ЗАО "Софткей" и оплатить их в местной валюте. + +129626, Россия, г. Москва, ул. Староалексеевская, д. 21, стр. 11, офис 411 Тел./факс (095) 775-1286 (многоканальный), (095) 991-7693 + +www.softkey.com.ua + + + Беларусь + + ЗАО "Софткей" + + Жители России, Украины, Белоруссии, Казахстана, Эстонии, Литвы, Латвии, Болгарии, Польши, Израиля могут приобретать лицензии у крупнейшего регистратора СНГ - ЗАО "Софткей" и оплатить их в местной валюте. + +129626, Россия, г. Москва, ул. Староалексеевская, д. 21, стр. 11, офис 411 Тел./факс (095) 775-1286 (многоканальный), (095) 991-7693 + +www.softkey.by + + + Туркмения + +Хозяйственное общество "Инфоком" + +744000, Туркменистан, г. Ашгабат, ул. Азади, 65 +тел: (+993 12) 35-79-54, 35-25-76 +contact@in4com.com + + Казахстан + + + ЗАО "Софткей" + + Жители России, Украины, Белоруссии, Казахстана, Эстонии, Литвы, Латвии, Болгарии, Польши, Израиля могут приобретать лицензии у крупнейшего регистратора СНГ - ЗАО "Софткей" и оплатить их в местной валюте. + +129626, Россия, г. Москва, ул. Староалексеевская, д. 21, стр. 11, офис 411 Тел./факс (095) 775-1286 (многоканальный), (095) 991-7693 + +www.softkey.kz + + + + + diff --git a/official/3.23/Dealers.txt b/official/3.23/Dealers.txt new file mode 100644 index 0000000..100b191 --- /dev/null +++ b/official/3.23/Dealers.txt @@ -0,0 +1,405 @@ +Dealers + + 1. United Kingdom + 1.1 QBS Software Ltd + 2. Germany + 2.1 BITA GmbH + 2.2 HK-Software + 3. Austria + 3.1 BITA GmbH + 4. Switzerland + 4.1 BITA GmbH + 5. Poland + 5.1 WebKomp + 5.2 Przedsiebiorstwo Komputerowo Obliczeniowe + 5.3 JSC "SoftKey" + 6. Czech + 6.1 Petr Zahradnik, Computer Laboratory + 6.2 HTK Pro s.r.o. + 7. Slovak + 7.1 HTK Pro s.r.o. + 8. Brazil + 8.1 EXPERTNET + 8.2 PRMAS SYSTEM + 9. South Korea + 9.1 DevTools Inc. + 9.2 Buysoft Inc. + 10. Taiwan, R.O.C. + 10.1 Crispin, Chen + 11. China + 11.1 Nora Xu + 11.2 CSTSOFT + 11.3 Chongqing Huidu Technology Co., Ltd. + 12. Nederland + 12.1 FastReport ook in Nederland verkrijgbaar + 13. Lithuania + 13.1 JSC "SoftKey" + 14. Latvia + 14.1 JSC "SoftKey" + 15. Estonia + 15.1 JSC "SoftKey" + 16. Bulgaria + 16.1 JSC "SoftKey" + 17. Colombia + 17.1 Luz Zapata Velasquez + 18. Latin America + 18.1 Danysoft + 19. Spain + 19.1 Danysoft + 20. Portugal + 20.1 Danysoft + 21. Israel + 21.1 Software Sources Ltd. + + + + 1. United Kingdom + + 1.1 QBS Software Ltd + + QBS Software Ltd +7 Wharfside +Rosemont Rd +Wembley HA0 4QB + +Tel +44 (0) 8456 580 580 +Fax +44 (0) 20 8902 7600 +email: sales@qbssoftware.com +http://www.qbssoftware.com/FASTREPORT + + + 2. Germany + + 2.1 BITA GmbH + + BITA GmbH +A-1070 Wien, Wimbergergasse 14/3-1-3 +E-mail: fastreport@bita.at +Tel: +43 (1) 9832873 +Fax: +43 (1) 9832873-30 +www.bita.at +Contact person: Robert Szuszkiewicz + + 3. Austria + + 3.1 BITA GmbH + + BITA GmbH +A-1070 Wien, Wimbergergasse 14/3-1-3 +E-mail: fastreport@bita.at +Tel: +43 (1) 9832873 +Fax: +43 (1) 9832873-30 +www.bita.at +Contact person: Robert Szuszkiewicz + + 4. Switzerland + + 4.1 BITA GmbH + + BITA GmbH +A-1070 Wien, Wimbergergasse 14/3-1-3 +E-mail: fastreport@bita.at +Tel: +43 (1) 9832873 +Fax: +43 (1) 9832873-30 +www.bita.at +Contact person: Robert Szuszkiewicz + + + 5. Poland + + 5.1 WebKomp + + WebKomp: +info@webkomp.net +ul. Sosnowskiego 3/18 +02-784 Warszawa +Poland +tel.: +48 501 232 256 +fax. +48 22 750 96 80 + +http://www.webkomp.net + + 5.2 Przedsiebiorstwo Komputerowo Obliczeniowe + + Przedsiebiorstwo Komputerowo Obliczeniowe +30-415 Krakow ul. Wadowicka 12 +fastreport@pko.pl +tel : +48 12 296 52 22 +fax: +48 12 296 52 23 +mobile: +48 602 801 659 +http://www.laptop.net.pl +http://www.laptop.net.pl/fastreport + + 5.3 JSC "SoftKey" + + Postal address: Zvezdny boulevard, 21, office 801, +129085, Moscow, Russia + +Tel./ fax: (095) 215-66-13, 797-26-64 + +www.softkey.net +www.softkey.lt +www.softkey.lv +www.softkey.pl +www.softkey.ee +www.softkeybg.com +email: sales@softkey.ru + + + 6. Czech + + 6.1 Petr Zahradnik, Computer Laboratory + + Petr Zahradnik, Computer Laboratory +Obvodova 740/14, CZ-40007 Usti nad Labem, Czech Republic +Phones: +420-47-5500610, +420-47-5501627 +Fax: +420-47-5511338 +WWW: http://www.clexpert.cz, http://www.zahradnik.cz +E-Mail: clexpert@clexpert.cz, petr@zahradnik.cz +ICQ: 21215917 + + + 6.2 HTK Pro s.r.o. + + HTK Pro s.r.o. +Prosecka 76a, Praha 9 +http://www.dev-shop.cz, http://www.dev-shop.sk +tel : +420-2-83880361, fax : +420-2-86891391 + + + 7. Slovak + + 7.1 HTK Pro s.r.o. + + HTK Pro s.r.o. +Prosecka 76a, Praha 9 +http://www.dev-shop.cz, http://www.dev-shop.sk +tel : +420-2-83880361, fax : +420-2-86891391 + + + 8. Brazil + + 8.1 EXPERTNET + + EXPERTNET +Phone: +55-11-9309-8017 +mailto:ndiay@expertnet.com.br +WWW:www.expertnet.com.br + + 8.2 PRMAS SYSTEM + + PRMAS SYSTEM +Phone: 55-11-97489924 +web: http://www.prmas.com.br +Email: vendas@prmas.com.br + + + 9. South Korea + + 9.1 DevTools Inc. + + DevTools Inc. +Tel : +82 (2) 521-7900 +Fac : +82 (2) 2297-7900 +email : midmee@devtools.co.kr +http://www.devtools.co.kr + + 9.2 Buysoft Inc. + + Buysoft Inc. +10F HungEun bldg., +824-22 Yeoksam-Dong, +Kangnam-Gu, +Seoul,Korea + +email: Irene Kwon +http://www.buysoft.co.kr + + + 10. Taiwan, R.O.C. + + + 10.1 Crispin, Chen + + Crispin, Chen +Tel: (04)2358-8484 +Mobile Phone: (0918)427-079 +E-Mail: crispin@pchome.com.tw +Web Site: +http://www.jane.com.tw/bbs/default.asp + + + 11. China + + 11.1 Nora Xu + + Nora Xu +ViewSlip SoftWare +mail:eric@viewslip.com +http://www.viewslip.com +Tel:+86-21-64069587 + + + 11.2 CSTSOFT + + CSTSOFT +Tel:+86 10 88416081 +Fax:+86 10 68767223 +Email:cstsoft@public3.bta.net.cn +http://www.cstsoft.com.cn + + + 11.3 Chongqing Huidu Technology Co., Ltd. + + Chongqing Huidu Technology Co., Ltd. +No.23, shixin Road, shiqiaopu, +Chongqing +China. 400039 +E-mail: sales@eVget.com +Tel: +86- (0) 23- 68690297 +Fax: +86- (0) 23- 68623874 +www.eVget.com + + + 12. Nederland + + 12.1 FastReport ook in Nederland verkrijgbaar + + FastReport producten worden in Nederland geleverd door TeoWin Software. +Wij geven graag meer informatie over de FastReport producten of antwoorden op vragen die voortkomen uit de kennismaking met FastReport. +Voor meer informatie +email:info@teowin-software.nl + + + 13. Lithuania + + + 13.1 JSC "SoftKey" + + Postal address: Zvezdny boulevard, 21, office 801, +129085, Moscow, Russia + +Tel./ fax: (095) 215-66-13, 797-26-64 + +www.softkey.net +www.softkey.lt +www.softkey.lv +www.softkey.pl +www.softkey.ee +www.softkeybg.com +email: sales@softkey.ru + + + 14. Latvia + + + 14.1 JSC "SoftKey" + + Postal address: Zvezdny boulevard, 21, office 801, +129085, Moscow, Russia + +Tel./ fax: (095) 215-66-13, 797-26-64 + +www.softkey.net +www.softkey.lt +www.softkey.lv +www.softkey.pl +www.softkey.ee +www.softkeybg.com +email: sales@softkey.ru + + + 15. Estonia + + 15.1 JSC "SoftKey" + + Postal address: Zvezdny boulevard, 21, office 801, +129085, Moscow, Russia + +Tel./ fax: (095) 215-66-13, 797-26-64 + +www.softkey.net +www.softkey.lt +www.softkey.lv +www.softkey.pl +www.softkey.ee +www.softkeybg.com +email: sales@softkey.ru + + + 16. Bulgaria + + 16.1 JSC "SoftKey" + + Postal address: Zvezdny boulevard, 21, office 801, +129085, Moscow, Russia + +Tel./ fax: (095) 215-66-13, 797-26-64 + +www.softkey.net +www.softkey.lt +www.softkey.lv +www.softkey.pl +www.softkey.ee +www.softkeybg.com +email: sales@softkey.ru + + + 17. Colombia + + 17.1 Luz Zapata Velasquez + + Luz Zapata Velasquez +Tr. 41 #146 A 40 Interior 17 sala 501 City: Bogota - D.C +Country: Colombia +Tel/Fax: (+57)-1-625-3024 +mail: info@safsoft.com +http://www.safsoft.com + + + 18. Latin America + + 18.1 Danysoft + + Danysoft Internatioal S.L. +Avda Industria 4, Edif 1, +28108 Accobendaj-Ma-Spain +email: sales@danysoft.com +http://www.danysoft.com + + + 19. Spain + + 19.1 Danysoft + + Danysoft Internatioal S.L. +Avda Industria 4, Edif 1, +28108 Accobendaj-Ma-Spain +email: sales@danysoft.com +http://www.danysoft.com + + + 20. Portugal + + 20.1 Danysoft + + Danysoft Internatioal S.L. +Avda Industria 4, Edif 1, +28108 Accobendaj-Ma-Spain +email: sales@danysoft.com +http://www.danysoft.com + + + + 21. Israel + + 21.1 Software Sources Ltd. + + Software Sources Ltd. +64B Hasharon St. +P.O.Box 639 +Ra'anana 43106 +Tel. +972-9-7714578 +Fax. +972-9-7712194 +email: chen@software-sources.co.il +http://www.software-sources.co.il \ No newline at end of file diff --git a/official/3.23/Demos/Dll/CALLDLL.DPR b/official/3.23/Demos/Dll/CALLDLL.DPR new file mode 100644 index 0000000..9531170 --- /dev/null +++ b/official/3.23/Demos/Dll/CALLDLL.DPR @@ -0,0 +1,13 @@ +program CallDLL; + +uses + Forms, + TestDLL in 'TestDLL.pas' {frmCallDLL}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TfrmCallDLL, frmCallDLL); + Application.Run; +end. diff --git a/official/3.23/Demos/Dll/CALLDLL.RES b/official/3.23/Demos/Dll/CALLDLL.RES new file mode 100644 index 0000000..f1bda73 Binary files /dev/null and b/official/3.23/Demos/Dll/CALLDLL.RES differ diff --git a/official/3.23/Demos/Dll/FormDLL.dfm b/official/3.23/Demos/Dll/FormDLL.dfm new file mode 100644 index 0000000..5c2b2ed Binary files /dev/null and b/official/3.23/Demos/Dll/FormDLL.dfm differ diff --git a/official/3.23/Demos/Dll/FormDLL.pas b/official/3.23/Demos/Dll/FormDLL.pas new file mode 100644 index 0000000..6187279 --- /dev/null +++ b/official/3.23/Demos/Dll/FormDLL.pas @@ -0,0 +1,62 @@ +unit FormDLL; + +interface + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, + Forms, Dialogs, StdCtrls, DBTables, DB, frxDBSet, frxClass; + +type + TfrmDLL = class(TForm) + btnBioLifePrintPreview: TButton; + Table1: TTable; + frxDBDataset1: TfrxDBDataset; + frxReport1: TfrxReport; + procedure btnBioLifePrintPreviewClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + private + { Private declarations } + public + { Public declarations } + end; + + +function ShowForm(A: TApplication): Bool; StdCall; + + +implementation + +{$R *.DFM} + +{------------------------------------------------------------------------} + +function ShowForm(A: TApplication): Bool; +var + Form1: TfrmDLL; +begin + Application.Handle := A.Handle; + Form1 := TfrmDLL.Create(A); + try + Result := (Form1.ShowModal = mrOK); + finally + Form1.Free; + end; +end; + +procedure TfrmDLL.btnBioLifePrintPreviewClick(Sender: TObject); +begin + frxReport1.ShowReport; +end; + +procedure TfrmDLL.FormActivate(Sender: TObject); +begin + Session.Active := True; +end; + +procedure TfrmDLL.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Session.Active := False; +end; + +end. diff --git a/official/3.23/Demos/Dll/RPTDLL.RES b/official/3.23/Demos/Dll/RPTDLL.RES new file mode 100644 index 0000000..f1bda73 Binary files /dev/null and b/official/3.23/Demos/Dll/RPTDLL.RES differ diff --git a/official/3.23/Demos/Dll/Rptdll.dpr b/official/3.23/Demos/Dll/Rptdll.dpr new file mode 100644 index 0000000..e037fd5 --- /dev/null +++ b/official/3.23/Demos/Dll/Rptdll.dpr @@ -0,0 +1,11 @@ +library RptDLL; + +uses + Forms, + FormDLL in 'FormDLL.pas' {frmDLL}; + +exports + ShowForm; + +begin +end. diff --git a/official/3.23/Demos/Dll/TestDLL.dfm b/official/3.23/Demos/Dll/TestDLL.dfm new file mode 100644 index 0000000..58b89b8 Binary files /dev/null and b/official/3.23/Demos/Dll/TestDLL.dfm differ diff --git a/official/3.23/Demos/Dll/TestDLL.pas b/official/3.23/Demos/Dll/TestDLL.pas new file mode 100644 index 0000000..88343aa --- /dev/null +++ b/official/3.23/Demos/Dll/TestDLL.pas @@ -0,0 +1,53 @@ +unit TestDLL; + +interface + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, + Forms, Dialogs, StdCtrls, DB, ExtCtrls, DBTables; + +type + TShowForm = function(A: TApplication): Bool; StdCall; + + EDLLLoadError = class(Exception); + + TfrmCallDLL = class(TForm) + Database1: TDatabase; + btnCallDLL: TButton; + btnClose: TButton; + procedure btnCallDLLClick(Sender: TObject); + procedure btnCloseClick(Sender: TObject); + end; + +var + frmCallDLL: TfrmCallDLL; + +implementation + + +{$R *.DFM} + +procedure TfrmCallDLL.btnCallDLLClick(Sender: TObject); +var + LibHandle: THandle; + ShowForm: TShowForm; +begin + LibHandle := LoadLibrary('RptDLL.DLL'); + try + if LibHandle = HINSTANCE_ERROR then + raise EDLLLoadError.Create('Unable to Load DLL'); + @ShowForm := GetProcAddress(LibHandle, 'ShowForm'); + if not (@ShowForm = nil) then + ShowForm(Application); + finally + FreeLibrary(LibHandle); + end; +end; + +procedure TfrmCallDLL.btnCloseClick(Sender: TObject); +begin + Close; +end; + + +end. diff --git a/official/3.23/Demos/InteractiveReport/Project1.dpr b/official/3.23/Demos/InteractiveReport/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/InteractiveReport/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/InteractiveReport/Project1.res b/official/3.23/Demos/InteractiveReport/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/InteractiveReport/Project1.res differ diff --git a/official/3.23/Demos/InteractiveReport/Unit1.dfm b/official/3.23/Demos/InteractiveReport/Unit1.dfm new file mode 100644 index 0000000..0de63c8 Binary files /dev/null and b/official/3.23/Demos/InteractiveReport/Unit1.dfm differ diff --git a/official/3.23/Demos/InteractiveReport/Unit1.pas b/official/3.23/Demos/InteractiveReport/Unit1.pas new file mode 100644 index 0000000..3f448b1 --- /dev/null +++ b/official/3.23/Demos/InteractiveReport/Unit1.pas @@ -0,0 +1,109 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls, frxDBSet, Db, DBTables; + +type + TForm1 = class(TForm) + Button1: TButton; + Customers: TTable; + CustomersCustNo: TFloatField; + CustomersCompany: TStringField; + CustomersAddr1: TStringField; + CustomersAddr2: TStringField; + CustomersCity: TStringField; + CustomersState: TStringField; + CustomersZip: TStringField; + CustomersCountry: TStringField; + CustomersPhone: TStringField; + CustomersFAX: TStringField; + CustomersTaxRate: TFloatField; + CustomersContact: TStringField; + CustomersLastInvoiceDate: TDateTimeField; + DetailQuery: TQuery; + DetailQueryCustNo: TFloatField; + DetailQueryCompany: TStringField; + DetailQueryAddr1: TStringField; + DetailQueryAddr2: TStringField; + DetailQueryCity: TStringField; + DetailQueryState: TStringField; + DetailQueryZip: TStringField; + DetailQueryCountry: TStringField; + DetailQueryPhone: TStringField; + DetailQueryFAX: TStringField; + DetailQueryTaxRate: TFloatField; + DetailQueryContact: TStringField; + DetailQueryLastInvoiceDate: TDateTimeField; + DetailQueryOrderNo: TFloatField; + DetailQueryCustNo_1: TFloatField; + DetailQuerySaleDate: TDateTimeField; + DetailQueryShipDate: TDateTimeField; + DetailQueryEmpNo: TIntegerField; + DetailQueryShipToContact: TStringField; + DetailQueryShipToAddr1: TStringField; + DetailQueryShipToAddr2: TStringField; + DetailQueryShipToCity: TStringField; + DetailQueryShipToState: TStringField; + DetailQueryShipToZip: TStringField; + DetailQueryShipToCountry: TStringField; + DetailQueryShipToPhone: TStringField; + DetailQueryShipVIA: TStringField; + DetailQueryPO: TStringField; + DetailQueryTerms: TStringField; + DetailQueryPaymentMethod: TStringField; + DetailQueryItemsTotal: TCurrencyField; + DetailQueryTaxRate_1: TFloatField; + DetailQueryFreight: TCurrencyField; + DetailQueryAmountPaid: TCurrencyField; + DetailQueryOrderNo_1: TFloatField; + DetailQueryItemNo: TFloatField; + DetailQueryPartNo: TFloatField; + DetailQueryQty: TIntegerField; + DetailQueryDiscount: TFloatField; + DetailQueryPartNo_1: TFloatField; + DetailQueryVendorNo: TFloatField; + DetailQueryDescription: TStringField; + DetailQueryOnHand: TFloatField; + DetailQueryOnOrder: TFloatField; + DetailQueryCost: TCurrencyField; + DetailQueryListPrice: TCurrencyField; + CustomersDS: TfrxDBDataset; + DetailQueryDS: TfrxDBDataset; + MainReport: TfrxReport; + DetailReport: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure MainReportClickObject(View: TfrxView; + Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +procedure TForm1.Button1Click(Sender: TObject); +begin + MainReport.ShowReport; +end; + +procedure TForm1.MainReportClickObject(View: TfrxView; + Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); +begin + if View.Name = 'Memo8' then + begin + DetailQuery.Close; + DetailQuery.ParamByName('custno').Text := View.TagStr; + DetailReport.ShowReport; + end; +end; + +end. diff --git a/official/3.23/Demos/Main/1.fr3 b/official/3.23/Demos/Main/1.fr3 new file mode 100644 index 0000000..f9e3ab8 --- /dev/null +++ b/official/3.23/Demos/Main/1.fr3 @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/10.FR3 b/official/3.23/Demos/Main/10.FR3 new file mode 100644 index 0000000..2a30316 --- /dev/null +++ b/official/3.23/Demos/Main/10.FR3 @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/11.FR3 b/official/3.23/Demos/Main/11.FR3 new file mode 100644 index 0000000..b2f7e74 --- /dev/null +++ b/official/3.23/Demos/Main/11.FR3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/12.FR3 b/official/3.23/Demos/Main/12.FR3 new file mode 100644 index 0000000..f4a9ce1 --- /dev/null +++ b/official/3.23/Demos/Main/12.FR3 @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/13.fr3 b/official/3.23/Demos/Main/13.fr3 new file mode 100644 index 0000000..cf59944 --- /dev/null +++ b/official/3.23/Demos/Main/13.fr3 @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/official/3.23/Demos/Main/2.FR3 b/official/3.23/Demos/Main/2.FR3 new file mode 100644 index 0000000..d0dea09 --- /dev/null +++ b/official/3.23/Demos/Main/2.FR3 @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/21.FR3 b/official/3.23/Demos/Main/21.FR3 new file mode 100644 index 0000000..1481b74 --- /dev/null +++ b/official/3.23/Demos/Main/21.FR3 @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/22.FR3 b/official/3.23/Demos/Main/22.FR3 new file mode 100644 index 0000000..a7d8344 --- /dev/null +++ b/official/3.23/Demos/Main/22.FR3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/23.FR3 b/official/3.23/Demos/Main/23.FR3 new file mode 100644 index 0000000..4602809 --- /dev/null +++ b/official/3.23/Demos/Main/23.FR3 @@ -0,0 +1,6 @@ + + + + + + diff --git a/official/3.23/Demos/Main/24.FR3 b/official/3.23/Demos/Main/24.FR3 new file mode 100644 index 0000000..f0d8417 --- /dev/null +++ b/official/3.23/Demos/Main/24.FR3 @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/25.fr3 b/official/3.23/Demos/Main/25.fr3 new file mode 100644 index 0000000..8ebc608 --- /dev/null +++ b/official/3.23/Demos/Main/25.fr3 @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/3.FR3 b/official/3.23/Demos/Main/3.FR3 new file mode 100644 index 0000000..ef25e57 --- /dev/null +++ b/official/3.23/Demos/Main/3.FR3 @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/31.FR3 b/official/3.23/Demos/Main/31.FR3 new file mode 100644 index 0000000..d3fa56f --- /dev/null +++ b/official/3.23/Demos/Main/31.FR3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/32.FR3 b/official/3.23/Demos/Main/32.FR3 new file mode 100644 index 0000000..9bc8c8c --- /dev/null +++ b/official/3.23/Demos/Main/32.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/3.23/Demos/Main/33.FR3 b/official/3.23/Demos/Main/33.FR3 new file mode 100644 index 0000000..860355b --- /dev/null +++ b/official/3.23/Demos/Main/33.FR3 @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/34.FR3 b/official/3.23/Demos/Main/34.FR3 new file mode 100644 index 0000000..bbab78a --- /dev/null +++ b/official/3.23/Demos/Main/34.FR3 @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/35.fr3 b/official/3.23/Demos/Main/35.fr3 new file mode 100644 index 0000000..0674088 --- /dev/null +++ b/official/3.23/Demos/Main/35.fr3 @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/36.fr3 b/official/3.23/Demos/Main/36.fr3 new file mode 100644 index 0000000..a70c764 --- /dev/null +++ b/official/3.23/Demos/Main/36.fr3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/4.FR3 b/official/3.23/Demos/Main/4.FR3 new file mode 100644 index 0000000..c12d517 --- /dev/null +++ b/official/3.23/Demos/Main/4.FR3 @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/41.FR3 b/official/3.23/Demos/Main/41.FR3 new file mode 100644 index 0000000..5338a78 --- /dev/null +++ b/official/3.23/Demos/Main/41.FR3 @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/42.FR3 b/official/3.23/Demos/Main/42.FR3 new file mode 100644 index 0000000..27a5604 --- /dev/null +++ b/official/3.23/Demos/Main/42.FR3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/43.FR3 b/official/3.23/Demos/Main/43.FR3 new file mode 100644 index 0000000..6c445f6 --- /dev/null +++ b/official/3.23/Demos/Main/43.FR3 @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/44.fr3 b/official/3.23/Demos/Main/44.fr3 new file mode 100644 index 0000000..d07ead3 --- /dev/null +++ b/official/3.23/Demos/Main/44.fr3 @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/45.fr3 b/official/3.23/Demos/Main/45.fr3 new file mode 100644 index 0000000..ca60950 --- /dev/null +++ b/official/3.23/Demos/Main/45.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/5.FR3 b/official/3.23/Demos/Main/5.FR3 new file mode 100644 index 0000000..60dcbf5 --- /dev/null +++ b/official/3.23/Demos/Main/5.FR3 @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/51.FR3 b/official/3.23/Demos/Main/51.FR3 new file mode 100644 index 0000000..a166485 --- /dev/null +++ b/official/3.23/Demos/Main/51.FR3 @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/52.FR3 b/official/3.23/Demos/Main/52.FR3 new file mode 100644 index 0000000..0e92260 --- /dev/null +++ b/official/3.23/Demos/Main/52.FR3 @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/6.FR3 b/official/3.23/Demos/Main/6.FR3 new file mode 100644 index 0000000..f8f8483 --- /dev/null +++ b/official/3.23/Demos/Main/6.FR3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/60.fr3 b/official/3.23/Demos/Main/60.fr3 new file mode 100644 index 0000000..248f469 --- /dev/null +++ b/official/3.23/Demos/Main/60.fr3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/61.FR3 b/official/3.23/Demos/Main/61.FR3 new file mode 100644 index 0000000..f2af0bc --- /dev/null +++ b/official/3.23/Demos/Main/61.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/62.FR3 b/official/3.23/Demos/Main/62.FR3 new file mode 100644 index 0000000..4e152bd --- /dev/null +++ b/official/3.23/Demos/Main/62.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/63.FR3 b/official/3.23/Demos/Main/63.FR3 new file mode 100644 index 0000000..d99cbb0 --- /dev/null +++ b/official/3.23/Demos/Main/63.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/64.FR3 b/official/3.23/Demos/Main/64.FR3 new file mode 100644 index 0000000..7721ada --- /dev/null +++ b/official/3.23/Demos/Main/64.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/65.FR3 b/official/3.23/Demos/Main/65.FR3 new file mode 100644 index 0000000..8591db2 --- /dev/null +++ b/official/3.23/Demos/Main/65.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/66.FR3 b/official/3.23/Demos/Main/66.FR3 new file mode 100644 index 0000000..a6a7b54 --- /dev/null +++ b/official/3.23/Demos/Main/66.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/67.FR3 b/official/3.23/Demos/Main/67.FR3 new file mode 100644 index 0000000..9f3376f --- /dev/null +++ b/official/3.23/Demos/Main/67.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/68.FR3 b/official/3.23/Demos/Main/68.FR3 new file mode 100644 index 0000000..0719428 --- /dev/null +++ b/official/3.23/Demos/Main/68.FR3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/69.FR3 b/official/3.23/Demos/Main/69.FR3 new file mode 100644 index 0000000..bc4c117 --- /dev/null +++ b/official/3.23/Demos/Main/69.FR3 @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/7.FR3 b/official/3.23/Demos/Main/7.FR3 new file mode 100644 index 0000000..4e25511 --- /dev/null +++ b/official/3.23/Demos/Main/7.FR3 @@ -0,0 +1,12 @@ + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/70.fr3 b/official/3.23/Demos/Main/70.fr3 new file mode 100644 index 0000000..978e81d --- /dev/null +++ b/official/3.23/Demos/Main/70.fr3 @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/71.fr3 b/official/3.23/Demos/Main/71.fr3 new file mode 100644 index 0000000..2ad9583 --- /dev/null +++ b/official/3.23/Demos/Main/71.fr3 @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/72.fr3 b/official/3.23/Demos/Main/72.fr3 new file mode 100644 index 0000000..c0864c6 --- /dev/null +++ b/official/3.23/Demos/Main/72.fr3 @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/73.fr3 b/official/3.23/Demos/Main/73.fr3 new file mode 100644 index 0000000..a823e13 --- /dev/null +++ b/official/3.23/Demos/Main/73.fr3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/8.FR3 b/official/3.23/Demos/Main/8.FR3 new file mode 100644 index 0000000..4a6b83f --- /dev/null +++ b/official/3.23/Demos/Main/8.FR3 @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/80.fr3 b/official/3.23/Demos/Main/80.fr3 new file mode 100644 index 0000000..21d4dca --- /dev/null +++ b/official/3.23/Demos/Main/80.fr3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/81.fr3 b/official/3.23/Demos/Main/81.fr3 new file mode 100644 index 0000000..8299f81 --- /dev/null +++ b/official/3.23/Demos/Main/81.fr3 @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/82.fr3 b/official/3.23/Demos/Main/82.fr3 new file mode 100644 index 0000000..a9ac08d --- /dev/null +++ b/official/3.23/Demos/Main/82.fr3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/3.23/Demos/Main/9.FR3 b/official/3.23/Demos/Main/9.FR3 new file mode 100644 index 0000000..3d41490 --- /dev/null +++ b/official/3.23/Demos/Main/9.FR3 @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/official/3.23/Demos/Main/FRDemo.dpr b/official/3.23/Demos/Main/FRDemo.dpr new file mode 100644 index 0000000..86680b9 --- /dev/null +++ b/official/3.23/Demos/Main/FRDemo.dpr @@ -0,0 +1,15 @@ +program FRDemo; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}, + Unit2 in 'Unit2.pas' {ReportData: TDataModule}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TReportData, ReportData); + Application.Run; +end. diff --git a/official/3.23/Demos/Main/FRDemo.drc b/official/3.23/Demos/Main/FRDemo.drc new file mode 100644 index 0000000..95a72fc --- /dev/null +++ b/official/3.23/Demos/Main/FRDemo.drc @@ -0,0 +1,1042 @@ +/* VER150 + Generated by the Borland Delphi Pascal Compiler + because -GD or --drc was supplied to the compiler. + + This file contains compiler-generated resources that + were bound to the executable. + If this file is empty, then no compiler-generated + resources were bound to the produced executable. +*/ + +#define ADOConst_sNameAttr 65008 +#define ADOConst_sValueAttr 65009 +#define VDBConsts_SPropDefByLookup 65024 +#define VDBConsts_STooManyColumns 65025 +#define VDBConsts_SRemoteLogin 65026 +#define ADOConst_SInvalidEnumValue 65027 +#define ADOConst_SMissingConnection 65028 +#define ADOConst_SNoDetailFilter 65029 +#define ADOConst_SBookmarksRequired 65030 +#define ADOConst_SMissingCommandText 65031 +#define ADOConst_SNoResultSet 65032 +#define ADOConst_SADOCreateError 65033 +#define ADOConst_SEventsNotSupported 65034 +#define ADOConst_SUsupportedFieldType 65035 +#define ADOConst_SConnectionRequired 65036 +#define ADOConst_SCantRequery 65037 +#define ADOConst_SNoFilterOptions 65038 +#define ADOConst_SRecordsetNotOpen 65039 +#define OleConst_SInvalidVerb 65040 +#define OleConst_SPropDlgCaption 65041 +#define OleConst_SInvalidStreamFormat 65042 +#define VDBConsts_SFirstRecord 65043 +#define VDBConsts_SPriorRecord 65044 +#define VDBConsts_SNextRecord 65045 +#define VDBConsts_SLastRecord 65046 +#define VDBConsts_SInsertRecord 65047 +#define VDBConsts_SDeleteRecord 65048 +#define VDBConsts_SEditRecord 65049 +#define VDBConsts_SPostEdit 65050 +#define VDBConsts_SCancelEdit 65051 +#define VDBConsts_SRefreshRecord 65052 +#define VDBConsts_SDeleteRecordQuestion 65053 +#define VDBConsts_SDeleteMultipleRecordsQuestion 65054 +#define VDBConsts_SDataSourceFixed 65055 +#define TeeConst_TeeMsg_ShapeGallery2 65056 +#define TeeConst_TeeMsg_ValuesX 65057 +#define TeeConst_TeeMsg_ValuesY 65058 +#define TeeConst_TeeMsg_ValuesPie 65059 +#define TeeConst_TeeMsg_ValuesBar 65060 +#define TeeConst_TeeMsg_ValuesAngle 65061 +#define TeeConst_TeeMsg_ValuesGanttStart 65062 +#define TeeConst_TeeMsg_ValuesGanttEnd 65063 +#define TeeConst_TeeMsg_ValuesGanttNextTask 65064 +#define TeeConst_TeeMsg_ValuesBubbleRadius 65065 +#define TeeConst_TeeMsg_ValuesArrowEndX 65066 +#define TeeConst_TeeMsg_ValuesArrowEndY 65067 +#define OleConst_SLinkProperties 65068 +#define OleConst_SInvalidLinkSource 65069 +#define OleConst_SCannotBreakLink 65070 +#define OleConst_SEmptyContainer 65071 +#define TeeConst_TeeMsg_DefaultFontSize 65072 +#define TeeConst_TeeMsg_DefaultGalleryFontSize 65073 +#define TeeConst_TeeMsg_FunctionAdd 65074 +#define TeeConst_TeeMsg_FunctionSubtract 65075 +#define TeeConst_TeeMsg_FunctionMultiply 65076 +#define TeeConst_TeeMsg_FunctionDivide 65077 +#define TeeConst_TeeMsg_FunctionHigh 65078 +#define TeeConst_TeeMsg_FunctionLow 65079 +#define TeeConst_TeeMsg_FunctionAverage 65080 +#define TeeConst_TeeMsg_GalleryShape 65081 +#define TeeConst_TeeMsg_GalleryBubble 65082 +#define TeeConst_TeeMsg_DefaultFontName 65083 +#define TeeConst_TeeMsg_CheckPointerSize 65084 +#define TeeConst_TeeMsg_FunctionPeriod 65085 +#define TeeConst_TeeMsg_PieOther 65086 +#define TeeConst_TeeMsg_ShapeGallery1 65087 +#define TeeConst_TeeMsg_PieSample8 65088 +#define TeeConst_TeeMsg_GalleryChartName 65089 +#define TeeConst_TeeMsg_GalleryStandard 65090 +#define TeeConst_TeeMsg_GalleryFunctions 65091 +#define TeeConst_TeeMsg_GalleryArrow 65092 +#define TeeConst_TeeMsg_GalleryGantt 65093 +#define TeeConst_TeeMsg_GanttSample1 65094 +#define TeeConst_TeeMsg_GanttSample2 65095 +#define TeeConst_TeeMsg_GanttSample3 65096 +#define TeeConst_TeeMsg_GanttSample4 65097 +#define TeeConst_TeeMsg_GanttSample5 65098 +#define TeeConst_TeeMsg_GanttSample6 65099 +#define TeeConst_TeeMsg_GanttSample7 65100 +#define TeeConst_TeeMsg_GanttSample8 65101 +#define TeeConst_TeeMsg_GanttSample9 65102 +#define TeeConst_TeeMsg_GanttSample10 65103 +#define TeeConst_TeeMsg_AxisLabels 65104 +#define TeeConst_TeeMsg_GalleryLine 65105 +#define TeeConst_TeeMsg_GalleryPoint 65106 +#define TeeConst_TeeMsg_GalleryArea 65107 +#define TeeConst_TeeMsg_GalleryBar 65108 +#define TeeConst_TeeMsg_GalleryHorizBar 65109 +#define TeeConst_TeeMsg_GalleryPie 65110 +#define TeeConst_TeeMsg_GalleryFastLine 65111 +#define TeeConst_TeeMsg_Rotation 65112 +#define TeeConst_TeeMsg_PieSample1 65113 +#define TeeConst_TeeMsg_PieSample2 65114 +#define TeeConst_TeeMsg_PieSample3 65115 +#define TeeConst_TeeMsg_PieSample4 65116 +#define TeeConst_TeeMsg_PieSample5 65117 +#define TeeConst_TeeMsg_PieSample6 65118 +#define TeeConst_TeeMsg_PieSample7 65119 +#define TeeConst_TeeMsg_AxisLogDateTime 65120 +#define TeeConst_TeeMsg_AxisLogNotPositive 65121 +#define TeeConst_TeeMsg_AxisLabelSep 65122 +#define TeeConst_TeeMsg_AxisIncrementNeg 65123 +#define TeeConst_TeeMsg_AxisMinMax 65124 +#define TeeConst_TeeMsg_AxisMaxMin 65125 +#define TeeConst_TeeMsg_AxisLogBase 65126 +#define TeeConst_TeeMsg_MaxPointsPerPage 65127 +#define TeeConst_TeeMsg_3dPercent 65128 +#define TeeConst_TeeMsg_CircularSeries 65129 +#define TeeConst_TeeMsg_BarWidthPercent 65130 +#define TeeConst_TeeMsg_BarOffsetPercent 65131 +#define TeeConst_TeeMsg_DefaultPercentOf 65132 +#define TeeConst_TeeMsg_DefPercentFormat 65133 +#define TeeConst_TeeMsg_DefValueFormat 65134 +#define TeeConst_TeeMsg_AxisTitle 65135 +#define DBConsts_SCouldNotParseTimeStamp 65136 +#define DBConsts_SInvalidSqlTimeStamp 65137 +#define ComConst_SOleError 65138 +#define ComConst_SNoMethod 65139 +#define ComConst_SVarNotObject 65140 +#define ComConst_STooManyParams 65141 +#define JConsts_sChangeJPGSize 65142 +#define JConsts_sJPEGError 65143 +#define JConsts_sJPEGImageFile 65144 +#define TeeConst_TeeMsg_LegendTopPos 65145 +#define TeeConst_TeeMsg_LegendFirstValue 65146 +#define TeeConst_TeeMsg_LegendColorWidth 65147 +#define TeeConst_TeeMsg_SeriesSetDataSource 65148 +#define TeeConst_TeeMsg_SeriesInvDataSource 65149 +#define TeeConst_TeeMsg_FillSample 65150 +#define TeeConst_TeeMsg_Angle 65151 +#define DBConsts_SDataSetEmpty 65152 +#define DBConsts_SDataSetReadOnly 65153 +#define DBConsts_SNestedDataSetClass 65154 +#define DBConsts_STextFalse 65155 +#define DBConsts_STextTrue 65156 +#define DBConsts_SParameterNotFound 65157 +#define DBConsts_SInvalidVersion 65158 +#define DBConsts_SBadFieldType 65159 +#define DBConsts_SProviderSQLNotSupported 65160 +#define DBConsts_SProviderExecuteNotSupported 65161 +#define DBConsts_SDataSetUnidirectional 65162 +#define DBConsts_SUnassignedVar 65163 +#define DBConsts_SRecordNotFound 65164 +#define DBConsts_SBcdOverflow 65165 +#define DBConsts_SInvalidBcdValue 65166 +#define DBConsts_SInvalidFormatType 65167 +#define DBConsts_SFieldTypeMismatch 65168 +#define DBConsts_SFieldSizeMismatch 65169 +#define DBConsts_SInvalidVarByteArray 65170 +#define DBConsts_SFieldOutOfRange 65171 +#define DBConsts_SFieldRequired 65172 +#define DBConsts_SDataSetMissing 65173 +#define DBConsts_SInvalidCalcType 65174 +#define DBConsts_SFieldReadOnly 65175 +#define DBConsts_SNoIndexForFields 65176 +#define DBConsts_SIndexNotFound 65177 +#define DBConsts_SCircularDataLink 65178 +#define DBConsts_SLookupInfoError 65179 +#define DBConsts_SDataSourceChange 65180 +#define DBConsts_SDataSetOpen 65181 +#define DBConsts_SNotEditing 65182 +#define DBConsts_SDataSetClosed 65183 +#define ComStrs_sFailSetCalMinMaxRange 65184 +#define ComStrs_sFailsetCalSelRange 65185 +#define WinHelpViewer_hNoKeyword 65186 +#define DBConsts_SInvalidFieldSize 65187 +#define DBConsts_SInvalidFieldKind 65188 +#define DBConsts_SUnknownFieldType 65189 +#define DBConsts_SFieldNameMissing 65190 +#define DBConsts_SDuplicateFieldName 65191 +#define DBConsts_SFieldNotFound 65192 +#define DBConsts_SFieldAccessError 65193 +#define DBConsts_SFieldValueError 65194 +#define DBConsts_SFieldRangeError 65195 +#define DBConsts_SBcdFieldRangeError 65196 +#define DBConsts_SInvalidIntegerValue 65197 +#define DBConsts_SInvalidBoolValue 65198 +#define DBConsts_SInvalidFloatValue 65199 +#define ComStrs_sTabFailSetObject 65200 +#define ComStrs_sTabMustBeMultiLine 65201 +#define ComStrs_sInvalidIndex 65202 +#define ComStrs_sInsertError 65203 +#define ComStrs_sInvalidOwner 65204 +#define ComStrs_sRichEditInsertError 65205 +#define ComStrs_sRichEditLoadFail 65206 +#define ComStrs_sRichEditSaveFail 65207 +#define ComStrs_sUDAssociated 65208 +#define ComStrs_sPageIndexError 65209 +#define ComStrs_sInvalidComCtl32 65210 +#define ComStrs_sDateTimeMax 65211 +#define ComStrs_sDateTimeMin 65212 +#define ComStrs_sNeedAllowNone 65213 +#define ComStrs_sFailSetCalDateTime 65214 +#define ComStrs_sFailSetCalMaxSelRange 65215 +#define ExtCtrls_clNameInfoBk 65216 +#define ExtCtrls_clNameInfoText 65217 +#define ExtCtrls_clNameMenu 65218 +#define ExtCtrls_clNameMenuText 65219 +#define ExtCtrls_clNameNone 65220 +#define ExtCtrls_clNameScrollBar 65221 +#define ExtCtrls_clName3DDkShadow 65222 +#define ExtCtrls_clName3DLight 65223 +#define ExtCtrls_clNameWindow 65224 +#define ExtCtrls_clNameWindowFrame 65225 +#define ExtCtrls_clNameWindowText 65226 +#define ComStrs_sTabFailClear 65227 +#define ComStrs_sTabFailDelete 65228 +#define ComStrs_sTabFailRetrieve 65229 +#define ComStrs_sTabFailGetObject 65230 +#define ComStrs_sTabFailSet 65231 +#define ExtCtrls_clNameActiveBorder 65232 +#define ExtCtrls_clNameActiveCaption 65233 +#define ExtCtrls_clNameAppWorkSpace 65234 +#define ExtCtrls_clNameBackground 65235 +#define ExtCtrls_clNameBtnFace 65236 +#define ExtCtrls_clNameBtnHighlight 65237 +#define ExtCtrls_clNameBtnShadow 65238 +#define ExtCtrls_clNameBtnText 65239 +#define ExtCtrls_clNameCaptionText 65240 +#define ExtCtrls_clNameDefault 65241 +#define ExtCtrls_clNameGrayText 65242 +#define ExtCtrls_clNameHighlight 65243 +#define ExtCtrls_clNameHighlightText 65244 +#define ExtCtrls_clNameInactiveBorder 65245 +#define ExtCtrls_clNameInactiveCaption 65246 +#define ExtCtrls_clNameInactiveCaptionText 65247 +#define ExtCtrls_clNameNavy 65248 +#define ExtCtrls_clNamePurple 65249 +#define ExtCtrls_clNameTeal 65250 +#define ExtCtrls_clNameGray 65251 +#define ExtCtrls_clNameSilver 65252 +#define ExtCtrls_clNameRed 65253 +#define ExtCtrls_clNameLime 65254 +#define ExtCtrls_clNameYellow 65255 +#define ExtCtrls_clNameBlue 65256 +#define ExtCtrls_clNameFuchsia 65257 +#define ExtCtrls_clNameAqua 65258 +#define ExtCtrls_clNameWhite 65259 +#define ExtCtrls_clNameMoneyGreen 65260 +#define ExtCtrls_clNameSkyBlue 65261 +#define ExtCtrls_clNameCream 65262 +#define ExtCtrls_clNameMedGray 65263 +#define Consts_SDockTreeRemoveError 65264 +#define Consts_SDockZoneNotFound 65265 +#define Consts_SDockZoneHasNoCtl 65266 +#define Consts_SMultiSelectRequired 65267 +#define Consts_SSeparator 65268 +#define Consts_SErrorSettingCount 65269 +#define Consts_SListBoxMustBeVirtual 65270 +#define Consts_SNoGetItemEventHandler 65271 +#define HelpIntfs_hNoTableOfContents 65272 +#define HelpIntfs_hNothingFound 65273 +#define HelpIntfs_hNoContext 65274 +#define HelpIntfs_hNoTopics 65275 +#define ExtCtrls_clNameBlack 65276 +#define ExtCtrls_clNameMaroon 65277 +#define ExtCtrls_clNameGreen 65278 +#define ExtCtrls_clNameOlive 65279 +#define Consts_SmkcIns 65280 +#define Consts_SmkcDel 65281 +#define Consts_SmkcShift 65282 +#define Consts_SmkcCtrl 65283 +#define Consts_SmkcAlt 65284 +#define Consts_srNone 65285 +#define Consts_SOutOfRange 65286 +#define Consts_SInsertLineError 65287 +#define Consts_SInvalidClipFmt 65288 +#define Consts_SIconToClipboard 65289 +#define Consts_SCannotOpenClipboard 65290 +#define Consts_SInvalidMemoSize 65291 +#define Consts_SInvalidPrinterOp 65292 +#define Consts_SNoDefaultPrinter 65293 +#define Consts_SDuplicateMenus 65294 +#define Consts_SDockedCtlNeedsName 65295 +#define Consts_SMsgDlgAll 65296 +#define Consts_SMsgDlgNoToAll 65297 +#define Consts_SMsgDlgYesToAll 65298 +#define Consts_SmkcBkSp 65299 +#define Consts_SmkcTab 65300 +#define Consts_SmkcEsc 65301 +#define Consts_SmkcEnter 65302 +#define Consts_SmkcSpace 65303 +#define Consts_SmkcPgUp 65304 +#define Consts_SmkcPgDn 65305 +#define Consts_SmkcEnd 65306 +#define Consts_SmkcHome 65307 +#define Consts_SmkcLeft 65308 +#define Consts_SmkcUp 65309 +#define Consts_SmkcRight 65310 +#define Consts_SmkcDown 65311 +#define Consts_SVIcons 65312 +#define Consts_SVBitmaps 65313 +#define Consts_SMaskErr 65314 +#define Consts_SMaskEditErr 65315 +#define Consts_SMsgDlgWarning 65316 +#define Consts_SMsgDlgError 65317 +#define Consts_SMsgDlgInformation 65318 +#define Consts_SMsgDlgConfirm 65319 +#define Consts_SMsgDlgYes 65320 +#define Consts_SMsgDlgNo 65321 +#define Consts_SMsgDlgOK 65322 +#define Consts_SMsgDlgCancel 65323 +#define Consts_SMsgDlgHelp 65324 +#define Consts_SMsgDlgAbort 65325 +#define Consts_SMsgDlgRetry 65326 +#define Consts_SMsgDlgIgnore 65327 +#define Consts_SGroupIndexTooLow 65328 +#define Consts_SNoMDIForm 65329 +#define Consts_SControlParentSetToSelf 65330 +#define Consts_SOKButton 65331 +#define Consts_SCancelButton 65332 +#define Consts_SYesButton 65333 +#define Consts_SNoButton 65334 +#define Consts_SHelpButton 65335 +#define Consts_SCloseButton 65336 +#define Consts_SIgnoreButton 65337 +#define Consts_SRetryButton 65338 +#define Consts_SAbortButton 65339 +#define Consts_SAllButton 65340 +#define Consts_SCannotDragForm 65341 +#define Consts_SVMetafiles 65342 +#define Consts_SVEnhMetafiles 65343 +#define Consts_SCannotFocus 65344 +#define Consts_SParentRequired 65345 +#define Consts_SParentGivenNotAParent 65346 +#define Consts_SMDIChildNotVisible 65347 +#define Consts_SVisibleChanged 65348 +#define Consts_SCannotShowModal 65349 +#define Consts_SScrollBarRange 65350 +#define Consts_SPropertyOutOfRange 65351 +#define Consts_SMenuIndexError 65352 +#define Consts_SMenuReinserted 65353 +#define Consts_SMenuNotFound 65354 +#define Consts_SNoTimers 65355 +#define Consts_SNotPrinting 65356 +#define Consts_SPrinting 65357 +#define Consts_SInvalidPrinter 65358 +#define Consts_SDeviceOnPort 65359 +#define Consts_SInvalidMetafile 65360 +#define Consts_SInvalidPixelFormat 65361 +#define Consts_SScanLine 65362 +#define Consts_SChangeIconSize 65363 +#define Consts_SUnknownExtension 65364 +#define Consts_SUnknownClipboardFormat 65365 +#define Consts_SOutOfResources 65366 +#define Consts_SNoCanvasHandle 65367 +#define Consts_SInvalidImageSize 65368 +#define Consts_SInvalidImageList 65369 +#define Consts_SReplaceImage 65370 +#define Consts_SImageIndexError 65371 +#define Consts_SImageReadFail 65372 +#define Consts_SImageWriteFail 65373 +#define Consts_SWindowDCError 65374 +#define Consts_SWindowClass 65375 +#define RTLConsts_STooManyDeleted 65376 +#define RTLConsts_SUnknownGroup 65377 +#define RTLConsts_SUnknownProperty 65378 +#define RTLConsts_SWriteError 65379 +#define RTLConsts_SThreadCreateError 65380 +#define RTLConsts_SThreadError 65381 +#define RTLConsts_sWindowsSocketError 65382 +#define RTLConsts_sAsyncSocketError 65383 +#define RTLConsts_sNoAddress 65384 +#define RTLConsts_sCannotCreateSocket 65385 +#define RTLConsts_sSocketAlreadyOpen 65386 +#define RTLConsts_sCantChangeWhileActive 65387 +#define Consts_SInvalidTabPosition 65388 +#define Consts_SInvalidTabStyle 65389 +#define Consts_SInvalidBitmap 65390 +#define Consts_SInvalidIcon 65391 +#define RTLConsts_SInvalidPropertyType 65392 +#define RTLConsts_SInvalidPropertyValue 65393 +#define RTLConsts_SInvalidRegType 65394 +#define RTLConsts_SListCapacityError 65395 +#define RTLConsts_SListCountError 65396 +#define RTLConsts_SListIndexError 65397 +#define RTLConsts_SMemoryStreamError 65398 +#define RTLConsts_SPropertyException 65399 +#define RTLConsts_SReadError 65400 +#define RTLConsts_SReadOnlyProperty 65401 +#define RTLConsts_SRegCreateFailed 65402 +#define RTLConsts_SRegGetDataFailed 65403 +#define RTLConsts_SRegSetDataFailed 65404 +#define RTLConsts_SResNotFound 65405 +#define RTLConsts_SSeekNotImplemented 65406 +#define RTLConsts_SSortedListError 65407 +#define RTLConsts_SDuplicateClass 65408 +#define RTLConsts_SDuplicateItem 65409 +#define RTLConsts_SDuplicateName 65410 +#define RTLConsts_SDuplicateString 65411 +#define RTLConsts_SFCreateErrorEx 65412 +#define RTLConsts_SFixedColTooBig 65413 +#define RTLConsts_SFixedRowTooBig 65414 +#define RTLConsts_SFOpenErrorEx 65415 +#define RTLConsts_SGridTooLarge 65416 +#define RTLConsts_SIndexOutOfRange 65417 +#define RTLConsts_SIniFileWriteError 65418 +#define RTLConsts_SInvalidImage 65419 +#define RTLConsts_SInvalidName 65420 +#define RTLConsts_SInvalidProperty 65421 +#define RTLConsts_SInvalidPropertyElement 65422 +#define RTLConsts_SInvalidPropertyPath 65423 +#define SysConst_SShortDayNameThu 65424 +#define SysConst_SShortDayNameFri 65425 +#define SysConst_SShortDayNameSat 65426 +#define SysConst_SLongDayNameSun 65427 +#define SysConst_SLongDayNameMon 65428 +#define SysConst_SLongDayNameTue 65429 +#define SysConst_SLongDayNameWed 65430 +#define SysConst_SLongDayNameThu 65431 +#define SysConst_SLongDayNameFri 65432 +#define SysConst_SLongDayNameSat 65433 +#define RTLConsts_SAncestorNotFound 65434 +#define RTLConsts_SAssignError 65435 +#define RTLConsts_SBitsIndexError 65436 +#define RTLConsts_SCantWriteResourceStreamError 65437 +#define RTLConsts_SCheckSynchronizeError 65438 +#define RTLConsts_SClassNotFound 65439 +#define SysConst_SLongMonthNameJan 65440 +#define SysConst_SLongMonthNameFeb 65441 +#define SysConst_SLongMonthNameMar 65442 +#define SysConst_SLongMonthNameApr 65443 +#define SysConst_SLongMonthNameMay 65444 +#define SysConst_SLongMonthNameJun 65445 +#define SysConst_SLongMonthNameJul 65446 +#define SysConst_SLongMonthNameAug 65447 +#define SysConst_SLongMonthNameSep 65448 +#define SysConst_SLongMonthNameOct 65449 +#define SysConst_SLongMonthNameNov 65450 +#define SysConst_SLongMonthNameDec 65451 +#define SysConst_SShortDayNameSun 65452 +#define SysConst_SShortDayNameMon 65453 +#define SysConst_SShortDayNameTue 65454 +#define SysConst_SShortDayNameWed 65455 +#define SysConst_SModuleAccessViolation 65456 +#define SysConst_SOSError 65457 +#define SysConst_SUnkOSError 65458 +#define SysConst_SNL 65459 +#define SysConst_SShortMonthNameJan 65460 +#define SysConst_SShortMonthNameFeb 65461 +#define SysConst_SShortMonthNameMar 65462 +#define SysConst_SShortMonthNameApr 65463 +#define SysConst_SShortMonthNameMay 65464 +#define SysConst_SShortMonthNameJun 65465 +#define SysConst_SShortMonthNameJul 65466 +#define SysConst_SShortMonthNameAug 65467 +#define SysConst_SShortMonthNameSep 65468 +#define SysConst_SShortMonthNameOct 65469 +#define SysConst_SShortMonthNameNov 65470 +#define SysConst_SShortMonthNameDec 65471 +#define SysConst_SVarTypeAlreadyUsedWithPrefix 65472 +#define SysConst_SVarTypeNotUsableWithPrefix 65473 +#define SysConst_SVarTypeTooManyCustom 65474 +#define SysConst_SVarTypeCouldNotConvert 65475 +#define SysConst_SVarTypeConvertOverflow 65476 +#define SysConst_SVarOverflow 65477 +#define SysConst_SVarInvalid 65478 +#define SysConst_SVarBadType 65479 +#define SysConst_SVarNotImplemented 65480 +#define SysConst_SVarUnexpected 65481 +#define SysConst_SExternalException 65482 +#define SysConst_SAssertionFailed 65483 +#define SysConst_SIntfCastError 65484 +#define SysConst_SSafecallException 65485 +#define SysConst_SAssertError 65486 +#define SysConst_SAbstractError 65487 +#define SysConst_SException 65488 +#define SysConst_SExceptTitle 65489 +#define SysConst_SInvalidFormat 65490 +#define SysConst_SArgumentMissing 65491 +#define SysConst_SDispatchError 65492 +#define SysConst_SReadAccess 65493 +#define SysConst_SWriteAccess 65494 +#define SysConst_SFormatTooLong 65495 +#define SysConst_SVarArrayCreate 65496 +#define SysConst_SVarArrayBounds 65497 +#define SysConst_SVarArrayLocked 65498 +#define SysConst_SInvalidVarCast 65499 +#define SysConst_SInvalidVarOp 65500 +#define SysConst_SInvalidVarNullOp 65501 +#define SysConst_SInvalidVarOpWithHResultWithPrefix 65502 +#define SysConst_SVarTypeOutOfRangeWithPrefix 65503 +#define SysConst_SInvalidInput 65504 +#define SysConst_SDivByZero 65505 +#define SysConst_SRangeError 65506 +#define SysConst_SIntOverflow 65507 +#define SysConst_SInvalidOp 65508 +#define SysConst_SZeroDivide 65509 +#define SysConst_SOverflow 65510 +#define SysConst_SUnderflow 65511 +#define SysConst_SInvalidPointer 65512 +#define SysConst_SInvalidCast 65513 +#define SysConst_SAccessViolationArg3 65514 +#define SysConst_SAccessViolationNoArg 65515 +#define SysConst_SStackOverflow 65516 +#define SysConst_SControlC 65517 +#define SysConst_SPrivilege 65518 +#define SysConst_SOperationAborted 65519 +#define SysConst_SInvalidInteger 65520 +#define SysConst_SInvalidFloat 65521 +#define SysConst_SInvalidDate 65522 +#define SysConst_SInvalidTime 65523 +#define SysConst_SInvalidDateTime 65524 +#define SysConst_SInvalidTimeStamp 65525 +#define SysConst_STimeEncodeError 65526 +#define SysConst_SDateEncodeError 65527 +#define SysConst_SOutOfMemory 65528 +#define SysConst_SInOutError 65529 +#define SysConst_SFileNotFound 65530 +#define SysConst_SInvalidFilename 65531 +#define SysConst_STooManyOpenFiles 65532 +#define SysConst_SAccessDenied 65533 +#define SysConst_SEndOfFile 65534 +#define SysConst_SDiskFull 65535 +STRINGTABLE +BEGIN + ADOConst_sNameAttr, "Name" + ADOConst_sValueAttr, "Value" + VDBConsts_SPropDefByLookup, "Property already defined by lookup field" + VDBConsts_STooManyColumns, "Grid requested to display more than 256 columns" + VDBConsts_SRemoteLogin, "Remote Login" + ADOConst_SInvalidEnumValue, "Invalid Enum Value" + ADOConst_SMissingConnection, "Missing Connection or ConnectionString" + ADOConst_SNoDetailFilter, "Filter property cannot be used for detail tables" + ADOConst_SBookmarksRequired, "Dataset does not support bookmarks, which are required for multi-record data controls" + ADOConst_SMissingCommandText, "Missing %s property" + ADOConst_SNoResultSet, "CommandText does not return a result set" + ADOConst_SADOCreateError, "Error creating object. Please verify that the Microsoft Data Access Components 2.1 (or later) have been properly installed" + ADOConst_SEventsNotSupported, "Events are not supported with server side TableDirect cursors" + ADOConst_SUsupportedFieldType, "Unsupported field type (%s) in field %s" + ADOConst_SConnectionRequired, "A connection component is required for async ExecuteOptions" + ADOConst_SCantRequery, "Cannot perform a requery after connection has changed" + ADOConst_SNoFilterOptions, "FilterOptions are not supported" + ADOConst_SRecordsetNotOpen, "Recordset is not open" + OleConst_SInvalidVerb, "Invalid object verb" + OleConst_SPropDlgCaption, "%s Properties" + OleConst_SInvalidStreamFormat, "Invalid stream format" + VDBConsts_SFirstRecord, "First record" + VDBConsts_SPriorRecord, "Prior record" + VDBConsts_SNextRecord, "Next record" + VDBConsts_SLastRecord, "Last record" + VDBConsts_SInsertRecord, "Insert record" + VDBConsts_SDeleteRecord, "Delete record" + VDBConsts_SEditRecord, "Edit record" + VDBConsts_SPostEdit, "Post edit" + VDBConsts_SCancelEdit, "Cancel edit" + VDBConsts_SRefreshRecord, "Refresh data" + VDBConsts_SDeleteRecordQuestion, "Delete record?" + VDBConsts_SDeleteMultipleRecordsQuestion, "Delete all selected records?" + VDBConsts_SDataSourceFixed, "Operation not allowed in a DBCtrlGrid" + TeeConst_TeeMsg_ShapeGallery2, "123" + TeeConst_TeeMsg_ValuesX, "X" + TeeConst_TeeMsg_ValuesY, "Y" + TeeConst_TeeMsg_ValuesPie, "Pie" + TeeConst_TeeMsg_ValuesBar, "Bar" + TeeConst_TeeMsg_ValuesAngle, "Angle" + TeeConst_TeeMsg_ValuesGanttStart, "Start" + TeeConst_TeeMsg_ValuesGanttEnd, "End" + TeeConst_TeeMsg_ValuesGanttNextTask, "NextTask" + TeeConst_TeeMsg_ValuesBubbleRadius, "Radius" + TeeConst_TeeMsg_ValuesArrowEndX, "EndX" + TeeConst_TeeMsg_ValuesArrowEndY, "EndY" + OleConst_SLinkProperties, "Link Properties" + OleConst_SInvalidLinkSource, "Cannot link to an invalid source." + OleConst_SCannotBreakLink, "Break link operation is not supported." + OleConst_SEmptyContainer, "Operation not allowed on an empty OLE container" + TeeConst_TeeMsg_DefaultFontSize, "8" + TeeConst_TeeMsg_DefaultGalleryFontSize, "8" + TeeConst_TeeMsg_FunctionAdd, "Add" + TeeConst_TeeMsg_FunctionSubtract, "Subtract" + TeeConst_TeeMsg_FunctionMultiply, "Multiply" + TeeConst_TeeMsg_FunctionDivide, "Divide" + TeeConst_TeeMsg_FunctionHigh, "High" + TeeConst_TeeMsg_FunctionLow, "Low" + TeeConst_TeeMsg_FunctionAverage, "Average" + TeeConst_TeeMsg_GalleryShape, "Shape" + TeeConst_TeeMsg_GalleryBubble, "Bubble" + TeeConst_TeeMsg_DefaultFontName, "Arial" + TeeConst_TeeMsg_CheckPointerSize, "Pointer size must be greater than zero" + TeeConst_TeeMsg_FunctionPeriod, "Function Period should be >= 0" + TeeConst_TeeMsg_PieOther, "Other" + TeeConst_TeeMsg_ShapeGallery1, "abc" + TeeConst_TeeMsg_PieSample8, "Chairs" + TeeConst_TeeMsg_GalleryChartName, "TeeGalleryChart" + TeeConst_TeeMsg_GalleryStandard, "Standard" + TeeConst_TeeMsg_GalleryFunctions, "Functions" + TeeConst_TeeMsg_GalleryArrow, "Arrow" + TeeConst_TeeMsg_GalleryGantt, "Gantt" + TeeConst_TeeMsg_GanttSample1, "Design" + TeeConst_TeeMsg_GanttSample2, "Prototyping" + TeeConst_TeeMsg_GanttSample3, "Development" + TeeConst_TeeMsg_GanttSample4, "Sales" + TeeConst_TeeMsg_GanttSample5, "Marketing" + TeeConst_TeeMsg_GanttSample6, "Testing" + TeeConst_TeeMsg_GanttSample7, "Manufac." + TeeConst_TeeMsg_GanttSample8, "Debugging" + TeeConst_TeeMsg_GanttSample9, "New Version" + TeeConst_TeeMsg_GanttSample10, "Banking" + TeeConst_TeeMsg_AxisLabels, "Axis Labels" + TeeConst_TeeMsg_GalleryLine, "Line" + TeeConst_TeeMsg_GalleryPoint, "Point" + TeeConst_TeeMsg_GalleryArea, "Area" + TeeConst_TeeMsg_GalleryBar, "Bar" + TeeConst_TeeMsg_GalleryHorizBar, "Horiz. Bar" + TeeConst_TeeMsg_GalleryPie, "Pie" + TeeConst_TeeMsg_GalleryFastLine, "Fast Line" + TeeConst_TeeMsg_Rotation, "Rotation" + TeeConst_TeeMsg_PieSample1, "Cars" + TeeConst_TeeMsg_PieSample2, "Phones" + TeeConst_TeeMsg_PieSample3, "Tables" + TeeConst_TeeMsg_PieSample4, "Monitors" + TeeConst_TeeMsg_PieSample5, "Lamps" + TeeConst_TeeMsg_PieSample6, "Keyboards" + TeeConst_TeeMsg_PieSample7, "Bikes" + TeeConst_TeeMsg_AxisLogDateTime, "DateTime Axis cannot be Logarithmic" + TeeConst_TeeMsg_AxisLogNotPositive, "Logarithmic Axis Min and Max values should be >= 0" + TeeConst_TeeMsg_AxisLabelSep, "Labels Separation % must be greater than 0" + TeeConst_TeeMsg_AxisIncrementNeg, "Axis increment must be >= 0" + TeeConst_TeeMsg_AxisMinMax, "Axis Minimum Value must be <= Maximum" + TeeConst_TeeMsg_AxisMaxMin, "Axis Maximum Value must be >= Minimum" + TeeConst_TeeMsg_AxisLogBase, "Axis Logarithmic Base should be >= 2" + TeeConst_TeeMsg_MaxPointsPerPage, "MaxPointsPerPage must be >= 0" + TeeConst_TeeMsg_3dPercent, "3D effect percent must be between %d and %d" + TeeConst_TeeMsg_CircularSeries, "Circular Series dependences are not allowed" + TeeConst_TeeMsg_BarWidthPercent, "Bar Width Percent must be between 1 and 100" + TeeConst_TeeMsg_BarOffsetPercent, "Bar Offset Percent must be between -100% and 100%" + TeeConst_TeeMsg_DefaultPercentOf, "%s of %s" + TeeConst_TeeMsg_DefPercentFormat, "##0.## %" + TeeConst_TeeMsg_DefValueFormat, "#,##0.###" + TeeConst_TeeMsg_AxisTitle, "Axis Title" + DBConsts_SCouldNotParseTimeStamp, "Could not parse SQL TimeStamp string" + DBConsts_SInvalidSqlTimeStamp, "Invalid SQL date/time values" + ComConst_SOleError, "OLE error %.8x" + ComConst_SNoMethod, "Method '%s' not supported by automation object" + ComConst_SVarNotObject, "Variant does not reference an automation object" + ComConst_STooManyParams, "Dispatch methods do not support more than 64 parameters" + JConsts_sChangeJPGSize, "Cannot change the size of a JPEG image" + JConsts_sJPEGError, "JPEG error #%d" + JConsts_sJPEGImageFile, "JPEG Image File" + TeeConst_TeeMsg_LegendTopPos, "Top Legend Position must be between 0 and 100 %" + TeeConst_TeeMsg_LegendFirstValue, "First Legend Value must be > 0" + TeeConst_TeeMsg_LegendColorWidth, "Legend Color Width must be between 0 and 100 %" + TeeConst_TeeMsg_SeriesSetDataSource, "No ParentChart to validate DataSource" + TeeConst_TeeMsg_SeriesInvDataSource, "No valid DataSource: %s" + TeeConst_TeeMsg_FillSample, "FillSampleValues NumValues must be > 0" + TeeConst_TeeMsg_Angle, "%s Angle must be between 0 and 359 degrees" + DBConsts_SDataSetEmpty, "Cannot perform this operation on an empty dataset" + DBConsts_SDataSetReadOnly, "Cannot modify a read-only dataset" + DBConsts_SNestedDataSetClass, "Nested dataset must inherit from %s" + DBConsts_STextFalse, "False" + DBConsts_STextTrue, "True" + DBConsts_SParameterNotFound, "Parameter '%s' not found" + DBConsts_SInvalidVersion, "Unable to load bind parameters" + DBConsts_SBadFieldType, "Field '%s' is of an unsupported type" + DBConsts_SProviderSQLNotSupported, "SQL not supported: %s" + DBConsts_SProviderExecuteNotSupported, "Execute not supported: %s" + DBConsts_SDataSetUnidirectional, "Operation not allowed on a unidirectional dataset" + DBConsts_SUnassignedVar, "Unassigned variant value" + DBConsts_SRecordNotFound, "Record not found" + DBConsts_SBcdOverflow, "BCD overflow" + DBConsts_SInvalidBcdValue, "%s is not a valid BCD value" + DBConsts_SInvalidFormatType, "Invalid format type for BCD" + DBConsts_SFieldTypeMismatch, "Type mismatch for field '%s', expecting: %s actual: %s" + DBConsts_SFieldSizeMismatch, "Size mismatch for field '%s', expecting: %d actual: %d" + DBConsts_SInvalidVarByteArray, "Invalid variant type or size for field '%s'" + DBConsts_SFieldOutOfRange, "Value of field '%s' is out of range" + DBConsts_SFieldRequired, "Field '%s' must have a value" + DBConsts_SDataSetMissing, "Field '%s' has no dataset" + DBConsts_SInvalidCalcType, "Field '%s' cannot be a calculated or lookup field" + DBConsts_SFieldReadOnly, "Field '%s' cannot be modified" + DBConsts_SNoIndexForFields, "No index for fields '%s'" + DBConsts_SIndexNotFound, "Index '%s' not found" + DBConsts_SCircularDataLink, "Circular datalinks are not allowed" + DBConsts_SLookupInfoError, "Lookup information for field '%s' is incomplete" + DBConsts_SDataSourceChange, "DataSource cannot be changed" + DBConsts_SDataSetOpen, "Cannot perform this operation on an open dataset" + DBConsts_SNotEditing, "Dataset not in edit or insert mode" + DBConsts_SDataSetClosed, "Cannot perform this operation on a closed dataset" + ComStrs_sFailSetCalMinMaxRange, "Failed to set calendar min/max range" + ComStrs_sFailsetCalSelRange, "Failed to set calendar selected range" + WinHelpViewer_hNoKeyword, "No help keyword specified." + DBConsts_SInvalidFieldSize, "Invalid field size" + DBConsts_SInvalidFieldKind, "Invalid FieldKind" + DBConsts_SUnknownFieldType, "Field '%s' is of an unknown type" + DBConsts_SFieldNameMissing, "Field name missing" + DBConsts_SDuplicateFieldName, "Duplicate field name '%s'" + DBConsts_SFieldNotFound, "Field '%s' not found" + DBConsts_SFieldAccessError, "Cannot access field '%s' as type %s" + DBConsts_SFieldValueError, "Invalid value for field '%s'" + DBConsts_SFieldRangeError, "%g is not a valid value for field '%s'. The allowed range is %g to %g" + DBConsts_SBcdFieldRangeError, "%s is not a valid value for field '%s'. The allowed range is %s to %s" + DBConsts_SInvalidIntegerValue, "'%s' is not a valid integer value for field '%s'" + DBConsts_SInvalidBoolValue, "'%s' is not a valid boolean value for field '%s'" + DBConsts_SInvalidFloatValue, "'%s' is not a valid floating point value for field '%s'" + ComStrs_sTabFailSetObject, "Failed to set object at index %d" + ComStrs_sTabMustBeMultiLine, "MultiLine must be True when TabPosition is tpLeft or tpRight" + ComStrs_sInvalidIndex, "Invalid index" + ComStrs_sInsertError, "Unable to insert an item" + ComStrs_sInvalidOwner, "Invalid owner" + ComStrs_sRichEditInsertError, "RichEdit line insertion error" + ComStrs_sRichEditLoadFail, "Failed to Load Stream" + ComStrs_sRichEditSaveFail, "Failed to Save Stream" + ComStrs_sUDAssociated, "%s is already associated with %s" + ComStrs_sPageIndexError, "%d is an invalid PageIndex value. PageIndex must be between 0 and %d" + ComStrs_sInvalidComCtl32, "This control requires version 4.70 or greater of COMCTL32.DLL" + ComStrs_sDateTimeMax, "Date exceeds maximum of %s" + ComStrs_sDateTimeMin, "Date is less than minimum of %s" + ComStrs_sNeedAllowNone, "You must be in ShowCheckbox mode to set to this date" + ComStrs_sFailSetCalDateTime, "Failed to set calendar date or time" + ComStrs_sFailSetCalMaxSelRange, "Failed to set maximum selection range" + ExtCtrls_clNameInfoBk, "Info Background" + ExtCtrls_clNameInfoText, "Info Text" + ExtCtrls_clNameMenu, "Menu Background" + ExtCtrls_clNameMenuText, "Menu Text" + ExtCtrls_clNameNone, "None" + ExtCtrls_clNameScrollBar, "Scroll Bar" + ExtCtrls_clName3DDkShadow, "3D Dark Shadow" + ExtCtrls_clName3DLight, "3D Light" + ExtCtrls_clNameWindow, "Window Background" + ExtCtrls_clNameWindowFrame, "Window Frame" + ExtCtrls_clNameWindowText, "Window Text" + ComStrs_sTabFailClear, "Failed to clear tab control" + ComStrs_sTabFailDelete, "Failed to delete tab at index %d" + ComStrs_sTabFailRetrieve, "Failed to retrieve tab at index %d" + ComStrs_sTabFailGetObject, "Failed to get object at index %d" + ComStrs_sTabFailSet, "Failed to set tab \"%s\" at index %d" + ExtCtrls_clNameActiveBorder, "Active Border" + ExtCtrls_clNameActiveCaption, "Active Caption" + ExtCtrls_clNameAppWorkSpace, "Application Workspace" + ExtCtrls_clNameBackground, "Background" + ExtCtrls_clNameBtnFace, "Button Face" + ExtCtrls_clNameBtnHighlight, "Button Highlight" + ExtCtrls_clNameBtnShadow, "Button Shadow" + ExtCtrls_clNameBtnText, "Button Text" + ExtCtrls_clNameCaptionText, "Caption Text" + ExtCtrls_clNameDefault, "Default" + ExtCtrls_clNameGrayText, "Gray Text" + ExtCtrls_clNameHighlight, "Highlight Background" + ExtCtrls_clNameHighlightText, "Highlight Text" + ExtCtrls_clNameInactiveBorder, "Inactive Border" + ExtCtrls_clNameInactiveCaption, "Inactive Caption" + ExtCtrls_clNameInactiveCaptionText, "Inactive Caption Text" + ExtCtrls_clNameNavy, "Navy" + ExtCtrls_clNamePurple, "Purple" + ExtCtrls_clNameTeal, "Teal" + ExtCtrls_clNameGray, "Gray" + ExtCtrls_clNameSilver, "Silver" + ExtCtrls_clNameRed, "Red" + ExtCtrls_clNameLime, "Lime" + ExtCtrls_clNameYellow, "Yellow" + ExtCtrls_clNameBlue, "Blue" + ExtCtrls_clNameFuchsia, "Fuchsia" + ExtCtrls_clNameAqua, "Aqua" + ExtCtrls_clNameWhite, "White" + ExtCtrls_clNameMoneyGreen, "Money Green" + ExtCtrls_clNameSkyBlue, "Sky Blue" + ExtCtrls_clNameCream, "Cream" + ExtCtrls_clNameMedGray, "Medium Gray" + Consts_SDockTreeRemoveError, "Error removing control from dock tree" + Consts_SDockZoneNotFound, " - Dock zone not found" + Consts_SDockZoneHasNoCtl, " - Dock zone has no control" + Consts_SMultiSelectRequired, "Multiselect mode must be on for this feature" + Consts_SSeparator, "Separator" + Consts_SErrorSettingCount, "Error setting %s.Count" + Consts_SListBoxMustBeVirtual, "Listbox (%s) style must be virtual in order to set Count" + Consts_SNoGetItemEventHandler, "No OnGetItem event handler assigned" + HelpIntfs_hNoTableOfContents, "Unable to find a Table of Contents" + HelpIntfs_hNothingFound, "No help found for %s" + HelpIntfs_hNoContext, "No context-sensitive help installed" + HelpIntfs_hNoTopics, "No topic-based help system installed" + ExtCtrls_clNameBlack, "Black" + ExtCtrls_clNameMaroon, "Maroon" + ExtCtrls_clNameGreen, "Green" + ExtCtrls_clNameOlive, "Olive" + Consts_SmkcIns, "Ins" + Consts_SmkcDel, "Del" + Consts_SmkcShift, "Shift+" + Consts_SmkcCtrl, "Ctrl+" + Consts_SmkcAlt, "Alt+" + Consts_srNone, "(None)" + Consts_SOutOfRange, "Value must be between %d and %d" + Consts_SInsertLineError, "Unable to insert a line" + Consts_SInvalidClipFmt, "Invalid clipboard format" + Consts_SIconToClipboard, "Clipboard does not support Icons" + Consts_SCannotOpenClipboard, "Cannot open clipboard" + Consts_SInvalidMemoSize, "Text exceeds memo capacity" + Consts_SInvalidPrinterOp, "Operation not supported on selected printer" + Consts_SNoDefaultPrinter, "There is no default printer currently selected" + Consts_SDuplicateMenus, "Menu '%s' is already being used by another form" + Consts_SDockedCtlNeedsName, "Docked control must have a name" + Consts_SMsgDlgAll, "&All" + Consts_SMsgDlgNoToAll, "N&o to All" + Consts_SMsgDlgYesToAll, "Yes to &All" + Consts_SmkcBkSp, "BkSp" + Consts_SmkcTab, "Tab" + Consts_SmkcEsc, "Esc" + Consts_SmkcEnter, "Enter" + Consts_SmkcSpace, "Space" + Consts_SmkcPgUp, "PgUp" + Consts_SmkcPgDn, "PgDn" + Consts_SmkcEnd, "End" + Consts_SmkcHome, "Home" + Consts_SmkcLeft, "Left" + Consts_SmkcUp, "Up" + Consts_SmkcRight, "Right" + Consts_SmkcDown, "Down" + Consts_SVIcons, "Icons" + Consts_SVBitmaps, "Bitmaps" + Consts_SMaskErr, "Invalid input value" + Consts_SMaskEditErr, "Invalid input value. Use escape key to abandon changes" + Consts_SMsgDlgWarning, "Warning" + Consts_SMsgDlgError, "Error" + Consts_SMsgDlgInformation, "Information" + Consts_SMsgDlgConfirm, "Confirm" + Consts_SMsgDlgYes, "&Yes" + Consts_SMsgDlgNo, "&No" + Consts_SMsgDlgOK, "OK" + Consts_SMsgDlgCancel, "Cancel" + Consts_SMsgDlgHelp, "&Help" + Consts_SMsgDlgAbort, "&Abort" + Consts_SMsgDlgRetry, "&Retry" + Consts_SMsgDlgIgnore, "&Ignore" + Consts_SGroupIndexTooLow, "GroupIndex cannot be less than a previous menu item's GroupIndex" + Consts_SNoMDIForm, "Cannot create form. No MDI forms are currently active" + Consts_SControlParentSetToSelf, "A control cannot have itself as its parent" + Consts_SOKButton, "OK" + Consts_SCancelButton, "Cancel" + Consts_SYesButton, "&Yes" + Consts_SNoButton, "&No" + Consts_SHelpButton, "&Help" + Consts_SCloseButton, "&Close" + Consts_SIgnoreButton, "&Ignore" + Consts_SRetryButton, "&Retry" + Consts_SAbortButton, "Abort" + Consts_SAllButton, "&All" + Consts_SCannotDragForm, "Cannot drag a form" + Consts_SVMetafiles, "Metafiles" + Consts_SVEnhMetafiles, "Enhanced Metafiles" + Consts_SCannotFocus, "Cannot focus a disabled or invisible window" + Consts_SParentRequired, "Control '%s' has no parent window" + Consts_SParentGivenNotAParent, "Parent given is not a parent of '%s'" + Consts_SMDIChildNotVisible, "Cannot hide an MDI Child Form" + Consts_SVisibleChanged, "Cannot change Visible in OnShow or OnHide" + Consts_SCannotShowModal, "Cannot make a visible window modal" + Consts_SScrollBarRange, "Scrollbar property out of range" + Consts_SPropertyOutOfRange, "%s property out of range" + Consts_SMenuIndexError, "Menu index out of range" + Consts_SMenuReinserted, "Menu inserted twice" + Consts_SMenuNotFound, "Sub-menu is not in menu" + Consts_SNoTimers, "Not enough timers available" + Consts_SNotPrinting, "Printer is not currently printing" + Consts_SPrinting, "Printing in progress" + Consts_SInvalidPrinter, "Printer selected is not valid" + Consts_SDeviceOnPort, "%s on %s" + Consts_SInvalidMetafile, "Metafile is not valid" + Consts_SInvalidPixelFormat, "Invalid pixel format" + Consts_SScanLine, "Scan line index out of range" + Consts_SChangeIconSize, "Cannot change the size of an icon" + Consts_SUnknownExtension, "Unknown picture file extension (.%s)" + Consts_SUnknownClipboardFormat, "Unsupported clipboard format" + Consts_SOutOfResources, "Out of system resources" + Consts_SNoCanvasHandle, "Canvas does not allow drawing" + Consts_SInvalidImageSize, "Invalid image size" + Consts_SInvalidImageList, "Invalid ImageList" + Consts_SReplaceImage, "Unable to Replace Image" + Consts_SImageIndexError, "Invalid ImageList Index" + Consts_SImageReadFail, "Failed to read ImageList data from stream" + Consts_SImageWriteFail, "Failed to write ImageList data to stream" + Consts_SWindowDCError, "Error creating window device context" + Consts_SWindowClass, "Error creating window class" + RTLConsts_STooManyDeleted, "Too many rows or columns deleted" + RTLConsts_SUnknownGroup, "%s not in a class registration group" + RTLConsts_SUnknownProperty, "Property %s does not exist" + RTLConsts_SWriteError, "Stream write error" + RTLConsts_SThreadCreateError, "Thread creation error: %s" + RTLConsts_SThreadError, "Thread Error: %s (%d)" + RTLConsts_sWindowsSocketError, "Windows socket error: %s (%d), on API '%s'" + RTLConsts_sAsyncSocketError, "Asynchronous socket error %d" + RTLConsts_sNoAddress, "No address specified" + RTLConsts_sCannotCreateSocket, "Can't create new socket" + RTLConsts_sSocketAlreadyOpen, "Socket already open" + RTLConsts_sCantChangeWhileActive, "Can't change value while socket is active" + Consts_SInvalidTabPosition, "Tab position incompatible with current tab style" + Consts_SInvalidTabStyle, "Tab style incompatible with current tab position" + Consts_SInvalidBitmap, "Bitmap image is not valid" + Consts_SInvalidIcon, "Icon image is not valid" + RTLConsts_SInvalidPropertyType, "Invalid property type: %s" + RTLConsts_SInvalidPropertyValue, "Invalid property value" + RTLConsts_SInvalidRegType, "Invalid data type for '%s'" + RTLConsts_SListCapacityError, "List capacity out of bounds (%d)" + RTLConsts_SListCountError, "List count out of bounds (%d)" + RTLConsts_SListIndexError, "List index out of bounds (%d)" + RTLConsts_SMemoryStreamError, "Out of memory while expanding memory stream" + RTLConsts_SPropertyException, "Error reading %s%s%s: %s" + RTLConsts_SReadError, "Stream read error" + RTLConsts_SReadOnlyProperty, "Property is read-only" + RTLConsts_SRegCreateFailed, "Failed to create key %s" + RTLConsts_SRegGetDataFailed, "Failed to get data for '%s'" + RTLConsts_SRegSetDataFailed, "Failed to set data for '%s'" + RTLConsts_SResNotFound, "Resource %s not found" + RTLConsts_SSeekNotImplemented, "%s.Seek not implemented" + RTLConsts_SSortedListError, "Operation not allowed on sorted list" + RTLConsts_SDuplicateClass, "A class named %s already exists" + RTLConsts_SDuplicateItem, "List does not allow duplicates ($0%x)" + RTLConsts_SDuplicateName, "A component named %s already exists" + RTLConsts_SDuplicateString, "String list does not allow duplicates" + RTLConsts_SFCreateErrorEx, "Cannot create file \"%s\". %s" + RTLConsts_SFixedColTooBig, "Fixed column count must be less than column count" + RTLConsts_SFixedRowTooBig, "Fixed row count must be less than row count" + RTLConsts_SFOpenErrorEx, "Cannot open file \"%s\". %s" + RTLConsts_SGridTooLarge, "Grid too large for operation" + RTLConsts_SIndexOutOfRange, "Grid index out of range" + RTLConsts_SIniFileWriteError, "Unable to write to %s" + RTLConsts_SInvalidImage, "Invalid stream format" + RTLConsts_SInvalidName, "''%s'' is not a valid component name" + RTLConsts_SInvalidProperty, "Invalid property value" + RTLConsts_SInvalidPropertyElement, "Invalid property element: %s" + RTLConsts_SInvalidPropertyPath, "Invalid property path" + SysConst_SShortDayNameThu, "Thu" + SysConst_SShortDayNameFri, "Fri" + SysConst_SShortDayNameSat, "Sat" + SysConst_SLongDayNameSun, "Sunday" + SysConst_SLongDayNameMon, "Monday" + SysConst_SLongDayNameTue, "Tuesday" + SysConst_SLongDayNameWed, "Wednesday" + SysConst_SLongDayNameThu, "Thursday" + SysConst_SLongDayNameFri, "Friday" + SysConst_SLongDayNameSat, "Saturday" + RTLConsts_SAncestorNotFound, "Ancestor for '%s' not found" + RTLConsts_SAssignError, "Cannot assign a %s to a %s" + RTLConsts_SBitsIndexError, "Bits index out of range" + RTLConsts_SCantWriteResourceStreamError, "Can't write to a read-only resource stream" + RTLConsts_SCheckSynchronizeError, "CheckSynchronize called from thread $%x, which is NOT the main thread" + RTLConsts_SClassNotFound, "Class %s not found" + SysConst_SLongMonthNameJan, "January" + SysConst_SLongMonthNameFeb, "February" + SysConst_SLongMonthNameMar, "March" + SysConst_SLongMonthNameApr, "April" + SysConst_SLongMonthNameMay, "May" + SysConst_SLongMonthNameJun, "June" + SysConst_SLongMonthNameJul, "July" + SysConst_SLongMonthNameAug, "August" + SysConst_SLongMonthNameSep, "September" + SysConst_SLongMonthNameOct, "October" + SysConst_SLongMonthNameNov, "November" + SysConst_SLongMonthNameDec, "December" + SysConst_SShortDayNameSun, "Sun" + SysConst_SShortDayNameMon, "Mon" + SysConst_SShortDayNameTue, "Tue" + SysConst_SShortDayNameWed, "Wed" + SysConst_SModuleAccessViolation, "Access violation at address %p in module '%s'. %s of address %p" + SysConst_SOSError, "System Error. Code: %d.\r\n%s" + SysConst_SUnkOSError, "A call to an OS function failed" + SysConst_SNL, "Application is not licensed to use this feature" + SysConst_SShortMonthNameJan, "Jan" + SysConst_SShortMonthNameFeb, "Feb" + SysConst_SShortMonthNameMar, "Mar" + SysConst_SShortMonthNameApr, "Apr" + SysConst_SShortMonthNameMay, "May" + SysConst_SShortMonthNameJun, "Jun" + SysConst_SShortMonthNameJul, "Jul" + SysConst_SShortMonthNameAug, "Aug" + SysConst_SShortMonthNameSep, "Sep" + SysConst_SShortMonthNameOct, "Oct" + SysConst_SShortMonthNameNov, "Nov" + SysConst_SShortMonthNameDec, "Dec" + SysConst_SVarTypeAlreadyUsedWithPrefix, "Custom variant type (%s%.4x) already used by %s" + SysConst_SVarTypeNotUsableWithPrefix, "Custom variant type (%s%.4x) is not usable" + SysConst_SVarTypeTooManyCustom, "Too many custom variant types have been registered" + SysConst_SVarTypeCouldNotConvert, "Could not convert variant of type (%s) into type (%s)" + SysConst_SVarTypeConvertOverflow, "Overflow while converting variant of type (%s) into type (%s)" + SysConst_SVarOverflow, "Variant overflow" + SysConst_SVarInvalid, "Invalid argument" + SysConst_SVarBadType, "Invalid variant type" + SysConst_SVarNotImplemented, "Operation not supported" + SysConst_SVarUnexpected, "Unexpected variant error" + SysConst_SExternalException, "External exception %x" + SysConst_SAssertionFailed, "Assertion failed" + SysConst_SIntfCastError, "Interface not supported" + SysConst_SSafecallException, "Exception in safecall method" + SysConst_SAssertError, "%s (%s, line %d)" + SysConst_SAbstractError, "Abstract Error" + SysConst_SException, "Exception %s in module %s at %p.\r\n%s%s\r\n" + SysConst_SExceptTitle, "Application Error" + SysConst_SInvalidFormat, "Format '%s' invalid or incompatible with argument" + SysConst_SArgumentMissing, "No argument for format '%s'" + SysConst_SDispatchError, "Variant method calls not supported" + SysConst_SReadAccess, "Read" + SysConst_SWriteAccess, "Write" + SysConst_SFormatTooLong, "Format string too long" + SysConst_SVarArrayCreate, "Error creating variant or safe array" + SysConst_SVarArrayBounds, "Variant or safe array index out of bounds" + SysConst_SVarArrayLocked, "Variant or safe array is locked" + SysConst_SInvalidVarCast, "Invalid variant type conversion" + SysConst_SInvalidVarOp, "Invalid variant operation" + SysConst_SInvalidVarNullOp, "Invalid NULL variant operation" + SysConst_SInvalidVarOpWithHResultWithPrefix, "Invalid variant operation (%s%.8x)\n%s" + SysConst_SVarTypeOutOfRangeWithPrefix, "Custom variant type (%s%.4x) is out of range" + SysConst_SInvalidInput, "Invalid numeric input" + SysConst_SDivByZero, "Division by zero" + SysConst_SRangeError, "Range check error" + SysConst_SIntOverflow, "Integer overflow" + SysConst_SInvalidOp, "Invalid floating point operation" + SysConst_SZeroDivide, "Floating point division by zero" + SysConst_SOverflow, "Floating point overflow" + SysConst_SUnderflow, "Floating point underflow" + SysConst_SInvalidPointer, "Invalid pointer operation" + SysConst_SInvalidCast, "Invalid class typecast" + SysConst_SAccessViolationArg3, "Access violation at address %p. %s of address %p" + SysConst_SAccessViolationNoArg, "Access violation" + SysConst_SStackOverflow, "Stack overflow" + SysConst_SControlC, "Control-C hit" + SysConst_SPrivilege, "Privileged instruction" + SysConst_SOperationAborted, "Operation aborted" + SysConst_SInvalidInteger, "'%s' is not a valid integer value" + SysConst_SInvalidFloat, "'%s' is not a valid floating point value" + SysConst_SInvalidDate, "'%s' is not a valid date" + SysConst_SInvalidTime, "'%s' is not a valid time" + SysConst_SInvalidDateTime, "'%s' is not a valid date and time" + SysConst_SInvalidTimeStamp, "'%d.%d' is not a valid timestamp" + SysConst_STimeEncodeError, "Invalid argument to time encode" + SysConst_SDateEncodeError, "Invalid argument to date encode" + SysConst_SOutOfMemory, "Out of memory" + SysConst_SInOutError, "I/O error %d" + SysConst_SFileNotFound, "File not found" + SysConst_SInvalidFilename, "Invalid filename" + SysConst_STooManyOpenFiles, "Too many open files" + SysConst_SAccessDenied, "File access denied" + SysConst_SEndOfFile, "Read beyond end of file" + SysConst_SDiskFull, "Disk full" +END + diff --git a/official/3.23/Demos/Main/FRDemo.res b/official/3.23/Demos/Main/FRDemo.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/3.23/Demos/Main/FRDemo.res differ diff --git a/official/3.23/Demos/Main/Frdemo.exe.manifest_ b/official/3.23/Demos/Main/Frdemo.exe.manifest_ new file mode 100644 index 0000000..67d6287 --- /dev/null +++ b/official/3.23/Demos/Main/Frdemo.exe.manifest_ @@ -0,0 +1,22 @@ + + + + Your application description here. + + + + + + \ No newline at end of file diff --git a/official/3.23/Demos/Main/Unit1.dcu b/official/3.23/Demos/Main/Unit1.dcu new file mode 100644 index 0000000..71b55b0 Binary files /dev/null and b/official/3.23/Demos/Main/Unit1.dcu differ diff --git a/official/3.23/Demos/Main/Unit1.dfm b/official/3.23/Demos/Main/Unit1.dfm new file mode 100644 index 0000000..c006c98 --- /dev/null +++ b/official/3.23/Demos/Main/Unit1.dfm @@ -0,0 +1,682 @@ +object Form1: TForm1 + Left = 305 + Top = 145 + ActiveControl = Tree + BorderStyle = bsDialog + Caption = 'FastReport 3.0 Demo' + ClientHeight = 339 + ClientWidth = 431 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Image1: TImage + Left = 204 + Top = 12 + Width = 62 + Height = 62 + AutoSize = True + Picture.Data = { + 07544269746D6170B6130000424DB61300000000000036040000280000003E00 + 00003E0000000100080000000000800F00000000000000000000000100000001 + 000000000000000080000080000000808000800000008000800080800000C0C0 + C000C0DCC000F0CAA6000020400000206000002080000020A0000020C0000020 + E00000400000004020000040400000406000004080000040A0000040C0000040 + E00000600000006020000060400000606000006080000060A0000060C0000060 + E00000800000008020000080400000806000008080000080A0000080C0000080 + E00000A0000000A0200000A0400000A0600000A0800000A0A00000A0C00000A0 + E00000C0000000C0200000C0400000C0600000C0800000C0A00000C0C00000C0 + E00000E0000000E0200000E0400000E0600000E0800000E0A00000E0C00000E0 + E00040000000400020004000400040006000400080004000A0004000C0004000 + E00040200000402020004020400040206000402080004020A0004020C0004020 + E00040400000404020004040400040406000404080004040A0004040C0004040 + E00040600000406020004060400040606000406080004060A0004060C0004060 + E00040800000408020004080400040806000408080004080A0004080C0004080 + E00040A0000040A0200040A0400040A0600040A0800040A0A00040A0C00040A0 + E00040C0000040C0200040C0400040C0600040C0800040C0A00040C0C00040C0 + E00040E0000040E0200040E0400040E0600040E0800040E0A00040E0C00040E0 + E00080000000800020008000400080006000800080008000A0008000C0008000 + E00080200000802020008020400080206000802080008020A0008020C0008020 + E00080400000804020008040400080406000804080008040A0008040C0008040 + E00080600000806020008060400080606000806080008060A0008060C0008060 + E00080800000808020008080400080806000808080008080A0008080C0008080 + E00080A0000080A0200080A0400080A0600080A0800080A0A00080A0C00080A0 + E00080C0000080C0200080C0400080C0600080C0800080C0A00080C0C00080C0 + E00080E0000080E0200080E0400080E0600080E0800080E0A00080E0C00080E0 + E000C0000000C0002000C0004000C0006000C0008000C000A000C000C000C000 + E000C0200000C0202000C0204000C0206000C0208000C020A000C020C000C020 + E000C0400000C0402000C0404000C0406000C0408000C040A000C040C000C040 + E000C0600000C0602000C0604000C0606000C0608000C060A000C060C000C060 + E000C0800000C0802000C0804000C0806000C0808000C080A000C080C000C080 + E000C0A00000C0A02000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0 + E000C0C00000C0C02000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0 + A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF + FF00FF0707070707070707070707070707070707070707070707070707070707 + 07070707070707070707070707070707070707070707070707070707070707FF + 000007E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E007 + 000007E0A4070707070707070707070707070707070707070707070707070707 + 0707070707070707070707070707070707070707070707070707070707A4E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFF07A4A4A4A40707FFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFF07E0E0E0E0E0E0E0E0A407FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFF07E0E0E0E0E0E0E0E0E0E0E0FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFF07E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFF07E0E0E0E0E0E0E0E0E0E0E0E0E0E0FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFA4A4A4A4A4A407FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFA4E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFF00000000000000000000A4FFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFA40000000000000000000000FFFFFFFFFFFFFFFF + FFFFFFFFFFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFF0700000000000000000000000000FFFFFFFFFFFFFF + FFFFFFFFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFFFFFFFFFFF + FFFFFFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFFFFFFFFFFF + FFFFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFFFFFFFFFFF + FFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFFFFFFFFFFF + FFE0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFFF07070707 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFF07E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0A407FFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A407FFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFF07E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0FFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000A4FFFF07070707 + 0707070707E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000A4A4A4A4A4A4 + A4A4A4A407FFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 000000000000FFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 00000000000000FFFFE0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 0000000000000000FF07E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 0000000000000000FF07E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 0000000000000000FF07E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 0000000000000000FF07E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 000000000000A4FFFFE0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000000000000000000 + 00000000A407FFFFA4E0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000A407FFFFFFFFFF + FFFFFFFFFFA4A4E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA40000000000000000000000000007FFFFE0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FFFFE0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E007FFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A4FFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000FF07E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0A407FFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000A4FFFFA4E0E0E0 + E0E0E0E0E0E0E0A4A4A4A4070707FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFA400000000000000000000000000000007FFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFF0000000000000000000000000000000000A4A4A4 + A4A4A4A4A4A4A4A4A4A4A4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFF0000000000000000000000000000000000000000 + 0000000000000000000000A4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFA400000000000000000000000000000000000000 + 00000000000000000000000007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFF00000000000000000000000000000000000000 + 000000000000000000000000A4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFF07000000000000000000000000000000000000 + 000000000000000000000000A4FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFF070000000000000000000000000000000000 + 00000000000000000000000007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFF0700000000000000000000000000000000 + 000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFA4A4A4A4A4A4A4A4A4A4A4A4A4A4 + A4A4A4A4A4A4A4A4A407FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF07E007 + 000007E0A4070707070707070707070707070707070707070707070707070707 + 0707070707070707070707070707070707070707070707070707070707A4E007 + 000007E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0 + E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E0E007 + 0000FF0707070707070707070707070707070707070707070707070707070707 + 07070707070707070707070707070707070707070707070707070707070707FF + 0000} + end + object Label1: TLabel + Left = 284 + Top = 8 + Width = 129 + Height = 25 + Alignment = taRightJustify + Caption = 'FastReport' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -21 + Font.Name = 'Verdana' + Font.Style = [fsBold] + ParentFont = False + Transparent = True + end + object Label2: TLabel + Left = 353 + Top = 40 + Width = 69 + Height = 13 + Alignment = taRightJustify + Caption = 'Version 3.15' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + Transparent = True + end + object Label3: TLabel + Left = 284 + Top = 60 + Width = 136 + Height = 13 + Caption = 'http://www.fast-report.com' + end + object Label4: TLabel + Left = 412 + Top = 8 + Width = 10 + Height = 13 + AutoSize = False + end + object DesignB: TButton + Left = 270 + Top = 308 + Width = 75 + Height = 25 + Caption = 'Design' + TabOrder = 0 + OnClick = DesignBClick + end + object Tree: TTreeView + Left = 4 + Top = 4 + Width = 193 + Height = 329 + HideSelection = False + Images = ImageList1 + Indent = 19 + ReadOnly = True + ShowRoot = False + TabOrder = 1 + OnChange = TreeChange + OnCustomDrawItem = TreeCustomDrawItem + Items.Data = { + 07000000260000000000000000000000FFFFFFFFFFFFFFFF000000000D000000 + 0D4261736963207265706F72747324000000010000000100000001000000FFFF + FFFF00000000000000000B53696D706C65206C69737425000000010000000100 + 000002000000FFFFFFFF00000000000000000C53696D706C652067726F757026 + 000000010000000100000003000000FFFFFFFF00000000000000000D4E657374 + 65642067726F75707330000000010000000100000004000000FFFFFFFF000000 + 0000000000174D61737465722D44657461696C2D53756264657461696C2D0000 + 00010000000100000005000000FFFFFFFF0000000000000000144D6173746572 + 2D44657461696C2D44657461696C2A000000010000000100000006000000FFFF + FFFF0000000000000000114D756C74692D636F6C756D6E206C6973742B000000 + 010000000100000007000000FFFFFFFF0000000000000000124D756C74692D63 + 6F6C756D6E2062616E64732B000000010000000100000008000000FFFFFFFF00 + 00000000000000124D656D6F7320616E64207069637475726573240000000100 + 00000100000009000000FFFFFFFF00000000000000000B53706C69742062616E + 64732300000001000000010000000A000000FFFFFFFF00000000000000000A53 + 75627265706F7274733000000001000000010000000B000000FFFFFFFF000000 + 000000000017536964652D62792D73696465207375627265706F7274732F0000 + 0001000000010000000C000000FFFFFFFF0000000000000000165265706F7274 + 2077697468207469746C6520706167652B00000001000000010000000D000000 + FFFFFFFF000000000000000012496E746572616374697665207265706F727423 + 0000000000000000000000FFFFFFFFFFFFFFFF000000000D0000000A43726F73 + 732D746162732000000001000000010000003D000000FFFFFFFF000000000000 + 0000074F6E6520726F772300000001000000010000003E000000FFFFFFFF0000 + 0000000000000A4F6E6520636F6C756D6E2C00000001000000010000003F0000 + 00FFFFFFFF0000000000000000134F6E6520726F772C206F6E6520636F6C756D + 6E21000000010000000100000040000000FFFFFFFF0000000000000000085477 + 6F20726F77732D000000010000000100000041000000FFFFFFFF000000000000 + 00001454776F20726F77732C206F6E6520636F6C756D6E2D0000000100000001 + 00000042000000FFFFFFFF00000000000000001454776F20636F6C756D6E732C + 206F6E6520726F7728000000010000000100000043000000FFFFFFFF00000000 + 000000000F54776F2063656C6C2076616C756573220000000100000001000000 + 44000000FFFFFFFF000000000000000009486967686C69676874270000000100 + 00000100000045000000FFFFFFFF00000000000000000E54776F2063726F7373 + 2D746162732F00000001000000010000003C000000FFFFFFFF00000000000000 + 001643726F73732066726F6D206E6F6E2D444220646174612B00000001000000 + 0100000046000000FFFFFFFF0000000000000000124F6C642D7374796C652063 + 726F737374616221000000010000000100000047000000FFFFFFFF0000000000 + 0000000843616C656E6461722D000000010000000100000049000000FFFFFFFF + 00000000000000001445787072657373696F6E7320696E2063726F7373270000 + 000000000000000000FFFFFFFFFFFFFFFF00000000050000000E4164642D696E + 206F626A6563747321000000010000000100000015000000FFFFFFFF00000000 + 0000000008526963687465787420000000010000000100000016000000FFFFFF + FF000000000000000007426172636F6465230000000100000001000000170000 + 00FFFFFFFF00000000000000000A4F4C45206F626A6563741F00000001000000 + 0100000018000000FFFFFFFF0000000000000000064368617274311F00000001 + 0000000100000019000000FFFFFFFF0000000000000000064368617274322500 + 00000000000000000000FFFFFFFFFFFFFFFF00000000060000000C4E65772066 + 656174757265733300000001000000010000001F000000FFFFFFFF0000000000 + 0000001A526F746174696F6E2C2066696C6C7320616E64207368617065732B00 + 0000010000000100000020000000FFFFFFFF00000000000000001248544D4C20 + 616E64207465787420666C6F772C000000010000000100000021000000FFFFFF + FF0000000000000000134B6565702067726F757020746F676574686572280000 + 00010000000100000022000000FFFFFFFF00000000000000000F507265766965 + 77206F75746C696E6526000000010000000100000023000000FFFFFFFF000000 + 00000000000D55524C732C20616E63686F727320000000010000000100000024 + 000000FFFFFFFF000000000000000007556E69636F64652B0000000000000000 + 000000FFFFFFFFFFFFFFFF0000000005000000124469616C6F677320616E6420 + 73637269707429000000010000000100000029000000FFFFFFFF000000000000 + 00001048656C6C6F20466173745265706F72742B00000001000000010000002A + 000000FFFFFFFF00000000000000001241736B20666F7220706172616D657465 + 72732C00000001000000010000002B000000FFFFFFFF00000000000000001343 + 6F6E74726F6C7320616E64206576656E74733200000001000000010000002C00 + 0000FFFFFFFF00000000000000001943686F6F73696E67207265636F72647320 + 746F207072696E742F00000001000000010000002D000000FFFFFFFF00000000 + 0000000016546F74616C7320696E2067726F7570206865616465722A00000000 + 00000000000000FFFFFFFFFFFFFFFF000000000200000011496E7465726E616C + 20646174617365747327000000010000000100000033000000FFFFFFFF000000 + 00000000000E496E7465726E616C207461626C65270000000100000001000000 + 34000000FFFFFFFF00000000000000000E496E7465726E616C2071756572792B + 0000000000000000000000FFFFFFFFFFFFFFFF000000000300000012446F742D + 6D6174726978207265706F72747326000000010000000100000050000000FFFF + FFFF00000000000000000D437573746F6D6572206C6973742200000001000000 + 0100000051000000FFFFFFFF00000000000000000946697368206C6973742200 + 0000010000000100000052000000FFFFFFFF00000000000000000943726F7373 + 2D746162} + end + object PreviewB: TButton + Left = 350 + Top = 308 + Width = 75 + Height = 25 + Caption = 'Preview' + TabOrder = 2 + OnClick = PreviewBClick + end + object DescriptionM: TMemo + Left = 204 + Top = 92 + Width = 221 + Height = 201 + ReadOnly = True + TabOrder = 3 + end + object frxReport1: TfrxReport + Version = '3.21' + DotMatrixReport = False + IniFile = '\Software\Fast Reports' + PreviewOptions.Buttons = [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick] + PreviewOptions.Zoom = 1.000000000000000000 + PrintOptions.Printer = 'Default' + ReportOptions.CreateDate = 37989.866077083300000000 + ReportOptions.LastChange = 38140.639774537000000000 + ScriptLanguage = 'PascalScript' + ScriptText.Strings = ( + 'begin' + '' + 'end.') + Left = 136 + Top = 176 + Datasets = <> + Variables = <> + Style = <> + object Page1: TfrxReportPage + PaperWidth = 210.000000000000000000 + PaperHeight = 297.000000000000000000 + PaperSize = 9 + LeftMargin = 10.000000000000000000 + RightMargin = 10.000000000000000000 + TopMargin = 10.000000000000000000 + BottomMargin = 10.000000000000000000 + end + end + object frxDesigner1: TfrxDesigner + DefaultScriptLanguage = 'PascalScript' + DefaultFont.Charset = DEFAULT_CHARSET + DefaultFont.Color = clWindowText + DefaultFont.Height = -13 + DefaultFont.Name = 'Arial' + DefaultFont.Style = [] + DefaultLeftMargin = 10.000000000000000000 + DefaultRightMargin = 10.000000000000000000 + DefaultTopMargin = 10.000000000000000000 + DefaultBottomMargin = 10.000000000000000000 + DefaultPaperSize = 9 + DefaultOrientation = poPortrait + Restrictions = [] + RTLLanguage = False + Left = 260 + Top = 144 + end + object frxBarCodeObject1: TfrxBarCodeObject + Left = 228 + Top = 208 + end + object frxRichObject1: TfrxRichObject + Left = 228 + Top = 176 + end + object frxDialogControls1: TfrxDialogControls + Left = 292 + Top = 176 + end + object ImageList1: TImageList + Left = 324 + Top = 144 + Bitmap = { + 494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000008000000080000000800000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000008000000000000000000000008000000080000000800000008000000080 + 0000008000000080000000800000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000800000FFFFFF0000000000000000000000000080808000C0C0C000C0C0 + C000FFFFFF00FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000080 + 000000800000FFFFFF0000000000C0C0C000FFFFFF0080808000000000000000 + 000000000000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008000000080 + 0000FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000000000000800000008000000080000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000080000000800000008000000080000000800000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000080000000FF0000008000000080000000800000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000080000000FF000000FF00000080000000800000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000000000000800000008000000080000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00FFFFFF0000000000C0C0C000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080808000FFFFFF0000800000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF00C0C0C0008080800080808000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00FFFFFF008080800000000000000000008080800080808000FFFFFF00FFFF + FF00808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000800000FFFF + FF00C0C0C0008080800000000000000000000000000000000000808080008080 + 8000808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000080808000C0C0 + C000808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00F1FFFFFF00000000E000FFFF00000000 + E000FFFF00000000E000FFFF00000000C000FFFF000000008000FC7F00000000 + 8000F83F000000008000F83F000000008000F83F000000008000FC7F00000000 + 8000FFFF000000008001FFFF000000008307FFFF0000000083C7FFFF00000000 + C7FFFFFF00000000EFFFFFFF0000000000000000000000000000000000000000 + 000000000000} + end + object frxOLEObject1: TfrxOLEObject + Left = 324 + Top = 176 + end + object frxCrossObject1: TfrxCrossObject + Left = 292 + Top = 208 + end + object frxDotMatrixExport1: TfrxDotMatrixExport + UseFileCache = True + ShowProgress = True + EscModel = 0 + GraphicFrames = False + SaveToFile = False + UseIniSettings = True + Left = 324 + Top = 208 + end + object frxPDFExport1: TfrxPDFExport + UseFileCache = True + ShowProgress = True + PrintOptimized = False + Outline = False + Author = 'FastReport' + Subject = 'FastReport PDF export' + Background = False + Creator = 'FastReport (http://www.fast-report.com)' + HTMLTags = True + Left = 368 + Top = 248 + end + object frxHTMLExport1: TfrxHTMLExport + UseFileCache = True + ShowProgress = True + FixedWidth = True + Background = False + Left = 272 + Top = 248 + end + object frxRTFExport1: TfrxRTFExport + UseFileCache = True + ShowProgress = True + Wysiwyg = True + Creator = 'FastReport http://www.fast-report.com' + SuppressPageHeadersFooters = False + Left = 208 + Top = 248 + end + object frxXLSExport1: TfrxXLSExport + UseFileCache = True + ShowProgress = True + AsText = False + Background = True + FastExport = True + PageBreaks = True + EmptyLines = True + SuppressPageHeadersFooters = False + Left = 304 + Top = 248 + end + object frxXMLExport1: TfrxXMLExport + UseFileCache = True + ShowProgress = True + Background = True + Creator = 'FastReport' + EmptyLines = True + SuppressPageHeadersFooters = False + Left = 336 + Top = 248 + end + object frxBMPExport1: TfrxBMPExport + UseFileCache = True + ShowProgress = True + Left = 112 + Top = 248 + end + object frxJPEGExport1: TfrxJPEGExport + UseFileCache = True + ShowProgress = True + Left = 144 + Top = 248 + end + object frxTIFFExport1: TfrxTIFFExport + UseFileCache = True + ShowProgress = True + Left = 176 + Top = 248 + end + object frxGZipCompressor1: TfrxGZipCompressor + Left = 260 + Top = 80 + end + object frxCheckBoxObject1: TfrxCheckBoxObject + Left = 356 + Top = 176 + end + object frxMailExport1: TfrxMailExport + UseFileCache = True + ShowProgress = True + ShowExportDialog = True + SmtpPort = 25 + UseIniFile = True + Left = 176 + Top = 284 + end + object frxCSVExport1: TfrxCSVExport + UseFileCache = True + ShowProgress = True + Separator = ';' + OEMCodepage = False + Left = 112 + Top = 284 + end + object frxGIFExport1: TfrxGIFExport + UseFileCache = True + ShowProgress = True + Left = 144 + Top = 284 + end + object frxSimpleTextExport1: TfrxSimpleTextExport + UseFileCache = True + ShowProgress = True + Frames = False + EmptyLines = False + OEMCodepage = False + Left = 240 + Top = 248 + end + object frxADOComponents1: TfrxADOComponents + DefaultDatabase = ReportData.ADOConnection1 + Left = 260 + Top = 208 + end +end diff --git a/official/3.23/Demos/Main/Unit1.pas b/official/3.23/Demos/Main/Unit1.pas new file mode 100644 index 0000000..e01d780 --- /dev/null +++ b/official/3.23/Demos/Main/Unit1.pas @@ -0,0 +1,115 @@ +unit Unit1; + +{$I frx.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Db, frxDesgn, frxClass, frxDCtrl, + frxChart, frxRich, frxBarcode, ImgList, ComCtrls, ExtCtrls, frxOLE, + frxCross, frxDMPExport, frxExportImage, frxExportRTF, + frxExportXML, frxExportXLS, frxExportHTML, frxGZip, frxExportPDF, + frxADOComponents, frxChBox, frxExportText, frxExportCSV, frxExportMail; + +type + TForm1 = class(TForm) + DesignB: TButton; + frxDesigner1: TfrxDesigner; + frxBarCodeObject1: TfrxBarCodeObject; + frxRichObject1: TfrxRichObject; + frxDialogControls1: TfrxDialogControls; + Tree: TTreeView; + ImageList1: TImageList; + PreviewB: TButton; + DescriptionM: TMemo; + Image1: TImage; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + frxOLEObject1: TfrxOLEObject; + frxCrossObject1: TfrxCrossObject; + frxDotMatrixExport1: TfrxDotMatrixExport; + frxBMPExport1: TfrxBMPExport; + frxJPEGExport1: TfrxJPEGExport; + frxTIFFExport1: TfrxTIFFExport; + frxHTMLExport1: TfrxHTMLExport; + frxXLSExport1: TfrxXLSExport; + frxXMLExport1: TfrxXMLExport; + frxRTFExport1: TfrxRTFExport; + frxReport1: TfrxReport; + frxGZipCompressor1: TfrxGZipCompressor; + frxPDFExport1: TfrxPDFExport; + Label4: TLabel; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxMailExport1: TfrxMailExport; + frxCSVExport1: TfrxCSVExport; + frxGIFExport1: TfrxGIFExport; + frxSimpleTextExport1: TfrxSimpleTextExport; + frxADOComponents1: TfrxADOComponents; + procedure DesignBClick(Sender: TObject); + procedure TreeCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); + procedure PreviewBClick(Sender: TObject); + procedure TreeChange(Sender: TObject; Node: TTreeNode); + procedure FormShow(Sender: TObject); + private + { Private declarations } + WPath: String; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +uses Unit2; + + + +{$R *.DFM} + +procedure TForm1.FormShow(Sender: TObject); +begin + WPath := ExtractFilePath(Application.ExeName); + Tree.Items[0].Item[0].Selected := True; + Label2.Caption := 'Version ' + FR_VERSION; + Label4.Caption := #174; +end; + +procedure TForm1.DesignBClick(Sender: TObject); +begin + frxReport1.DesignReport; +end; + +procedure TForm1.PreviewBClick(Sender: TObject); +begin + frxReport1.ShowReport; +end; + +procedure TForm1.TreeCustomDrawItem(Sender: TCustomTreeView; + Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Node.Count <> 0 then + Tree.Canvas.Font.Style := [fsBold]; +end; + +procedure TForm1.TreeChange(Sender: TObject; Node: TTreeNode); +begin + if Node.StateIndex = -1 then + begin + Tree.FullCollapse; + Node[0].Selected := True; + end + else + begin + DesignB.Enabled := True; + PreviewB.Enabled := True; + frxReport1.LoadFromFile(WPath + IntToStr(Node.StateIndex) + '.fr3'); + DescriptionM.Lines := frxReport1.ReportOptions.Description; + end; +end; + +end. diff --git a/official/3.23/Demos/Main/Unit2.dcu b/official/3.23/Demos/Main/Unit2.dcu new file mode 100644 index 0000000..2e30894 Binary files /dev/null and b/official/3.23/Demos/Main/Unit2.dcu differ diff --git a/official/3.23/Demos/Main/Unit2.dfm b/official/3.23/Demos/Main/Unit2.dfm new file mode 100644 index 0000000..40d1419 Binary files /dev/null and b/official/3.23/Demos/Main/Unit2.dfm differ diff --git a/official/3.23/Demos/Main/Unit2.pas b/official/3.23/Demos/Main/Unit2.pas new file mode 100644 index 0000000..8237569 --- /dev/null +++ b/official/3.23/Demos/Main/Unit2.pas @@ -0,0 +1,152 @@ +unit Unit2; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxDBSet, Db, frxClass, ADODB; + +type + TReportData = class(TDataModule) + Customers: TADOTable; + CustomersCustNo: TFloatField; + CustomersCompany: TStringField; + CustomersAddr1: TStringField; + CustomersAddr2: TStringField; + CustomersCity: TStringField; + CustomersState: TStringField; + CustomersZip: TStringField; + CustomersCountry: TStringField; + CustomersPhone: TStringField; + CustomersFAX: TStringField; + CustomersTaxRate: TFloatField; + CustomersContact: TStringField; + CustomersLastInvoiceDate: TDateTimeField; + Orders: TADOTable; + OrdersOrderNo: TFloatField; + OrdersCustNo: TFloatField; + OrdersCustCompany: TStringField; + OrdersSaleDate: TDateTimeField; + OrdersShipDate: TDateTimeField; + OrdersEmpNo: TIntegerField; + OrdersShipToContact: TStringField; + OrdersShipToAddr1: TStringField; + OrdersShipToAddr2: TStringField; + OrdersShipToCity: TStringField; + OrdersShipToState: TStringField; + OrdersShipToZip: TStringField; + OrdersShipToCountry: TStringField; + OrdersShipToPhone: TStringField; + OrdersShipVIA: TStringField; + OrdersPO: TStringField; + OrdersTerms: TStringField; + OrdersPaymentMethod: TStringField; + OrdersItemsTotal: TCurrencyField; + OrdersTaxRate: TFloatField; + OrdersFreight: TCurrencyField; + OrdersAmountPaid: TCurrencyField; + LineItems: TADOTable; + LineItemsOrderNo: TFloatField; + LineItemsItemNo: TFloatField; + LineItemsPartNo: TFloatField; + LineItemsPartName: TStringField; + LineItemsQty: TIntegerField; + LineItemsPrice: TCurrencyField; + LineItemsDiscount: TFloatField; + LineItemsTotal: TCurrencyField; + LineItemsExtendedPrice: TCurrencyField; + Parts: TADOTable; + PartsPartNo: TFloatField; + PartsVendorNo: TFloatField; + PartsDescription: TStringField; + PartsOnHand: TFloatField; + PartsOnOrder: TFloatField; + PartsCost: TCurrencyField; + PartsListPrice: TCurrencyField; + CustomerSource: TDataSource; + OrderSource: TDataSource; + LineItemSource: TDataSource; + PartSource: TDataSource; + RepQuery: TADOQuery; + RepQuerySource: TDataSource; + CustomersDS: TfrxDBDataset; + OrdersDS: TfrxDBDataset; + ItemsDS: TfrxDBDataset; + PartDS: TfrxDBDataset; + QueryDS: TfrxDBDataset; + Bio: TADOTable; + BioSource: TDataSource; + BioDS: TfrxDBDataset; + Country: TADOTable; + CountrySource: TDataSource; + CountryDS: TfrxDBDataset; + Cross: TADOTable; + CrossSource: TDataSource; + CrossDS: TfrxDBDataset; + ADOConnection1: TADOConnection; + RepQueryaCustNo: TFloatField; + RepQueryCompany: TWideStringField; + RepQueryAddr1: TWideStringField; + RepQueryAddr2: TWideStringField; + RepQueryCity: TWideStringField; + RepQueryState: TWideStringField; + RepQueryZip: TWideStringField; + RepQueryCountry: TWideStringField; + RepQueryPhone: TWideStringField; + RepQueryFAX: TWideStringField; + RepQueryaTaxRate: TFloatField; + RepQueryContact: TWideStringField; + RepQueryLastInvoiceDate: TDateTimeField; + RepQuerybOrderNo: TFloatField; + RepQuerybCustNo: TFloatField; + RepQuerySaleDate: TDateTimeField; + RepQueryShipDate: TDateTimeField; + RepQueryEmpNo: TIntegerField; + RepQueryShipToContact: TWideStringField; + RepQueryShipToAddr1: TWideStringField; + RepQueryShipToAddr2: TWideStringField; + RepQueryShipToCity: TWideStringField; + RepQueryShipToState: TWideStringField; + RepQueryShipToZip: TWideStringField; + RepQueryShipToCountry: TWideStringField; + RepQueryShipToPhone: TWideStringField; + RepQueryShipVIA: TWideStringField; + RepQueryPO: TWideStringField; + RepQueryTerms: TWideStringField; + RepQueryPaymentMethod: TWideStringField; + RepQueryItemsTotal: TFloatField; + RepQuerybTaxRate: TFloatField; + RepQueryFreight: TFloatField; + RepQueryAmountPaid: TFloatField; + RepQuerycOrderNo: TFloatField; + RepQueryItemNo: TFloatField; + RepQuerycPartNo: TFloatField; + RepQueryQty: TIntegerField; + RepQueryDiscount: TFloatField; + RepQuerydPartNo: TFloatField; + RepQueryVendorNo: TFloatField; + RepQueryDescription: TWideStringField; + RepQueryOnHand: TFloatField; + RepQueryOnOrder: TFloatField; + RepQueryCost: TFloatField; + RepQueryListPrice: TFloatField; + procedure DataModuleCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + ReportData: TReportData; + +implementation + +{$R *.DFM} + +procedure TReportData.DataModuleCreate(Sender: TObject); +begin +// Cross.DatabaseName := ExtractFilePath(Application.ExeName); +end; + +end. diff --git a/official/3.23/Demos/Main/crosstest.db b/official/3.23/Demos/Main/crosstest.db new file mode 100644 index 0000000..1865ed1 Binary files /dev/null and b/official/3.23/Demos/Main/crosstest.db differ diff --git a/official/3.23/Demos/Main/demo.mdb b/official/3.23/Demos/Main/demo.mdb new file mode 100644 index 0000000..d959714 Binary files /dev/null and b/official/3.23/Demos/Main/demo.mdb differ diff --git a/official/3.23/Demos/MasterDetailUDS/Project1.dpr b/official/3.23/Demos/MasterDetailUDS/Project1.dpr new file mode 100644 index 0000000..08b344c --- /dev/null +++ b/official/3.23/Demos/MasterDetailUDS/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/MasterDetailUDS/Project1.res b/official/3.23/Demos/MasterDetailUDS/Project1.res new file mode 100644 index 0000000..1228533 Binary files /dev/null and b/official/3.23/Demos/MasterDetailUDS/Project1.res differ diff --git a/official/3.23/Demos/MasterDetailUDS/Unit1.dfm b/official/3.23/Demos/MasterDetailUDS/Unit1.dfm new file mode 100644 index 0000000..c628e5f --- /dev/null +++ b/official/3.23/Demos/MasterDetailUDS/Unit1.dfm @@ -0,0 +1,131 @@ +object Form1: TForm1 + Left = 272 + Top = 220 + Width = 244 + Height = 166 + Caption = 'Master-Detail demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object BitBtn1: TBitBtn + Left = 80 + Top = 56 + Width = 75 + Height = 25 + Caption = 'Run!' + TabOrder = 0 + OnClick = BitBtn1Click + end + object frxReport1: TfrxReport + Version = '3.20' + DotMatrixReport = False + IniFile = '\Software\Fast Reports' + PreviewOptions.Buttons = [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick] + PreviewOptions.Zoom = 1 + PrintOptions.Printer = 'Default' + ReportOptions.CreateDate = 38806.5953306944 + ReportOptions.LastChange = 38806.5953306944 + ScriptLanguage = 'PascalScript' + ScriptText.Strings = ( + 'begin' + '' + 'end.') + Left = 4 + Top = 12 + Datasets = < + item + DataSet = DetailDS + DataSetName = 'DetailDS' + end + item + DataSet = MasterDS + DataSetName = 'MasterDS' + end> + Variables = <> + Style = <> + object Page1: TfrxReportPage + PaperWidth = 210 + PaperHeight = 297 + PaperSize = 9 + LeftMargin = 10 + RightMargin = 10 + TopMargin = 10 + BottomMargin = 10 + object MasterData1: TfrxMasterData + Height = 20 + Top = 16 + Width = 718.1107 + DataSet = MasterDS + DataSetName = 'MasterDS' + RowCount = 0 + object Memo1: TfrxMemoView + Width = 260 + Height = 20 + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Arial' + Font.Style = [fsBold] + Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] + Memo.UTF8 = ( + '[MasterDS."name"]') + ParentFont = False + end + end + object DetailData1: TfrxDetailData + Height = 20 + Top = 56 + Width = 718.1107 + DataSet = DetailDS + DataSetName = 'DetailDS' + RowCount = 0 + object Memo2: TfrxMemoView + Left = 24 + Width = 236 + Height = 20 + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Arial' + Font.Style = [fsBold] + Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] + Memo.UTF8 = ( + '[DetailDS."name"]') + ParentFont = False + end + end + end + end + object MasterDS: TfrxUserDataSet + UserName = 'MasterDS' + OnCheckEOF = MasterDSCheckEOF + OnFirst = MasterDSFirst + OnNext = MasterDSNext + OnPrior = MasterDSPrior + Fields.Strings = ( + 'name') + OnGetValue = MasterDSGetValue + Left = 40 + Top = 12 + end + object DetailDS: TfrxUserDataSet + UserName = 'DetailDS' + OnCheckEOF = DetailDSCheckEOF + OnFirst = DetailDSFirst + OnNext = DetailDSNext + OnPrior = DetailDSPrior + Fields.Strings = ( + 'mas_id' + 'name') + OnGetValue = DetailDSGetValue + Left = 76 + Top = 12 + end +end diff --git a/official/3.23/Demos/MasterDetailUDS/Unit1.pas b/official/3.23/Demos/MasterDetailUDS/Unit1.pas new file mode 100644 index 0000000..6fe65ee --- /dev/null +++ b/official/3.23/Demos/MasterDetailUDS/Unit1.pas @@ -0,0 +1,114 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, Buttons, frxClass; + +type + TForm1 = class(TForm) + MasterDS: TfrxUserDataSet; + DetailDS: TfrxUserDataSet; + BitBtn1: TBitBtn; + frxReport1: TfrxReport; + procedure MasterDSFirst(Sender: TObject); + procedure MasterDSNext(Sender: TObject); + procedure MasterDSPrior(Sender: TObject); + procedure MasterDSCheckEOF(Sender: TObject; var Eof: Boolean); + procedure MasterDSGetValue(const VarName: String; var Value: Variant); + procedure DetailDSCheckEOF(Sender: TObject; var Eof: Boolean); + procedure DetailDSFirst(Sender: TObject); + procedure DetailDSGetValue(const VarName: String; var Value: Variant); + procedure DetailDSNext(Sender: TObject); + procedure DetailDSPrior(Sender: TObject); + procedure BitBtn1Click(Sender: TObject); + private + MasterNo: Integer; + DetailNo: Integer; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +const + Master: array[1..3, 1..2] of ShortString = ( // master Id, master name + ('1', 'master 1'), + ('2', 'master 2'), + ('3', 'master 3')); + Detail: array[1..15, 1..2] of ShortString = ( // master Id, detail name + ('2', 'detail 2.5'), ('3', 'detail 3.1'), ('3', 'detail 3.2'), + ('1', 'detail 1.1'), ('1', 'detail 1.2'), ('1', 'detail 1.3'), + ('2', 'detail 2.2'), ('2', 'detail 2.3'), ('2', 'detail 2.4'), + ('1', 'detail 1.4'), ('1', 'detail 1.5'), ('2', 'detail 2.1'), + ('3', 'detail 3.3'), ('3', 'detail 3.4'), ('3', 'detail 3.5')); + + +procedure TForm1.MasterDSFirst(Sender: TObject); +begin + MasterNo := 1; +end; + +procedure TForm1.MasterDSNext(Sender: TObject); +begin + Inc(MasterNo); +end; + +procedure TForm1.MasterDSPrior(Sender: TObject); +begin + Dec(MasterNo); +end; + +procedure TForm1.MasterDSCheckEOF(Sender: TObject; var Eof: Boolean); +begin + Eof := MasterNo > High(Master); +end; + +procedure TForm1.MasterDSGetValue(const VarName: String; var Value: Variant); +begin + Value := Master[MasterNo][2]; +end; + +procedure TForm1.DetailDSFirst(Sender: TObject); +begin + DetailNo := 1; + while (not DetailDS.Eof) and (Detail[DetailNo][1] <> Master[MasterNo][1]) do + Inc(DetailNo); +end; + +procedure TForm1.DetailDSNext(Sender: TObject); +begin + Inc(DetailNo); + while (not DetailDS.Eof) and (Detail[DetailNo][1] <> Master[MasterNo][1]) do + Inc(DetailNo); +end; + +procedure TForm1.DetailDSPrior(Sender: TObject); +begin + Dec(DetailNo); + while (DetailNo > 1) and (Detail[DetailNo][1] <> Master[MasterNo][1]) do + Dec(DetailNo); +end; + +procedure TForm1.DetailDSCheckEOF(Sender: TObject; var Eof: Boolean); +begin + Eof := DetailNo > High(Detail); +end; + +procedure TForm1.DetailDSGetValue(const VarName: String; var Value: Variant); +begin + Value := Detail[DetailNo][2]; +end; + +procedure TForm1.BitBtn1Click(Sender: TObject); +begin + frxReport1.ShowReport(); +end; + +end. diff --git a/official/3.23/Demos/PrintArray/Project1.dpr b/official/3.23/Demos/PrintArray/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/PrintArray/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/PrintArray/Project1.res b/official/3.23/Demos/PrintArray/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/PrintArray/Project1.res differ diff --git a/official/3.23/Demos/PrintArray/Unit1.dfm b/official/3.23/Demos/PrintArray/Unit1.dfm new file mode 100644 index 0000000..18df611 Binary files /dev/null and b/official/3.23/Demos/PrintArray/Unit1.dfm differ diff --git a/official/3.23/Demos/PrintArray/Unit1.pas b/official/3.23/Demos/PrintArray/Unit1.pas new file mode 100644 index 0000000..b5d3953 --- /dev/null +++ b/official/3.23/Demos/PrintArray/Unit1.pas @@ -0,0 +1,45 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls; + +type + TForm1 = class(TForm) + Button1: TButton; + ArrayDS: TfrxUserDataSet; + frxReport1: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure frxReport1GetValue(VarName: String; var Value: Variant); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +var + ar: array[0..9] of Integer = (0,1,2,3,4,5,6,7,8,9); + +procedure TForm1.Button1Click(Sender: TObject); +begin + ArrayDS.RangeEnd := reCount; + ArrayDS.RangeEndCount := 10; + frxReport1.ShowReport; +end; + +procedure TForm1.frxReport1GetValue(VarName: String; var Value: Variant); +begin + if CompareText(VarName, 'element') = 0 then + Value := ar[ArrayDS.RecNo]; +end; + +end. diff --git a/official/3.23/Demos/PrintFile/Project1.dpr b/official/3.23/Demos/PrintFile/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/PrintFile/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/PrintFile/Project1.res b/official/3.23/Demos/PrintFile/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/PrintFile/Project1.res differ diff --git a/official/3.23/Demos/PrintFile/Unit1.dfm b/official/3.23/Demos/PrintFile/Unit1.dfm new file mode 100644 index 0000000..d221ca5 Binary files /dev/null and b/official/3.23/Demos/PrintFile/Unit1.dfm differ diff --git a/official/3.23/Demos/PrintFile/Unit1.pas b/official/3.23/Demos/PrintFile/Unit1.pas new file mode 100644 index 0000000..90c23dd --- /dev/null +++ b/official/3.23/Demos/PrintFile/Unit1.pas @@ -0,0 +1,49 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls; + +type + TForm1 = class(TForm) + Button1: TButton; + frxReport1: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure frxReport1GetValue(VarName: String; var Value: Variant); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +var + ar: array[0..9] of Integer = (0,1,2,3,4,5,6,7,8,9); + +procedure TForm1.Button1Click(Sender: TObject); +begin + frxReport1.ShowReport; +end; + +procedure TForm1.frxReport1GetValue(VarName: String; var Value: Variant); +var + sl: TStringList; +begin + if CompareText(VarName, 'file') = 0 then + begin + sl := TStringList.Create; + sl.LoadFromFile('unit1.pas'); + Value := sl.Text; + sl.Free; + end; +end; + +end. diff --git a/official/3.23/Demos/PrintStringGrid/Project1.dpr b/official/3.23/Demos/PrintStringGrid/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/PrintStringGrid/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/PrintStringGrid/Project1.res b/official/3.23/Demos/PrintStringGrid/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/PrintStringGrid/Project1.res differ diff --git a/official/3.23/Demos/PrintStringGrid/Unit1.dfm b/official/3.23/Demos/PrintStringGrid/Unit1.dfm new file mode 100644 index 0000000..fbbd9fa Binary files /dev/null and b/official/3.23/Demos/PrintStringGrid/Unit1.dfm differ diff --git a/official/3.23/Demos/PrintStringGrid/Unit1.pas b/official/3.23/Demos/PrintStringGrid/Unit1.pas new file mode 100644 index 0000000..94899d1 --- /dev/null +++ b/official/3.23/Demos/PrintStringGrid/Unit1.pas @@ -0,0 +1,59 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls, Grids, frxCross; + +type + TForm1 = class(TForm) + Button1: TButton; + StringGrid1: TStringGrid; + frxCrossObject1: TfrxCrossObject; + frxReport1: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure frxReport1BeforePrint(c: TfrxReportComponent); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +procedure TForm1.FormCreate(Sender: TObject); +var + i, j: Integer; +begin + for i := 1 to 16 do + for j := 1 to 16 do + StringGrid1.Cells[i - 1, j - 1] := IntToStr(i * j); +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + frxReport1.ShowReport; +end; + +procedure TForm1.frxReport1BeforePrint(c: TfrxReportComponent); +var + Cross: TfrxCrossView; + i, j: Integer; +begin + if c is TfrxCrossView then + begin + Cross := TfrxCrossView(c); + for i := 1 to 16 do + for j := 1 to 16 do + Cross.AddValue([i], [j], [StringGrid1.Cells[i - 1, j - 1]]); + end; +end; + +end. diff --git a/official/3.23/Demos/PrintStringList/Project1.dpr b/official/3.23/Demos/PrintStringList/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/PrintStringList/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/PrintStringList/Project1.res b/official/3.23/Demos/PrintStringList/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/PrintStringList/Project1.res differ diff --git a/official/3.23/Demos/PrintStringList/Unit1.dfm b/official/3.23/Demos/PrintStringList/Unit1.dfm new file mode 100644 index 0000000..a0480f8 Binary files /dev/null and b/official/3.23/Demos/PrintStringList/Unit1.dfm differ diff --git a/official/3.23/Demos/PrintStringList/Unit1.pas b/official/3.23/Demos/PrintStringList/Unit1.pas new file mode 100644 index 0000000..5c379c3 --- /dev/null +++ b/official/3.23/Demos/PrintStringList/Unit1.pas @@ -0,0 +1,58 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls; + +type + TForm1 = class(TForm) + Button1: TButton; + StringDS: TfrxUserDataSet; + frxReport1: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure frxReport1GetValue(const VarName: String; var Value: Variant); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + sl: TStringList; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +procedure TForm1.FormCreate(Sender: TObject); +begin + sl := TStringList.Create; + sl.Add('1'); + sl.Add('2'); + sl.Add('3'); + sl.Add('4'); + sl.Add('5'); + sl.Add('6'); + sl.Add('7'); + sl.Add('8'); + sl.Add('9'); +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + StringDS.RangeEnd := reCount; + StringDS.RangeEndCount := sl.Count; + frxReport1.ShowReport; +end; + +procedure TForm1.frxReport1GetValue(const VarName: String; var Value: Variant); +begin + if CompareText(VarName, 'element') = 0 then + Value := sl[StringDS.RecNo]; +end; + +end. diff --git a/official/3.23/Demos/PrintTable/Project1.dpr b/official/3.23/Demos/PrintTable/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/3.23/Demos/PrintTable/Project1.dpr @@ -0,0 +1,13 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Demos/PrintTable/Project1.res b/official/3.23/Demos/PrintTable/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/3.23/Demos/PrintTable/Project1.res differ diff --git a/official/3.23/Demos/PrintTable/Unit1.dfm b/official/3.23/Demos/PrintTable/Unit1.dfm new file mode 100644 index 0000000..1d253d1 Binary files /dev/null and b/official/3.23/Demos/PrintTable/Unit1.dfm differ diff --git a/official/3.23/Demos/PrintTable/Unit1.pas b/official/3.23/Demos/PrintTable/Unit1.pas new file mode 100644 index 0000000..e2b1d57 --- /dev/null +++ b/official/3.23/Demos/PrintTable/Unit1.pas @@ -0,0 +1,57 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, StdCtrls, frxCross, Db, DBTables; + +type + TForm1 = class(TForm) + Button1: TButton; + frxCrossObject1: TfrxCrossObject; + Table1: TTable; + frxReport1: TfrxReport; + procedure Button1Click(Sender: TObject); + procedure frxReport1BeforePrint(c: TfrxReportComponent); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +procedure TForm1.Button1Click(Sender: TObject); +begin + frxReport1.ShowReport; +end; + +procedure TForm1.frxReport1BeforePrint(c: TfrxReportComponent); +var + Cross: TfrxCrossView; + i, j: Integer; +begin + if c is TfrxCrossView then + begin + Cross := TfrxCrossView(c); + + Table1.First; + i := 0; + while not Table1.Eof do + begin + for j := 0 to Table1.Fields.Count - 1 do + Cross.AddValue([i], [Table1.Fields[j].DisplayLabel], [Table1.Fields[j].AsString]); + + Table1.Next; + Inc(i); + end; + end; +end; + +end. diff --git a/official/3.23/Extra/New DB engine/Main.dfm b/official/3.23/Extra/New DB engine/Main.dfm new file mode 100644 index 0000000..1f71b9d Binary files /dev/null and b/official/3.23/Extra/New DB engine/Main.dfm differ diff --git a/official/3.23/Extra/New DB engine/Main.pas b/official/3.23/Extra/New DB engine/Main.pas new file mode 100644 index 0000000..6c8719a --- /dev/null +++ b/official/3.23/Extra/New DB engine/Main.pas @@ -0,0 +1,202 @@ +unit Main; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, StdCtrls; + +type + TForm1 = class(TForm) + Label1: TLabel; + Label2: TLabel; + AbbrE: TEdit; + Label3: TLabel; + Label4: TLabel; + TableE: TEdit; + QueryE: TEdit; + DatabaseE: TEdit; + Button1: TButton; + Button2: TButton; + Bevel1: TBevel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + UnitsE: TEdit; + CopyrightM: TMemo; + Label9: TLabel; + Label10: TLabel; + CommentsM: TMemo; + Label11: TLabel; + PackageE: TEdit; + procedure Button1Click(Sender: TObject); + procedure AbbrEExit(Sender: TObject); + procedure Button2Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} +{$I-} + +type + PCharArray = ^TCharArray; + TCharArray = Array[0..32767] of Char; + +procedure TForm1.Button1Click(Sender: TObject); +var + BaseDir, NewDir: String; + SearchRec: TSearchRec; + r: Word; + mem: PCharArray; + memSize: Integer; + + procedure Replace(sFrom, sTo: String); + var + i, j: Integer; + Flag: Boolean; + begin + while Pos('?', sFrom) <> 0 do + sFrom[Pos('?', sFrom)] := #0; + i := 0; + while i < memSize do + begin + Flag := True; + for j := 1 to Length(sFrom) do + if AnsiCompareText(mem^[i + j - 1], sFrom[j]) <> 0 then + begin + Flag := False; + break; + end; + if Flag then + begin + Move((PChar(mem) + i + Length(sFrom))^, + (PChar(mem) + i + Length(sTo))^, memSize - (i + Length(sFrom))); + for j := 1 to Length(sTo) do + mem^[i + j - 1] := sTo[j]; + Inc(memSize, Length(sTo) - Length(sFrom)); + end; + Inc(i); + end; + end; + + procedure ProcessFile(s: String); + var + n: Integer; + stm: TMemoryStream; + stm1: TFileStream; + + function MakeTwoChar(s: String): String; + var + i: Integer; + begin + Result := ''; + for i := 1 to Length(s) do + Result := Result + s[i] + #0; + end; + + function GetCopyText: String; + var + i: Integer; + begin + Result := ''; + for i := 0 to CopyrightM.Lines.Count - 1 do + Result := Result + '// ' + CopyrightM.Lines[i] + #13#10; + end; + + begin + stm := TMemoryStream.Create; + stm.LoadFromFile(BaseDir + '\' + s); + FillChar(mem^, 32768, 0); + Move(stm.Memory^, mem^, stm.Size); + memSize := stm.Size; + + // components + Replace('TXXXTable', TableE.Text); + Replace('TXXXQuery', QueryE.Text); + Replace('TXXXDatabase', DatabaseE.Text); + // units + Replace('UXXX', UnitsE.Text); + // package + Replace('PXXX', PackageE.Text); + // dcr + Replace('F?R?X?X?X?X?', MakeTwoChar('FRX' + AbbrE.Text)); + // other + Replace('frxXXX', 'frx' + AbbrE.Text); + Replace('XXX', AbbrE.Text); + Replace('// Copyright', GetCopyText); + Replace('IdCopyright', CopyrightM.Lines.Text); + Replace('IdComments', CommentsM.Lines.Text); + + n := Pos('FRXXXX', AnsiUpperCase(s)); + if n <> 0 then + begin + Delete(s, n, 6); + Insert('frx' + AbbrE.Text, s, n); + end; + stm1 := TFileStream.Create(NewDir + '\' + s, fmCreate); + stm1.Write(mem^, memSize); + stm1.Free; + + stm.Free; + end; + +begin + if (Trim(AbbrE.Text) = '') or (Trim(TableE.Text) = '') or + (Trim(QueryE.Text) = '') or (Trim(DatabaseE.Text) = '') or + (Trim(UnitsE.Text) = '') or (Trim(PackageE.Text) = '') then + begin + MessageBox(0, PChar('You should fill all fields!'), PChar('Error'), + mb_OK + mb_IconError); + AbbrE.SetFocus; + Exit; + end; + + SetCurrentDir(ExtractFilePath(ParamStr(0))); + BaseDir := GetCurrentDir + '\Template'; + ChDir('..'); + NewDir := GetCurrentDir + '\' + AbbrE.Text; + New(mem); + +// make dir + MkDir(NewDir); + +// processing files + R := FindFirst(BaseDir + '\*.*', faAnyFile, SearchRec); + while R = 0 do + begin + if (SearchRec.Attr and faDirectory) = 0 then + ProcessFile(SearchRec.Name); + R := FindNext(SearchRec); + end; + FindClose(SearchRec); + + Dispose(mem); + + MessageBox(0, PChar('Files are converted and placed in the ' + + NewDir + ' folder.'), '', mb_OK + mb_IconInformation); + Close; +end; + +procedure TForm1.AbbrEExit(Sender: TObject); +begin + if AbbrE.Text = '' then Exit; + TableE.Text := 'T' + AbbrE.Text + 'Table'; + QueryE.Text := 'T' + AbbrE.Text + 'Query'; + DatabaseE.Text := 'T' + AbbrE.Text + 'Database'; +end; + +procedure TForm1.Button2Click(Sender: TObject); +begin + Close; +end; + +end. diff --git a/official/3.23/Extra/New DB engine/NewEngine.dpr b/official/3.23/Extra/New DB engine/NewEngine.dpr new file mode 100644 index 0000000..d9ecaad --- /dev/null +++ b/official/3.23/Extra/New DB engine/NewEngine.dpr @@ -0,0 +1,13 @@ +program NewEngine; + +uses + Forms, + Main in 'Main.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/3.23/Extra/New DB engine/NewEngine.res b/official/3.23/Extra/New DB engine/NewEngine.res new file mode 100644 index 0000000..c832058 Binary files /dev/null and b/official/3.23/Extra/New DB engine/NewEngine.res differ diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX4.dpk b/official/3.23/Extra/New DB engine/Template/dclfrxXXX4.dpk new file mode 100644 index 0000000..d42154b --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX4.dpk @@ -0,0 +1,38 @@ +// Package file for Delphi 4 + +package dclfrxXXX4; + +{$R 'frxXXXReg.dcr'} +{$DESCRIPTION 'FastReport 3.0 XXX 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 + VCL40, + frxXXX4; + +contains + frxXXXReg in 'frxXXXReg.pas'; + +end. diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX5.dpk b/official/3.23/Extra/New DB engine/Template/dclfrxXXX5.dpk new file mode 100644 index 0000000..2b8265d --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX5.dpk @@ -0,0 +1,38 @@ +// Package file for Delphi 5 + +package dclfrxXXX5; + +{$R 'frxXXXReg.dcr'} +{$DESCRIPTION 'FastReport 3.0 XXX 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 + VCL50, + frxXXX5; + +contains + frxXXXReg in 'frxXXXReg.pas'; + +end. diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX6.dpk b/official/3.23/Extra/New DB engine/Template/dclfrxXXX6.dpk new file mode 100644 index 0000000..e00f322 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX6.dpk @@ -0,0 +1,39 @@ +// Package file for Delphi 6 + +package dclfrxXXX6; + +{$R 'frxXXXReg.dcr'} +{$DESCRIPTION 'FastReport 3.0 XXX 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 + VCL, + DESIGNIDE, + frxXXX6; + +contains + frxXXXReg in 'frxXXXReg.pas'; + +end. diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX7.dpk b/official/3.23/Extra/New DB engine/Template/dclfrxXXX7.dpk new file mode 100644 index 0000000..b52d81a --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX7.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 7 + +package dclfrxXXX7; + +{$R 'frxXXXReg.dcr'} +{$DESCRIPTION 'FastReport 3.0 XXX 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 + VCL, + DESIGNIDE, + frxXXX7; + +contains + frxXXXReg in 'frxXXXReg.pas'; + + +end. diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.bdsproj b/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.bdsproj new file mode 100644 index 0000000..f9ecffb --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + dclfrxXXX9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastReport 3.0 Components + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.dpk b/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.dpk new file mode 100644 index 0000000..60d4955 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/dclfrxXXX9.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 2005 + +package dclfrxXXX9; + +{$R 'frxXXXReg.dcr'} +{$DESCRIPTION 'FastReport 3.0 XXX 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 + VCL, + DESIGNIDE, + frxXXX9; + +contains + frxXXXReg in 'frxXXXReg.pas'; + + +end. diff --git a/official/3.23/Extra/New DB engine/Template/file_id.diz b/official/3.23/Extra/New DB engine/Template/file_id.diz new file mode 100644 index 0000000..a5c17f8 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/file_id.diz @@ -0,0 +1,3 @@ +IdComments + +IdCopyright \ No newline at end of file diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX4.bpk b/official/3.23/Extra/New DB engine/Template/frxXXX4.bpk new file mode 100644 index 0000000..793756c --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX4.bpk @@ -0,0 +1,189 @@ +# --------------------------------------------------------------------------- +!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 = frxXXX4.bpl +OBJFILES = frxXXXReg.obj frxXXX4.obj +RESFILES = frxXXX4.res frxXXXReg.dcr +RESDEPEN = $(RESFILES) +LIBFILES = +LIBRARIES = +SPARELIBS = VCL40.lib +PACKAGES = vcl40.bpi vcldb40.bpi PXXX40.bpi frx4.bpi frxDB4.bpi fs4.bpi fqb40.bpi +DEFFILE = +# --------------------------------------------------------------------------- +PATHCPP = .; +PATHASM = .; +PATHPAS = .; +PATHRC = .; +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release;..\;..\..\FastScript;..\..\FastQB +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)\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)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -D"FastReport 3.0 XXX 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/official/3.23/Extra/New DB engine/Template/frxXXX4.cpp b/official/3.23/Extra/New DB engine/Template/frxXXX4.cpp new file mode 100644 index 0000000..b2b7a42 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX4.cpp @@ -0,0 +1,23 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("frxXXX4.res"); +USEPACKAGE("vcl40.bpi"); +USEUNIT("frxXXXReg.pas"); +USERES("frxXXXReg.dcr"); +USEPACKAGE("vcldb40.bpi"); +USEPACKAGE("PXXX40.bpi"); +USEPACKAGE("frx4.bpi"); +USEPACKAGE("frxDB4.bpi"); +USEPACKAGE("fs4.bpi"); +USEPACKAGE("fqb40.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX4.dpk b/official/3.23/Extra/New DB engine/Template/frxXXX4.dpk new file mode 100644 index 0000000..65001c7 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX4.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 4 + +package frxXXX4; + +{$I frx.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLDB40, + PXXX40, + frx4, + frxDB4, +{$IFDEF QBUILDER} + fqb40, +{$ENDIF} + fs4; + +contains + frxXXXComponents in 'frxXXXComponents.pas', + frxXXXEditor in 'frxXXXEditor.pas', + frxXXXRTTI in 'frxXXXRTTI.pas'; + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX4.res b/official/3.23/Extra/New DB engine/Template/frxXXX4.res new file mode 100644 index 0000000..eb2597a Binary files /dev/null and b/official/3.23/Extra/New DB engine/Template/frxXXX4.res differ diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX5.bpk b/official/3.23/Extra/New DB engine/Template/frxXXX5.bpk new file mode 100644 index 0000000..a1f8fc6 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX5.bpk @@ -0,0 +1,92 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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= + +[Debugging] +DebugSourceDirs=$(BCB)\source\vcl + +[Parameters] +RunParams= +HostApplication= +RemoteHost= +RemotePath= +RemoteDebug=0 + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[CORBA] +AddServerUnit=1 +AddClientUnit=1 +PrecompiledHeaders=1 + + \ No newline at end of file diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX5.cpp b/official/3.23/Extra/New DB engine/Template/frxXXX5.cpp new file mode 100644 index 0000000..88b89f8 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX5.cpp @@ -0,0 +1,27 @@ +//--------------------------------------------------------------------------- + +#include +#pragma hdrstop +USERES("frxBDE5.res"); +USEPACKAGE("vcl50.bpi"); +USEUNIT("frxXXXReg.pas"); +USERES("frxXXXReg.dcr"); +USEPACKAGE("vcldb50.bpi"); +USEPACKAGE("PXXX50.bpi"); +USEPACKAGE("frx5.bpi"); +USEPACKAGE("frxDB5.bpi"); +USEPACKAGE("fs5.bpi"); +USEPACKAGE("fqb50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- + +// Package source. +//--------------------------------------------------------------------------- + +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX5.dpk b/official/3.23/Extra/New DB engine/Template/frxXXX5.dpk new file mode 100644 index 0000000..db72b8d --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX5.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 5 + +package frxXXX5; + +{$I frx.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + PXXX50, + frx5, + frxDB5, +{$IFDEF QBUILDER} + fqb50, +{$ENDIF} + fs5; + +contains + frxXXXComponents in 'frxXXXComponents.pas', + frxXXXEditor in 'frxXXXEditor.pas', + frxXXXRTTI in 'frxXXXRTTI.pas'; + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX5.res b/official/3.23/Extra/New DB engine/Template/frxXXX5.res new file mode 100644 index 0000000..da3d366 Binary files /dev/null and b/official/3.23/Extra/New DB engine/Template/frxXXX5.res differ diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX6.bpk b/official/3.23/Extra/New DB engine/Template/frxXXX6.bpk new file mode 100644 index 0000000..261f387 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX6.bpk @@ -0,0 +1,148 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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=2 +Item0=$(BCB)\Projects;$(BCB)\include;$(BCB)\include\vcl;..\ +Item1=$(BCB)\Projects;..\..\FR\SOURCE\ADO;$(BCB)\include;$(BCB)\include\vcl + +[HistoryLists\hlLibraryPath] +Count=2 +Item0=$(BCB)\Projects;$(BCB)\lib\obj;$(BCB)\lib;..\ +Item1=$(BCB)\Projects;..\..\FR\SOURCE\ADO;$(BCB)\lib\obj;$(BCB)\lib + +[HistoryLists\hlDebugSourcePath] +Count=1 +Item0=$(BCB)\source\vcl + +[HistoryLists\hlConditionals] +Count=1 +Item0=_DEBUG + +[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 + +[Language] +ActiveLang= +ProjectLang= +RootDir= + +[Linker] +LibPrefix= +LibSuffix= +LibVersion= + + \ No newline at end of file diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX6.cpp b/official/3.23/Extra/New DB engine/Template/frxXXX6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX6.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/official/3.23/Extra/New DB engine/Template/frxXXX6.dpk b/official/3.23/Extra/New DB engine/Template/frxXXX6.dpk new file mode 100644 index 0000000..4770ce9 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX6.dpk @@ -0,0 +1,48 @@ +// Package file for Delphi 6 + +package frxXXX6; + +{$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 + VCL, + VCLDB, + PXXX60, + frx6, + frxDB6, +{$IFDEF QBUILDER} + fqb60, +{$ENDIF} + fs6; + +contains + frxXXXComponents in 'frxXXXComponents.pas', + frxXXXEditor in 'frxXXXEditor.pas', + frxXXXRTTI in 'frxXXXRTTI.pas'; + + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX6.res b/official/3.23/Extra/New DB engine/Template/frxXXX6.res new file mode 100644 index 0000000..2bbdbc1 Binary files /dev/null and b/official/3.23/Extra/New DB engine/Template/frxXXX6.res differ diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX7.dpk b/official/3.23/Extra/New DB engine/Template/frxXXX7.dpk new file mode 100644 index 0000000..3a14558 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX7.dpk @@ -0,0 +1,48 @@ +// Package file for Delphi 7 + +package frxXXX7; + +{$I frx.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + PXXX70, + frx7, + frxDB7, +{$IFDEF QBUILDER} + fqb70, +{$ENDIF} + fs7; + +contains + frxXXXComponents in 'frxXXXComponents.pas', + frxXXXEditor in 'frxXXXEditor.pas', + frxXXXRTTI in 'frxXXXRTTI.pas'; + + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX9.bdsproj b/official/3.23/Extra/New DB engine/Template/frxXXX9.bdsproj new file mode 100644 index 0000000..f21e329 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + frxXXX9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/Extra/New DB engine/Template/frxXXX9.dpk b/official/3.23/Extra/New DB engine/Template/frxXXX9.dpk new file mode 100644 index 0000000..6a761bc --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXX9.dpk @@ -0,0 +1,48 @@ +// Package file for Delphi 2005 + +package frxXXX9; + +{$I frx.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + PXXX90, + frx9, + frxDB9, +{$IFDEF QBUILDER} + fqb90, +{$ENDIF} + fs9; + +contains + frxXXXComponents in 'frxXXXComponents.pas', + frxXXXEditor in 'frxXXXEditor.pas', + frxXXXRTTI in 'frxXXXRTTI.pas'; + + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXComponents.pas b/official/3.23/Extra/New DB engine/Template/frxXXXComponents.pas new file mode 100644 index 0000000..cf68c9d --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXXComponents.pas @@ -0,0 +1,491 @@ + +{******************************************} +{ } +{ FastReport v3.0 } +{ XXX enduser components } +{ } + +// Copyright +{ } +{******************************************} + +unit frxXXXComponents; + +interface + +{$I frx.inc} + +uses + Windows, Classes, frxClass, frxCustomDB, DB, UXXX +{$IFDEF Delphi6} +, Variants +{$ENDIF} +{$IFDEF QBUILDER} +, fqbClass +{$ENDIF}; + + +type + TfrxXXXComponents = class(TfrxDBComponents) + private + FDefaultDatabase: TXXXDatabase; + FOldComponents: TfrxXXXComponents; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function GetDescription: String; override; + published + property DefaultDatabase: TXXXDatabase read FDefaultDatabase write FDefaultDatabase; + end; + + TfrxXXXDatabase = class(TfrxCustomDatabase) + private + FDatabase: TXXXDatabase; + 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: TXXXDatabase read FDatabase; + published + property DatabaseName; + property LoginPrompt; + property Params; + property Connected; + end; + + TfrxXXXTable = class(TfrxCustomTable) + private + FDatabase: TfrxXXXDatabase; + FTable: TXXXTable; + procedure SetDatabase(const Value: TfrxXXXDatabase); + 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: TXXXTable read FTable; + published + property Database: TfrxXXXDatabase read FDatabase write SetDatabase; + end; + + TfrxXXXQuery = class(TfrxCustomQuery) + private + FDatabase: TfrxXXXDatabase; + FQuery: TXXXQuery; + procedure SetDatabase(const Value: TfrxXXXDatabase); + 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: TXXXQuery read FQuery; + published + property Database: TfrxXXXDatabase read FDatabase write SetDatabase; + end; + +{$IFDEF QBUILDER} + TfrxEngineXXX = class(TfqbEngine) + private + FQuery: TXXXQuery; + 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 + XXXComponents: TfrxXXXComponents; + + +implementation + +{$R *.res} + +uses + frxXXXRTTI, +{$IFNDEF NO_EDITORS} + frxXXXEditor, +{$ENDIF} + frxDsgnIntf, frxRes; + + +{ TfrxXXXComponents } + +constructor TfrxXXXComponents.Create(AOwner: TComponent); +begin + inherited; + FOldComponents := XXXComponents; + XXXComponents := Self; +end; + +destructor TfrxXXXComponents.Destroy; +begin + if XXXComponents = Self then + XXXComponents := FOldComponents; + inherited; +end; + +function TfrxXXXComponents.GetDescription: String; +begin + Result := 'XXX'; +end; + + +{ TfrxXXXDatabase } + +constructor TfrxXXXDatabase.Create(AOwner: TComponent); +begin + inherited; + FDatabase := TXXXDatabase.Create(nil); + Component := FDatabase; +end; + +destructor TfrxXXXDatabase.Destroy; +begin + inherited; +end; + +class function TfrxXXXDatabase.GetDescription: String; +begin + Result := 'XXX Database'; +end; + +function TfrxXXXDatabase.GetConnected: Boolean; +begin + Result := FDatabase.Connected; +end; + +function TfrxXXXDatabase.GetDatabaseName: String; +begin + Result := FDatabase.DatabaseName; +end; + +function TfrxXXXDatabase.GetLoginPrompt: Boolean; +begin + Result := FDatabase.LoginPrompt; +end; + +function TfrxXXXDatabase.GetParams: TStrings; +begin + Result := FDatabase.Params; +end; + +procedure TfrxXXXDatabase.SetConnected(Value: Boolean); +begin + FDatabase.Connected := Value; +end; + +procedure TfrxXXXDatabase.SetDatabaseName(const Value: String); +begin + FDatabase.DatabaseName := Value; +end; + +procedure TfrxXXXDatabase.SetLoginPrompt(Value: Boolean); +begin + FDatabase.LoginPrompt := Value; +end; + +procedure TfrxXXXDatabase.SetParams(Value: TStrings); +begin + FDatabase.Params := Value; +end; + +procedure TfrxXXXDatabase.SetLogin(const Login, Password: String); +begin +// this method is used by "New connection" wizard +// for example (IBX): +// Params.Text := 'user_name=' + Login + #13#10 + 'password=' + Password; +end; + + +{ TfrxXXXTable } + +constructor TfrxXXXTable.Create(AOwner: TComponent); +begin + FTable := TXXXTable.Create(nil); + DataSet := FTable; + SetDatabase(nil); + inherited; +end; + +constructor TfrxXXXTable.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 TfrxXXXDatabase then + begin + SetDatabase(TfrxXXXDatabase(l[i])); + break; + end; +end; + +class function TfrxXXXTable.GetDescription: String; +begin + Result := 'XXX Table'; +end; + +procedure TfrxXXXTable.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (Operation = opRemove) and (AComponent = FDatabase) then + SetDatabase(nil); +end; + +procedure TfrxXXXTable.SetDatabase(const Value: TfrxXXXDatabase); +begin + FDatabase := Value; + if Value <> nil then + FTable.Database := Value.Database + else if XXXComponents <> nil then + FTable.Database := XXXComponents.DefaultDatabase + else + FTable.Database := nil; +end; + +function TfrxXXXTable.GetIndexFieldNames: String; +begin + Result := FTable.IndexFieldNames; +end; + +function TfrxXXXTable.GetIndexName: String; +begin + Result := FTable.IndexName; +end; + +function TfrxXXXTable.GetTableName: String; +begin + Result := FTable.TableName; +end; + +procedure TfrxXXXTable.SetIndexFieldNames(const Value: String); +begin + FTable.IndexFieldNames := Value; +end; + +procedure TfrxXXXTable.SetIndexName(const Value: String); +begin + FTable.IndexName := Value; +end; + +procedure TfrxXXXTable.SetTableName(const Value: String); +begin + FTable.TableName := Value; +end; + +procedure TfrxXXXTable.SetMaster(const Value: TDataSource); +begin + FTable.MasterSource := Value; +end; + +procedure TfrxXXXTable.SetMasterFields(const Value: String); +begin + FTable.MasterFields := Value; +end; + +procedure TfrxXXXTable.BeforeStartReport; +begin + SetDatabase(FDatabase); +end; + + +{ TfrxXXXQuery } + +constructor TfrxXXXQuery.Create(AOwner: TComponent); +begin + FQuery := TXXXQuery.Create(nil); + Dataset := FQuery; + SetDatabase(nil); + inherited; +end; + +constructor TfrxXXXQuery.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 TfrxXXXDatabase then + begin + SetDatabase(TfrxXXXDatabase(l[i])); + break; + end; +end; + +class function TfrxXXXQuery.GetDescription: String; +begin + Result := 'XXX Query'; +end; + +procedure TfrxXXXQuery.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (Operation = opRemove) and (AComponent = FDatabase) then + SetDatabase(nil); +end; + +procedure TfrxXXXQuery.SetDatabase(const Value: TfrxXXXDatabase); +begin + FDatabase := Value; + if Value <> nil then + FQuery.Database := Value.Database + else if XXXComponents <> nil then + FQuery.Database := XXXComponents.DefaultDatabase + else + FQuery.Database := nil; +end; + +function TfrxXXXQuery.GetSQL: TStrings; +begin + Result := FQuery.SQL; +end; + +procedure TfrxXXXQuery.SetSQL(Value: TStrings); +begin + FQuery.SQL := Value; +end; + +procedure TfrxXXXQuery.SetMaster(const Value: TDataSource); +begin + FQuery.DataSource := Value; +end; + +procedure TfrxXXXQuery.UpdateParams; +begin + frxParamsToTParams(Self, FQuery.Params); +end; + +procedure TfrxXXXQuery.BeforeStartReport; +begin + SetDatabase(FDatabase); +end; + +{$IFDEF QBUILDER} +function TfrxXXXQuery.QBEngine: TfqbEngine; +begin + Result := TfrxEngineXXX.Create(nil); + TfrxEngineXXX(Result).FQuery.Database := FQuery.Database; +end; +{$ENDIF} + + +{$IFDEF QBUILDER} +constructor TfrxEngineXXX.Create(AOwner: TComponent); +begin + inherited; + FQuery := TXXXQuery.Create(Self); +end; + +destructor TfrxEngineXXX.Destroy; +begin + FQuery.Free; + inherited; +end; + +procedure TfrxEngineXXX.ReadFieldList(const ATableName: string; + var AFieldList: TfqbFieldList); +var + TempTable: TXXXTable; + Fields: TFieldDefs; + i: Integer; + tmpField: TfqbField; +begin + AFieldList.Clear; + TempTable := TXXXTable.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 TfrxEngineXXX.ReadTableList(ATableList: TStrings); +begin + ATableList.Clear; + FQuery.Database.GetTableNames(ATableList, ShowSystemTables); +end; + +function TfrxEngineXXX.ResultDataSet: TDataSet; +begin + Result := FQuery; +end; + +procedure TfrxEngineXXX.SetSQL(const Value: string); +begin + FQuery.SQL.Text := Value; +end; +{$ENDIF} + + +var + CatBmp: TBitmap; + +initialization + CatBmp := TBitmap.Create; + CatBmp.LoadFromResourceName(hInstance, 'frxXXX'); + frxObjects.RegisterCategory('XXX', CatBmp, 'XXX Components'); + frxObjects.RegisterObject1(TfrxXXXDataBase, nil, '', 'XXX', 0, 37); + frxObjects.RegisterObject1(TfrxXXXTable, nil, '', 'XXX', 0, 38); + frxObjects.RegisterObject1(TfrxXXXQuery, nil, '', 'XXX', 0, 39); + +finalization + CatBmp.Free; + frxObjects.UnRegister(TfrxXXXDataBase); + frxObjects.UnRegister(TfrxXXXTable); + frxObjects.UnRegister(TfrxXXXQuery); + + +end. \ No newline at end of file diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXComponents.res b/official/3.23/Extra/New DB engine/Template/frxXXXComponents.res new file mode 100644 index 0000000..5003505 Binary files /dev/null and b/official/3.23/Extra/New DB engine/Template/frxXXXComponents.res differ diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXEditor.pas b/official/3.23/Extra/New DB engine/Template/frxXXXEditor.pas new file mode 100644 index 0000000..933c527 --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXXEditor.pas @@ -0,0 +1,162 @@ + +{******************************************} +{ } +{ FastReport v3.0 } +{ XXX components design editors } +{ } + +// Copyright +{ } +{******************************************} + +unit frxXXXEditor; + +interface + +{$I frx.inc} + +implementation + +uses + Windows, Classes, SysUtils, Forms, Dialogs, frxXXXComponents, frxCustomDB, + frxDsgnIntf, frxRes, UXXX +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +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 := 'put your filter here'; + Result := Execute; + if Result then + with TfrxXXXDatabase(Component).Database do + begin + SaveConnected := Connected; + Connected := False; + DatabaseName := FileName; + Connected := SaveConnected; + end; + Free; + end; +end; + + +{ TfrxDatabaseProperty } + +function TfrxDatabaseProperty.GetValue: String; +var + db: TfrxXXXDatabase; +begin + db := TfrxXXXDatabase(GetOrdValue); + if db = nil then + begin + if (XXXComponents <> nil) and (XXXComponents.DefaultDatabase <> nil) then + Result := XXXComponents.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 TfrxXXXTable(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 TfrxXXXTable(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), TfrxXXXDataBase, 'DatabaseName', + TfrxDataBaseNameProperty); + frxPropertyEditors.Register(TypeInfo(TfrxXXXDatabase), TfrxXXXTable, 'Database', + TfrxDatabaseProperty); + frxPropertyEditors.Register(TypeInfo(TfrxXXXDatabase), TfrxXXXQuery, 'Database', + TfrxDatabaseProperty); + frxPropertyEditors.Register(TypeInfo(String), TfrxXXXTable, 'TableName', + TfrxTableNameProperty); + frxPropertyEditors.Register(TypeInfo(String), TfrxXXXTable, 'IndexName', + TfrxIndexNameProperty); + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXRTTI.pas b/official/3.23/Extra/New DB engine/Template/frxXXXRTTI.pas new file mode 100644 index 0000000..d9e22dd --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXXRTTI.pas @@ -0,0 +1,67 @@ + +{******************************************} +{ } +{ FastReport v3.0 } +{ XXX components RTTI } +{ } + +// Copyright +{ } +{******************************************} + +unit frxXXXRTTI; + +interface + +{$I frx.inc} + +implementation + +uses + Windows, Classes, fs_iinterpreter, frxXXXComponents +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +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(TfrxXXXDatabase, 'TfrxCustomDatabase'); + AddClass(TfrxXXXTable, 'TfrxCustomTable'); + with AddClass(TfrxXXXQuery, '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 = TfrxXXXQuery then + begin + if MethodName = 'EXECSQL' then + TfrxXXXQuery(Instance).Query.ExecSQL + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +end. diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXReg.dcr b/official/3.23/Extra/New DB engine/Template/frxXXXReg.dcr new file mode 100644 index 0000000..afd0cd9 Binary files /dev/null and b/official/3.23/Extra/New DB engine/Template/frxXXXReg.dcr differ diff --git a/official/3.23/Extra/New DB engine/Template/frxXXXReg.pas b/official/3.23/Extra/New DB engine/Template/frxXXXReg.pas new file mode 100644 index 0000000..8a72a7c --- /dev/null +++ b/official/3.23/Extra/New DB engine/Template/frxXXXReg.pas @@ -0,0 +1,36 @@ + +{******************************************} +{ } +{ FastReport v3.0 } +{ XXX components registration } +{ } + +// Copyright +{ } +{******************************************} + +unit frxXXXReg; + +interface + +{$I frx.inc} + +procedure Register; + +implementation + +uses + Windows, Messages, SysUtils, Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf, DesignEditors +{$ENDIF} +, frxXXXComponents; + +procedure Register; +begin + RegisterComponents('FastReport 3.0', [TfrxXXXComponents]); +end; + +end. diff --git a/official/3.23/Extra/clean.bat b/official/3.23/Extra/clean.bat new file mode 100644 index 0000000..4bce90f --- /dev/null +++ b/official/3.23/Extra/clean.bat @@ -0,0 +1,2 @@ +del %windir%\system32\%1 +del "C:\Program Files\Borland\Delphi7\Projects\Bpl\%1" \ No newline at end of file diff --git a/official/3.23/Extra/cleanFR3.bat b/official/3.23/Extra/cleanFR3.bat new file mode 100644 index 0000000..42743f2 --- /dev/null +++ b/official/3.23/Extra/cleanFR3.bat @@ -0,0 +1,13 @@ +cmd /C clean.bat frx7.bpl +cmd /C clean.bat fqb70.bpl +cmd /C clean.bat frxBDE7.bpl +cmd /C clean.bat frxADO7.bpl +cmd /C clean.bat frxDB7.bpl +cmd /C clean.bat frxDBX7.bpl +cmd /C clean.bat frxIBX7.bpl +cmd /C clean.bat fsADO7.bpl +cmd /C clean.bat fsBDE7.bpl +cmd /C clean.bat fsDB7.bpl +cmd /C clean.bat fsDBX7.bpl +cmd /C clean.bat fsIBX7.bpl +cmd /C clean.bat fs7.bpl \ No newline at end of file diff --git a/official/3.23/Extra/frcc/frcc.dpr b/official/3.23/Extra/frcc/frcc.dpr new file mode 100644 index 0000000..0f88292 --- /dev/null +++ b/official/3.23/Extra/frcc/frcc.dpr @@ -0,0 +1,88 @@ +program frcc; +{$APPTYPE CONSOLE} +uses + SysUtils, Classes; + + +procedure MakeAllResources; +var + sl, sl1: TStringList; + curDir, resName: String; + i: Integer; +begin + curDir := GetCurrentDir; + resName := ''; + for i := Length(curDir) downto 1 do + if curDir[i] = '\' then + begin + resName := Copy(curDir, i + 1, 255); + break; + end; + sl := TStringList.Create; + sl1 := TStringList.Create; + sl.LoadFromFile(curDir + '\frxrcClass.frc'); + sl1.AddStrings(sl); + sl.LoadFromFile(curDir + '\frxrcDesgn.frc'); + sl1.AddStrings(sl); + sl.LoadFromFile(curDir + '\frxrcExports.frc'); + sl1.AddStrings(sl); + sl.LoadFromFile(curDir + '\frxrcInsp.frc'); + sl1.AddStrings(sl); + sl1.SaveToFile(curDir + '\' + resName + '.frc'); + sl.Free; + sl1.Free; +end; + +procedure MakeResource(const fileName: String); +var + i: Integer; + curDir: String; + sl, sl1: TStringList; +begin + curDir := GetCurrentDir; + sl := TStringList.Create; + sl1 := TStringList.Create; + + sl.LoadFromFile(curDir + '\' + fileName); + sl1.Add('{******************************************}'); + sl1.Add('{ }'); + sl1.Add('{ FastReport v3.0 }'); + sl1.Add('{ Language resource file }'); + sl1.Add('{ }'); + sl1.Add('{ Copyright (c) 1998-2005 }'); + sl1.Add('{ by Alexander Tzyganenko, }'); + sl1.Add('{ Fast Reports Inc. }'); + sl1.Add('{ }'); + sl1.Add('{******************************************}'); + sl1.Add(''); + sl1.Add('unit ' + ChangeFileExt(fileName, '') + ';'); + sl1.Add(''); + sl1.Add('interface'); + sl1.Add(''); + sl1.Add('implementation'); + sl1.Add(''); + sl1.Add('uses frxRes;'); + sl1.Add(''); + sl1.Add('const resStr ='); + + for i := 0 to sl.Count - 1 do + sl1.Add(QuotedStr(Trim(sl[i])) + ' + #13#10 +'); + + sl1.Add('''' + ''';'); + sl1.Add(''); + sl1.Add('initialization'); + sl1.Add(' frxResources.AddStrings(resStr);'); + sl1.Add(''); + sl1.Add('end.'); + sl1.SaveToFile(curDir + '\' + ChangeFileExt(fileName, '.pas')); + + sl.Free; + sl1.Free; +end; + +begin + if CompareText(ParamStr(1), '-all') = 0 then + MakeAllResources + else if FileExists(ParamStr(1)) then + MakeResource(ParamStr(1)); +end. diff --git a/official/3.23/FastQB/adler32.zobj b/official/3.23/FastQB/adler32.zobj new file mode 100644 index 0000000..04e2028 Binary files /dev/null and b/official/3.23/FastQB/adler32.zobj differ diff --git a/official/3.23/FastQB/ado/dclfqbADO70.dpk b/official/3.23/FastQB/ado/dclfqbADO70.dpk new file mode 100644 index 0000000..e5dd5d1 --- /dev/null +++ b/official/3.23/FastQB/ado/dclfqbADO70.dpk @@ -0,0 +1,38 @@ +package dclfqbADO70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder ADO Engine'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqbADO70 + ; + +contains + fqbRegADO in 'fqbRegADO.pas' + ; + +end. diff --git a/official/3.23/FastQB/ado/fqbADO70.dpk b/official/3.23/FastQB/ado/fqbADO70.dpk new file mode 100644 index 0000000..0228268 --- /dev/null +++ b/official/3.23/FastQB/ado/fqbADO70.dpk @@ -0,0 +1,44 @@ +package fqbADO70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder ADO Engine'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl, + fqb70, + adortl + ; + +contains + fqbADOEngine in 'fqbADOEngine.pas' + ; + +end. diff --git a/official/3.23/FastQB/ado/fqbADOEngine.dcu b/official/3.23/FastQB/ado/fqbADOEngine.dcu new file mode 100644 index 0000000..8f2d77e Binary files /dev/null and b/official/3.23/FastQB/ado/fqbADOEngine.dcu differ diff --git a/official/3.23/FastQB/ado/fqbRegADO.dcu b/official/3.23/FastQB/ado/fqbRegADO.dcu new file mode 100644 index 0000000..7aa7571 Binary files /dev/null and b/official/3.23/FastQB/ado/fqbRegADO.dcu differ diff --git a/official/3.23/FastQB/ado/fqb_ado.dcr b/official/3.23/FastQB/ado/fqb_ado.dcr new file mode 100644 index 0000000..0b7688d Binary files /dev/null and b/official/3.23/FastQB/ado/fqb_ado.dcr differ diff --git a/official/3.23/FastQB/bde/dclfqbBDE70.dpk b/official/3.23/FastQB/bde/dclfqbBDE70.dpk new file mode 100644 index 0000000..f5348a7 --- /dev/null +++ b/official/3.23/FastQB/bde/dclfqbBDE70.dpk @@ -0,0 +1,38 @@ +package dclfqbBDE70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder BDE Engine'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqbBDE70 + ; + +contains + fqbRegBDE in 'fqbRegBDE.pas' + ; + +end. diff --git a/official/3.23/FastQB/bde/fqbBDE70.dpk b/official/3.23/FastQB/bde/fqbBDE70.dpk new file mode 100644 index 0000000..07ff83a --- /dev/null +++ b/official/3.23/FastQB/bde/fqbBDE70.dpk @@ -0,0 +1,43 @@ +package fqbBDE70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder BDE Engine'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl, + fqb70 + ; + +contains + fqbBDEEngine in 'fqbBDEEngine.pas' + ; + +end. diff --git a/official/3.23/FastQB/bde/fqbBDEEngine.dcu b/official/3.23/FastQB/bde/fqbBDEEngine.dcu new file mode 100644 index 0000000..c6d9884 Binary files /dev/null and b/official/3.23/FastQB/bde/fqbBDEEngine.dcu differ diff --git a/official/3.23/FastQB/bde/fqbRegBDE.dcu b/official/3.23/FastQB/bde/fqbRegBDE.dcu new file mode 100644 index 0000000..f686df5 Binary files /dev/null and b/official/3.23/FastQB/bde/fqbRegBDE.dcu differ diff --git a/official/3.23/FastQB/bde/fqb_bde.dcr b/official/3.23/FastQB/bde/fqb_bde.dcr new file mode 100644 index 0000000..081d412 Binary files /dev/null and b/official/3.23/FastQB/bde/fqb_bde.dcr differ diff --git a/official/3.23/FastQB/compress.zobj b/official/3.23/FastQB/compress.zobj new file mode 100644 index 0000000..4de94fa Binary files /dev/null and b/official/3.23/FastQB/compress.zobj differ diff --git a/official/3.23/FastQB/crc32.zobj b/official/3.23/FastQB/crc32.zobj new file mode 100644 index 0000000..4b7261c Binary files /dev/null and b/official/3.23/FastQB/crc32.zobj differ diff --git a/official/3.23/FastQB/dbx/dclfqbDBX70.dpk b/official/3.23/FastQB/dbx/dclfqbDBX70.dpk new file mode 100644 index 0000000..db9c269 --- /dev/null +++ b/official/3.23/FastQB/dbx/dclfqbDBX70.dpk @@ -0,0 +1,38 @@ +package dclfqbDBX70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder DBX Engine'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqbDBX70 + ; + +contains + fqbRegDBX in 'fqbRegDBX.pas' + ; + +end. diff --git a/official/3.23/FastQB/dbx/fqbDBX70.dpk b/official/3.23/FastQB/dbx/fqbDBX70.dpk new file mode 100644 index 0000000..b21f8e5 --- /dev/null +++ b/official/3.23/FastQB/dbx/fqbDBX70.dpk @@ -0,0 +1,46 @@ +package fqbDBX70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder DBX Engine'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl, + fqb70, + dbexpress, + dsnap, + dbxcds + ; + +contains + fqbDBXEngine in 'fqbDBXEngine.pas' + ; + +end. diff --git a/official/3.23/FastQB/dbx/fqbDBXEngine.dcu b/official/3.23/FastQB/dbx/fqbDBXEngine.dcu new file mode 100644 index 0000000..977ffa1 Binary files /dev/null and b/official/3.23/FastQB/dbx/fqbDBXEngine.dcu differ diff --git a/official/3.23/FastQB/dbx/fqbRegDBX.dcu b/official/3.23/FastQB/dbx/fqbRegDBX.dcu new file mode 100644 index 0000000..f729ac8 Binary files /dev/null and b/official/3.23/FastQB/dbx/fqbRegDBX.dcu differ diff --git a/official/3.23/FastQB/dbx/fqb_dbx.dcr b/official/3.23/FastQB/dbx/fqb_dbx.dcr new file mode 100644 index 0000000..78a19cc Binary files /dev/null and b/official/3.23/FastQB/dbx/fqb_dbx.dcr differ diff --git a/official/3.23/FastQB/dclfqb100.bdsproj b/official/3.23/FastQB/dclfqb100.bdsproj new file mode 100644 index 0000000..01ea97a --- /dev/null +++ b/official/3.23/FastQB/dclfqb100.bdsproj @@ -0,0 +1,161 @@ +п»ї + + + + + + + + + + + dclfqb100.dpk + + + 9.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastQueryBuilder 1.03 + + + + + + + + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1053 + 1252 + + + diff --git a/official/3.23/FastQB/dclfqb100.dpk b/official/3.23/FastQB/dclfqb100.dpk new file mode 100644 index 0000000..1bbe409 --- /dev/null +++ b/official/3.23/FastQB/dclfqb100.dpk @@ -0,0 +1,38 @@ +package dclfqb100; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + DESIGNIDE, + fqb100 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/dclfqb40.dpk b/official/3.23/FastQB/dclfqb40.dpk new file mode 100644 index 0000000..2f2e92f --- /dev/null +++ b/official/3.23/FastQB/dclfqb40.dpk @@ -0,0 +1,40 @@ +package dclfqb40; + +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl40, + vclx40, + vcldb40, + fqb40 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/dclfqb50.bpk b/official/3.23/FastQB/dclfqb50.bpk new file mode 100644 index 0000000..0b88aeb --- /dev/null +++ b/official/3.23/FastQB/dclfqb50.bpk @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=1 +Special=1 +Private=0 +DLL=0 + + diff --git a/official/3.23/FastQB/dclfqb50.cpp b/official/3.23/FastQB/dclfqb50.cpp new file mode 100644 index 0000000..082e232 --- /dev/null +++ b/official/3.23/FastQB/dclfqb50.cpp @@ -0,0 +1,21 @@ + +#include +#pragma hdrstop +USEUNIT("fqbReg.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("fqb50.bpi"); + +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- + +// Package source. +//--------------------------------------------------------------------------- + +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/3.23/FastQB/dclfqb50.dpk b/official/3.23/FastQB/dclfqb50.dpk new file mode 100644 index 0000000..7c97e6e --- /dev/null +++ b/official/3.23/FastQB/dclfqb50.dpk @@ -0,0 +1,38 @@ +package dclfqb50; + +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl50, + fqb50 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/dclfqb60.bpk b/official/3.23/FastQB/dclfqb60.bpk new file mode 100644 index 0000000..6f33c71 --- /dev/null +++ b/official/3.23/FastQB/dclfqb60.bpk @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=1 +Special=1 +Private=0 +DLL=0 + + diff --git a/official/3.23/FastQB/dclfqb60.cpp b/official/3.23/FastQB/dclfqb60.cpp new file mode 100644 index 0000000..b70f973 --- /dev/null +++ b/official/3.23/FastQB/dclfqb60.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; +} +//--------------------------------------------------------------------------- + diff --git a/official/3.23/FastQB/dclfqb60.dpk b/official/3.23/FastQB/dclfqb60.dpk new file mode 100644 index 0000000..76167da --- /dev/null +++ b/official/3.23/FastQB/dclfqb60.dpk @@ -0,0 +1,38 @@ +package dclfqb60; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqb60 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/dclfqb70.dpk b/official/3.23/FastQB/dclfqb70.dpk new file mode 100644 index 0000000..3dc6088 --- /dev/null +++ b/official/3.23/FastQB/dclfqb70.dpk @@ -0,0 +1,38 @@ +package dclfqb70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqb70 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/dclfqb90.bdsproj b/official/3.23/FastQB/dclfqb90.bdsproj new file mode 100644 index 0000000..b6931a9 --- /dev/null +++ b/official/3.23/FastQB/dclfqb90.bdsproj @@ -0,0 +1,161 @@ +п»ї + + + + + + + + + + + dclfqb90.dpk + + + 9.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastQueryBuilder 1.03 + + + + + + + + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1053 + 1252 + + + diff --git a/official/3.23/FastQB/dclfqb90.dpk b/official/3.23/FastQB/dclfqb90.dpk new file mode 100644 index 0000000..2609799 --- /dev/null +++ b/official/3.23/FastQB/dclfqb90.dpk @@ -0,0 +1,38 @@ +package dclfqb90; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqb90 + ; + +contains + fqbReg in 'fqbReg.pas' + ; + +end. diff --git a/official/3.23/FastQB/deflate.zobj b/official/3.23/FastQB/deflate.zobj new file mode 100644 index 0000000..8cf3759 Binary files /dev/null and b/official/3.23/FastQB/deflate.zobj differ diff --git a/official/3.23/FastQB/fib/dclfqbFIB70.dpk b/official/3.23/FastQB/fib/dclfqbFIB70.dpk new file mode 100644 index 0000000..e55d5ee --- /dev/null +++ b/official/3.23/FastQB/fib/dclfqbFIB70.dpk @@ -0,0 +1,38 @@ +package dclfqbFIB70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder FIB Engine'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqbFIB70 + ; + +contains + fqbRegFIB in 'fqbRegFIB.pas' + ; + +end. diff --git a/official/3.23/FastQB/fib/fqbFIB70.dpk b/official/3.23/FastQB/fib/fqbFIB70.dpk new file mode 100644 index 0000000..e6d0035 --- /dev/null +++ b/official/3.23/FastQB/fib/fqbFIB70.dpk @@ -0,0 +1,44 @@ +package fqbFIB70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder FIB Engine'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl, + fqb70, + fibplus7 + ; + +contains + fqbFIBEngine in 'fqbFIBEngine.pas' + ; + +end. diff --git a/official/3.23/FastQB/fib/fqbFIBEngine.pas b/official/3.23/FastQB/fib/fqbFIBEngine.pas new file mode 100644 index 0000000..e55e29f --- /dev/null +++ b/official/3.23/FastQB/fib/fqbFIBEngine.pas @@ -0,0 +1,122 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.01 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbFIBEngine; + +interface + +uses + Windows, Messages, Classes, Dialogs, DB +{$IFDEF Delphi6} + ,Variants +{$ENDIF} + ,fqbClass, FIBDatabase, pFIBDatabase, FIBDataSet, pFIBDataSet; + +type + TfqbFIBEngine = class(TfqbEngine) + private + FDatabase: TpFIBDatabase; + FQuery: TFIBDataSet; + procedure SetDatabase(Value: TpFIBDatabase); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); + override; + procedure ReadTableList(ATableList: TStrings); override; + function ResultDataSet: TDataSet; override; + procedure SetSQL(const Value: string); override; + published + property Database: TpFIBDatabase read FDatabase write SetDatabase; + end; + + +implementation + +uses SysUtils, FIBQuery; + +{----------------------- TfqbFIBEngine -----------------------} +constructor TfqbFIBEngine.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FQuery := TFIBDataSet.Create(Self); +end; + +destructor TfqbFIBEngine.Destroy; +begin + FQuery.Free; + inherited Destroy; +end; + +procedure TfqbFIBEngine.ReadFieldList(const ATableName: string; var AFieldList: + TfqbFieldList); +var + tmpTransaction: TFIBTransaction; + tbl: TFIBDataSet; + tmpField: TfqbField; + i: Integer; +begin + tbl := TFIBDataSet.Create(Self); + tmpTransaction := TFIBTransaction.Create(Self); + tmpTransaction.DefaultDatabase := FDatabase; + try + tbl.Database := FDatabase; + tbl.Transaction := tmpTransaction; + tbl.SelectSQL.Add('SELECT *'); + tbl.SelectSQL.Add('FROM ' + UpperCase(ATableName)); + tmpTransaction.StartTransaction; + tbl.Prepare; + tbl.Open; + tmpField:= TfqbField(AFieldList.Add); + tmpField.FieldName := '*'; + for i := 0 to tbl.FieldCount - 1 do + begin + tmpField:= TfqbField(AFieldList.Add); + tmpField.FieldName := tbl.Fields[i].DisplayName; + tmpField.FieldType := Ord(tbl.Fields[i].DataType); + end + finally + if tmpTransaction.Active then + tmpTransaction.Commit; + tbl.Close; + tbl.Free; + tmpTransaction.Free; + end; +end; + +procedure TfqbFIBEngine.ReadTableList(ATableList: TStrings); +begin + ATableList.Clear; + FDatabase.Open; + FDatabase.GetTableNames(ATableList, ShowSystemTables); +end; + +function TfqbFIBEngine.ResultDataSet: TDataSet; +begin + Result := FQuery +end; + +procedure TfqbFIBEngine.SetDatabase(Value: TpFIBDatabase); +begin + FQuery.Close; + FDatabase := Value; + FQuery.Database := FDatabase; +end; + +procedure TfqbFIBEngine.SetSQL(const Value: string); +begin + FQuery.Close; + FQuery.SelectSQL.Text := Value; +end; + + + +end. diff --git a/official/3.23/FastQB/fib/fqbRegFIB.pas b/official/3.23/FastQB/fib/fqbRegFIB.pas new file mode 100644 index 0000000..709abb1 --- /dev/null +++ b/official/3.23/FastQB/fib/fqbRegFIB.pas @@ -0,0 +1,36 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.01 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbRegFIB; + +interface + +procedure Register; + +implementation + +uses + Classes, +{$IFNDEF Delphi6} + DsgnIntf, +{$ELSE} + DesignIntf, +{$ENDIF} + fqbClass, fqbFIBEngine; + +{$R 'fqb_fib.DCR'} + +procedure Register; +begin + RegisterComponents('FastQueryBuilder', [TfqbFIBEngine]) +end; + +end. diff --git a/official/3.23/FastQB/fib/fqb_fib.dcr b/official/3.23/FastQB/fib/fqb_fib.dcr new file mode 100644 index 0000000..ab0fcdf Binary files /dev/null and b/official/3.23/FastQB/fib/fqb_fib.dcr differ diff --git a/official/3.23/FastQB/fqb.dcr b/official/3.23/FastQB/fqb.dcr new file mode 100644 index 0000000..1f3ca4c Binary files /dev/null and b/official/3.23/FastQB/fqb.dcr differ diff --git a/official/3.23/FastQB/fqb.inc b/official/3.23/FastQB/fqb.inc new file mode 100644 index 0000000..a1fce53 --- /dev/null +++ b/official/3.23/FastQB/fqb.inc @@ -0,0 +1,98 @@ +{*******************************************} +{ } +{ FastQueryBuilder v1.03 } +{ Include file } +{ } +{ Copyright (c) 2004-2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + + +{$B-} {- Complete Boolean Evaluation } +{$R-} {- Range-Checking } +{$V-} {- Var-String Checking } +{$T-} {- Typed @ operator } +{$X+} {- Extended syntax } +{$P+} {- Open string params } +{$J+} {- Writeable structured consts } +{$H+} {- Use long strings by default } + +{$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} + {$DEFINE Delphi7} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF} + +{$IFDEF VER170} // Delphi 9.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$WARN UNSAFE_CODE OFF} +{$ENDIF} + +{$IFDEF VER180} // Delphi 10.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$WARN UNSAFE_CODE OFF} +{$ENDIF} + +{$IFDEF VER93} // Borland C++ Builder 1.0 + {$DEFINE Delphi2} +{$ENDIF} + +{$IFDEF VER110} // Borland C++ Builder 3.0 + {$DEFINE Delphi3} + {$ObjExportAll on} +{$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} + {$WARN UNSAFE_CODE OFF} + {$ENDIF} +{$ENDIF} + +{$WARNINGS OFF} diff --git a/official/3.23/FastQB/fqb100.bdsproj b/official/3.23/FastQB/fqb100.bdsproj new file mode 100644 index 0000000..d28461b --- /dev/null +++ b/official/3.23/FastQB/fqb100.bdsproj @@ -0,0 +1,161 @@ +п»ї + + + + + + + + + + + fqb100.dpk + + + 9.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastQueryBuilder 1.03 + + + + + + + + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1053 + 1252 + + + diff --git a/official/3.23/FastQB/fqb100.dpk b/official/3.23/FastQB/fqb100.dpk new file mode 100644 index 0000000..60eebc3 --- /dev/null +++ b/official/3.23/FastQB/fqb100.dpk @@ -0,0 +1,47 @@ +package fqb100; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqb40.bpk b/official/3.23/FastQB/fqb40.bpk new file mode 100644 index 0000000..4622d63 --- /dev/null +++ b/official/3.23/FastQB/fqb40.bpk @@ -0,0 +1,189 @@ +# --------------------------------------------------------------------------- +!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 = fqb40.bpl +OBJFILES = fqbReg.obj fqb40.obj +RESFILES = fqb.dcr +RESDEPEN = $(RESFILES) +LIBFILES = +IDLFILES = +IDLGENFILES = +LIBRARIES = +SPARELIBS = Vcl40.lib +PACKAGES = vcl40.bpi vcldb40.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 -Od -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -r- \ + -a8 -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES) +IDLCFLAGS = -I$(BCB)\include -I$(BCB)\include\vcl -src_suffixcpp +PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ + -I$(BCB)\include;$(BCB)\include\vcl -$YD -$W -$O- -v -JPHNE -M +RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl +AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zd +LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -D"FastQueryBuilder 1.0" -aa -Tpp -x -Gn -Gl \ + -Gi -v +# --------------------------------------------------------------------------- +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= + +[Debugging] +DebugSourceDirs=$(BCB)\source\vcl + +[Parameters] +RunParams= +HostApplication= +RemoteHost= +RemotePath= +RemoteDebug=0 + +[Compiler] +InMemoryExe=0 +ShowInfoMsgs=0 + +[CORBA] +AddServerUnit=1 +AddClientUnit=1 +PrecompiledHeaders=1 + +!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(IDL2CPP) +IDL2CPP = idl2cpp +!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): $(IDLGENFILES) $(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/official/3.23/FastQB/fqb40.cpp b/official/3.23/FastQB/fqb40.cpp new file mode 100644 index 0000000..a0e4ed2 --- /dev/null +++ b/official/3.23/FastQB/fqb40.cpp @@ -0,0 +1,18 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USEPACKAGE("vcl40.bpi"); +USERES("fqb.dcr"); +USEUNIT("fqbReg.pas"); +USEPACKAGE("vcldb40.bpi"); +USEPACKAGE("vclx40.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/3.23/FastQB/fqb40.dpk b/official/3.23/FastQB/fqb40.dpk new file mode 100644 index 0000000..b5e14a3 --- /dev/null +++ b/official/3.23/FastQB/fqb40.dpk @@ -0,0 +1,44 @@ +package fqb40; + +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl40, + vclx40, + vcldb40 + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqb50.bpk b/official/3.23/FastQB/fqb50.bpk new file mode 100644 index 0000000..3fc8999 --- /dev/null +++ b/official/3.23/FastQB/fqb50.bpk @@ -0,0 +1,89 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=1 +Special=1 +Private=0 +DLL=0 + + diff --git a/official/3.23/FastQB/fqb50.cpp b/official/3.23/FastQB/fqb50.cpp new file mode 100644 index 0000000..9b34e80 --- /dev/null +++ b/official/3.23/FastQB/fqb50.cpp @@ -0,0 +1,28 @@ + +#include +#pragma hdrstop +USEUNIT("fqbClass.pas"); +USEUNIT("fqbSynmemo.pas"); +USEUNIT("fqbLinkForm.pas"); +USEUNIT("fqbUtils.pas"); +USEUNIT("fqbDesign.pas"); +USEUNIT("fqbZLib.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("vclx50.bpi"); +USEPACKAGE("vcldb50.bpi"); +USEPACKAGE("vclbde50.bpi"); + +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- + +// Package source. +//--------------------------------------------------------------------------- + +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/3.23/FastQB/fqb50.dpk b/official/3.23/FastQB/fqb50.dpk new file mode 100644 index 0000000..a612a4d --- /dev/null +++ b/official/3.23/FastQB/fqb50.dpk @@ -0,0 +1,45 @@ +package fqb50; + +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl50, + vclx50, + vcldb50, + vclbde50 + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqb60.bpk b/official/3.23/FastQB/fqb60.bpk new file mode 100644 index 0000000..5ee1914 --- /dev/null +++ b/official/3.23/FastQB/fqb60.bpk @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=1 +Special=1 +Private=0 +DLL=0 + + diff --git a/official/3.23/FastQB/fqb60.cpp b/official/3.23/FastQB/fqb60.cpp new file mode 100644 index 0000000..55bebe9 --- /dev/null +++ b/official/3.23/FastQB/fqb60.cpp @@ -0,0 +1,20 @@ + +#include +#pragma hdrstop +USEFORMNS("fqbSynmemo.pas", Fqbsynmemo, fqbSynmemo); +USEFORMNS("fqbLinkForm.pas", Fqblinkform, fqbLinkForm); +USEFORMNS("fqbDesign.pas", Fqbdesign, fqbDesign); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- + +// Package source. +//--------------------------------------------------------------------------- + +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/3.23/FastQB/fqb60.dpk b/official/3.23/FastQB/fqb60.dpk new file mode 100644 index 0000000..ed6a741 --- /dev/null +++ b/official/3.23/FastQB/fqb60.dpk @@ -0,0 +1,47 @@ +package fqb60; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqb70.dpk b/official/3.23/FastQB/fqb70.dpk new file mode 100644 index 0000000..0413133 --- /dev/null +++ b/official/3.23/FastQB/fqb70.dpk @@ -0,0 +1,47 @@ +package fqb70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqb90.bdsproj b/official/3.23/FastQB/fqb90.bdsproj new file mode 100644 index 0000000..ec17ecc --- /dev/null +++ b/official/3.23/FastQB/fqb90.bdsproj @@ -0,0 +1,161 @@ +п»ї + + + + + + + + + + + fqb90.dpk + + + 9.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastQueryBuilder 1.03 + + + + + + + + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1053 + 1252 + + + diff --git a/official/3.23/FastQB/fqb90.dpk b/official/3.23/FastQB/fqb90.dpk new file mode 100644 index 0000000..afda5e0 --- /dev/null +++ b/official/3.23/FastQB/fqb90.dpk @@ -0,0 +1,47 @@ +package fqb90; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder 1.03'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl + ; + +contains + fqbClass in 'fqbClass.pas' , + fqbSynmemo in 'fqbSynmemo.pas' {fqbSynmemo}, + fqbLinkForm in 'fqbLinkForm.pas' {fqbLinkForm}, + fqbUtils in 'fqbUtils.pas' , + fqbDesign in 'fqbDesign.pas' {fqbDesign}, + fqbZLib in 'fqbZLib.pas' + ; + +end. diff --git a/official/3.23/FastQB/fqbClass.pas b/official/3.23/FastQB/fqbClass.pas new file mode 100644 index 0000000..e16c09c --- /dev/null +++ b/official/3.23/FastQB/fqbClass.pas @@ -0,0 +1,2272 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbClass; + +interface + +uses + Windows, Messages, Classes, Controls, Menus, Forms, Graphics, StdCtrls, Grids, + DB, SysUtils, ExtCtrls, CheckLst, Buttons, Comctrls +{$IFDEF Delphi6} + ,Variants +{$ENDIF}; + +type + TfqbTable = class; + TfqbTableArea = class; + EfqbError = class(Exception) + end; + + TfqbField = class(TCollectionItem) + private + FFieldName: string; + FFielType: Integer; + FLinked: Boolean; + function GetFieldName: string; + public + property FieldName: string read GetFieldName write FFieldName; + property FieldType: Integer read FFielType write FFielType; + property Linked: Boolean read FLinked write FLinked; + end; + + TfqbFieldList = class(TOwnedCollection) + private + function GetItem(Index: Integer): TfqbField; + procedure SetItem(Index: Integer; const Value: TfqbField); + public + function Add: TfqbField; + property Items[Index: Integer]: TfqbField read GetItem write SetItem; default; + end; + + TfqbLink = class(TCollectionItem) + protected + FArea: TfqbTableArea; + FDestField: TfqbField; + FDestTable: TfqbTable; + FJOp: Integer; + FJType: Integer; + FMenu: TPopupMenu; + FSelected: Boolean; + FSourceField: TfqbField; + FSourceTable: TfqbTable; + procedure DoDelete(Sender: TObject); + procedure DoOptions(Sender: TObject); + procedure Draw; + function GetDestCoords: TPoint; + function GetSourceCoords: TPoint; + procedure SetSelected(const Value: Boolean); + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + property DestCoords: TPoint read GetDestCoords; + property DestField: TfqbField read FDestField; + property DestTable: TfqbTable read FDestTable; + property JoinOperator: Integer read FJOp write FJOp; + property JoinType: Integer read FJType write FJType; + property Selected: Boolean read FSelected write SetSelected; + property SourceCoords: TPoint read GetSourceCoords; + property SourceField: TfqbField read FSourceField; + property SourceTable: TfqbTable read FSourceTable; + end; + + TfqbLinkList = class(TOwnedCollection) + private + function GetItem(Index: Integer): TfqbLink; + procedure SetItem(Index: Integer; const Value: TfqbLink); + public + function Add: TfqbLink; + property Items[Index: Integer]: TfqbLink read GetItem write SetItem; default; + end; + + TfqbCheckListBox = class(TCheckListBox) + protected + procedure ClickCheck; override; + procedure DragOver(Sender: TObject; X, Y: Integer; State: TDragState; var + Accept: Boolean); override; + public + procedure DragDrop(Sender: TObject; X, Y: Integer); override; + end; + + TfqbTable = class(TPanel) + private + FAliasName: string; + FButtonClose: TSpeedButton; + FButtonMinimize: TSpeedButton; + FCheckListBox: TfqbCheckListBox; + FFieldList: TfqbFieldList; + FImage: TImage; + FLabel: TLabel; + FOldHeight: Integer; + FTableName: string; + function GetSellectedField: TfqbField; + procedure SetTableName(const Value: string); + procedure SetXPStyle(const AComp: TControl); + protected + procedure CreateParams(var Params: TCreateParams); override; + function GetLinkPoint(AIndex: integer; ASide: char): TPoint; + procedure Resize; override; + procedure WMMove(var Message: TWMMove); message WM_MOVE; + procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; + procedure WMPaint(var Message: TWMPaint); message WM_PAINT; + procedure CMRelease(var Message: TMessage); message CM_RELEASE; + procedure _DoExit(Sender: TObject); + procedure _DoMinimize(Sender: TObject); + procedure _DoRestore(Sender: TObject); + property ChBox: TfqbCheckListBox read FCheckListBox; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure UpdateFieldList; + procedure UpdateLinkList; + property AliasName: string read FAliasName; + property FieldList: TfqbFieldList read FFieldList write FFieldList; + property SellectedField: TfqbField read GetSellectedField; + property TableName: string read FTableName write SetTableName; + end; + + TfqbTableArea = class(TScrollBox) + private + FCanvas: TCanvas; + FInstX: Integer; + FInstY: Integer; + FLinkList: TfqbLinkList; + protected + procedure Click; override; + function GenerateAlias(const ATableNAme: string): string; virtual; + function GetLineAtCursor: Integer; + procedure WMPaint(var Message: TWMPaint); message WM_PAINT; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function CompareFields(TableID1: integer; FIndex1: integer; TableID2: integer; + FIndex2: integer): Boolean; + procedure DragDrop(Source: TObject; X, Y: Integer); override; + procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var + Accept: Boolean); override; + function FindTable(const AName, AAlias: string): TfqbTable; + procedure InsertTable(const X, Y : integer; const Name: string); overload; + procedure InsertTable(const Name : string); overload; + property LinkList: TfqbLinkList read FLinkList; + end; + + TfqbTableListBox = class(TListBox) + protected + procedure DblClick; override; + procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); + override; + public + constructor Create(AOwner: TComponent); override; + end; + + PGridColumn = ^TGridColumn; + TGridColumn = record + Table: string; + Alias: string; + Field: string; + Visibl: Boolean; + Where: string; + Sort: Integer; + Func: Integer; + Group: Integer; + end; + + TfqbEdit = class(TEdit) + private + FButton: TSpeedButton; + FOnButtonClick: TNotifyEvent; + FPanel: TPanel; + FShowButton: Boolean; + procedure SetShowButton(const Value: Boolean); + protected + procedure ButtonClick(Sender: TObject); + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + procedure SetEditRect; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + public + constructor Create(AOwner: TComponent); override; + property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick; + property ShowButton: Boolean read FShowButton write SetShowButton; + end; + + TfqbColumnResizeEvent = procedure (Sender: TCustomListview; ColumnIndex: Integer; + ColumnWidth: Integer) of object; + TfqbGrid = class(TListView) + private + FEndColumnResizeEvent: TfqbColumnResizeEvent; + FFunctionList: TComboBox; + FGroupList: TComboBox; + FPopupMenu: TPopupMenu; + FSortList: TComboBox; + FVisibleList: TComboBox; + FWhereEditor: TfqbEdit; + procedure fqbOnChange(Sender: TObject); + procedure fqbOnMenu(Sender: TObject); + procedure fqbOnPopup(Sender: TObject); + procedure fqbOnSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); + procedure fqbSetBounds(var Contr: TControl); + protected + procedure CreateWnd; override; + procedure DoColumnResize(ColumnIndex, ColumnWidth: Integer); virtual; + function FindColumnIndex(pHeader: pNMHdr): Integer; + function FindColumnWidth(pHeader: pNMHdr): Integer; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + override; + procedure RecalcColWidth; + procedure Resize; override; + procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY; + procedure WMVscroll(var Msg: TWMNotify); message WM_VSCROLL; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function AddColumn: Integer; + procedure Exchange(const AItm1, AItm2: integer); + procedure fqbUpdate; + procedure UpdateColumn; + property OnEndColumnResize: TfqbColumnResizeEvent read FEndColumnResizeEvent + write FEndColumnResizeEvent; + end; + + TfqbEngine = class(TComponent) + private + FShowSystemTables: Boolean; + public + procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); + virtual; abstract; + procedure ReadTableList(ATableList: TStrings); virtual; abstract; + function ResultDataSet: TDataSet; virtual; abstract; + procedure SetSQL(const Value: string); virtual; abstract; + published + property ShowSystemTables: Boolean read FShowSystemTables write + FShowSystemTables default False; + end; + + TfqbDialog = class(TComponent) + private + FEngine: TfqbEngine; + function GetSchemaInsideSQL: Boolean; + function GetSQL: string; + function GetSQLSchema: string; + procedure SetEngine(const Value: TfqbEngine); + procedure SetSchemaInsideSQL(const Value: Boolean); + procedure SetSQL(Value: string); + procedure SetSQLSchema(const Value: string); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + function Execute: Boolean; virtual; + property SQL: string read GetSQL write SetSQL; + property SQLSchema: string read GetSQLSchema write SetSQLSchema; + published + property Engine: TfqbEngine read FEngine write SetEngine; + property SchemaInsideSQL: Boolean read GetSchemaInsideSQL write + SetSchemaInsideSQL default True; + end; + + TfqbCore = class(TObject) + private + FEngine: TfqbEngine; + FGrid: TfqbGrid; + FSchemaInsideSQL: Boolean; + FSQL: string; + FSQLSchema: string; + FTableArea: TfqbTableArea; + FUseCoding: Boolean; + FText: string; + FUsingQuotes: Boolean; + function ExtractSchema(const Value: string): string; + function ExtractSQL(const Str: string): string; + function GetEngine: TfqbEngine; + function GetGrid: TfqbGrid; + function GetSQL: string; + function GetSQLSchema: string; + function GetTableArea: TfqbTableArea; + procedure SetSchemaInsideSQL(const Value: Boolean); + procedure SetSQL(Value: string); + procedure SetSQLSchema(const Value: string); + public + constructor Create; virtual; + destructor Destroy; override; + procedure Clear; + function GenerateSQL: string; + procedure LoadFromFile(const FileName: string); + procedure LoadFromStr(const Str: TStringList); + procedure RecognizeModel(const crc32: Cardinal; const FileName: string); + procedure SaveToFile(const FileName: string); + procedure SaveToStr(var Str: TStringList); + property Engine: TfqbEngine read GetEngine write FEngine; + property Grid: TfqbGrid read GetGrid write FGrid; + property SQL: string read GetSQL write SetSQL; + property SQLSchema: string read GetSQLSchema write SetSQLSchema; + property TableArea: TfqbTableArea read GetTableArea write FTableArea; + property SchemaInsideSQL: Boolean read FSchemaInsideSQL write SetSchemaInsideSQL + default True; + property UsingQuotes: Boolean read FUsingQuotes write FUsingQuotes; + + end; + + +function fqbCore: TfqbCore; + +const + StrFieldType : array [0..29] of string = (''{0}, 'String'{1}, 'Smallint'{2}, + 'Integer'{3}, 'Word'{4}, 'Boolean'{5}, 'Float'{6}, + 'Currency'{7}, 'BCD'{8}, 'Date'{9}, 'Time'{10}, + 'DateTime'{11}, 'Bytes'{12}, 'VarBytes'{13}, 'AutoInc'{14}, + 'Blob'{15}, 'Memo'{16}, 'Graphic'{17}, 'FmtMemo'{18}, + 'ParadoxOle'{19}, 'DBaseOle'{20}, 'TypedBinary'{21}, + 'Cursor'{22}, 'FixedChar'{23}, 'WideString'{24}, 'Largeint'{25}, + 'ADT'{26}, 'Array'{27}, 'Reference'{28}, 'DataSet'{29}); + + _fqbBeginModel = '/*_FQBMODEL'; + _fqbEndModel = '_FQBEND*/'; + +implementation + +{$R images.res} + +uses Math, IniFiles, Dialogs, Commctrl, fqbDesign, fqbLinkForm, fqbUtils, + fqbRes, fqbrcDesign + {$IFDEF Delphi7} + ,Themes + {$ENDIF} + ; + +const + clSelectedLink = clGreen; + clNotSelectedLink = clBlack; + + LinkType: array[0..5] of string = ('=', '>', '<', '>=', '<=', '<>'); + JoinType: array[0..3] of string = ('INNER JOIN', 'LEFT OUTER JOIN', + 'RIGHT OUTER JOIN', 'FULL OUTER JOIN'); + + rowColumn = 0; + rowVisibility = 1; + rowWhere = 2; + rowSort = 3; + rowFunction = 4; + rowGroup = 5; + + CompatibleIntTypes = [2, 3, 4, 12, 14]; + CompatibleDateTimeTypes = [9, 10, 11]; + CompatibleFloatTypes = [6, 7]; + +type + TcrTControl = class(TControl) + end; + +var + FfqbCore: TfqbCore = nil; + FExternalCreation: Boolean = True; + +function fqbCore: TfqbCore; +begin + if FfqbCore = nil then + begin + FExternalCreation := False; + try + FfqbCore := TfqbCore.Create; + finally + FExternalCreation := True; + end; + end; + Result := FfqbCore; +end; + +function FindFQBcomp(const AClassName: string; const Source: TComponent): TComponent; + var + i: integer; +begin + Result := nil; + if UpperCase(Source.ClassName) = UpperCase(AClassName) then + Result := Source + else + for i := 0 to Source.ComponentCount - 1 do + if Result = nil then + Result := FindFQBcomp(AClassName, Source.Components[i]) + else + Exit +end; + +{----------------------- TfqbField -----------------------} +function TfqbField.GetFieldName: string; +begin + if ((Pos(' ', FFieldName) > 0) or (Pos('/', FFieldName) > 0) + or ((UpperCase(FFieldName) <> FFieldName)) and fqbCore.UsingQuotes) then + Result := '"' + FFieldName + '"' + else + Result := FFieldName +end; + +{----------------------- TfqbFieldList -----------------------} +function TfqbFieldList.Add: TfqbField; +begin + Result := TfqbField(inherited Add) +end; + +function TfqbFieldList.GetItem(Index: Integer): TfqbField; +begin + Result := TfqbField(inherited Items[Index]) +end; + +procedure TfqbFieldList.SetItem(Index: Integer; const Value: TfqbField); +begin + Items[Index].Assign(Value) +end; + +{----------------------- TfqbLinkList -----------------------} +function TfqbLinkList.Add: TfqbLink; +begin + Result := TfqbLink(inherited Add) +end; + +function TfqbLinkList.GetItem(Index: Integer): TfqbLink; +begin + Result := TfqbLink(inherited Items[Index]) +end; + +procedure TfqbLinkList.SetItem(Index: Integer; const Value: TfqbLink); +begin + Items[Index].Assign(Value) +end; + +{----------------------- TfqbLink -----------------------} +constructor TfqbLink.Create(Collection: TCollection); +var + tmp: TMenuItem; +begin + inherited Create(Collection); + FJOp := 0; + FJType:= 0; + FMenu:= TPopupMenu.Create(nil); + tmp:= TMenuItem.Create(FMenu); + tmp.Caption:= 'Link options'; + tmp.OnClick:= DoOptions; + FMenu.Items.Add(tmp); + tmp:= TMenuItem.Create(FMenu); + tmp.Caption:= 'Delete'; + tmp.OnClick:= DoDelete; + FMenu.Items.Add(tmp) +end; + +destructor TfqbLink.Destroy; +begin + SourceField.Linked := false; + DestField.Linked := false; + FMenu.Free; + inherited Destroy; +end; + +procedure TfqbLink.DoDelete(Sender: TObject); +begin + Free +end; + +procedure TfqbLink.DoOptions(Sender: TObject); +var + fqbLinkForm: TfqbLinkForm; +begin + fqbLinkForm := TfqbLinkForm.Create(nil); + try + fqbLinkForm.txtTable1.Caption := SourceTable.TableName; + fqbLinkForm.txtCol1.Caption := SourceField.FieldName; + fqbLinkForm.txtTable2.Caption := DestTable.TableName; + fqbLinkForm.txtCol2.Caption := DestField.FieldName;; + fqbLinkForm.RadioOpt.ItemIndex := JoinOperator; + fqbLinkForm.RadioType.ItemIndex := JoinType; + if fqbLinkForm.ShowModal = mrOk then + begin + JoinOperator := fqbLinkForm.RadioOpt.ItemIndex; + JoinType := fqbLinkForm.RadioType.ItemIndex + end; + finally + fqbLinkForm.Free + end +end; + +procedure TfqbLink.Draw; +var + pnt1, pnt2: TPoint; + cnt1, cnt2: Integer; + dSrc, dDest: Integer; + + const Delta = 15; + +begin + pnt1:= SourceCoords; + pnt2:= DestCoords; + cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); + cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); + if cnt1 < cnt2 then + begin + dSrc:= Delta; + dDest:= -Delta + end + else + begin + dSrc:= -Delta; + dDest:= Delta + end; + FArea.FCanvas.MoveTo(pnt1.x, pnt1.y); + FArea.FCanvas.Pen.Color:= clNotSelectedLink; + FArea.FCanvas.Pen.Width:= 3; + FArea.FCanvas.LineTo(pnt1.x + dSrc, pnt1.y); + FArea.FCanvas.Pen.Width:= 1; + if Selected then + FArea.FCanvas.Pen.Color:= clSelectedLink + else + FArea.FCanvas.Pen.Color:= clNotSelectedLink; + FArea.FCanvas.LineTo(pnt2.x + dDest, pnt2.y); + FArea.FCanvas.Pen.Width:= 3; + FArea.FCanvas.Pen.Color:= clNotSelectedLink; + FArea.FCanvas.LineTo(pnt2.x, pnt2.y) +end; + +function TfqbLink.GetDestCoords: TPoint; +var + cnt1, cnt2: Integer; +begin + cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); + cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); + + if cnt1 < cnt2 then + Result:= DestTable.GetLinkPoint(DestField.Index,'L') + else + Result:= DestTable.GetLinkPoint(DestField.Index,'R') +end; + +function TfqbLink.GetSourceCoords: TPoint; +var + cnt1, cnt2: Integer; +begin + cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2); + cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2); + + if cnt1 < cnt2 then + Result:= SourceTable.GetLinkPoint(SourceField.Index,'R') + else + Result:= SourceTable.GetLinkPoint(SourceField.Index,'L') +end; + +procedure TfqbLink.SetSelected(const Value: Boolean); +var + i: Integer; +begin + for i:= 0 to Collection.Count - 1 do + TfqbLinkList(Collection).Items[i].FSelected := false; + FSelected := Value +end; + +{----------------------- TfqbTableArea -----------------------} +constructor TfqbTableArea.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCanvas := TControlCanvas.Create; + TControlCanvas(FCanvas).Control := Self; + Color := clBtnFace; + FCanvas.Brush.Color := clBtnFace; + + FLinkList := TfqbLinkList.Create(Self, TfqbLink); + + FInstX := 15; + FInstY := 15; +end; + +destructor TfqbTableArea.Destroy; +begin + FCanvas.Free; + FLinkList.Free; + inherited Destroy; +end; + +procedure TfqbTableArea.Click; +var + n: Integer; +begin + n := GetLineAtCursor; + if ((n >= 0) and (n < LinkList.Count)) then + begin + LinkList[n].Selected := true; + Invalidate; + LinkList[n].FMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y) + end; + inherited Click; +end; + +function TfqbTableArea.CompareFields(TableID1: integer; FIndex1: integer; TableID2: + integer; FIndex2: integer): Boolean; +var + tp1, tp2: Integer; +begin + if ((TableID1 > ComponentCount) or (TableID2 > ComponentCount)) then + Result := false + else + begin + tp1 := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType; + tp2 := TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType; + + if ((tp1 in CompatibleIntTypes) + and (tp2 in CompatibleIntTypes)) then + Result := True + else + if ((tp1 in CompatibleDateTimeTypes) + and (tp2 in CompatibleDateTimeTypes)) then + Result := True + else + if ((tp1 in CompatibleFloatTypes) + and (tp2 in CompatibleFloatTypes)) then + Result := True + else + Result := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType = + TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType + end +end; + +procedure TfqbTableArea.DragDrop(Source: TObject; X, Y: Integer); +begin + InsertTable(X, Y, (Source as TfqbTableListBox).Items[(Source as TfqbTableListBox).ItemIndex]) +end; + +procedure TfqbTableArea.DragOver(Source: TObject; X, Y: Integer; State: TDragState; + var Accept: Boolean); +begin + Accept := Source is TfqbTableListBox +end; + +function TfqbTableArea.FindTable(const AName, AAlias: string): TfqbTable; +var + i: Integer; +begin + Result:= nil; + for i:= 0 to ComponentCount - 1 do + if ((TfqbTable(Components[i]).TableName = AName) and + (TfqbTable(Components[i]).AliasName = AAlias)) then + Result:= TfqbTable(Components[i]) +end; + +function TfqbTableArea.GenerateAlias(const ATableNAme: string): string; +var + n: Integer; + + function FindDublicat(AAlias: string): boolean; + var i: integer; + begin + Result:= False; + for i:= 0 to ComponentCount - 1 do + begin + if AAlias = TfqbTable(Components[i]).AliasName then + begin + Result:= True; + Break + end + end + end; + +begin + Result:= ATableName[1]; + n:=1; + while FindDublicat(Result) do + begin + Result:= ATableName[1] + IntToStr(n); + Inc(n) + end +end; + +function TfqbTableArea.GetLineAtCursor: Integer; + + procedure SwapInt(var X, Y: Integer); + var + T: Integer; + begin + T := X; + X := Y; + Y := T + end; + + function InRange(const AValue, AMin, AMax: Integer): Boolean; + begin + Result := (AValue >= AMin) and (AValue <= AMax) + end; + + const + sf = 6; //Scale factor + var + i,TX1, TX2, TY1,TY2,X1,Y1, + X2,Y2,Lx, Ly, C: integer; + MousePos: TPoint; + Delta: Real; + +begin + Result:= - 1; + for i:= 0 to LinkList.Count - 1 do + begin + MousePos:= Mouse.CursorPos; + MousePos:= ScreenToClient(MousePos); + X1:= TfqbLink(LinkList[i]).GetSourceCoords.X; + X2:= TfqbLink(LinkList[i]).GetDestCoords.X; + Y1:= TfqbLink(LinkList[i]).GetSourceCoords.Y; + Y2:= TfqbLink(LinkList[i]).GetDestCoords.Y; + TX1:= X1; + TX2:= X2; + TY1:= Y1; + TY2:= Y2; + if TX1> TX2 then SwapInt(TX1, TX2); + if TY1> TY2 then SwapInt(TY1, TY2); + Lx:= X2-X1; + Ly:= Y2-Y1; + C:= -Ly*X1 + Lx*Y1; + Delta:= Sqrt(Power((X1-X2), 2) + Power((Y1-Y2), 2)) * sf; + if (Abs(-Ly*MousePos.X + Lx*MousePos.Y - C)<= Delta) and + InRange(MousePos.X, TX1 - sf, TX2 + sf) and + InRange(MousePos.Y, TY1 - sf, TY2 + sf) then + begin + Result:= i; + break + end + end +end; + +procedure TfqbTableArea.InsertTable(const X, Y : integer; const Name: string); +var + tmp: TfqbTable; +begin + tmp := TfqbTable.Create(Self); + tmp.Left := X; + tmp.Top := Y; + tmp.Parent := Self; + tmp.TableName := Name; + fqbCore.Engine.ReadFieldList(Name, tmp.FFieldList); + tmp.UpdateFieldList +end; + +procedure TfqbTableArea.InsertTable(const Name : string); +begin + InsertTable(FInstX, FInstY, Name); + + if FInstY > Height then + FInstY:= 15 + else + FInstY:= FInstY + 15; + + if FInstX > Width then + FInstX := 15 + else + FInstX:= FInstX + 15 +end; + +procedure TfqbTableArea.WMPaint(var Message: TWMPaint); +var + i: Integer; + + {$IFDEF TRIAL} + str: string; + l, dx: integer; + {$ENDIF} + +begin + inherited; + {$IFDEF TRIAL} + FCanvas.Font.Size := 50; + FCanvas.Font.Color:= clRed; + FCanvas.Font.Name := 'Tahoma'; + str := 'deretsigern'; + l := FCanvas.TextWidth(str + 'U'); + dx := (Width div 2) - (l div 2); + FCanvas.TextOut(dx, 100, 'U'); + for i := 11 downto 1 do + FCanvas.TextOut(FCanvas.PenPos.x, FCanvas.PenPos.y, str[i]); + {$ENDIF} + for i := 0 to LinkList.Count - 1 do + LinkList[i].Draw +end; + +{----------------------- TfqbTable -----------------------} +constructor TfqbTable.Create(AOwner: TComponent); +begin + inherited; + + Width := 130; + Height := 150; + BevelOuter := bvNone; + BorderWidth := 1; + + FLabel := TLabel.Create(Self); + with FLabel do + begin + Parent := Self; + Align := alTop; + Color := clActiveCaption; + Font.Charset := DEFAULT_CHARSET; + Font.Color := clCaptionText; + AutoSize := False; + Height := Height + 6; + Font.Size := Font.Size + 1; + Layout := tlCenter; + SetXPStyle(FLabel); + end; + + FImage := TImage.Create(Self); + with FImage do + begin + Parent := Self; + Top := 3; + Left := 3; + Width := 16; + Height := 16; + AutoSize := True; + FImage.Picture.Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1'); + Transparent := True; + SetXPStyle(FImage); + end; + + FButtonClose := TSpeedButton.Create(Self); + with FButtonClose do + begin + Parent := Self; + Top := 3; + Width := 17; + Height := 15; + OnClick := _DoExit; + Glyph.LoadFromResourceName(HInstance,'BTN_CLOSE'); + end; + + FButtonMinimize := TSpeedButton.Create(Self); + with FButtonMinimize do + begin + Parent := Self; + Top := 3; + Width := 17; + Height := 15; + OnClick := _DoMinimize; + Glyph.LoadFromResourceName(HInstance,'BTN_MINI'); + end; + + FCheckListBox := TfqbCheckListBox.Create(Self); + with FCheckListBox do + begin + Parent := Self; + Align := alClient; + ItemHeight := 13; + Style := lbOwnerDrawVariable; + DragMode := dmAutomatic + end; + + Constraints.MinHeight := FLabel.Height + 8; + Constraints.MinWidth := 120; + + Caption := ''; + FFieldList := TfqbFieldList.Create(Self, TfqbField); + DragMode := dmAutomatic; + DoubleBuffered := true; + ShowHint := False; + Height := 200; + Width := 150; + + SetXPStyle(Self); +end; + +destructor TfqbTable.Destroy; +var + i: Integer; +begin + if GetParentForm(Self) <> nil then + begin + for i:= fqbCore.Grid.Items.Count - 1 downto 0 do + begin + if TGridColumn(fqbCore.Grid.Items[i].Data^).Table = TableName then + begin + FreeMem(fqbCore.Grid.Items[i].Data,SizeOf(TGridColumn)); + fqbCore.Grid.Items[i].Delete; + end + end; + fqbCore.Grid.UpdateColumn + end; + UpdateLinkList; + + FLabel.Free; + FCheckListBox.Free; + FFieldList.Free; + FImage.Free; + FButtonClose.Free; + FButtonMinimize.Free; + + if Parent <> nil then + begin + Parent.Invalidate; + Parent:= nil + end; + inherited +end; + +procedure TfqbTable.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + Style:= Style or WS_SIZEBOX; + WindowClass.hIcon:= LoadIcon(hInstance, 'TABLEICO'); + WindowClass.Style:= WindowClass.Style xor CS_VREDRAW + end +end; + +function TfqbTable.GetLinkPoint(AIndex: integer; ASide: char): TPoint; +var + tmpRec: TRect; +begin + tmpRec := ChBox.ItemRect(AIndex); + tmpRec.Top := tmpRec.Top + FLabel.Height + (ChBox.Height - ChBox.ClientHeight); + tmpRec.Bottom := tmpRec.Bottom + FLabel.Height + (ChBox.Height - ChBox.ClientHeight); + + if tmpRec.Bottom > ClientHeight then + Result.y := ClientHeight + else + if tmpRec.Top < 0 then + Result.y := 0 + else + Result.y := tmpRec.Top + (tmpRec.Bottom - tmpRec.Top) div 2; + + Result := Parent.ScreenToClient(ClientToScreen(Result)); + + // if ASide = 'L' then Left side else if ASide = 'R' then Right side + if ASide = 'L' then + Result.x := BoundsRect.Left + else + Result.x := BoundsRect.Right +end; + +function TfqbTable.GetSellectedField: TfqbField; +begin + Result := FFieldList[ChBox.ItemIndex] +end; + +procedure TfqbTable.Resize; +begin + inherited Resize; + FButtonClose.Left := Width - 25; + FButtonMinimize.Left := Width - 42 +end; + +procedure TfqbTable.SetTableName(const Value: string); + + function GetSpace(const Width: integer):string; + begin + Result := ''; + repeat + Result := Result + ' ' + until FLabel.Canvas.TextWidth(Result) > Width + end; + +begin + FTableName := Value; + FAliasName:= TfqbTableArea(Parent).GenerateAlias(Value); + FLabel.Caption := GetSpace(FImage.Width + 2) + Value + ' - ' + FAliasName +end; + +procedure TfqbTable.SetXPStyle(const AComp: TControl); +begin + {$IFDEF Delphi7} + if ThemeServices.ThemesEnabled then + AComp.ControlStyle := AComp.ControlStyle - [csParentBackground] + [csOpaque]; + {$ENDIF}; +end; + +procedure TfqbTable.UpdateFieldList; +var + i: Integer; +begin + ChBox.Items.BeginUpdate; + ChBox.Items.Clear; + if FFieldList.Count > 0 then + ChBox.Items.Add(TfqbField(FFieldList[0]).FieldName); + for i:= 1 to FFieldList.Count - 1 do + ChBox.Items.Add(TfqbField(FFieldList[i]).FieldName + ' (' + + StrFieldType[TfqbField(FFieldList[i]).FieldType] + ')'); + ChBox.Items.EndUpdate +end; + +procedure TfqbTable.UpdateLinkList; +var + i: Integer; +begin + if Parent = nil then Exit; + for i:= (Parent as TfqbTableArea).LinkList.Count - 1 downto 0 do + if (((Parent as TfqbTableArea).LinkList[i].SourceTable = self) or ((Parent as TfqbTableArea).LinkList[i].DestTable = self)) then + (Parent as TfqbTableArea).LinkList[i].Free +end; + +procedure TfqbTable.WMMove(var Message: TWMMove); +begin + inherited; + Parent.Invalidate +end; + +procedure TfqbTable.WMNCHitTest(var M: TWMNCHitTest); +var + x: Integer; +begin + inherited; + x := ClientToScreen(Point(FButtonMinimize.Left,0)).X; + if ((M.Result = htClient) and (M.XPos - x < 0)) then + M.Result := htCaption +end; + +procedure TfqbTable.WMPaint(var Message: TWMPaint); +begin + inherited; + Parent.Invalidate +end; + +procedure TfqbTable._DoExit(Sender: TObject); +begin + PostMessage(Handle, CM_RELEASE, 0, 0); +end; + +procedure TfqbTable._DoMinimize(Sender: TObject); +begin + FOldHeight := Height; + Height := 0; + FButtonMinimize.OnClick := _DoRestore +end; + +procedure TfqbTable._DoRestore(Sender: TObject); +begin + Height := FOldHeight; + FButtonMinimize.OnClick := _DoMinimize +end; + +{----------------------- TfqbTableListBox -----------------------} +constructor TfqbTableListBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + DragMode := dmAutomatic; + Style := lbOwnerDrawVariable +end; + +procedure TfqbTableListBox.DblClick; +begin + inherited DblClick; + fqbCore.TableArea.InsertTable(Items[ItemIndex]) +end; + +procedure TfqbTableListBox.DrawItem(Index: Integer; Rect: TRect; State: + TOwnerDrawState); +var + Bitmap: TBitmap; + Offset: Integer; + BMPRect: TRect; +begin + inherited DrawItem(Index, Rect, State); + Canvas.FillRect(Rect); + Bitmap := TBitmap.Create; + Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1'); + Offset := 0; + if Bitmap <> nil then + begin + BMPRect := Bounds(Rect.Left, Rect.Top, + (Rect.Bottom-Rect.Top), Rect.Bottom-Rect.Top); + Canvas.BrushCopy(BMPRect,Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), + Bitmap.Canvas.Pixels[0, Bitmap.Height-1]); + Offset := (Rect.Bottom-Rect.Top+1); + end; + Canvas.TextOut(Rect.Left+Offset, Rect.Top, Items[Index]); + Bitmap.Free +end; + +{----------------------- TfqbDialog -----------------------} +constructor TfqbDialog.Create(AOwner: TComponent); +begin + inherited; + fqbCore.SchemaInsideSQL := True; +end; + +function TfqbDialog.Execute: Boolean; +var + tmp: TStringList; +begin + {$IFDEF TRIAL} + ShowMessage(' Fast Query Builder'#10#13'Unregistered version'); + {$ENDIF} + fqbDesigner := TfqbDesigner.Create(Self); + fqbCore.Engine := Engine; + fqbCore.Grid := fqbDesigner.fqbGrid1; + fqbCore.TableArea := fqbDesigner.fqbTableArea1; + + tmp:= TStringList.Create; + tmp.Text := fqbCore.FText; + try + try + fqbCore.LoadFromStr(tmp); + except + end; + + if fqbDesigner.ShowModal = mrOk then + begin + tmp.Clear; + fqbCore.SaveToStr(tmp); + fqbCore.FText := tmp.Text; + Result := true + end + else + Result := false; + finally + tmp.Free; + fqbDesigner.Free + end +end; + +function TfqbDialog.GetSchemaInsideSQL: Boolean; +begin + Result := fqbCore.SchemaInsideSQL; +end; + +function TfqbDialog.GetSQL: string; +begin + Result := fqbCore.SQL; +end; + +function TfqbDialog.GetSQLSchema: string; +begin + Result := fqbCore.SQLSchema; +end; + +procedure TfqbDialog.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (AComponent = FEngine) and (Operation = opRemove) then + begin + FEngine := nil; + fqbCore.Engine := nil; + end; +end; + +procedure TfqbDialog.SetEngine(const Value: TfqbEngine); +begin + if FEngine <> Value then + begin + FEngine := Value; + fqbCore.Engine := Value; + FreeNotification(FEngine); + end +end; + +procedure TfqbDialog.SetSchemaInsideSQL(const Value: Boolean); +begin + fqbCore.SchemaInsideSQL := Value; +end; + +procedure TfqbDialog.SetSQL(Value: string); +begin + fqbCore.SQL := Value; +end; + +procedure TfqbDialog.SetSQLSchema(const Value: string); +begin + fqbCore.SQLSchema := Value; +end; + +{----------------------- TfqbCore -----------------------} +constructor TfqbCore.Create; +begin + if FfqbCore <> nil then + raise EfqbError.Create('TfqbCore class already initialized.'); + if FExternalCreation then + raise EfqbError.Create('Call fqbCore function to reference this class.'); + inherited; + FUseCoding := True; + FUsingQuotes := False; +end; + +destructor TfqbCore.Destroy; +begin + FfqbCore := nil; + inherited; +end; + +procedure TfqbCore.Clear; +var + i: Integer; +begin + for i:= Grid.Items.Count - 1 downto 0 do + Dispose(PGridColumn(Grid.Items[i].Data)); + Grid.Items.Clear; + + for i := TableArea.ComponentCount - 1 downto 0 do + TableArea.Components[i].Free +end; + +function TfqbCore.ExtractSchema(const Value: string): string; +var + e, b: Integer; +begin + b := Pos(_fqbBeginModel, Value) + Length(_fqbBeginModel); + e := Pos(_fqbEndModel, Value); + if not (e = 0) then + begin + Result := Copy(Value, b, e-b); + Result := fqbTrim(Result, [#10, #13]); + end + else + Result := Value; +end; + +function TfqbCore.ExtractSQL(const Str: string): string; +var + e, b: Integer; +begin + b := Pos(_fqbBeginModel, Str); + e := Pos(_fqbEndModel, Str); + Result := Str; + Delete(Result, b, e); +end; + +function TfqbCore.GenerateSQL: string; + + const + strTab = ' '; + strSel = 'SELECT '; + strFrom = 'FROM'; + strWhere = 'WHERE'; + strOrder = 'ORDER BY '; + strGroup = 'GROUP BY '; + var + i: integer; + tmpStr, orderStr, prd, groupStr: string; + slFrom, slWhere: TStringList; + Tbl1, Tbl2, Tbl3: TfqbTable; + CopyLL: TList; + flg: boolean; + SQL: TStringList; + + function FormingFrom(const Ind: integer):string; + var + tmp: TfqbLink; + begin + tmp := TableArea.LinkList[Ind]; + Result := {strTab + }JoinType[tmp.JoinType] + ' ' + + Tbl2.TableName + ' ' + Tbl2.AliasName + ' ON (' + + Tbl1.AliasName + '.' + tmp.SourceField.FieldName + + LinkType[tmp.JoinOperator] + + Tbl2.AliasName + '.' + tmp.DestField.FieldName + ')' + end; + + function FormingFromAnd(const Ind: integer):string; + var + tmp: TfqbLink; + begin + tmp := TfqbLink(TableArea.LinkList[Ind]); + Result := ' AND (' + + Tbl1.AliasName + '.' + tmp.SourceField.FieldName + + LinkType[tmp.JoinOperator] + + Tbl3.AliasName + '.' + tmp.DestField.FieldName + ') ' + end; + +begin + SQL := TStringList.Create; + //SELECT + tmpStr := strSel; + + if Grid.Items.Count = 0 then Exit; + + for i := 0 to Grid.Items.Count - 1 do + + if TGridColumn(Grid.Items[i].Data^).Visibl then + begin + + if Grid.Items[i].SubItems[rowFunction - 1] <> '' then + prd := Grid.Items[i].SubItems[rowFunction - 1] + '(' + else + prd := ''; + + tmpStr := tmpStr + prd + TGridColumn(Grid.Items[i].Data^).Alias + '.' + + TGridColumn(Grid.Items[i].Data^).Field; + + if prd <> '' then prd := ')'; + + tmpStr := tmpStr + prd + ', ' + end; + tmpStr := Copy(tmpStr,1,Length(tmpStr) - 2); + SQL.Add(tmpStr); + + //FROM + tmpStr := ''; + slFrom := TStringList.Create; + CopyLL := TList.Create; + for i := 0 to TableArea.LinkList.Count - 1 do + CopyLL.Add(Pointer(i)); + while CopyLL.Count <> 0 do + begin + Tbl1 := TableArea.LinkList[0].SourceTable; + Tbl2 := TableArea.LinkList[0].DestTable; + slFrom.Add(strTab + Tbl1.TableName + ' ' + Tbl1.AliasName); + slFrom.Add(strTab + FormingFrom(0)); + for i := 1 to CopyLL.Count - 1 do + begin + Tbl3 := TableArea.LinkList[i].DestTable; + + if (Tbl3.AliasName = Tbl2.AliasName) then + begin + slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + FormingFromAnd(Integer(CopyLL[i])); + CopyLL[i] := Pointer(-1); + end + else + begin + Tbl1 := TableArea.LinkList[Integer(CopyLL[i])].SourceTable; + Tbl2 := Tbl3; + slFrom.Add(strTab + FormingFrom(Integer(CopyLL[i]))); + CopyLL[i] := Pointer(-1) + end + + end; + CopyLL.Delete(0); + for i := CopyLL.Count - 1 downto 0 do + if Integer(CopyLL[i]) = -1 then CopyLL.Delete(i) + end; + + flg := false; + for i := 0 to Grid.Items.Count - 1 do + begin + tmpStr := TGridColumn(Grid.Items[i].Data^).Table + ' ' + + TGridColumn(Grid.Items[i].Data^).Alias; + + if Pos(tmpStr, slFrom.Text) = 0 then + begin + if slFrom.Count <> 0 then + slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + ', '; + + slFrom.Add(strTab + tmpStr); + flg := true + end + end; + + if flg then + slFrom.Text := Copy(slFrom.Text,1,Length(slFrom.Text) - 2); + + CopyLL.Free; + + //WHERE + slWhere := TStringList.Create; + for i := 0 to Grid.Items.Count - 1 do + if TGridColumn(Grid.Items[i].Data^).Where <> '' then + slWhere.Add(strTab + TGridColumn(Grid.Items[i].Data^).Alias + '.' + + TGridColumn(Grid.Items[i].Data^).Field + ' ' + + TGridColumn(Grid.Items[i].Data^).Where + ' AND'); + + if slWhere.Count <> 0 then + begin + slWhere.Text:= Copy(slWhere.Text,1,Length(slWhere.Text) - 6); + slWhere.Insert(0,strWhere) + end; + + //ORDER + orderStr:= ''; + prd:= ''; + flg:= false; + for i:= 0 to Grid.Items.Count - 1 do + begin + if TGridColumn(Grid.Items[i].Data^).Sort <> 0 then + begin + if TGridColumn(Grid.Items[i].Data^).Sort = 2 then + prd := 'DESC' + else + prd := ''; + orderStr:= orderStr + TGridColumn(Grid.Items[i].Data^).Alias + '.' + + TGridColumn(Grid.Items[i].Data^).Field + ' ' + prd + ', '; + flg:= true; + end; + end; + if flg then + orderStr := Trim(Copy(orderStr,1,Length(orderStr) - 2)); + + //GROUP + groupStr:= ''; + flg:= false; + for i:= 0 to Grid.Items.Count - 1 do + begin + if TGridColumn(Grid.Items[i].Data^).Group <> 0 then + begin + groupStr:= groupStr + TGridColumn(Grid.Items[i].Data^).Alias + '.' + + TGridColumn(Grid.Items[i].Data^).Field + ', '; + flg:= true; + end; + end; + if flg then groupStr:= Copy(groupStr,1,Length(groupStr) - 2); + + SQL.Add(strFrom); + SQL.AddStrings(slFrom); + SQL.AddStrings(slWhere); + + if orderStr <> '' then SQL.Add(strOrder + orderStr); + + if groupStr <> '' then SQL.Add(strGroup + groupStr); + + slFrom.Free; + slWhere.Free; + + FText := SQL.Text; + Result := SQL.Text; + SQL.Free +end; + +function TfqbCore.GetEngine: TfqbEngine; +begin + Result := FEngine; + if not Assigned(FEngine) then + raise EfqbError.Create('fqbCore.Engine not assigned'); + +end; + +function TfqbCore.GetGrid: TfqbGrid; +begin + Result := FGrid; + if not Assigned(FGrid) then + raise EfqbError.Create('fqbCore.Grid not assigned'); +end; + +function TfqbCore.GetSQL: string; +begin + if SchemaInsideSQL then + Result := Ftext + else + Result := fqbCore.ExtractSQL(Ftext); +end; + +function TfqbCore.GetSQLSchema: string; +begin + if SchemaInsideSQL then + Result := '' + else + Result := fqbCore.ExtractSchema(Ftext); +end; + +function TfqbCore.GetTableArea: TfqbTableArea; +begin + Result := FTableArea; + if not Assigned(FTableArea) then + raise EfqbError.Create('fqbCore.TableArea not assigned'); +end; + +procedure TfqbCore.LoadFromFile(const FileName: string); +var + StrLst, StrSrc: TStringList; + tmp, tmp2: string; +begin + StrLst := TStringList.Create; + StrSrc := TStringList.Create; + StrSrc.LoadFromFile(FileName); + + try + tmp2 := ExtractSQL(StrSrc.Text); + tmp := ExtractSchema(StrSrc.Text); + + if fqbCore.FUseCoding then + begin + tmp := fqbTrim(tmp, [#10,#13]); + if tmp = '' then Exit; + tmp:= fqbDeCompress(tmp) + end; + + StrLst.Clear; + StrLst.Text := tmp; + + tmp := fqbGetUniqueFileName('fqb'); + StrLst.SaveToFile(tmp); + tmp2 := fqbTrim(tmp2, [#10,#13]); + fqbCore.RecognizeModel(fqbStringCRC32(tmp2), tmp); + finally + DeleteFile(tmp); + + StrLst.Free; + StrSrc.Free; + end; +end; + +procedure TfqbCore.LoadFromStr(const Str: TStringList); +var + tmp: string; +begin + tmp := fqbGetUniqueFileName('fqb'); + Str.SaveToFile(tmp); + try + fqbCore.LoadFromFile(tmp); + finally + DeleteFile(tmp) + end +end; + +procedure TfqbCore.RecognizeModel(const crc32: Cardinal; const FileName: string); +var + fqbFile: TIniFile; + tbl: TStringList; + i: Integer; + Rec: TRect; + parstr, tmpstr: string; + vis: TfqbTable; + lnk: TfqbLink; + c: Cardinal; + + function IndexOf(const FieldName: string): integer; + var + i: integer; + begin + Result:= -1; + for i:= 0 to vis.FieldList.Count - 1 do + if TfqbField(vis.FieldList[i]).FieldName = FieldName then + Result:= i; + end; + +begin + fqbFile:= TIniFile.Create(FileName); + tbl:= TStringList.Create; + tmpstr := fqbFile.ReadString('DataBase','SQL',''); + c := StrToInt64(tmpstr); + if c <> crc32 then + begin + ShowMessage('The file was changed. The Model can not be loaded.'); + fqbFile.Free; + tbl.Free; + Exit + end; + try + fqbCore.Engine.ReadTableList(TfqbTableListBox(FindFQBcomp('TfqbTableListBox',GetParentForm(TableArea))).Items); + fqbFile.ReadSectionValues('Tables',tbl); + try + for i:= 0 to tbl.Count - 1 do + begin + parstr:= tbl.Values[tbl.Names[i]]; + tmpstr:= fqbParse(',',parstr,1); + Rec.Top:= StrToInt(fqbParse(',',parstr,2)); + Rec.Left:= StrToInt(fqbParse(',',parstr,3)); + Rec.Right:= StrToInt(fqbParse(',',parstr,4)); + Rec.Bottom:= StrToInt(fqbParse(',',parstr,5)); + TableArea.InsertTable(Rec.Left, Rec.Top, tmpstr); + TfqbTable(TableArea.Components[i]).Height:= Rec.Right; + TfqbTable(TableArea.Components[i]).Width:= Rec.Bottom + end + except + fqbCore.Clear; + Exit + end; + tbl.Clear; + fqbFile.ReadSectionValues('Grid',tbl); + try + for i:= 0 to tbl.Count - 1 do + begin + parstr:=tbl.Values[tbl.Names[i]]; + vis:= TableArea.FindTable(fqbParse(',',parstr,2),fqbParse(',',parstr,3)); + if vis = nil then Exit; + + vis.ChBox.Checked[IndexOf(fqbParse(',',parstr,1))]:= true; + vis.ChBox.ItemIndex:= IndexOf(fqbParse(',',parstr,1)); + vis.ChBox.ClickCheck; + + // n:= Grid.Items.Count - 1; + + TGridColumn(Grid.Items[i].Data^).Table:= fqbParse(',',parstr,2); + TGridColumn(Grid.Items[i].Data^).Alias:= fqbParse(',',parstr,3); + TGridColumn(Grid.Items[i].Data^).Field:= fqbParse(',',parstr,1); + TGridColumn(Grid.Items[i].Data^).Visibl:= Boolean(StrToInt(fqbParse(',',parstr,4))); + TGridColumn(Grid.Items[i].Data^).Sort:= StrToInt(fqbParse(',',parstr,5)); + TGridColumn(Grid.Items[i].Data^).Func:= StrToInt(fqbParse(',',parstr,6)); + TGridColumn(Grid.Items[i].Data^).Group:= StrToInt(fqbParse(',',parstr,7)); + TGridColumn(Grid.Items[i].Data^).Where:= fqbParse(',',parstr,8, True); + + // format: + // field_name = table_name, alias, visible, sorting, function, group, where + end; + except + fqbCore.Clear; + Exit + end; + tbl.Clear; + fqbFile.ReadSectionValues('Links',tbl); + try + for i:= 0 to tbl.Count - 1 do + begin + parstr:=tbl.Values[tbl.Names[i]]; + + lnk:= TfqbLink(TableArea.LinkList.Add); + lnk.FArea:= TableArea; + lnk.FSourceTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,2))]); + lnk.FSourceField := lnk.SourceTable.FieldList[StrToInt(fqbParse(',',parstr,1))]; + lnk.SourceField.Linked := True; + + lnk.FDestTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,4))]); + lnk.FDestField := lnk.DestTable.FieldList[StrToInt(fqbParse(',',parstr,3))]; + lnk.FDestField.Linked := True; + + lnk.FJType := StrToInt(fqbParse(',',parstr, 5)); + lnk.FJOp := StrToInt(fqbParse(',',parstr, 6)); + // format: + // index = sind,slst,dind,dlst,JType,JOper + end; + except + fqbCore.Clear; + Exit + end; + Grid.UpdateColumn; + finally + fqbFile.Free; + tbl.Free + end +end; + +procedure TfqbCore.SaveToFile(const FileName: string); +var + tmp: TStringList; +begin + tmp := TStringList.Create; + fqbCore.SaveToStr(tmp); + tmp.SaveToFile(FileName); + tmp.Free; +end; + +procedure TfqbCore.SaveToStr(var Str: TStringList); +var + i: Integer; + tmp, tmp2: string; +begin + Str.Clear; + tmp2 := fqbCore.GenerateSQL; + tmp := fqbTrim(tmp2, [#10,#13]); + + if tmp = '' then Exit; + + Str.Add('[DataBase]'); + Str.Add('SQL=' + IntToStr(fqbStringCRC32(tmp))); + + Str.Add('[Tables]'); + for i:= 0 to TableArea.ComponentCount - 1 do + begin + tmp := TfqbTable(TableArea.Components[i]).AliasName + '='; + tmp := tmp + TfqbTAble(TableArea.Components[i]).TableName; + tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Top); + tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Left); + tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Height); + tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Width); + Str.Add(tmp); + // format: + // alias= tablename,top,left,height,width + end; + + Str.Add('[Grid]'); + for i:= 0 to Grid.Items.Count - 1 do + begin + tmp := IntToStr(i) + '='; + tmp:= tmp + TGridColumn(Grid.Items[i].Data^).Field; + tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Table; + tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Alias; + tmp:= tmp + ',' + IntToStr(Integer(TGridColumn(Grid.Items[i].Data^).Visibl)); + tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Sort); + tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Func); + tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Group); + tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Where; + Str.Add(tmp); + // format: + // field_name = table_name, alias, visible, sorting, function, group, where + end; + + Str.Add('[Links]'); + for i:= 0 to TableArea.LinkList.Count - 1 do + begin + tmp:= IntToStr(i) + '='; + tmp:= tmp + IntToStr(TableArea.LinkList[i].SourceField.Index); + tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].SourceTable.ComponentIndex); + tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestField.Index); + tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestTable.ComponentIndex); + tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinType); + tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinOperator); + Str.Add(tmp); + // format: + // index = sind,slst,dind,dlst,JType,JOper + end; + + if fqbCore.FUseCoding then + tmp := fqbCompress(str.Text) + else + tmp := str.Text; + + Str.Clear; + Str.Add(tmp2); + Str.Add(_fqbBeginModel); + Str.Add(tmp); + Str.Add(_fqbEndModel); +end; + +procedure TfqbCore.SetSchemaInsideSQL(const Value: Boolean); +begin + FSchemaInsideSQL := Value; + if SchemaInsideSQL then + begin + FSQL := fqbCore.ExtractSQL(Ftext); + FSQLSchema := fqbCore.ExtractSchema(Ftext); + end +end; + +procedure TfqbCore.SetSQL(Value: string); +begin + FSQL := fqbCore.ExtractSQL(Value); + FSQLSchema := fqbCore.ExtractSchema(Value); + Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel +end; + +procedure TfqbCore.SetSQLSchema(const Value: string); +begin + FSQLSchema := fqbCore.ExtractSchema(Value); + Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel +end; + +{----------------------- TfqbCheckListBox -----------------------} +procedure TfqbCheckListBox.ClickCheck; +var + tmp: TfqbGrid; + tbl: TfqbTable; + i: Integer; +begin + tmp := fqbCore.Grid; + tbl := (Parent as TfqbTable); + + if not Assigned(tmp) then + raise EfqbError.Create('Class TfqbGrid not fount on form.'); + + if State[ItemIndex] = cbChecked then + begin + i:= tmp.AddColumn; + TGridColumn(tmp.Items[i].Data^).Table:= tbl.TableName; + TGridColumn(tmp.Items[i].Data^).Field:= tbl.FieldList[ItemIndex].FieldName; + TGridColumn(tmp.Items[i].Data^).Alias:= tbl.AliasName; + TGridColumn(tmp.Items[i].Data^).Where:= ''; + TGridColumn(tmp.Items[i].Data^).Sort:= 0; + TGridColumn(tmp.Items[i].Data^).Func:= 0; + TGridColumn(tmp.Items[i].Data^).Group:= 0; + TGridColumn(tmp.Items[i].Data^).Visibl:= True + end + else + if State[ItemIndex] = cbUnchecked then + begin + for i:= tmp.Items.Count - 1 downto 0 do + begin + if ((TGridColumn(tmp.Items[i].Data^).Table = tbl.TableName) + and (TGridColumn(tmp.Items[i].Data^).Field = tbl.FieldList[ItemIndex].FieldName)) then + begin + FreeMem(tmp.Items[i].Data, SizeOf(TGridColumn)); + tmp.Items.Delete(i) + end + end + end; + tmp.UpdateColumn; + Repaint; + inherited ClickCheck; +end; + +procedure TfqbCheckListBox.DragDrop(Sender: TObject; X, Y: Integer); +var + lnk: TfqbLink; +begin + lnk := (Parent.Parent as TfqbTableArea).LinkList.Add; + lnk.FArea := Parent.Parent as TfqbTableArea; + lnk.FSourceField := ((Sender as TControl).Parent as TfqbTable).SellectedField; + lnk.FSourceField.Linked := true; + lnk.FSourceTable := (Sender as TControl).Parent as TfqbTable; + + lnk.FDestField := (Self.Parent as TfqbTable).SellectedField; + lnk.FDestField.Linked := true; + lnk.FDestTable := Self.Parent as TfqbTable; + + TfqbTableArea(Parent.Parent).Invalidate; + TfqbTable((Sender as TControl).Parent).Invalidate; + Invalidate +end; + +procedure TfqbCheckListBox.DragOver(Sender: TObject; X, Y: Integer; State: + TDragState; var Accept: Boolean); +var + int: Integer; +begin + Accept := False; + if ((not (Sender is TfqbCheckListBox)) or + (Self = Sender)) then Exit; + + int := (Self as TfqbCheckListBox).ItemAtPos(Point(X,Y),True); + + if (int > (Self as TfqbCheckListBox).Items.Count - 1) or (int < 0) then + Exit; + + (Self as TfqbCheckListBox).ItemIndex:= int; + if not (Parent.Parent as TfqbTableArea).CompareFields(Parent.ComponentIndex, int, (Sender as TfqbCheckListBox).Parent.ComponentIndex, (Sender as TfqbCheckListBox).ItemIndex) + then Exit; + + Accept := True +end; + +{----------------------- TfqbGrid -----------------------} +constructor TfqbGrid.Create(AOwner: TComponent); +var + i: Integer; + mi: TMenuItem; +begin + inherited Create(AOwner); + for i:= 0 to 5 do + with Columns.Add do + begin + case i of + rowColumn : Caption := fqbGet(1820); + rowVisibility: Caption := fqbGet(1821); + rowWhere : Caption := fqbGet(1822); + rowSort : Caption := fqbGet(1823); + rowFunction : Caption := fqbGet(1824); + rowGroup : Caption := fqbGet(1825); + end; + Width := 80; + end; + + ViewStyle := vsReport; + ColumnClick := False; + HideSelection := False; + Width := 300; + DragMode := dmAutomatic; + + OnSelectItem := fqbOnSelectItem; + + FPopupMenu := TPopupMenu.Create(Self); + mi := TMenuItem.Create(FPopupMenu); + mi.Caption := fqbGet(1826); + mi.OnClick := fqbOnMenu; + mi.Tag := -1; + FPopupMenu.Items.Add(mi); + mi := TMenuItem.Create(FPopupMenu); + mi.Caption := fqbGet(1827); + mi.OnClick := fqbOnMenu; + mi.Tag := 1; + FPopupMenu.Items.Add(mi); + + FPopupMenu.OnPopup := fqbOnPopup; + PopupMenu := FPopupMenu; +end; + +destructor TfqbGrid.Destroy; +var + i: Integer; +begin + for i:= 0 to Items.Count - 1 do + Dispose(PGridColumn(Items[i])); + inherited +end; + +function TfqbGrid.AddColumn: Integer; +var + tmp: TListItem; + p: PGridColumn; +begin + tmp := Items.Add; + tmp.SubItems.Add(''); + tmp.SubItems.Add(''); + tmp.SubItems.Add(''); + tmp.SubItems.Add(''); + tmp.SubItems.Add(''); + + New(p); + tmp.Data := p; + + Result:= tmp.Index +end; + +procedure TfqbGrid.CreateWnd; +var + wnd: HWND; +begin + inherited CreateWnd; + + FVisibleList := TComboBox.Create(Self); + FVisibleList.Visible := false; + FVisibleList.Parent := Self; + FVisibleList.Style := csOwnerDrawFixed; + FVisibleList.ItemHeight := 12; + FVisibleList.Items.Add(fqbGet(1828)); + FVisibleList.Items.Add(fqbGet(1829)); + FVisibleList.OnChange := fqbOnChange; + FVisibleList.Tag := rowVisibility; + + FWhereEditor:= TfqbEdit.Create(Self); + FWhereEditor.Visible := false; + FWhereEditor.Parent := Self; + FWhereEditor.OnChange := fqbOnChange; + FWhereEditor.Tag := rowWhere; + + FSortList := TComboBox.Create(Self); + FSortList.Visible := false; + FSortList.Parent := Self; + FSortList.Style := csOwnerDrawFixed; + FSortList.ItemHeight := 12; + FSortList.Items.Add(fqbGet(1830)); + FSortList.Items.Add(fqbGet(1831)); + FSortList.Items.Add(fqbGet(1832)); + FSortList.OnChange := fqbOnChange; + FSortList.Tag := rowSort; + + FFunctionList := TComboBox.Create(Self); + FFunctionList.Visible := false; + FFunctionList.Parent := Self; + FFunctionList.Style := csOwnerDrawFixed; + FFunctionList.ItemHeight := 12; + FFunctionList.Items.Add(fqbGet(1830)); + FFunctionList.Items.Add('AVG'); + FFunctionList.Items.Add('COUNT'); + FFunctionList.Items.Add('MAX'); + FFunctionList.Items.Add('MIN'); + FFunctionList.Items.Add('SUM'); + FFunctionList.OnChange := fqbOnChange; + FFunctionList.Tag := rowFunction; + + FGroupList := TComboBox.Create(Self); + FGroupList.Visible := False; + FGroupList.Parent := Self; + FGroupList.Style := csOwnerDrawFixed; + FGroupList.ItemHeight := 12; + FGroupList.Items.Add(fqbGet(1830)); + FGroupList.Items.Add(fqbGet(1833)); + FGroupList.OnChange := fqbOnChange; + FGroupList.Tag := rowGroup; + + RecalcColWidth; + + wnd := GetWindow(Handle, GW_CHILD); + SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG) +end; + +procedure TfqbGrid.DoColumnResize(ColumnIndex, ColumnWidth: Integer); +begin + // RecalcColWidth; + fqbUpdate; + if Assigned(FEndColumnResizeEvent) then + FEndColumnResizeEvent(Self, ColumnIndex, ColumnWidth) +end; + +procedure TfqbGrid.Exchange(const AItm1, AItm2: integer); +var + tmpStr: string; + tmpDat: Pointer; +begin + tmpStr := Items[AItm1].Caption; + tmpDat := Items[AItm1].Data; + + Items[AItm1].Caption := Items[AItm2].Caption; + Items[AItm1].Data := Items[AItm2].Data; + + Items[AItm2].Caption := tmpStr; + Items[AItm2].Data := tmpDat; + + fqbUpdate; +end; + +function TfqbGrid.FindColumnIndex(pHeader: pNMHdr): Integer; +var + hwndHeader: HWND; + ItemInfo: THdItem; + ItemIndex: Integer; + buf: array [0..128] of Char; +begin + Result := -1; + hwndHeader := pHeader^.hwndFrom; + ItemIndex := pHDNotify(pHeader)^.Item; + FillChar(iteminfo, SizeOf(iteminfo), 0); + iteminfo.Mask := HDI_TEXT; + iteminfo.pszText := buf; + iteminfo.cchTextMax := SizeOf(buf) - 1; + Header_GetItem(hwndHeader, ItemIndex, iteminfo); + if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then + Result := ItemIndex + else + begin + for ItemIndex := 0 to Columns.Count - 1 do + if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then + begin + Result := ItemIndex; + Break; + end + end +end; + +function TfqbGrid.FindColumnWidth(pHeader: pNMHdr): Integer; +begin + Result := -1; + if Assigned(PHDNotify(pHeader)^.pItem) and + ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then + Result := PHDNotify(pHeader)^.pItem^.cxy; +end; + +procedure TfqbGrid.fqbOnChange(Sender: TObject); +var + tmp: TcrTControl; +begin + if Selected = nil then Exit; + tmp := TcrTControl(Sender); + if tmp.ClassName = 'TComboBox' then + if TComboBox(tmp).ItemIndex = 0 then + Selected.SubItems[tmp.tag - 1] := '' + else + Selected.SubItems[tmp.tag - 1] := tmp.Text; + + if tmp.ClassName = 'TfqbEdit' then + Selected.SubItems[tmp.tag - 1] := tmp.Text; + + if tmp.tag = rowVisibility then + TGridColumn(Selected.Data^).Visibl := (TComboBox(tmp).ItemIndex = 0); + if tmp.tag = rowWhere then + TGridColumn(Selected.Data^).Where := tmp.Caption; + if tmp.tag = rowSort then + TGridColumn(Selected.Data^).Sort := TComboBox(tmp).ItemIndex; + if tmp.tag = rowFunction then + TGridColumn(Selected.Data^).Func := TComboBox(tmp).ItemIndex; + if tmp.tag = rowGroup then + TGridColumn(Selected.Data^).Group := TComboBox(tmp).ItemIndex; +end; + +procedure TfqbGrid.fqbOnMenu(Sender: TObject); +begin + Exchange(Selected.Index, Selected.Index + (Sender as TComponent).Tag); + Items[Selected.Index + (Sender as TComponent).Tag].Selected := True; + UpdateColumn +end; + +procedure TfqbGrid.fqbOnPopup(Sender: TObject); +begin + if Assigned(Selected) then + begin + FPopupMenu.Items[0].Enabled := Selected.Index <> 0; + FPopupMenu.Items[1].Enabled := Selected.Index <> Items.Count - 1; + end + else + begin + FPopupMenu.Items[0].Enabled := False; + FPopupMenu.Items[1].Enabled := False; + end +end; + +procedure TfqbGrid.fqbOnSelectItem(Sender: TObject; Item: TListItem; Selected: + Boolean); +var + tmp: TfqbTableArea; + tbl: TfqbTable; + i: Integer; +begin + fqbUpdate; + tmp := fqbCore.TableArea; + if not Assigned(tmp) then Exit; + tbl := tmp.FindTable(TGridColumn(Item.Data^).Table, TGridColumn(Item.Data^).Alias); + if not Assigned(tbl) then Exit; + tbl.BringToFront; + for i:= 0 to tbl.FieldList.Count - 1 do + if tbl.FieldList[i].FieldName = TGridColumn(Item.Data^).Field then + tbl.ChBox.ItemIndex := i; +end; + +procedure TfqbGrid.fqbSetBounds(var Contr: TControl); +var + i: Integer; +begin + Contr.Visible := false; + if Selected = nil then Exit; + if Assigned(TopItem) then + if TopItem.Index > Selected.Index then Exit; + Contr.Width := Columns[Contr.Tag].Width + 1; + Contr.Top := Selected.Top - 2; + Contr.Left := 0; + for i:= 0 to Contr.Tag - 1 do + Contr.Left := Contr.Left + Columns[i].Width; + Contr.Height := 19; + if Contr.ClassName = 'TComboBox' then + begin + TComboBox(Contr).ItemIndex := TComboBox(Contr).Items.IndexOf(Selected.SubItems[Contr.Tag - 1]); + end + else + if Contr.ClassName = 'TfqbEdit' then + begin + TcrTControl(Contr).Text := Selected.SubItems[Contr.Tag - 1]; + end; + Contr.Visible := true; +end; + +procedure TfqbGrid.fqbUpdate; +begin + if not (Assigned(FVisibleList) and Assigned(FWhereEditor) + and Assigned(FSortList) and Assigned(FFunctionList) + and Assigned(FGroupList)) then Exit; + fqbSetBounds(TControl(FVisibleList)); + fqbSetBounds(TControl(FWhereEditor)); + fqbSetBounds(TControl(FSortList)); + fqbSetBounds(TControl(FFunctionList)); + fqbSetBounds(TControl(FGroupList)); + FWhereEditor.Height := 18; +end; + +procedure TfqbGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + Selected := GetItemAt(5, Y); + ItemFocused := Selected +end; + +procedure TfqbGrid.RecalcColWidth; +var + i, n: Integer; + w, dw: Integer; + p: Real; +begin + w:= 0; + n := Columns.Count - 1; + for i := 0 to n do + w := w + Columns[i].Width; + dw := 0; + for i := 0 to n do + begin + p := Columns[i].Width / w; + Columns[i].Width := Round(p * (Width - 4)); + dw := dw + Columns[i].Width; + end; + Columns[n].Width := Columns[n].Width + (Width - dw - 4); +end; + +procedure TfqbGrid.Resize; +begin + inherited; + RecalcColWidth; + fqbUpdate +end; + +procedure TfqbGrid.UpdateColumn; +var + i: Integer; +begin + for i:= 0 to Items.Count - 1 do + begin + Items[i].Caption := TGridColumn(Items[i].Data^).Field; + + if TGridColumn(Items[i].Data^).Visibl then + Items[i].SubItems[rowVisibility - 1] := '' + else + Items[i].SubItems[rowVisibility - 1] := FVisibleList.Items[1]; + + Items[i].SubItems[rowWhere - 1]:= TGridColumn(Items[i].Data^).Where; + + if TGridColumn(Items[i].Data^).Sort = 0 then + Items[i].SubItems[rowSort - 1]:= '' + else + Items[i].SubItems[rowSort - 1]:= FSortList.Items[TGridColumn(Items[i].Data^).Sort]; + + if TGridColumn(Items[i].Data^).Func = 0 then + Items[i].SubItems[rowFunction - 1]:= '' + else + Items[i].SubItems[rowFunction - 1]:= FFunctionList.Items[TGridColumn(Items[i].Data^).Func]; + + if TGridColumn(Items[i].Data^).Group = 0 then + Items[i].SubItems[rowGroup - 1]:= '' + else + Items[i].SubItems[rowGroup - 1]:= FGroupList.Items[TGridColumn(Items[i].Data^).Group]; + end +end; + +procedure TfqbGrid.WMNotify(var Msg: TWMNotify); +begin + inherited; + case Msg.NMHdr^.code of + HDN_ENDTRACK: + DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr)); + end +end; + +procedure TfqbGrid.WMVscroll(var Msg: TWMNotify); +begin + inherited; + fqbUpdate +end; + +{----------------------- TfqbEdit -----------------------} +constructor TfqbEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FPanel := TPanel.Create(Self); + FPanel.Parent := Self; + FPanel.Align := alRight; + FPanel.Width := Height - 3; + FPanel.BevelOuter := bvNone; + + FButton := TSpeedButton.Create(Self); + FButton.Parent := FPanel; + FButton.Align := alClient; + FButton.OnClick := ButtonClick; +end; + +procedure TfqbEdit.ButtonClick(Sender: TObject); +begin + SetFocus; + if Assigned(FOnButtonClick) then + FOnButtonClick(Self); +end; + +procedure TfqbEdit.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + Params.Style := Params.Style or WS_CLIPCHILDREN; +end; + +procedure TfqbEdit.CreateWnd; +begin + inherited; + ShowButton := false; +end; + +procedure TfqbEdit.SetEditRect; +var + Rec: TRect; +begin + SendMessage(Handle, EM_GETRECT, 0, LongInt(@Rec)); + if ShowButton then + begin + Rec.Bottom := ClientHeight + 1; + Rec.Right := ClientWidth - FPanel.Width - 1 + end + else + begin + Rec.Bottom := ClientHeight + 1; + Rec.Right := ClientWidth; + end; + Rec.Top := 0; + Rec.Left := 0; + SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Rec)); +end; + +procedure TfqbEdit.SetShowButton(const Value: Boolean); +begin + FShowButton := Value; + FPanel.Visible := Value; + SetEditRect +end; + +procedure TfqbEdit.WMSize(var Message: TWMSize); +begin + inherited; + SetEditRect +end; + +procedure TfqbTable.CMRelease(var Message: TMessage); +begin + Free +end; + +initialization + RegisterClasses([TComboBox, TfqbEdit]); + +finalization + if FfqbCore <> nil then + FfqbCore.Free; + +end. diff --git a/official/3.23/FastQB/fqbDesign.dfm b/official/3.23/FastQB/fqbDesign.dfm new file mode 100644 index 0000000..ab014ea Binary files /dev/null and b/official/3.23/FastQB/fqbDesign.dfm differ diff --git a/official/3.23/FastQB/fqbDesign.pas b/official/3.23/FastQB/fqbDesign.pas new file mode 100644 index 0000000..5d37155 --- /dev/null +++ b/official/3.23/FastQB/fqbDesign.pas @@ -0,0 +1,200 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbDesign; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ToolWin, ComCtrls, StdCtrls, ExtCtrls, Grids, DBGrids, + ImgList, Buttons, Menus, DB +{$IFDEF Delphi6} + ,Variants +{$ENDIF} + ,fqbSynmemo, fqbClass; + +type + + TfqbDesigner = class(TForm) + DataSource1: TDataSource; + DBGrid1: TDBGrid; + fqbGrid1: TfqbGrid; + fqbSyntaxMemo1: TfqbSyntaxMemo; + fqbTableArea1: TfqbTableArea; + fqbTableListBox1: TfqbTableListBox; + ImageList2: TImageList; + OpenDialog1: TOpenDialog; + PageControl1: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + SaveDialog1: TSaveDialog; + Splitter1: TSplitter; + Splitter2: TSplitter; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + TabSheet3: TTabSheet; + ToolBar1: TToolBar; + ToolButton10: TToolButton; + ToolButton3: TToolButton; + ToolButton4: TToolButton; + ToolButton5: TToolButton; + ToolButton6: TToolButton; + ToolButton7: TToolButton; + ToolButton8: TToolButton; + procedure FormCreate(Sender: TObject); + procedure TabSheet2Show(Sender: TObject); + procedure TabSheet3Hide(Sender: TObject); + procedure TabSheet3Show(Sender: TObject); + procedure ToolButton10Click(Sender: TObject); + procedure ToolButton3Click(Sender: TObject); + procedure ToolButton4Click(Sender: TObject); + procedure ToolButton6Click(Sender: TObject); + procedure ToolButton7Click(Sender: TObject); + procedure FormDestroy(Sender: TObject); + protected + procedure LoadPos; + procedure SavePos; + end; + + +var + fqbDesigner: TfqbDesigner; + +implementation + +{$R *.dfm} + +uses fqbUtils, fqbRes, Registry; + +{----------------------- TfqbDesigner -----------------------} +procedure TfqbDesigner.FormCreate(Sender: TObject); +begin + LoadPos; + + ToolButton7.Hint := fqbGet(1); + ToolButton10.Hint := fqbGet(2); + ToolButton6.Hint := fqbGet(1803); + ToolButton3.Hint := fqbGet(1805); + ToolButton4.Hint := fqbGet(1804); + TabSheet1.Caption := fqbGet(1806); + TabSheet2.Caption := fqbGet(1807); + TabSheet3.Caption := fqbGet(1808); + fqbGrid1.Column[0].Caption := fqbGet(1820); + fqbGrid1.Column[1].Caption := fqbGet(1821); + fqbGrid1.Column[2].Caption := fqbGet(1822); + fqbGrid1.Column[3].Caption := fqbGet(1823); + fqbGrid1.Column[4].Caption := fqbGet(1824); + fqbGrid1.Column[5].Caption := fqbGet(1825); + + PageControl1.ActivePage := PageControl1.Pages[0]; + DataSource1.DataSet := fqbCore.Engine.ResultDataSet; + fqbTableListBox1.Items.BeginUpdate; + fqbTableListBox1.Items.Clear; + fqbCore.Engine.ReadTableList(fqbTableListBox1.Items); + fqbTableListBox1.Items.EndUpdate; +end; + +procedure TfqbDesigner.TabSheet2Show(Sender: TObject); +begin + fqbSyntaxMemo1.Lines.BeginUpdate; + fqbSyntaxMemo1.Lines.Clear; + fqbSyntaxMemo1.Lines.Text := fqbCore.GenerateSQL; + fqbSyntaxMemo1.Lines.EndUpdate +end; + +procedure TfqbDesigner.TabSheet3Hide(Sender: TObject); +begin + fqbCore.Engine.ResultDataSet.Close; +end; + +procedure TfqbDesigner.TabSheet3Show(Sender: TObject); +begin + fqbCore.Engine.ResultDataSet.Close; + fqbCore.Engine.SetSQL(fqbCore.GenerateSQL); + fqbCore.Engine.ResultDataSet.Open; +end; + +procedure TfqbDesigner.ToolButton10Click(Sender: TObject); +begin + ModalResult := mrCancel +end; + +procedure TfqbDesigner.ToolButton3Click(Sender: TObject); +begin + if OpenDialog1.Execute then + begin + fqbCore.Clear; + fqbCore.LoadFromFile(OpenDialog1.FileName); + end; +end; + +procedure TfqbDesigner.ToolButton4Click(Sender: TObject); +begin + if SaveDialog1.Execute then + fqbCore.SaveToFile(SaveDialog1.FileName); +end; + +procedure TfqbDesigner.ToolButton6Click(Sender: TObject); +begin + fqbCore.Clear; +end; + +procedure TfqbDesigner.ToolButton7Click(Sender: TObject); +begin + ModalResult := mrOk +end; + +procedure TfqbDesigner.FormDestroy(Sender: TObject); +begin + SavePos; +end; + +procedure TfqbDesigner.LoadPos; +var + Reg: TRegIniFile; + s: string; +begin + s := ChangeFileExt(ExtractFileName(Application.ExeName), ''); + Reg := TRegIniFile.Create('\Software\Fast Reports\FQBuilder\' + s); + try + Reg.RootKey := HKEY_CURRENT_USER; + Reg.OpenKey('\Software\Fast Reports\FQBuilder\' + s, True); + Top := Reg.ReadInteger(Name, 'Top', Top); + Left := Reg.ReadInteger(Name, 'Left', Left); + Height := Reg.ReadInteger(Name, 'Height', Height); + Width := Reg.ReadInteger(Name, 'Width', Width); + finally + Reg.Free; + end +end; + +procedure TfqbDesigner.SavePos; +var + Reg: TRegIniFile; + s: string; +begin + s := ChangeFileExt(ExtractFileName(Application.ExeName), ''); + Reg := TRegIniFile.Create('\Software\Fast Reports\FQBuilder\' + s); + try + Reg.RootKey := HKEY_CURRENT_USER; + Reg.OpenKey('\Software\Fast Reports\FQBuilder\' + s, True); + Reg.WriteInteger(Name, 'Top', Top); + Reg.WriteInteger(Name, 'Left', Left); + Reg.WriteInteger(Name, 'Height', Height); + Reg.WriteInteger(Name, 'Width', Width); + finally + Reg.Free; + end +end; + +end. + diff --git a/official/3.23/FastQB/fqbLinkForm.dfm b/official/3.23/FastQB/fqbLinkForm.dfm new file mode 100644 index 0000000..b14f10e Binary files /dev/null and b/official/3.23/FastQB/fqbLinkForm.dfm differ diff --git a/official/3.23/FastQB/fqbLinkForm.pas b/official/3.23/FastQB/fqbLinkForm.pas new file mode 100644 index 0000000..fcf4257 --- /dev/null +++ b/official/3.23/FastQB/fqbLinkForm.pas @@ -0,0 +1,40 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbLinkForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, Buttons; + +type + TfqbLinkForm = class(TForm) + RadioOpt: TRadioGroup; + RadioType: TRadioGroup; + txtTable1: TStaticText; + txtTable2: TStaticText; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + txtCol1: TStaticText; + Label4: TLabel; + txtCol2: TStaticText; + BitBtn1: TBitBtn; + BitBtn2: TBitBtn; + end; + +implementation + +{$R *.DFM} + +end. diff --git a/official/3.23/FastQB/fqbReg.pas b/official/3.23/FastQB/fqbReg.pas new file mode 100644 index 0000000..a0fe66b --- /dev/null +++ b/official/3.23/FastQB/fqbReg.pas @@ -0,0 +1,37 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbReg; + +interface + +procedure Register; + +implementation + +uses + Windows, Messages, Classes +{$IFNDEF Delphi6} + ,DsgnIntf +{$ELSE} + ,DesignIntf, DesignEditors +{$ENDIF} + ,fqbClass, fqbSynMemo; + +{$R 'FQB.DCR'} + +procedure Register; +begin + RegisterComponents('FastQueryBuilder', [TfqbDialog, + TfqbTableArea, TfqbTableListBox, TfqbSyntaxMemo, TfqbGrid]); +end; + +end. diff --git a/official/3.23/FastQB/fqbRes.pas b/official/3.23/FastQB/fqbRes.pas new file mode 100644 index 0000000..1a06128 --- /dev/null +++ b/official/3.23/FastQB/fqbRes.pas @@ -0,0 +1,172 @@ +{******************************************} +{ } +{ FastReport v3.0 } +{ Language resources management } +{ } +{ Copyright (c) 1998-2005 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit fqbRes; + +interface + +{$I fqb.inc} + +uses + Windows, SysUtils, Classes, Controls, Graphics, Forms, ImgList, TypInfo +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfqbResources = class(TObject) + private + FNames: TStringList; + FValues: TStringList; + public + constructor Create; + destructor Destroy; override; + function Get(const StrName: String): String; + procedure Add(const Ref, Str: String); + procedure AddStrings(const Str: String); + procedure Clear; + procedure LoadFromFile(const FileName: String); + procedure LoadFromStream(Stream: TStream); + end; + +function fqbResources: TfqbResources; +function fqbGet(ID: Integer): String; + + +implementation + +var + FResources: TfqbResources = nil; + +{ TfrxResources } + +constructor TfqbResources.Create; +begin + inherited; + FNames := TStringList.Create; + FValues := TStringList.Create; + FNames.Sorted := True; +end; + +destructor TfqbResources.Destroy; +begin + FNames.Free; + FValues.Free; + inherited; +end; + +procedure TfqbResources.Add(const Ref, Str: String); +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[Integer(FNames.Objects[i])] := Str; +end; + +procedure TfqbResources.AddStrings(const Str: String); +var + i: Integer; + sl: TStringList; + nm, vl: String; +begin + sl := TStringList.Create; + sl.Text := Str; + for i := 0 to sl.Count - 1 do + begin +// nm := sl[i]; + nm := sl.Names[i];// Copy(nm, Pos('=', nm) + 1, MaxInt); + vl := sl.Values[nm];// Copy(nm, 1, Pos('=', nm) - 1); + if (nm <> '') and (vl <> '') then + Add(nm, vl); + end; + sl.Free; +end; + +procedure TfqbResources.Clear; +begin + FNames.Clear; + FValues.Clear; +end; + +function TfqbResources.Get(const StrName: String): String; +var + i: Integer; +begin + i := FNames.IndexOf(StrName); + if i <> -1 then + Result := FValues[Integer(FNames.Objects[i])] else + Result := StrName; +end; + +procedure TfqbResources.LoadFromFile(const FileName: String); +var + f: TFileStream; +begin + f := TFileStream.Create(FileName, fmOpenRead); + try + LoadFromStream(f); + finally + f.Free; + end; +end; + +procedure TfqbResources.LoadFromStream(Stream: TStream); +var + sl: TStringList; + i: Integer; + nm, vl: String; +begin + sl := TStringList.Create; + try + sl.LoadFromStream(Stream); + Clear; + 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; + finally + sl.Free; + end +end; + + +function fqbResources: TfqbResources; +begin + if FResources = nil then + FResources := TfqbResources.Create; + Result := FResources; +end; + +function fqbGet(ID: Integer): String; +begin + Result := fqbResources.Get(IntToStr(ID)); +end; + + +initialization + +finalization + if FResources <> nil then + FResources.Free; + FResources := nil; + +end. diff --git a/official/3.23/FastQB/fqbSynmemo.dfm b/official/3.23/FastQB/fqbSynmemo.dfm new file mode 100644 index 0000000..05d74a8 Binary files /dev/null and b/official/3.23/FastQB/fqbSynmemo.dfm differ diff --git a/official/3.23/FastQB/fqbSynmemo.pas b/official/3.23/FastQB/fqbSynmemo.pas new file mode 100644 index 0000000..5be8bb0 --- /dev/null +++ b/official/3.23/FastQB/fqbSynmemo.pas @@ -0,0 +1,2013 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ Syntax memo control } +{ } +{ (c) 2003 by Alexander Tzyganenko, } +{ Fast Reports, Inc } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbSynmemo; + +interface + +uses + Windows, Messages, Classes, Controls, StdCtrls, Forms, Menus, Graphics, SysUtils; + +type + + TSyntaxType = (stPascal, stCpp, stSQL, stText); + TCharAttr = (caNone, caText, caBlock, caComment, caKeyword, caString); + TCharAttributes = set of TCharAttr; + + TfqbSyntaxMemo = 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; +{$IFDEF Delphi4} + KWheel: Integer; +{$ENDIF} + LastSearch: String; + FShowGutter: boolean; + FShowFooter: boolean; +{$IFDEF Delphi4} + Bookmarks: array of Integer; +{$ELSE} + Bookmarks: array [0..10] of Integer; +{$ENDIF} + FActiveLine: Integer; + 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; line : integer); + procedure ActiveLineDraw(Y :integer; line : 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: TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; + procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + { 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; +{$IFDEF Delphi4} + property Anchors; + property BiDiMode; + property Constraints; + property DragKind; + property ParentBiDiMode; +{$ENDIF} + property Color; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property ParentColor; + property ParentCtl3D; + 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 OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + end; + + TfqbSynMemoSearch = 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 + fqbSynMemoSearch: TfqbSynMemoSearch; + +procedure Register; + +implementation + +{$R *.DFM} + +uses Clipbrd, comctrls; + +procedure Register; +begin + RegisterComponents('FastQB2', [TfqbSyntaxMemo]) +end; + +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,view,' + + 'wait,when,where,while,with,work'; + + WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_']; + +type + THackScrollBar = class(TScrollBar) + end; + +{ TfrSyntaxMemo } + +constructor TfqbSyntaxMemo.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 := []; + + + if AOwner is TWinControl then + Parent := AOwner as TWinControl; + + OnDragOver := DOver; + OnDragDrop := DDrop; + +{$IFDEF Delphi4} + OnMouseWheelUp := MouseWheelUp; + OnMouseWheelDown := MouseWheelDown; + KWheel := 1; +{$ENDIF} + + FText := TStringList.Create; + FUndo := TStringList.Create; + FSynStrings := TStringList.Create; + FText.Add(''); + FText.OnChange := LinesChange; + FMaxLength := 1024; + SyntaxType := stPascal; + FMoved := True; + SetPos(1, 1); + + 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 := ''; +{$IFDEF Delphi4} + Setlength(Bookmarks, 10); + for i := 0 to Length(Bookmarks)-1 do +{$ELSE} + for i := 0 to 9 do +{$ENDIF} + Bookmarks[i] := -1; + + FActiveLine := -1; + + Height := 200; + Width := 200; + +end; + +destructor TfqbSyntaxMemo.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 TfqbSyntaxMemo.CreateParams(var Params: TCreateParams); +begin + inherited; + with Params do + ExStyle := ExStyle or WS_EX_CLIENTEDGE; +end; + +procedure TfqbSyntaxMemo.WMKillFocus(var Msg: TWMKillFocus); +begin + inherited; + HideCaret(Handle); + DestroyCaret; +end; + +procedure TfqbSyntaxMemo.WMSetFocus(var Msg: TWMSetFocus); +begin + inherited; + CreateCaret(Handle, 0, 2, FCharHeight); + ShowCaretPos; +end; + +procedure TfqbSyntaxMemo.ShowCaretPos; +begin + SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth, + FCharHeight * (FPos.Y - 1 - FOffset.Y)); + ShowCaret(Handle); + ShowPos; +end; + +procedure TfqbSyntaxMemo.ShowPos; +begin + if FFooterHeight > 0 then + with Canvas do + begin + Font.Name := 'Tahoma'; + Font.Color := clBlack; + Font.Style := []; + Font.Size := 8; + Brush.Color := clBtnFace; + TextOut(FGutterWidth + 4, Height - TextHeight('|') - 5, IntToStr(FPos.y) + ' : ' + IntToStr(FPos.x) + ' '); + end; +end; + +procedure TfqbSyntaxMemo.WMGetDlgCode(var Message: TWMGetDlgCode); +begin + Message.Result := DLGC_WANTARROWS or DLGC_WANTTAB; +end; + +procedure TfqbSyntaxMemo.CMFontChanged(var Message: TMessage); +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'); + FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0; + end; + b.Free; +end; + +{ End of stuff } + +procedure TfqbSyntaxMemo.SetParent(Value: TWinControl); +begin + inherited SetParent(Value); + if (Parent = nil) or (csDestroying in ComponentState) then Exit; + + ShowGutter := True; + ShowFooter := True; + FVScroll.Parent := Self; + FVScroll.Kind := sbVertical; + FVScroll.OnChange := ScrollClick; + FVScroll.OnEnter := ScrollEnter; + FVScroll.Ctl3D := False; + Color := clWindow; + TabStop := True; + +end; + + +function TfqbSyntaxMemo.GetClientRect: TRect; +begin + if FVScroll.Visible then + Result := Bounds(0, 0, Width - FVScroll.Width - 4, Height) else + Result := inherited GetClientRect; +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.UpdateSyntax; +begin + CreateSynArray; + Repaint; +end; + +procedure TfqbSyntaxMemo.UpdateScrollBar; +begin + with FVScroll do + begin +// prevent OnScroll event + FUpdating := True; + Position := 0; +{$IFDEF Delphi4} + PageSize := 0; +{$ENDIF} + if Assigned(FText) then + Max := FText.Count + else + Max := 0; + SmallChange := 1; + if FWindowSize.Y < Max then + begin + Visible := True; +{$IFDEF Delphi4} + PageSize := FWindowSize.Y; +{$ENDIF} + 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 TfqbSyntaxMemo.GetText: TStrings; +var + i: Integer; +begin + for i := 0 to FText.Count - 1 do + FText[i] := LineAt(i); + Result := FText; + FAllowLinesChange := True; +end; + +procedure TfqbSyntaxMemo.SetText(Value: TStrings); +begin + FAllowLinesChange := True; + FText.Assign(Value); +end; + +procedure TfqbSyntaxMemo.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 + FKeywords := ''; + UpdateSyntax; +end; + +function TfqbSyntaxMemo.GetPos: TPoint; +begin + Result := FPos; +end; + +procedure TfqbSyntaxMemo.DoChange; +begin + FModified := True; +end; + +procedure TfqbSyntaxMemo.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); + ClearSel; + ShowCaretPos; + UpdateScrollBar; + end; +end; + +procedure TfqbSyntaxMemo.ShowMessage(s: String); +begin + FMessage := s; + Repaint; +end; + +procedure TfqbSyntaxMemo.CopyToClipboard; +begin + if FSelStart.X <> 0 then + Clipboard.AsText := SelText; +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.PasteFromClipboard; +begin + if not FReadOnly then + SelText := Clipboard.AsText; +end; + +function TfqbSyntaxMemo.LineAt(Index: Integer): String; +begin + if Index < FText.Count then + Result := TrimRight(FText[Index]) + else + Result := ''; +end; + +function TfqbSyntaxMemo.LineLength(Index: Integer): Integer; +begin + Result := Length(LineAt(Index)); +end; + +function TfqbSyntaxMemo.Pad(n: Integer): String; +begin + result := ''; + SetLength(result, n); + FillChar(result[1], n, ' '); +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.ClearSel; +begin + if FSelStart.X <> 0 then + begin + FSelStart := Point(0, 0); + Repaint; + end; +end; + +procedure TfqbSyntaxMemo.AddSel; +begin + if FSelStart.X = 0 then + FSelStart := FTempPos; + FSelEnd := FPos; + Repaint; +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.ScrollEnter(Sender: TObject); +begin + SetFocus; +end; + +procedure TfqbSyntaxMemo.DblClick; +var + s: String; +begin + FDoubleClicked := True; + DoCtrlL; + FSelStart := FPos; + s := LineAt(FPos.Y - 1); + if s <> '' then + while s[FPos.X] in WordChars do + Inc(FPos.X); + FSelEnd := FPos; + Repaint; +end; + +procedure TfqbSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if FDoubleClicked then + begin + FDoubleClicked := False; + Exit; + end; + if (Button = mbRight) and (PopupMenu = nil) then +{$IFDEF Delphi4} + FPopUpMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y) +{$ENDIF} + 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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FDown := False; +end; + +procedure TfqbSyntaxMemo.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 + fqbSynMemoSearch := TfqbSynMemoSearch.Create(nil); + if fqbSynMemoSearch.ShowModal = mrOk then + Find(fqbSynMemoSearch.Edit1.Text); + LastSearch := fqbSynMemoSearch.Edit1.Text; + fqbSynMemoSearch.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.DoLeft; +begin + Dec(FPos.X); + if FPos.X < 1 then + FPos.X := 1; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.DoRight; +begin + Inc(FPos.X); + if FPos.X > FMaxLength then + FPos.X := FMaxLength; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.DoUp; +begin + Dec(FPos.Y); + if FPos.Y < 1 then + FPos.Y := 1; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.DoDown; +begin + Inc(FPos.Y); + if FPos.Y > FText.Count then + FPos.Y := FText.Count; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.DoHome(Ctrl: Boolean); +begin + if Ctrl then + SetPos(1, 1) else + SetPos(1, FPos.Y); +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.DoCtrlI; +begin + if FSelStart.X <> 0 then + ShiftSelected(True); +end; + +procedure TfqbSyntaxMemo.DoCtrlU; +begin + if FSelStart.X <> 0 then + ShiftSelected(False); +end; + +procedure TfqbSyntaxMemo.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 (s[i] in WordChars) do + if s[i] = #13 then + break else + Dec(i); + while (i > 0) and (s[i] in WordChars) do + Dec(i); + Inc(i); + + FPos := GetPosPlainText(i); + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.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 (s[i] in WordChars) do + Inc(i); + while (i < Length(s)) and not (s[i] in WordChars) do + if s[i] = #13 then + break else + Inc(i); + + FPos := GetPosPlainText(i); + SetPos(FPos.X, FPos.Y); +end; + +procedure TfqbSyntaxMemo.DoChar(Ch: Char); +begin + SelText := Ch; +end; + +function TfqbSyntaxMemo.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; + +procedure TfqbSyntaxMemo.Paint; +var + i, j, j1: Integer; + a, a1: TCharAttributes; + s: String; + + procedure SetAttr(a: TCharAttributes); + 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 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 + if FIsMonoType then + Canvas.TextOut(x, y, s) + 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; + +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; + +procedure TfqbSyntaxMemo.CreateSynArray; +var + i, n, Pos: Integer; + ch: Char; + FSyn: String; + + procedure SkipSpaces; + begin + while (Pos <= Length(FSyn)) and + ((FSyn[Pos] in [#1..#32]) or + not (FSyn[Pos] in ['_', '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 = stCpp 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 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 + 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 (FSyn[Pos] in [#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 FSyn[i] > #31 then + FSyn[i] := ch; + end; + + FUpdatingSyntax := True; + FSynStrings.Text := FSyn; + FSynStrings.Add(' '); + FUpdatingSyntax := False; +end; + +procedure TfqbSyntaxMemo.UpdateView; +begin + UpdateSyntax; + Invalidate; +end; + +procedure TfqbSyntaxMemo.CopyPopup(Sender: TObject); +begin + CopyToClipboard; +end; + +procedure TfqbSyntaxMemo.PastePopup(Sender: TObject); +begin + PasteFromClipboard; +end; + +procedure TfqbSyntaxMemo.CutPopup(Sender: TObject); +begin + CutToClipboard; +end; + +{$IFDEF Delphi4} +procedure TfqbSyntaxMemo.MouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + FVScroll.Position := FVScroll.Position - FVScroll.SmallChange * KWheel; +end; + +procedure TfqbSyntaxMemo.MouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + FVScroll.Position := FVScroll.Position + FVScroll.SmallChange * KWheel; +end; +{$ENDIF} + +procedure TfqbSyntaxMemo.SetShowGutter(Value: boolean); +begin + FShowGutter := Value; + if Value then + FGutterWidth := 20 + else + FGutterWidth := 0; + Repaint; +end; + +procedure TfqbSyntaxMemo.SetShowFooter(Value: boolean); +begin + FShowFooter := Value; + if Value then + FFooterHeight := 20 + else + FFooterHeight := 0; + Repaint; +end; + +function TfqbSyntaxMemo.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 TfqbSyntaxMemo.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 TfqbSyntaxMemo.ActiveLineDraw(Y : integer; line : integer); +begin + if ShowGutter then + with Canvas do + if line = FActiveLine then + begin + Brush.Color := clRed; + Pen.Color := clBlack; + Ellipse(4, Y+4, 11, Y+11); + end; +end; + +procedure TfqbSyntaxMemo.BookmarkDraw(Y : integer; line : integer); +var + bm : integer; +begin + if ShowGutter then + with Canvas do + begin + bm := IsBookmark(Line); + 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 TfqbSyntaxMemo.IsBookmark(Line : integer): integer; +var + Pos : integer; +begin + Result := -1; +{$IFDEF Delphi4} + for Pos := 0 to Length(Bookmarks) - 1 do +{$ELSE} + for Pos := 0 to 9 do +{$ENDIF} + if Bookmarks[Pos] = Line then + begin + Result := Pos; + break; + end; +end; + +procedure TfqbSyntaxMemo.AddBookmark(Line, Number : integer); +begin +{$IFDEF Delphi4} + if Number < Length(Bookmarks) then +{$ELSE} + if Number < 10 then +{$ENDIF} + begin + Bookmarks[Number] := Line; + Repaint; + end; +end; + +procedure TfqbSyntaxMemo.DeleteBookmark(Number : integer); +begin +{$IFDEF Delphi4} + if Number < Length(Bookmarks) then +{$ELSE} + if Number < 10 then +{$ENDIF} + begin + Bookmarks[Number] := -1; + Repaint; + end; +end; + +procedure TfqbSyntaxMemo.CorrectBookmark(Line : integer; delta : integer); +var + i : integer; +begin +{$IFDEF Delphi4} + for i := 0 to Length(Bookmarks) - 1 do +{$ELSE} + for i := 0 to 9 do +{$ENDIF} + if Bookmarks[i] >= Line then + Inc(Bookmarks[i], Delta); +end; + +procedure TfqbSyntaxMemo.GotoBookmark(Number : integer); +begin +{$IFDEF Delphi4} + if Number < Length(Bookmarks) then +{$ELSE} + if Number < 10 then +{$ENDIF} + if Bookmarks[Number] >= 0 then + SetPos(0, Bookmarks[Number] + 1); +end; + +procedure TfqbSyntaxMemo.DOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +begin + Accept := Source is TTreeView; +end; + +procedure TfqbSyntaxMemo.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 TfqbSyntaxMemo.SetKeywordAttr(Value: TFont); +begin + FKeywordAttr.Assign(Value); + UpdateSyntax; +end; + +procedure TfqbSyntaxMemo.SetStringAttr(Value: TFont); +begin + FStringAttr.Assign(Value); + UpdateSyntax; +end; + +procedure TfqbSyntaxMemo.SetTextAttr(Value: TFont); +begin + FTextAttr.Assign(Value); + UpdateSyntax; +end; + +procedure TfqbSyntaxMemo.SetCommentAttr(Value: TFont); +begin + FCommentAttr.Assign(Value); + UpdateSyntax; +end; + +procedure TfqbSyntaxMemo.SetActiveLine(Line : Integer); +begin + FActiveLine := Line; + Repaint; +end; + +function TfqbSyntaxMemo.GetActiveLine: Integer; +begin + Result := FActiveLine; +end; + +// + +procedure TfqbSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + ModalResult := mrOk; +end; + +end. + diff --git a/official/3.23/FastQB/fqbUtils.pas b/official/3.23/FastQB/fqbUtils.pas new file mode 100644 index 0000000..c42a21d --- /dev/null +++ b/official/3.23/FastQB/fqbUtils.pas @@ -0,0 +1,334 @@ +{*******************************************} +{ } +{ FastQueryBuilder 1.03 } +{ } +{ Copyright (c) 2005 } +{ Fast Reports Inc. } +{ } +{*******************************************} + +{$I fqb.inc} + +unit fqbUtils; + +interface + +uses Windows, Messages, Classes, SysUtils, fqbZLib; + +function fqbStringCRC32(const Str: string): Cardinal; +function fqbGetUniqueFileName(const Prefix: String): string; +function fqbTrim(const Input: string; EArray: TSysCharSet):string; +function fqbParse(Char, S: string; Count: Integer; Last: Boolean = False): string; +function fqbBase64Decode(const S: String): String; +function fqbBase64Encode(const S: String): String; +function fqbCompress(const S: String): String; +function fqbDeCompress(const S: String): String; +procedure fqbDeflateStream(Source, Dest: TStream; Compression: TZCompressionLevel = zcDefault); +procedure fqbInflateStream(Source, Dest: TStream); + + +implementation + +const + Base64Charset = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; + + 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 fqbStringCRC32(const Str: string): Cardinal; + var + i: Integer; + b: Byte; + c: Cardinal; +begin + c := $ffffffff; + for i := 1 to Length(Str) do + begin + b := Byte(Str[i]); + c := CrcTable[(c xor Cardinal(b)) and $ff] xor (c shr 8) + end; + Result := c xor $ffffffff +end; + +function fqbGetUniqueFileName(const Prefix: String): string; + var + TempPath: array[0..MAX_PATH] of Char; + FileName: String[255]; +begin + GetTempPath(SizeOf(TempPath) - 1, TempPath); + GetTempFileName(TempPath, PChar(Prefix), 0, @FileName[1]); + Result := StrPas(@FileName[1]) +end; + +function fqbTrim(const Input: string; EArray: TSysCharSet):string; + var + tmp: string; +begin + Result := ''; + tmp := Input; + while Length(tmp) <> 0 do + if tmp[1] in EArray then + Delete(tmp, 1, 1) + else + begin + Result := Result + tmp[1]; + Delete(tmp, 1, 1) + end; + repeat + if Pos(' ', Result) > 0 then + Delete(Result, Pos(' ', Result) + 1, 1) + until Pos(' ', Result) = 0; +end; + +function fqbParse(Char, S: string; Count: Integer; Last: Boolean = False): string; + var + i: Integer; + t: string; +begin + if S[Length(S)] <> Char then + S := S + Char; + for i := 1 to Count do + begin + if Last then + t := Copy(S, 0, Length(S) - 1) + else + t := Copy(S, 0, Pos(Char, S) - 1); + S := Copy(S, Pos(Char, S) + 1, Length(S)) + end; + Result := t +end; + + +function fqbBase64Decode(const S: String): String; + var + F, L, M, P: Integer; + B, OutPos: Byte; + OutB: Array[1..3] of Byte; + Lookup: Array[Char] of Byte; + R: PChar; +begin + L := Length(S); + P := 0; + while (L - P > 0) and (S[L - P] = '=') do Inc(P); + M := L - P; + if M <> 0 then + begin + SetLength(Result, (M * 3) div 4); + FillChar(Lookup, Sizeof(Lookup), #0); + for F := 0 to 63 do + Lookup[Base64Charset[F + 1]] := F; + R := Pointer(Result); + OutPos := 0; + for F := 1 to L - P do + begin + B := Lookup[S[F]]; + case OutPos of + 0 : OutB[1] := B shl 2; + 1 : begin + OutB[1] := OutB[1] or (B shr 4); + R^ := Char(OutB[1]); + Inc(R); + OutB[2] := (B shl 4) and $FF + end; + 2 : begin + OutB[2] := OutB[2] or (B shr 2); + R^ := Char(OutB[2]); + Inc(R); + OutB[3] := (B shl 6) and $FF + end; + 3 : begin + OutB[3] := OutB[3] or B; + R^ := Char(OutB[3]); + Inc(R) + end + end; + OutPos := (OutPos + 1) mod 4 + end; + if (OutPos > 0) and (P = 0) then + if OutB[OutPos] <> 0 then + Result := Result + Char(OutB[OutPos]) + end else + Result := '' +end; + +function fqbBase64Encode(const S: String): String; + var + R, C : Byte; + F, L, M, N, U : Integer; + P : PChar; +begin + L := Length(S); + if L > 0 then + begin + M := L mod 3; + N := (L div 3) * 4 + M; + if M > 0 then Inc(N); + U := N mod 4; + if U > 0 then + begin + U := 4 - U; + Inc(N, U) + end; + SetLength(Result, N); + P := Pointer(Result); + R := 0; + for F := 0 to L - 1 do + begin + C := Byte(S [F + 1]); + case F mod 3 of + 0 : begin + P^ := Base64Charset[C shr 2 + 1]; + Inc(P); + R := (C and 3) shl 4 + end; + 1 : begin + P^ := Base64Charset[C shr 4 + R + 1]; + Inc(P); + R := (C and $0F) shl 2 + end; + 2 : begin + P^ := Base64Charset[C shr 6 + R + 1]; + Inc(P); + P^ := Base64Charset[C and $3F + 1]; + Inc(P) + end + end + end; + if M > 0 then + begin + P^ := Base64Charset[R + 1]; + Inc(P) + end; + for F := 1 to U do + begin + P^ := '='; + Inc(P) + end; + end else + Result := '' +end; + +function fqbCompress(const S: String): String; + var + st, stres: TStringStream; +begin + st := TStringStream.Create(s); + stres := TStringStream.Create(''); + + fqbDeflateStream(st, stres, zcMax); + Result := fqbBase64Encode(stres.DataString); + + stres.Free; + st.Free +end; + +function fqbDeCompress(const S: String): String; + var + st, stres: TStringStream; +begin + + st := TStringStream.Create(fqbBase64Decode(s)); + stres := TStringStream.Create(''); + + fqbInflateStream(st, stres); + Result := stres.DataString; + + stres.Free; + st.Free +end; + +procedure fqbDeflateStream(Source, Dest: TStream; Compression: TZCompressionLevel = zcDefault); +var + Compressor: TZCompressionStream; +begin + Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression)); + try + Compressor.CopyFrom(Source, 0) + finally + Compressor.Free + end +end; + +procedure fqbInflateStream(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; + +end. diff --git a/official/3.23/FastQB/fqbZLib.pas b/official/3.23/FastQB/fqbZLib.pas new file mode 100644 index 0000000..00d6d33 --- /dev/null +++ b/official/3.23/FastQB/fqbZLib.pas @@ -0,0 +1,616 @@ +{***************************************************************************** +* ZLibEx.pas (zlib 1.2.1) * +* * +* copyright (c) 2002-2003 Roberto Della Pasqua (www.dellapasqua.com) * +* copyright (c) 2000-2002 base2 technologies (www.base2ti.com) * +* copyright (c) 1997 Borland International (www.borland.com) * +* * +* revision history * +* 2003.12.18 updated with latest zlib 1.2.1 (see www.zlib.org) * +* obj's compiled with fastest speed optimizations (bcc 5.6.4) * +* (hint:see basm newsgroup about a Move RTL fast replacement) * +* Thanks to Cosmin Truta for the pascal zlib reference * +* * +* 2002.11.02 ZSendToBrowser: deflate algorithm for HTTP1.1 compression * +* 2002.10.24 ZFastCompressString and ZFastDecompressString:300% faster * +* 2002.10.15 recompiled zlib 1.1.4 c sources with speed optimizations * +* (and targeting 686+ cpu) and changes to accomodate Borland * +* standards (C++ v5.6 compiler) * +* 2002.10.15 optimized move mem for not aligned structures (strings,etc)* +* 2002.10.15 little changes to avoid system unique string calls * +* * +* 2002.03.15 updated to zlib version 1.1.4 * +* 2001.11.27 enhanced TZDecompressionStream.Read to adjust source * +* stream position upon end of compression data * +* fixed endless loop in TZDecompressionStream.Read when * +* destination count was greater than uncompressed data * +* 2001.10.26 renamed unit to integrate "nicely" with delphi 6 * +* 2000.11.24 added soFromEnd condition to TZDecompressionStream.Seek * +* added ZCompressStream and ZDecompressStream * +* 2000.06.13 optimized, fixed, rewrote, and enhanced the zlib.pas unit * +* included on the delphi cd (zlib version 1.1.3) * +* * +* acknowledgements * +* erik turner Z*Stream routines * +* david bennion finding the nastly little endless loop quirk with the * +* TZDecompressionStream.Read method * +* burak kalayci informing me about the zlib 1.1.4 update * +*****************************************************************************} + +unit fqbZLib; + +interface + +uses + Windows, + Sysutils, + Classes; + +const + ZLIB_VERSION = '1.2.1'; + +type + TZAlloc = function(opaque: Pointer; items, size: Integer): Pointer; + TZFree = procedure(opaque, block: Pointer); + TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax); + + {** TZStreamRec ***********************************************************} + + TZStreamRec = packed record + next_in: PChar; // next input byte + avail_in: Longint; // number of bytes available at next_in + total_in: Longint; // total nb of input bytes read so far + next_out: PChar; // next output byte should be put here + avail_out: Longint; // remaining free space at next_out + total_out: Longint; // total nb of bytes output so far + msg: PChar; // last error message, NULL if no error + state: Pointer; // not visible by applications + zalloc: TZAlloc; // used to allocate the internal state + zfree: TZFree; // used to free the internal state + opaque: Pointer; // private data object passed to zalloc and zfree + data_type: Integer; // best guess about the data type: ascii or binary + adler: Longint; // adler32 value of the uncompressed data + reserved: Longint; // reserved for future use + end; + + {** TCustomZStream ********************************************************} + + TCustomZStream = class(TStream) + private + FStream: TStream; + FStreamPos: Integer; + FOnProgress: TNotifyEvent; + FZStream: TZStreamRec; + FBuffer: array[Word] of Char; + protected + constructor Create(stream: TStream); + procedure DoProgress; dynamic; + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + end; + + {** TZCompressionStream ***************************************************} + + TZCompressionStream = class(TCustomZStream) + private + function GetCompressionRate: Single; + public + constructor Create(dest: TStream; compressionLevel: TZCompressionLevel = zcDefault); + destructor Destroy; override; + function Read(var buffer; count: Longint): Longint; override; + function Write(const buffer; count: Longint): Longint; override; + function Seek(offset: Longint; origin: Word): Longint; override; + property CompressionRate: Single read GetCompressionRate; + property OnProgress; + end; + + {** TZDecompressionStream *************************************************} + + TZDecompressionStream = class(TCustomZStream) + public + constructor Create(source: TStream); + destructor Destroy; override; + function Read(var buffer; count: Longint): Longint; override; + function Write(const buffer; count: Longint): Longint; override; + function Seek(offset: Longint; origin: Word): Longint; override; + property OnProgress; + end; + +{** zlib public routines ****************************************************} + +{***************************************************************************** +* ZCompress * +* * +* pre-conditions * +* inBuffer = pointer to uncompressed data * +* inSize = size of inBuffer (bytes) * +* outBuffer = pointer (unallocated) * +* level = compression level * +* * +* post-conditions * +* outBuffer = pointer to compressed data (allocated) * +* outSize = size of outBuffer (bytes) * +*****************************************************************************} + +procedure ZCompress(const inBuffer: Pointer; inSize: Integer; + out outBuffer: Pointer; out outSize: Integer; + level: TZCompressionLevel = zcDefault); + +{***************************************************************************** +* ZDecompress * +* * +* pre-conditions * +* inBuffer = pointer to compressed data * +* inSize = size of inBuffer (bytes) * +* outBuffer = pointer (unallocated) * +* outEstimate = estimated size of uncompressed data (bytes) * +* * +* post-conditions * +* outBuffer = pointer to decompressed data (allocated) * +* outSize = size of outBuffer (bytes) * +*****************************************************************************} + +procedure ZDecompress(const inBuffer: Pointer; inSize: Integer; + out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0); + +{** utility routines ********************************************************} + +function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; +function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt; +function compressBound(sourceLen: LongInt): LongInt; + +{****************************************************************************} + + +type + EZLibError = class(Exception); + EZCompressionError = class(EZLibError); + EZDecompressionError = class(EZLibError); + +implementation + +{** link zlib 1.2.1 **************************************************************} +{** bcc32 flags: -c -6 -O2 -Ve -X- -pr -a8 -b -d -k- -vi -tWM -r -RT- -DFASTEST **} + +{$L adler32.zobj} +{$L compress.zobj} +{$L crc32.zobj} +{$L deflate.zobj} +{$L infback.zobj} +{$L inffast.zobj} +{$L inflate.zobj} +{$L inftrees.zobj} +{$L trees.zobj} + +{***************************************************************************** +* note: do not reorder the above -- doing so will result in external * +* functions being undefined * +*****************************************************************************} + +const + {** flush constants *******************************************************} + + Z_NO_FLUSH = 0; + Z_FINISH = 4; + + {** return codes **********************************************************} + + Z_OK = 0; + Z_STREAM_END = 1; + Z_NEED_DICT = 2; + Z_ERRNO = (-1); + Z_STREAM_ERROR = (-2); + Z_DATA_ERROR = (-3); + Z_MEM_ERROR = (-4); + Z_BUF_ERROR = (-5); + Z_VERSION_ERROR = (-6); + + {** compression levels ****************************************************} + + Z_NO_COMPRESSION = 0; + Z_BEST_SPEED = 1; + Z_BEST_COMPRESSION = 9; + Z_DEFAULT_COMPRESSION = (-1); + + {** compression methods ***************************************************} + + Z_DEFLATED = 8; + + {** return code messages **************************************************} + + _z_errmsg: array[0..9] of PChar = ( + 'need dictionary', // Z_NEED_DICT (2) + 'stream end', // Z_STREAM_END (1) + '', // Z_OK (0) + 'file error', // Z_ERRNO (-1) + 'stream error', // Z_STREAM_ERROR (-2) + 'data error', // Z_DATA_ERROR (-3) + 'insufficient memory', // Z_MEM_ERROR (-4) + 'buffer error', // Z_BUF_ERROR (-5) + 'incompatible version', // Z_VERSION_ERROR (-6) + '' + ); + + ZLevels: array[TZCompressionLevel] of Shortint = ( + Z_NO_COMPRESSION, + Z_BEST_SPEED, + Z_DEFAULT_COMPRESSION, + Z_BEST_COMPRESSION + ); + + SZInvalid = 'Invalid ZStream operation!'; + +{** deflate routines ********************************************************} + +function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; + recsize: Integer): Integer; external; + +function deflate(var strm: TZStreamRec; flush: Integer): Integer; + external; + +function deflateEnd(var strm: TZStreamRec): Integer; external; + +{** inflate routines ********************************************************} + +function inflateInit_(var strm: TZStreamRec; version: PChar; + recsize: Integer): Integer; external; + +function inflate(var strm: TZStreamRec; flush: Integer): Integer; + external; + +function inflateEnd(var strm: TZStreamRec): Integer; external; + +function inflateReset(var strm: TZStreamRec): Integer; external; + +{** utility routines *******************************************************} + +function adler32; external; +function crc32; external; +function compressBound; external; + +{** zlib function implementations *******************************************} + +function zcalloc(opaque: Pointer; items, size: Integer): Pointer; +begin + GetMem(result, items * size); +end; + +procedure zcfree(opaque, block: Pointer); +begin + FreeMem(block); +end; + +{** c function implementations **********************************************} + +procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl; +begin + FillChar(p^, count, b); +end; + +procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; +begin + Move(source^, dest^, count); +end; + +{** custom zlib routines ****************************************************} + +function DeflateInit(var stream: TZStreamRec; level: Integer): Integer; +begin + result := DeflateInit_(stream, level, ZLIB_VERSION, SizeOf(TZStreamRec)); +end; + +function InflateInit(var stream: TZStreamRec): Integer; +begin + result := InflateInit_(stream, ZLIB_VERSION, SizeOf(TZStreamRec)); +end; + +{****************************************************************************} + +function ZCompressCheck(code: Integer): Integer; +begin + result := code; + + if code < 0 then + begin + raise EZCompressionError.Create(_z_errmsg[2 - code]); + end; +end; + +function ZDecompressCheck(code: Integer): Integer; +begin + Result := code; + + if code < 0 then + begin + raise EZDecompressionError.Create(_z_errmsg[2 - code]); + end; +end; + +procedure ZCompress(const inBuffer: Pointer; inSize: Integer; + out outBuffer: Pointer; out outSize: Integer; + level: TZCompressionLevel); +const + delta = 256; +var + zstream: TZStreamRec; +begin + FillChar(zstream, SizeOf(TZStreamRec), 0); + + outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255; + GetMem(outBuffer, outSize); + + try + zstream.next_in := inBuffer; + zstream.avail_in := inSize; + zstream.next_out := outBuffer; + zstream.avail_out := outSize; + + ZCompressCheck(DeflateInit(zstream, ZLevels[level])); + + try + while ZCompressCheck(deflate(zstream, Z_FINISH)) <> Z_STREAM_END do + begin + Inc(outSize, delta); + ReallocMem(outBuffer, outSize); + + zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out); + zstream.avail_out := delta; + end; + finally + ZCompressCheck(deflateEnd(zstream)); + end; + + ReallocMem(outBuffer, zstream.total_out); + outSize := zstream.total_out; + except + FreeMem(outBuffer); + raise; + end; +end; + +procedure ZDecompress(const inBuffer: Pointer; inSize: Integer; + out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer); +var + zstream: TZStreamRec; + delta: Integer; +begin + FillChar(zstream, SizeOf(TZStreamRec), 0); + + delta := (inSize + 255) and not 255; + + if outEstimate = 0 then outSize := delta + else outSize := outEstimate; + + GetMem(outBuffer, outSize); + + try + zstream.next_in := inBuffer; + zstream.avail_in := inSize; + zstream.next_out := outBuffer; + zstream.avail_out := outSize; + + ZDecompressCheck(InflateInit(zstream)); + + try + while ZDecompressCheck(inflate(zstream, Z_NO_FLUSH)) <> Z_STREAM_END do + begin + Inc(outSize, delta); + ReallocMem(outBuffer, outSize); + + zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out); + zstream.avail_out := delta; + end; + finally + ZDecompressCheck(inflateEnd(zstream)); + end; + + ReallocMem(outBuffer, zstream.total_out); + outSize := zstream.total_out; + except + FreeMem(outBuffer); + raise; + end; +end; + +{** TCustomZStream **********************************************************} + +constructor TCustomZStream.Create(stream: TStream); +begin + inherited Create; + FStream := stream; + FStreamPos := stream.Position; +end; + +procedure TCustomZStream.DoProgress; +begin + if Assigned(FOnProgress) then FOnProgress(Self); +end; + +{** TZCompressionStream *****************************************************} + +constructor TZCompressionStream.Create(dest: TStream; + compressionLevel: TZCompressionLevel); +begin + inherited Create(dest); + + FZStream.next_out := FBuffer; + FZStream.avail_out := SizeOf(FBuffer); + + ZCompressCheck(DeflateInit(FZStream, ZLevels[compressionLevel])); +end; + +destructor TZCompressionStream.Destroy; +begin + FZStream.next_in := nil; + FZStream.avail_in := 0; + + try + if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; + + while ZCompressCheck(deflate(FZStream, Z_FINISH)) <> Z_STREAM_END do + begin + FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out); + + FZStream.next_out := FBuffer; + FZStream.avail_out := SizeOf(FBuffer); + end; + + if FZStream.avail_out < SizeOf(FBuffer) then + begin + FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out); + end; + finally + deflateEnd(FZStream); + end; + + inherited Destroy; +end; + +function TZCompressionStream.Read(var buffer; count: Longint): Longint; +begin + raise EZCompressionError.Create(SZInvalid); +end; + +function TZCompressionStream.Write(const buffer; count: Longint): Longint; +begin + FZStream.next_in := @buffer; + FZStream.avail_in := count; + + if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; + + while FZStream.avail_in > 0 do + begin + ZCompressCheck(deflate(FZStream, Z_NO_FLUSH)); + + if FZStream.avail_out = 0 then + begin + FStream.WriteBuffer(FBuffer, SizeOf(FBuffer)); + + FZStream.next_out := FBuffer; + FZStream.avail_out := SizeOf(FBuffer); + + FStreamPos := FStream.Position; + + DoProgress; + end; + end; + + result := Count; +end; + +function TZCompressionStream.Seek(offset: Longint; origin: Word): Longint; +begin + if (offset = 0) and (origin = soFromCurrent) then + begin + result := FZStream.total_in; + end + else raise EZCompressionError.Create(SZInvalid); +end; + +function TZCompressionStream.GetCompressionRate: Single; +begin + if FZStream.total_in = 0 then result := 0 + else result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0; +end; + +{** TZDecompressionStream ***************************************************} + +constructor TZDecompressionStream.Create(source: TStream); +begin + inherited Create(source); + FZStream.next_in := FBuffer; + FZStream.avail_in := 0; + ZDecompressCheck(InflateInit(FZStream)); +end; + +destructor TZDecompressionStream.Destroy; +begin + inflateEnd(FZStream); + inherited Destroy; +end; + +function TZDecompressionStream.Read(var buffer; count: Longint): Longint; +var + zresult: Integer; +begin + FZStream.next_out := @buffer; + FZStream.avail_out := count; + + if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; + + zresult := Z_OK; + + while (FZStream.avail_out > 0) and (zresult <> Z_STREAM_END) do + begin + if FZStream.avail_in = 0 then + begin + FZStream.avail_in := FStream.Read(FBuffer, SizeOf(FBuffer)); + + if FZStream.avail_in = 0 then + begin + result := count - FZStream.avail_out; + + Exit; + end; + + FZStream.next_in := FBuffer; + FStreamPos := FStream.Position; + + DoProgress; + end; + + zresult := ZDecompressCheck(inflate(FZStream, Z_NO_FLUSH)); + end; + + if (zresult = Z_STREAM_END) and (FZStream.avail_in > 0) then + begin + FStream.Position := FStream.Position - FZStream.avail_in; + FStreamPos := FStream.Position; + + FZStream.avail_in := 0; + end; + + result := count - FZStream.avail_out; +end; + +function TZDecompressionStream.Write(const Buffer; Count: Longint): Longint; +begin + raise EZDecompressionError.Create(SZInvalid); +end; + +function TZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; +var + buf: array[0..8191] of Char; + i: Integer; +begin + if (offset = 0) and (origin = soFromBeginning) then + begin + ZDecompressCheck(inflateReset(FZStream)); + + FZStream.next_in := FBuffer; + FZStream.avail_in := 0; + + FStream.Position := 0; + FStreamPos := 0; + end + else if ((offset >= 0) and (origin = soFromCurrent)) or + (((offset - FZStream.total_out) > 0) and (origin = soFromBeginning)) then + begin + if origin = soFromBeginning then Dec(offset, FZStream.total_out); + + if offset > 0 then + begin + for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf, SizeOf(buf)); + ReadBuffer(buf, offset mod SizeOf(buf)); + end; + end + else if (offset = 0) and (origin = soFromEnd) then + begin + while Read(buf, SizeOf(buf)) > 0 do ; + end + else raise EZDecompressionError.Create(SZInvalid); + + result := FZStream.total_out; +end; + +end. + diff --git a/official/3.23/FastQB/fqbrcDesign.pas b/official/3.23/FastQB/fqbrcDesign.pas new file mode 100644 index 0000000..18b0839 --- /dev/null +++ b/official/3.23/FastQB/fqbrcDesign.pas @@ -0,0 +1,48 @@ +{******************************************} +{ } +{ FastQueryBuilder } +{ Language resource file } +{ } +{ Copyright (c) 1998-2005 } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit fqbrcDesign; + +interface + +implementation + +uses fqbRes; + +const resStr = +'1=Ok' + #13#10 + +'2=Cancel' + #13#10 + +'1803=Clear' + #13#10 + +'1804=Save to file' + #13#10 + +'1805=Load from file' + #13#10 + +'1806=Model' + #13#10 + +'1807=SQL' + #13#10 + +'1808=Result' + #13#10 + +'-------TfqbGrid-------' + #13#10 + +'1820=Collumn' + #13#10 + +'1821=Visible' + #13#10 + +'1822=Where' + #13#10 + +'1823=Sort' + #13#10 + +'1824=Function' + #13#10 + +'1825=Group' + #13#10 + +'1826=Move up' + #13#10 + +'1827=Move down' + #13#10 + +'1828=Visible' + #13#10 + +'1829=Not Visible' + #13#10 + +'1830=No' + #13#10 + +'1831=Ascending' + #13#10 + +'1832=Descending' + #13#10 + +'1833=Grouping' + #13#10 + +''; + +initialization + fqbResources.AddStrings(resStr); + +end. diff --git a/official/3.23/FastQB/help/eng/fqb_user.cnt b/official/3.23/FastQB/help/eng/fqb_user.cnt new file mode 100644 index 0000000..1d2ef2c --- /dev/null +++ b/official/3.23/FastQB/help/eng/fqb_user.cnt @@ -0,0 +1,8 @@ + * This help file was created with HelpScribble 6.2.0 + * Registered to: + +:BASE fqb_user.hlp +:TITLE Fast Query Builder Guide +1 Introduction=Scribble5000 +1 Quick Start=Scribble5010 +1 Work with Query Builders=Scribble5030 diff --git a/official/3.23/FastQB/help/eng/fqb_user.hlp b/official/3.23/FastQB/help/eng/fqb_user.hlp new file mode 100644 index 0000000..9cba867 Binary files /dev/null and b/official/3.23/FastQB/help/eng/fqb_user.hlp differ diff --git a/official/3.23/FastQB/help/ru/fqb_user.cnt b/official/3.23/FastQB/help/ru/fqb_user.cnt new file mode 100644 index 0000000..50a5368 --- /dev/null +++ b/official/3.23/FastQB/help/ru/fqb_user.cnt @@ -0,0 +1,8 @@ + * This help file was created with HelpScribble 6.2.0 + * Registered to: + +:BASE fqb_user.hlp +:TITLE Fast Query Builder Guide +1 Введение=Scribble5000 +1 Быстрый старт=Scribble5010 +1 Работа с построителем запросов=Scribble5030 diff --git a/official/3.23/FastQB/help/ru/fqb_user.hlp b/official/3.23/FastQB/help/ru/fqb_user.hlp new file mode 100644 index 0000000..e0d4e1b Binary files /dev/null and b/official/3.23/FastQB/help/ru/fqb_user.hlp differ diff --git a/official/3.23/FastQB/ibx/dclfqbIBX70.dpk b/official/3.23/FastQB/ibx/dclfqbIBX70.dpk new file mode 100644 index 0000000..d697096 --- /dev/null +++ b/official/3.23/FastQB/ibx/dclfqbIBX70.dpk @@ -0,0 +1,38 @@ +package dclfqbIBX70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder IBX Engine'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + designide, + fqbIBX70 + ; + +contains + fqbRegIBX in 'fqbRegIBX.pas' + ; + +end. diff --git a/official/3.23/FastQB/ibx/fqbIBX70.dpk b/official/3.23/FastQB/ibx/fqbIBX70.dpk new file mode 100644 index 0000000..cead91f --- /dev/null +++ b/official/3.23/FastQB/ibx/fqbIBX70.dpk @@ -0,0 +1,44 @@ +package fqbIBX70; + +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastQueryBuilder IBX Engine'} +{$RUNONLY} +{$IMPLICITBUILD OFF} +{$I fqb.inc} + +requires + vcl, + rtl, + vclx, + dbrtl, + vcldb, + bdertl, + fqb70, + ibxpress + ; + +contains + fqbIBXEngine in 'fqbIBXEngine.pas' + ; + +end. diff --git a/official/3.23/FastQB/ibx/fqbIBXEngine.dcu b/official/3.23/FastQB/ibx/fqbIBXEngine.dcu new file mode 100644 index 0000000..81f15cd Binary files /dev/null and b/official/3.23/FastQB/ibx/fqbIBXEngine.dcu differ diff --git a/official/3.23/FastQB/ibx/fqbRegIBX.dcu b/official/3.23/FastQB/ibx/fqbRegIBX.dcu new file mode 100644 index 0000000..cf624aa Binary files /dev/null and b/official/3.23/FastQB/ibx/fqbRegIBX.dcu differ diff --git a/official/3.23/FastQB/ibx/fqb_ib.dcr b/official/3.23/FastQB/ibx/fqb_ib.dcr new file mode 100644 index 0000000..45eebc5 Binary files /dev/null and b/official/3.23/FastQB/ibx/fqb_ib.dcr differ diff --git a/official/3.23/FastQB/images.res b/official/3.23/FastQB/images.res new file mode 100644 index 0000000..533ebc2 Binary files /dev/null and b/official/3.23/FastQB/images.res differ diff --git a/official/3.23/FastQB/infback.zobj b/official/3.23/FastQB/infback.zobj new file mode 100644 index 0000000..1f6ff57 Binary files /dev/null and b/official/3.23/FastQB/infback.zobj differ diff --git a/official/3.23/FastQB/inffast.zobj b/official/3.23/FastQB/inffast.zobj new file mode 100644 index 0000000..ba4ae54 Binary files /dev/null and b/official/3.23/FastQB/inffast.zobj differ diff --git a/official/3.23/FastQB/inflate.zobj b/official/3.23/FastQB/inflate.zobj new file mode 100644 index 0000000..0bf06b1 Binary files /dev/null and b/official/3.23/FastQB/inflate.zobj differ diff --git a/official/3.23/FastQB/inftrees.zobj b/official/3.23/FastQB/inftrees.zobj new file mode 100644 index 0000000..1da0225 Binary files /dev/null and b/official/3.23/FastQB/inftrees.zobj differ diff --git a/official/3.23/FastQB/res/Danish/fqbrcDesign.frc b/official/3.23/FastQB/res/Danish/fqbrcDesign.frc new file mode 100644 index 0000000..ffc9acd --- /dev/null +++ b/official/3.23/FastQB/res/Danish/fqbrcDesign.frc @@ -0,0 +1,23 @@ +1=Ok +2=Fortryd +1803=Rens +1804=Gem til fil +1805=Hent fra fil +1806=Model +1807=SQL +1808=Resultat +-------TfqbGrid------- +1820=Kolonne +1821=Synlig +1822=Hvor +1823=Sorter +1824=Funktion +1825=Gruppиr +1826=Flyt op +1827=Flyt ned +1828=Synlig +1829=Ikke synlig +1830=Nej +1831=Stigende +1832=Faldende +1833=Gruppering diff --git a/official/3.23/FastQB/res/Danish/mk.bat b/official/3.23/FastQB/res/Danish/mk.bat new file mode 100644 index 0000000..40e75f0 --- /dev/null +++ b/official/3.23/FastQB/res/Danish/mk.bat @@ -0,0 +1,3 @@ +..\frcc.exe fqbrcDesign.frc +copy *.pas ..\..\source +del *.pas \ No newline at end of file diff --git a/official/3.23/FastQB/res/Danish/mkall.bat b/official/3.23/FastQB/res/Danish/mkall.bat new file mode 100644 index 0000000..418d3cd --- /dev/null +++ b/official/3.23/FastQB/res/Danish/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 ; fqbResources.LoadFromFile('danish.frc'); +..\frcc.exe -all \ No newline at end of file diff --git a/official/3.23/FastQB/res/English/fqbrcDesign.frc b/official/3.23/FastQB/res/English/fqbrcDesign.frc new file mode 100644 index 0000000..9acab07 --- /dev/null +++ b/official/3.23/FastQB/res/English/fqbrcDesign.frc @@ -0,0 +1,23 @@ +1=Ok +2=Cancel +1803=Clear +1804=Save to file +1805=Load from file +1806=Model +1807=SQL +1808=Result +-------TfqbGrid------- +1820=Collumn +1821=Visible +1822=Where +1823=Sort +1824=Function +1825=Group +1826=Move up +1827=Move down +1828=Visible +1829=Not Visible +1830=No +1831=Ascending +1832=Descending +1833=Grouping diff --git a/official/3.23/FastQB/res/English/mk.bat b/official/3.23/FastQB/res/English/mk.bat new file mode 100644 index 0000000..40e75f0 --- /dev/null +++ b/official/3.23/FastQB/res/English/mk.bat @@ -0,0 +1,3 @@ +..\frcc.exe fqbrcDesign.frc +copy *.pas ..\..\source +del *.pas \ No newline at end of file diff --git a/official/3.23/FastQB/res/English/mkall.bat b/official/3.23/FastQB/res/English/mkall.bat new file mode 100644 index 0000000..1c3af24 --- /dev/null +++ b/official/3.23/FastQB/res/English/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 ; fqbResources.LoadFromFile('english.frc'); +..\frcc.exe -all \ No newline at end of file diff --git a/official/3.23/FastQB/res/Portuguese/fqbrcDesign.frc b/official/3.23/FastQB/res/Portuguese/fqbrcDesign.frc new file mode 100644 index 0000000..6c29774 --- /dev/null +++ b/official/3.23/FastQB/res/Portuguese/fqbrcDesign.frc @@ -0,0 +1,23 @@ +1=Ok +2=Cancela +1803=Limpa +1804=Salva para arquivo +1805=Carrega de arquivo +1806=Modela +1807=SQL +1808=Resultado +-------TfqbGrid------- +1820=Colunas +1821=Visнvel +1822=Onde +1823=Ordena +1824=Funзхes +1825=Grupo +1826=Move para cima +1827=Move para baixo +1828=Visнvel +1829=Invisнvel +1830=Nгo +1831=Ascendente +1832=Descendente +1833=Agrupando diff --git a/official/3.23/FastQB/res/Portuguese/mk.bat b/official/3.23/FastQB/res/Portuguese/mk.bat new file mode 100644 index 0000000..40e75f0 --- /dev/null +++ b/official/3.23/FastQB/res/Portuguese/mk.bat @@ -0,0 +1,3 @@ +..\frcc.exe fqbrcDesign.frc +copy *.pas ..\..\source +del *.pas \ No newline at end of file diff --git a/official/3.23/FastQB/res/Portuguese/mkall.bat b/official/3.23/FastQB/res/Portuguese/mkall.bat new file mode 100644 index 0000000..1c3af24 --- /dev/null +++ b/official/3.23/FastQB/res/Portuguese/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 ; fqbResources.LoadFromFile('english.frc'); +..\frcc.exe -all \ No newline at end of file diff --git a/official/3.23/FastQB/res/Russian/fqbrcDesign.frc b/official/3.23/FastQB/res/Russian/fqbrcDesign.frc new file mode 100644 index 0000000..8eab600 --- /dev/null +++ b/official/3.23/FastQB/res/Russian/fqbrcDesign.frc @@ -0,0 +1,23 @@ +1=ОК +2=Отмена +1803=Очистить +1804=Сохранить в файл +1805=Загрузить из файла +1806=Модель +1807=SQL +1808=Результат +-------TfqbGrid------- +1820=Поле +1821=Видимость +1822=Условие +1823=Сортировка +1824=Функция +1825=Группировка +1826=Вверх +1827=Вниз +1828=Видимый +1829=Невидимый +1830=Нет +1831=По возростанию +1832=По убыванию +1833=Группировать diff --git a/official/3.23/FastQB/res/Russian/mk.bat b/official/3.23/FastQB/res/Russian/mk.bat new file mode 100644 index 0000000..de19e68 --- /dev/null +++ b/official/3.23/FastQB/res/Russian/mk.bat @@ -0,0 +1,3 @@ +..\frcc.exe fqbrcDesign.frc +copy *.pas ..\..\source +del *.pas \ No newline at end of file diff --git a/official/3.23/FastQB/res/Russian/mkall.bat b/official/3.23/FastQB/res/Russian/mkall.bat new file mode 100644 index 0000000..1c3af24 --- /dev/null +++ b/official/3.23/FastQB/res/Russian/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 ; fqbResources.LoadFromFile('english.frc'); +..\frcc.exe -all \ No newline at end of file diff --git a/official/3.23/FastQB/res/frcc.exe b/official/3.23/FastQB/res/frcc.exe new file mode 100644 index 0000000..51a5316 Binary files /dev/null and b/official/3.23/FastQB/res/frcc.exe differ diff --git a/official/3.23/FastQB/trees.zobj b/official/3.23/FastQB/trees.zobj new file mode 100644 index 0000000..274284e Binary files /dev/null and b/official/3.23/FastQB/trees.zobj differ diff --git a/official/3.23/FastReports.url b/official/3.23/FastReports.url new file mode 100644 index 0000000..630efe4 --- /dev/null +++ b/official/3.23/FastReports.url @@ -0,0 +1,2 @@ +[InternetShortcut] +URL=http://www.fast-report.com/en/ diff --git a/official/3.23/FastScript/dclfs10.bdsproj b/official/3.23/FastScript/dclfs10.bdsproj new file mode 100644 index 0000000..50df875 --- /dev/null +++ b/official/3.23/FastScript/dclfs10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfs10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfs10.dpk b/official/3.23/FastScript/dclfs10.dpk new file mode 100644 index 0000000..dab007b --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfs4.dpk b/official/3.23/FastScript/dclfs4.dpk new file mode 100644 index 0000000..1b84a5d --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfs5.dpk b/official/3.23/FastScript/dclfs5.dpk new file mode 100644 index 0000000..0e7f924 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfs6.dpk b/official/3.23/FastScript/dclfs6.dpk new file mode 100644 index 0000000..2561e28 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfs7.dpk b/official/3.23/FastScript/dclfs7.dpk new file mode 100644 index 0000000..35cf091 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfs9.bdsproj b/official/3.23/FastScript/dclfs9.bdsproj new file mode 100644 index 0000000..8b1acd0 --- /dev/null +++ b/official/3.23/FastScript/dclfs9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfs9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfs9.dpk b/official/3.23/FastScript/dclfs9.dpk new file mode 100644 index 0000000..487ba26 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsADO10.bdsproj b/official/3.23/FastScript/dclfsADO10.bdsproj new file mode 100644 index 0000000..957918a --- /dev/null +++ b/official/3.23/FastScript/dclfsADO10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsADO10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsADO10.dpk b/official/3.23/FastScript/dclfsADO10.dpk new file mode 100644 index 0000000..17c028a --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsADO5.dpk b/official/3.23/FastScript/dclfsADO5.dpk new file mode 100644 index 0000000..bda911c --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsADO6.dpk b/official/3.23/FastScript/dclfsADO6.dpk new file mode 100644 index 0000000..242527c --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsADO7.dpk b/official/3.23/FastScript/dclfsADO7.dpk new file mode 100644 index 0000000..8f45468 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsADO9.bdsproj b/official/3.23/FastScript/dclfsADO9.bdsproj new file mode 100644 index 0000000..42ee713 --- /dev/null +++ b/official/3.23/FastScript/dclfsADO9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsADO9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsADO9.dpk b/official/3.23/FastScript/dclfsADO9.dpk new file mode 100644 index 0000000..17fb9e1 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE10.bdsproj b/official/3.23/FastScript/dclfsBDE10.bdsproj new file mode 100644 index 0000000..bd86a0b --- /dev/null +++ b/official/3.23/FastScript/dclfsBDE10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsBDE10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsBDE10.dpk b/official/3.23/FastScript/dclfsBDE10.dpk new file mode 100644 index 0000000..24d4e72 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE4.dpk b/official/3.23/FastScript/dclfsBDE4.dpk new file mode 100644 index 0000000..fd93b28 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE5.dpk b/official/3.23/FastScript/dclfsBDE5.dpk new file mode 100644 index 0000000..da3463f --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE6.dpk b/official/3.23/FastScript/dclfsBDE6.dpk new file mode 100644 index 0000000..df6f823 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE7.dpk b/official/3.23/FastScript/dclfsBDE7.dpk new file mode 100644 index 0000000..ef69a85 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsBDE9.bdsproj b/official/3.23/FastScript/dclfsBDE9.bdsproj new file mode 100644 index 0000000..8ff5e78 --- /dev/null +++ b/official/3.23/FastScript/dclfsBDE9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsBDE9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsBDE9.dpk b/official/3.23/FastScript/dclfsBDE9.dpk new file mode 100644 index 0000000..b2728a0 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB10.bdsproj b/official/3.23/FastScript/dclfsDB10.bdsproj new file mode 100644 index 0000000..4b0941c --- /dev/null +++ b/official/3.23/FastScript/dclfsDB10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsDB10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsDB10.dpk b/official/3.23/FastScript/dclfsDB10.dpk new file mode 100644 index 0000000..b520942 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB4.dpk b/official/3.23/FastScript/dclfsDB4.dpk new file mode 100644 index 0000000..52150e5 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB5.dpk b/official/3.23/FastScript/dclfsDB5.dpk new file mode 100644 index 0000000..95cc9c5 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB6.dpk b/official/3.23/FastScript/dclfsDB6.dpk new file mode 100644 index 0000000..27c6a1a --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB7.dpk b/official/3.23/FastScript/dclfsDB7.dpk new file mode 100644 index 0000000..8cecdc9 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsDB9.bdsproj b/official/3.23/FastScript/dclfsDB9.bdsproj new file mode 100644 index 0000000..c9a5e68 --- /dev/null +++ b/official/3.23/FastScript/dclfsDB9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsDB9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsDB9.dpk b/official/3.23/FastScript/dclfsDB9.dpk new file mode 100644 index 0000000..78e2625 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsIBX10.bdsproj b/official/3.23/FastScript/dclfsIBX10.bdsproj new file mode 100644 index 0000000..706b834 --- /dev/null +++ b/official/3.23/FastScript/dclfsIBX10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsIBX10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsIBX10.dpk b/official/3.23/FastScript/dclfsIBX10.dpk new file mode 100644 index 0000000..4284ca0 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsIBX5.dpk b/official/3.23/FastScript/dclfsIBX5.dpk new file mode 100644 index 0000000..f2c41e7 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsIBX6.dpk b/official/3.23/FastScript/dclfsIBX6.dpk new file mode 100644 index 0000000..0cb72ab --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsIBX7.dpk b/official/3.23/FastScript/dclfsIBX7.dpk new file mode 100644 index 0000000..874e462 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsIBX9.bdsproj b/official/3.23/FastScript/dclfsIBX9.bdsproj new file mode 100644 index 0000000..e5dfa3d --- /dev/null +++ b/official/3.23/FastScript/dclfsIBX9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + dclfsIBX9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + FastScript 1.9 IBX Components + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/FastScript/dclfsIBX9.dpk b/official/3.23/FastScript/dclfsIBX9.dpk new file mode 100644 index 0000000..c6e1b95 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee10.bdsproj b/official/3.23/FastScript/dclfsTee10.bdsproj new file mode 100644 index 0000000..c61771e --- /dev/null +++ b/official/3.23/FastScript/dclfsTee10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsTee10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsTee10.dpk b/official/3.23/FastScript/dclfsTee10.dpk new file mode 100644 index 0000000..374cd4b --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee4.dpk b/official/3.23/FastScript/dclfsTee4.dpk new file mode 100644 index 0000000..a4c5d05 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee5.dpk b/official/3.23/FastScript/dclfsTee5.dpk new file mode 100644 index 0000000..e5e6d9c --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee6.dpk b/official/3.23/FastScript/dclfsTee6.dpk new file mode 100644 index 0000000..0aaf40d --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee7.dpk b/official/3.23/FastScript/dclfsTee7.dpk new file mode 100644 index 0000000..a9dc221 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsTee9.bdsproj b/official/3.23/FastScript/dclfsTee9.bdsproj new file mode 100644 index 0000000..06055e2 --- /dev/null +++ b/official/3.23/FastScript/dclfsTee9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsTee9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/dclfsTee9.dpk b/official/3.23/FastScript/dclfsTee9.dpk new file mode 100644 index 0000000..6da0340 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS 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/official/3.23/FastScript/dclfsx.dpk b/official/3.23/FastScript/dclfsx.dpk new file mode 100644 index 0000000..5d22370 --- /dev/null +++ b/official/3.23/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} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$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/official/3.23/FastScript/dclfsx.res b/official/3.23/FastScript/dclfsx.res new file mode 100644 index 0000000..fa40de9 Binary files /dev/null and b/official/3.23/FastScript/dclfsx.res differ diff --git a/official/3.23/FastScript/fs.inc b/official/3.23/FastScript/fs.inc new file mode 100644 index 0000000..e525c23 --- /dev/null +++ b/official/3.23/FastScript/fs.inc @@ -0,0 +1,110 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Include file } +{ } +{ (c) 2003, 2004 by Alexander Tzyganenko, } +{ Fast Reports, Inc } +{ } +{******************************************} + + +{$B-} {- Complete Boolean Evaluation } +{$R-} {- Range-Checking } +{$V-} {- Var-String Checking } +{$T-} {- Typed @ operator } +{$X+} {- Extended syntax } +{$P+} {- Open string params } +{$J+} {- Writeable structured consts } +{$H+} {- Use long strings by default } + +{$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 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 LINUX} // KYLIX + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE CLX} + {$IFDEF BCB} + {$DEFINE CLXCPP} + {$ENDIF} +{$ENDIF} + +// Uncomment below line for CLX compilation +//{$DEFINE CLX} + +// include ole dispatch module +{$IFNDEF CLX} + {$DEFINE OLE} +{$ENDIF} diff --git a/official/3.23/FastScript/fs10.bdsproj b/official/3.23/FastScript/fs10.bdsproj new file mode 100644 index 0000000..78c733f --- /dev/null +++ b/official/3.23/FastScript/fs10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fs10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fs10.dpk b/official/3.23/FastScript/fs10.dpk new file mode 100644 index 0000000..4532c03 --- /dev/null +++ b/official/3.23/FastScript/fs10.dpk @@ -0,0 +1,64 @@ +// Package file for Delphi 2006 + +package fs10; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/3.23/FastScript/fs4.bpk b/official/3.23/FastScript/fs4.bpk new file mode 100644 index 0000000..fd7b16a --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs4.cpp b/official/3.23/FastScript/fs4.cpp new file mode 100644 index 0000000..43953d6 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs4.dpk b/official/3.23/FastScript/fs4.dpk new file mode 100644 index 0000000..21e1000 --- /dev/null +++ b/official/3.23/FastScript/fs4.dpk @@ -0,0 +1,63 @@ +// Package file for Delphi 4 + +package fs4; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + +end. diff --git a/official/3.23/FastScript/fs4.res b/official/3.23/FastScript/fs4.res new file mode 100644 index 0000000..eb2597a Binary files /dev/null and b/official/3.23/FastScript/fs4.res differ diff --git a/official/3.23/FastScript/fs5.bpk b/official/3.23/FastScript/fs5.bpk new file mode 100644 index 0000000..8b10919 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs5.cpp b/official/3.23/FastScript/fs5.cpp new file mode 100644 index 0000000..daadee8 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs5.dpk b/official/3.23/FastScript/fs5.dpk new file mode 100644 index 0000000..b59a9e5 --- /dev/null +++ b/official/3.23/FastScript/fs5.dpk @@ -0,0 +1,64 @@ +// Package file for Delphi 5 + +package fs5; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/3.23/FastScript/fs5.res b/official/3.23/FastScript/fs5.res new file mode 100644 index 0000000..da3d366 Binary files /dev/null and b/official/3.23/FastScript/fs5.res differ diff --git a/official/3.23/FastScript/fs6.bpk b/official/3.23/FastScript/fs6.bpk new file mode 100644 index 0000000..822a6d2 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs6.cpp b/official/3.23/FastScript/fs6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fs6.dpk b/official/3.23/FastScript/fs6.dpk new file mode 100644 index 0000000..eb9bae6 --- /dev/null +++ b/official/3.23/FastScript/fs6.dpk @@ -0,0 +1,64 @@ +// Package file for Delphi 6 + +package fs6; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/3.23/FastScript/fs6.res b/official/3.23/FastScript/fs6.res new file mode 100644 index 0000000..2bbdbc1 Binary files /dev/null and b/official/3.23/FastScript/fs6.res differ diff --git a/official/3.23/FastScript/fs7.dpk b/official/3.23/FastScript/fs7.dpk new file mode 100644 index 0000000..8635985 --- /dev/null +++ b/official/3.23/FastScript/fs7.dpk @@ -0,0 +1,64 @@ +// Package file for Delphi 7 + +package fs7; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/3.23/FastScript/fs9.bdsproj b/official/3.23/FastScript/fs9.bdsproj new file mode 100644 index 0000000..6cd3ca1 --- /dev/null +++ b/official/3.23/FastScript/fs9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fs9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fs9.dpk b/official/3.23/FastScript/fs9.dpk new file mode 100644 index 0000000..4e81b29 --- /dev/null +++ b/official/3.23/FastScript/fs9.dpk @@ -0,0 +1,64 @@ +// Package file for Delphi 2005 + +package fs9; + +{$I fs.inc} + +{$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} +{$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_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_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/3.23/FastScript/fsADO10.bdsproj b/official/3.23/FastScript/fsADO10.bdsproj new file mode 100644 index 0000000..34727e5 --- /dev/null +++ b/official/3.23/FastScript/fsADO10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsADO10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsADO10.dpk b/official/3.23/FastScript/fsADO10.dpk new file mode 100644 index 0000000..3cb2b90 --- /dev/null +++ b/official/3.23/FastScript/fsADO10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsADO10; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs10, + fsDB10; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsADO5.bpk b/official/3.23/FastScript/fsADO5.bpk new file mode 100644 index 0000000..5aa3c2b --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsADO5.cpp b/official/3.23/FastScript/fsADO5.cpp new file mode 100644 index 0000000..1701cde --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsADO5.dpk b/official/3.23/FastScript/fsADO5.dpk new file mode 100644 index 0000000..9be3c1f --- /dev/null +++ b/official/3.23/FastScript/fsADO5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsADO5; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLADO50, + fs5, + fsDB5; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsADO6.bpk b/official/3.23/FastScript/fsADO6.bpk new file mode 100644 index 0000000..324e945 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsADO6.cpp b/official/3.23/FastScript/fsADO6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsADO6.dpk b/official/3.23/FastScript/fsADO6.dpk new file mode 100644 index 0000000..1778b4e --- /dev/null +++ b/official/3.23/FastScript/fsADO6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsADO6; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs6, + fsDB6; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsADO7.dpk b/official/3.23/FastScript/fsADO7.dpk new file mode 100644 index 0000000..af401dc --- /dev/null +++ b/official/3.23/FastScript/fsADO7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsADO7; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs7, + fsDB7; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsADO9.bdsproj b/official/3.23/FastScript/fsADO9.bdsproj new file mode 100644 index 0000000..9d0a211 --- /dev/null +++ b/official/3.23/FastScript/fsADO9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + fsADO9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/FastScript/fsADO9.dpk b/official/3.23/FastScript/fsADO9.dpk new file mode 100644 index 0000000..af0ae0f --- /dev/null +++ b/official/3.23/FastScript/fsADO9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsADO9; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs9, + fsDB9; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE10.bdsproj b/official/3.23/FastScript/fsBDE10.bdsproj new file mode 100644 index 0000000..f085ba5 --- /dev/null +++ b/official/3.23/FastScript/fsBDE10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsBDE10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsBDE10.dpk b/official/3.23/FastScript/fsBDE10.dpk new file mode 100644 index 0000000..c2805df --- /dev/null +++ b/official/3.23/FastScript/fsBDE10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsBDE10; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs10, + fsDB10; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE4.bpk b/official/3.23/FastScript/fsBDE4.bpk new file mode 100644 index 0000000..72be8ad --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE4.cpp b/official/3.23/FastScript/fsBDE4.cpp new file mode 100644 index 0000000..cb7bb1d --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE4.dpk b/official/3.23/FastScript/fsBDE4.dpk new file mode 100644 index 0000000..e02998a --- /dev/null +++ b/official/3.23/FastScript/fsBDE4.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 4 + +package fsBDE4; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLDB40, + fs4, + fsDB4; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE5.bpk b/official/3.23/FastScript/fsBDE5.bpk new file mode 100644 index 0000000..17a4c8d --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE5.cpp b/official/3.23/FastScript/fsBDE5.cpp new file mode 100644 index 0000000..b2619a0 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE5.dpk b/official/3.23/FastScript/fsBDE5.dpk new file mode 100644 index 0000000..2983caf --- /dev/null +++ b/official/3.23/FastScript/fsBDE5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsBDE5; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLBDE50, + fs5, + fsDB5; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE6.bpk b/official/3.23/FastScript/fsBDE6.bpk new file mode 100644 index 0000000..5db87d1 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE6.cpp b/official/3.23/FastScript/fsBDE6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsBDE6.dpk b/official/3.23/FastScript/fsBDE6.dpk new file mode 100644 index 0000000..f620394 --- /dev/null +++ b/official/3.23/FastScript/fsBDE6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsBDE6; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs6, + fsDB6; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE7.dpk b/official/3.23/FastScript/fsBDE7.dpk new file mode 100644 index 0000000..fff8c0e --- /dev/null +++ b/official/3.23/FastScript/fsBDE7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsBDE7; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs7, + fsDB7; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsBDE9.bdsproj b/official/3.23/FastScript/fsBDE9.bdsproj new file mode 100644 index 0000000..acd77ea --- /dev/null +++ b/official/3.23/FastScript/fsBDE9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + fsBDE9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/FastScript/fsBDE9.dpk b/official/3.23/FastScript/fsBDE9.dpk new file mode 100644 index 0000000..1e40f6f --- /dev/null +++ b/official/3.23/FastScript/fsBDE9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsBDE9; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs9, + fsDB9; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB10.bdsproj b/official/3.23/FastScript/fsDB10.bdsproj new file mode 100644 index 0000000..7627517 --- /dev/null +++ b/official/3.23/FastScript/fsDB10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsDB10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsDB10.dpk b/official/3.23/FastScript/fsDB10.dpk new file mode 100644 index 0000000..017ce26 --- /dev/null +++ b/official/3.23/FastScript/fsDB10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package fsDB10; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs10; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB4.bpk b/official/3.23/FastScript/fsDB4.bpk new file mode 100644 index 0000000..a4df936 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB4.cpp b/official/3.23/FastScript/fsDB4.cpp new file mode 100644 index 0000000..4fe67af --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB4.dpk b/official/3.23/FastScript/fsDB4.dpk new file mode 100644 index 0000000..65ca403 --- /dev/null +++ b/official/3.23/FastScript/fsDB4.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 4 + +package fsDB4; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLDB40, + fs4; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB5.bpk b/official/3.23/FastScript/fsDB5.bpk new file mode 100644 index 0000000..f12ab61 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB5.cpp b/official/3.23/FastScript/fsDB5.cpp new file mode 100644 index 0000000..d782c17 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB5.dpk b/official/3.23/FastScript/fsDB5.dpk new file mode 100644 index 0000000..7fb6a03 --- /dev/null +++ b/official/3.23/FastScript/fsDB5.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 5 + +package fsDB5; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + fs5; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB6.bpk b/official/3.23/FastScript/fsDB6.bpk new file mode 100644 index 0000000..8a6dc71 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB6.cpp b/official/3.23/FastScript/fsDB6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsDB6.dpk b/official/3.23/FastScript/fsDB6.dpk new file mode 100644 index 0000000..d0487f2 --- /dev/null +++ b/official/3.23/FastScript/fsDB6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package fsDB6; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs6; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB7.dpk b/official/3.23/FastScript/fsDB7.dpk new file mode 100644 index 0000000..5cf7a92 --- /dev/null +++ b/official/3.23/FastScript/fsDB7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package fsDB7; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs7; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsDB9.bdsproj b/official/3.23/FastScript/fsDB9.bdsproj new file mode 100644 index 0000000..4f121f2 --- /dev/null +++ b/official/3.23/FastScript/fsDB9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsDB9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsDB9.dpk b/official/3.23/FastScript/fsDB9.dpk new file mode 100644 index 0000000..f3c6e69 --- /dev/null +++ b/official/3.23/FastScript/fsDB9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package fsDB9; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs9; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsIBX10.bdsproj b/official/3.23/FastScript/fsIBX10.bdsproj new file mode 100644 index 0000000..4e8e760 --- /dev/null +++ b/official/3.23/FastScript/fsIBX10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsIBX10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsIBX10.dpk b/official/3.23/FastScript/fsIBX10.dpk new file mode 100644 index 0000000..bf8a34f --- /dev/null +++ b/official/3.23/FastScript/fsIBX10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsIBX10; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs10, + fsDB10; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsIBX5.bpk b/official/3.23/FastScript/fsIBX5.bpk new file mode 100644 index 0000000..f58100b --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsIBX5.cpp b/official/3.23/FastScript/fsIBX5.cpp new file mode 100644 index 0000000..3b8be05 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsIBX5.dpk b/official/3.23/FastScript/fsIBX5.dpk new file mode 100644 index 0000000..7b87736 --- /dev/null +++ b/official/3.23/FastScript/fsIBX5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsIBX5; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLIB50, + fs5, + fsDB5; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsIBX6.bpk b/official/3.23/FastScript/fsIBX6.bpk new file mode 100644 index 0000000..3ece52b --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsIBX6.cpp b/official/3.23/FastScript/fsIBX6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsIBX6.dpk b/official/3.23/FastScript/fsIBX6.dpk new file mode 100644 index 0000000..38c3379 --- /dev/null +++ b/official/3.23/FastScript/fsIBX6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsIBX6; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs6, + fsDB6; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsIBX7.dpk b/official/3.23/FastScript/fsIBX7.dpk new file mode 100644 index 0000000..2edb2e2 --- /dev/null +++ b/official/3.23/FastScript/fsIBX7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsIBX7; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs7, + fsDB7; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsIBX9.bdsproj b/official/3.23/FastScript/fsIBX9.bdsproj new file mode 100644 index 0000000..013ea63 --- /dev/null +++ b/official/3.23/FastScript/fsIBX9.bdsproj @@ -0,0 +1,168 @@ +п»ї + + + + + + + + + + + fsIBX9.dpk + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + + + + False + + + + + + False + + + + + + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/3.23/FastScript/fsIBX9.dpk b/official/3.23/FastScript/fsIBX9.dpk new file mode 100644 index 0000000..ff4f87b --- /dev/null +++ b/official/3.23/FastScript/fsIBX9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsIBX9; + +{$I fs.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs9, + fsDB9; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee10.bdsproj b/official/3.23/FastScript/fsTee10.bdsproj new file mode 100644 index 0000000..49aba99 --- /dev/null +++ b/official/3.23/FastScript/fsTee10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsTee10.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsTee10.dpk b/official/3.23/FastScript/fsTee10.dpk new file mode 100644 index 0000000..41e55cb --- /dev/null +++ b/official/3.23/FastScript/fsTee10.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 2006 + +package fsTee10; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, {$ENDIF} +{$IFDEF TeeChart4} TEE410, {$ENDIF} +{$IFDEF TeeChart5} TEE510, {$ENDIF} +{$IFDEF TeeChart6} TEE610, {$ENDIF} +{$IFDEF TeeChart7} TEE710, {$ENDIF} + VCLX, + fs10; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee4.bpk b/official/3.23/FastScript/fsTee4.bpk new file mode 100644 index 0000000..cd082cc --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsTee4.cpp b/official/3.23/FastScript/fsTee4.cpp new file mode 100644 index 0000000..396b5fd --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsTee4.dpk b/official/3.23/FastScript/fsTee4.dpk new file mode 100644 index 0000000..c1c2725 --- /dev/null +++ b/official/3.23/FastScript/fsTee4.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 4 + +package fsTee4; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$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} + VCLX40, + fs4; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee5.bpk b/official/3.23/FastScript/fsTee5.bpk new file mode 100644 index 0000000..f19b65b --- /dev/null +++ b/official/3.23/FastScript/fsTee5.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/official/3.23/FastScript/fsTee5.cpp b/official/3.23/FastScript/fsTee5.cpp new file mode 100644 index 0000000..1f8f0ba --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsTee5.dpk b/official/3.23/FastScript/fsTee5.dpk new file mode 100644 index 0000000..b9160da --- /dev/null +++ b/official/3.23/FastScript/fsTee5.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 5 + +package fsTee5; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$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} + VCLX50, + fs5; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee6.bpk b/official/3.23/FastScript/fsTee6.bpk new file mode 100644 index 0000000..2d92b4c --- /dev/null +++ b/official/3.23/FastScript/fsTee6.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] +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/official/3.23/FastScript/fsTee6.cpp b/official/3.23/FastScript/fsTee6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/3.23/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/official/3.23/FastScript/fsTee6.dpk b/official/3.23/FastScript/fsTee6.dpk new file mode 100644 index 0000000..f8f2f0f --- /dev/null +++ b/official/3.23/FastScript/fsTee6.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 6 + +package fsTee6; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$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} + VCLX, + fs6; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee7.dpk b/official/3.23/FastScript/fsTee7.dpk new file mode 100644 index 0000000..1cdcc59 --- /dev/null +++ b/official/3.23/FastScript/fsTee7.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 7 + +package fsTee7; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, {$ENDIF} +{$IFDEF TeeChart4} TEE47, {$ENDIF} +{$IFDEF TeeChart5} TEE57, {$ENDIF} +{$IFDEF TeeChart6} TEE67, {$ENDIF} +{$IFDEF TeeChart7} TEE77, {$ENDIF} + VCLX, + fs7; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fsTee9.bdsproj b/official/3.23/FastScript/fsTee9.bdsproj new file mode 100644 index 0000000..5baa922 --- /dev/null +++ b/official/3.23/FastScript/fsTee9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsTee9.dpk + + + 7.0 + + + diff --git a/official/3.23/FastScript/fsTee9.dpk b/official/3.23/FastScript/fsTee9.dpk new file mode 100644 index 0000000..540c549 --- /dev/null +++ b/official/3.23/FastScript/fsTee9.dpk @@ -0,0 +1,47 @@ +// Package file for Delphi 2005 + +package fsTee9; + +{$I fs.inc} +{$I tee.inc} + +{$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} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, {$ENDIF} +{$IFDEF TeeChart4} TEE49, {$ENDIF} +{$IFDEF TeeChart5} TEE59, {$ENDIF} +{$IFDEF TeeChart6} TEE69, {$ENDIF} +{$IFDEF TeeChart7} TEE79, {$ENDIF} + VCLX, + fs9; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/3.23/FastScript/fs_iadoreg.pas b/official/3.23/FastScript/fs_iadoreg.pas new file mode 100644 index 0000000..feee0e9 --- /dev/null +++ b/official/3.23/FastScript/fs_iadoreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iadoreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_iadortti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsADORTTI]); +end; + +end. diff --git a/official/3.23/FastScript/fs_iadortti.pas b/official/3.23/FastScript/fs_iadortti.pas new file mode 100644 index 0000000..f7da3d3 --- /dev/null +++ b/official/3.23/FastScript/fs_iadortti.pas @@ -0,0 +1,94 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ ADO classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iadortti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, + DB, ADODB, ADOInt; + +type + TfsADORTTI = 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; + + +{ 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; + AddClass(TCustomADODataSet, 'TDataSet'); + 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 := Integer(TParameters(Instance).AddParameter) + else if MethodName = 'ITEMS.GET' then + Result := Integer(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; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. + diff --git a/official/3.23/FastScript/fs_ibasic.pas b/official/3.23/FastScript/fs_ibasic.pas new file mode 100644 index 0000000..2d34c45 --- /dev/null +++ b/official/3.23/FastScript/fs_ibasic.pas @@ -0,0 +1,170 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Basic grammar } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ibasic; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_itools; + +type + 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 + fsRegisterLanguage('BasicScript', BASIC_GRAMMAR); + +end. diff --git a/official/3.23/FastScript/fs_ibdereg.pas b/official/3.23/FastScript/fs_ibdereg.pas new file mode 100644 index 0000000..4566bd1 --- /dev/null +++ b/official/3.23/FastScript/fs_ibdereg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ibdereg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_ibdertti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsBDERTTI]); +end; + +end. diff --git a/official/3.23/FastScript/fs_ibdertti.pas b/official/3.23/FastScript/fs_ibdertti.pas new file mode 100644 index 0000000..05b83f1 --- /dev/null +++ b/official/3.23/FastScript/fs_ibdertti.pas @@ -0,0 +1,163 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ BDE classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ibdertti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, + DB, DBTables; + +type + 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; + begin + VariantToVarRec(Caller.Params[0], ar); + Result := TTable(Instance).FindKey(ar); + ClearVarRec(ar); + end; + + procedure DoFindNearest; + var + ar: TVarRecArray; + begin + VariantToVarRec(Caller.Params[0], ar); + TTable(Instance).FindNearest(ar); + ClearVarRec(ar); + 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 := Integer(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 := Integer(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 + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_ichartrtti.pas b/official/3.23/FastScript/fs_ichartrtti.pas new file mode 100644 index 0000000..40cdebe --- /dev/null +++ b/official/3.23/FastScript/fs_ichartrtti.pas @@ -0,0 +1,120 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Chart } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ichartrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti, Chart, + Series, TeEngine, TeeProcs, TeCanvas; + + +type + TfsChartRTTI = 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; + + +{ 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'); + + 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'); + with AddClass(TChartSeries, 'TComponent') do + begin + AddMethod('procedure Clear', CallMethod); + AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod); + end; + AddClass(TSeriesPointer, 'TPersistent'); + AddClass(TCustomSeries, 'TChartSeries'); + AddClass(TLineSeries, 'TCustomSeries'); + AddClass(TPointSeries, 'TCustomSeries'); + AddClass(TAreaSeries, 'TCustomSeries'); + AddClass(TCustomBarSeries, 'TChartSeries'); + 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], Caller.Params[1], Caller.Params[2]) + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iclassesrtti.pas b/official/3.23/FastScript/fs_iclassesrtti.pas new file mode 100644 index 0000000..5b0bee9 --- /dev/null +++ b/official/3.23/FastScript/fs_iclassesrtti.pas @@ -0,0 +1,473 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Classes.pas classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iclassesrtti; + +interface + +{$i fs.inc} + +uses SysUtils, Classes, fs_iinterpreter, fs_xml; + +type + TfsClassesRTTI = 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('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 + 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; + 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 Prop(const Name: String): String', CallMethod); + AddMethod('function Root: TfsXMLItem', CallMethod); + AddProperty('Data', 'Integer', GetProp, SetProp); + AddProperty('Count', 'Integer', GetProp, nil); + AddDefaultProperty('Items', 'Integer', 'TfsXMLItem', CallMethod, True); + 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; +begin + Result := 0; + + if ClassType = TObject then + begin + if MethodName = 'CREATE' then + Result := Integer(Instance.Create) + 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(Integer(Caller.Params[0]))); + end + else if ClassType = TCollection then + begin + if MethodName = 'CLEAR' then + TCollection(Instance).Clear + else if MethodName = 'ITEMS.GET' then + Result := Integer(TCollection(Instance).Items[Caller.Params[0]]) + end + else if ClassType = TList then + begin + _TList := TList(Instance); + if MethodName = 'ADD' then + _TList.Add(Pointer(Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'INSERT' then + _TList.Insert(Caller.Params[0], Pointer(Integer(Caller.Params[1]))) + else if MethodName = 'REMOVE' then + _TList.Remove(Pointer(Integer(Caller.Params[0]))) + else if MethodName = 'ITEMS.GET' then + Result := Integer(_TList.Items[Caller.Params[0]]) + else if MethodName = 'ITEMS.SET' then + _TList.Items[Caller.Params[0]] := Pointer(Integer(Caller.Params[1])) + end + else if ClassType = TStrings then + begin + _TStrings := TStrings(Instance); + if MethodName = 'ADD' then + Result := _TStrings.Add(Caller.Params[0]) + else if MethodName = 'ADDOBJECT' then + Result := _TStrings.AddObject(Caller.Params[0], TObject(Integer(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(Integer(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(Integer(Caller.Params[2]))) + else if MethodName = 'LOADFROMFILE' then + _TStrings.LoadFromFile(Caller.Params[0]) + else if MethodName = 'LOADFROMSTREAM' then + _TStrings.LoadFromStream(TStream(Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'NAMES.GET' then + Result := _TStrings.Names[Caller.Params[0]] + else if MethodName = 'OBJECTS.GET' then + Result := Integer(_TStrings.Objects[Caller.Params[0]]) + else if MethodName = 'OBJECTS.SET' then + _TStrings.Objects[Caller.Params[0]] := TObject(Integer(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 + Result := _TStream.Seek(Caller.Params[0], Caller.Params[1]) + else if MethodName = 'COPYFROM' then + Result := _TStream.CopyFrom(TStream(Integer(Caller.Params[0])), Caller.Params[1]) + end + else if ClassType = TFileStream then + begin + if MethodName = 'CREATE' then + Result := Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'LOADFROMFILE' then + _TMemoryStream.LoadFromFile(Caller.Params[0]) + else if MethodName = 'SAVETOSTREAM' then + _TMemoryStream.SaveToStream(TStream(Integer(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 := Integer(TComponent(Instance).Create(TComponent(Integer(Caller.Params[0])))) + end + else if ClassType = TfsXMLItem then + begin + _TfsXMLItem := TfsXMLItem(Instance); + if MethodName = 'CREATE' then + Result := Integer(_TfsXMLItem.Create) + else if MethodName = 'ADDITEM' then + _TfsXMLItem.AddItem(TfsXMLItem(Integer(Caller.Params[0]))) + else if MethodName = 'CLEAR' then + _TfsXMLItem.Clear + else if MethodName = 'INSERTITEM' then + _TfsXMLItem.InsertItem(Caller.Params[0], TfsXMLItem(Integer(Caller.Params[1]))) + else if MethodName = 'ADD' then + Result := Integer(_TfsXMLItem.Add) + else if MethodName = 'FIND' then + Result := _TfsXMLItem.Find(Caller.Params[0]) + else if MethodName = 'FINDITEM' then + Result := Integer(_TfsXMLItem.FindItem(Caller.Params[0])) + else if MethodName = 'PROP' then + Result := _TfsXMLItem.Prop[Caller.Params[0]] + else if MethodName = 'ROOT' then + Result := Integer(_TfsXMLItem.Root) + else if MethodName = 'ROOT' then + Result := Integer(_TfsXMLItem.Root) + else if MethodName = 'ITEMS.GET' then + Result := Integer(_TfsXMLItem[Caller.Params[0]]) + end + else if ClassType = TfsXMLDocument then + begin + _TfsXMLDocument := TfsXMLDocument(Instance); + if MethodName = 'CREATE' then + Result := Integer(_TfsXMLDocument.Create) + else if MethodName = 'SAVETOSTREAM' then + _TfsXMLDocument.SaveToStream(TStream(Integer(Caller.Params[0]))) + else if MethodName = 'LOADFROMSTREAM' then + _TfsXMLDocument.LoadFromStream(TStream(Integer(Caller.Params[0]))) + else if MethodName = 'SAVETOFILE' then + _TfsXMLDocument.SaveToFile(Caller.Params[0]) + else if MethodName = 'LOADFROMFILE' then + _TfsXMLDocument.LoadFromFile(Caller.Params[0]) + end +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 := Integer(TComponent(Instance).Owner) + end + else if ClassType = TfsXMLItem then + begin + if PropName = 'DATA' then + Result := Integer(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 := Integer(TfsXMLItem(Instance).Parent) + else if PropName = 'TEXT' then + Result := TfsXMLItem(Instance).Text + end + else if ClassType = TfsXMLDocument then + begin + if PropName = 'ROOT' then + Result := Integer(TfsXMLDocument(Instance).Root) + end +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(Integer(Value)) + else if PropName = 'NAME' then + TfsXMLItem(Instance).Name := Value + else if PropName = 'TEXT' then + TfsXMLItem(Instance).Text := Value + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iconst.pas b/official/3.23/FastScript/fs_iconst.pas new file mode 100644 index 0000000..b5d2267 --- /dev/null +++ b/official/3.23/FastScript/fs_iconst.pas @@ -0,0 +1,59 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Resources } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iconst; + +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; + + +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'; + +end. diff --git a/official/3.23/FastScript/fs_icpp.pas b/official/3.23/FastScript/fs_icpp.pas new file mode 100644 index 0000000..af4390f --- /dev/null +++ b/official/3.23/FastScript/fs_icpp.pas @@ -0,0 +1,159 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ C++ grammar } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_icpp; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_itools; + +type + TfsCPP = class(TComponent); + + +implementation + +const + CPP_GRAMMAR = + '' + + '' + + '<' + + '/types>' + + '<' + + 'keyword text="DEFINE" err="err13"/>' + + '<' + + '/optional>' + + '<' + + 'char text="-" add="op" addtext="unminus"/><' + + '/sequence>' + + '<' + + 'char text="|" add="op" addtext="or"/>' + + '' + + '' + + '<' + + 'char text="-" opt="1" add="modificator"/><' + + 'trystmt/><' + + 'whilestmt/><' + + 'keyword text="DO"/>'; + + +initialization + fsRegisterLanguage('C++Script', CPP_GRAMMAR); + +end. diff --git a/official/3.23/FastScript/fs_idbctrlsrtti.pas b/official/3.23/FastScript/fs_idbctrlsrtti.pas new file mode 100644 index 0000000..181b675 --- /dev/null +++ b/official/3.23/FastScript/fs_idbctrlsrtti.pas @@ -0,0 +1,171 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ DB controls } +{ } +{ (c) 2003-2005 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}; + + +type + TfsDBCtrlsRTTI = class(TComponent); // fake component + + +implementation + +type + THackDBLookupControl = class(TDBLookupControl); + + 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'); + 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); + 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 := Integer(TDBGridColumns(Instance).Add) + else if MethodName = 'ITEMS.GET' then + Result := Integer(TDBGridColumns(Instance).Items[Caller.Params[0]]) + else if MethodName = 'REBUILDCOLUMNS' then + TDBGridColumns(Instance).RebuildColumns + else if MethodName = 'RESTOREDEFAULTS' then + TDBGridColumns(Instance).RestoreDefaults + 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 + 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 +end; + +procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; + const PropName: String; Value: Variant); +begin + if ClassType = TDBLookupControl then + begin + if PropName = 'KEYVALUE' then + THackDBLookupControl(Instance).KeyValue := Value + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_idbreg.pas b/official/3.23/FastScript/fs_idbreg.pas new file mode 100644 index 0000000..d39d81d --- /dev/null +++ b/official/3.23/FastScript/fs_idbreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idbreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_idbrtti, fs_idbctrlsrtti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsDBRTTI, TfsDBCtrlsRTTI]); +end; + +end. diff --git a/official/3.23/FastScript/fs_idbrtti.pas b/official/3.23/FastScript/fs_idbrtti.pas new file mode 100644 index 0000000..3a0d5fa --- /dev/null +++ b/official/3.23/FastScript/fs_idbrtti.pas @@ -0,0 +1,559 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ DB.pas classes and functions } +{ } +{ (c) 2003-2005 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; + +type + 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, nil); + AddProperty('Value', 'Variant', GetProp, SetProp); + 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 := Integer(TFields(Instance)[Caller.Params[0]]) + end + else if ClassType = TFieldDefs then + begin + if MethodName = 'ITEMS.GET' then + Result := Integer(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 := Integer(TFieldDefs(Instance).AddFieldDef) + else if MethodName = 'CLEAR' then + TFieldDefs(Instance).Clear + else if MethodName = 'FIND' then + Result := Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'SAVETOFILE' then + TBlobField(Instance).SaveToFile(Caller.Params[0]) + else if MethodName = 'SAVETOSTREAM' then + TBlobField(Instance).SaveToStream(TStream(Integer(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 := Integer(_TDataSet.FieldByName(Caller.Params[0])) + else if MethodName = 'GETFIELDNAMES' then + _TDataSet.GetFieldNames(TStrings(Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'GETBOOKMARK' then + Result := Integer(_TDataSet.GetBookmark) + else if MethodName = 'GOTOBOOKMARK' then + _TDataSet.GotoBookmark(TBookMark(Integer(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 := Integer(TParams(Instance).ParamByName(Caller.Params[0])) + else if MethodName = 'FINDPARAM' then + Result := Integer(TParams(Instance).FindParam(Caller.Params[0])) + else if MethodName = 'ITEMS.GET' then + Result := Integer(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 + 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 := Integer(_TDataSet.FieldDefs) + else if PropName = 'FIELDS' then + Result := Integer(_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 + 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 + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_idialogsrtti.pas b/official/3.23/FastScript/fs_idialogsrtti.pas new file mode 100644 index 0000000..a78e368 --- /dev/null +++ b/official/3.23/FastScript/fs_idialogsrtti.pas @@ -0,0 +1,149 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Dialogs.pas classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idialogsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti +{$IFDEF CLX} +, QDialogs +{$ELSE} +, Dialogs +{$ENDIF}; + +type + 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} + AddClass(TPrintDialog, dlg); + AddClass(TPrinterSetupDialog, dlg); +{$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 + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_idisp.pas b/official/3.23/FastScript/fs_idisp.pas new file mode 100644 index 0000000..1f92d53 --- /dev/null +++ b/official/3.23/FastScript/fs_idisp.pas @@ -0,0 +1,126 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ OLE dispatch module } +{ } +{ (c) 2003-2005 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 := 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 then + begin + Params.rgdispidNamedArgs := @DispIDArgs; + Params.cNamedArgs := 1; + end; + + if NeedResult and (Flags <> DISPATCH_PROPERTYPUT) 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; + raise Exception.Create('OLE error ' + IntToHex(Status, 8) + ': ' + + Name + ': ' + SysErrorMessage(Status) + ExcepMess); + end; +end; + +procedure TfsOLEHelper.SetValue(const Value: Variant); +var + i: Integer; + v: Variant; +begin + v := VarArrayCreate([0, Count], varVariant); + for i := 0 to Count - 1 do + v[i] := Params[i].Value; + v[Count] := Value; + + DispatchInvoke(v, Count + 1, DISPATCH_PROPERTYPUT); +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); +end; + +end. diff --git a/official/3.23/FastScript/fs_ievents.pas b/official/3.23/FastScript/fs_ievents.pas new file mode 100644 index 0000000..0031376 --- /dev/null +++ b/official/3.23/FastScript/fs_ievents.pas @@ -0,0 +1,201 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Standard events } +{ } +{ (c) 2003-2005 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. diff --git a/official/3.23/FastScript/fs_iexpression.pas b/official/3.23/FastScript/fs_iexpression.pas new file mode 100644 index 0000000..2ace0f8 --- /dev/null +++ b/official/3.23/FastScript/fs_iexpression.pas @@ -0,0 +1,881 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Expression parser } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iexpression; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter +{$IFDEF Delphi6} +, 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 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 + +uses fs_itools; + +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; + if FOptimizeInt then + Result := Integer(Result) + Integer(FRight.Value) + else + Result := Result + FRight.Value; +end; + +function TStrCatNode.GetValue: Variant; +begin + Result := FLeft.Value; + if TVarData(Result).VType = varString 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 := Integer(Result) - Integer(FRight.Value) + else + Result := Result - FRight.Value; +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 := Integer(Result) * Integer(FRight.Value) + else + Result := Result * FRight.Value; +end; + +function TDivFloatNode.GetValue: Variant; +begin + Result := FLeft.Value; + Result := Result / FRight.Value; +end; + +function TDivIntNode.GetValue: Variant; +begin + Result := FLeft.Value; + if FOptimizeInt then + Result := Integer(Result) div Integer(FRight.Value) + else + Result := Result div FRight.Value; +end; + +function TModNode.GetValue: Variant; +begin + Result := FLeft.Value; + if FOptimizeInt then + Result := Integer(Result) mod Integer(FRight.Value) + else + Result := Result mod FRight.Value; +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]; + + if (i < Count - 1) and (ar[i + 1] = Null) then { subrange } + begin + Result := (selfVal >= val) and (selfVal <= ar[i + 2]); + Inc(i, 2); + end + else + Result := selfVal = val; + + if Result then break; + Inc(i); + end; + end; +end; + +function TIsNode.GetValue: Variant; +begin + Result := TObject(Integer(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 + inherited Create('', fvtInt, ''); + Value := AValue; + + t := fvtInt; + if TVarData(AValue).VType = varBoolean then + t := fvtBool + else if TVarData(AValue).VType in [varSingle, varDouble, varCurrency] then + t := fvtFloat + else if (TVarData(AValue).VType = varOleStr) or + (TVarData(AValue).VType = varString) then + t := fvtString; + + Typ := t; +end; + +function TfsOperandNode.Priority: Integer; +begin + Result := 0; +end; + + +{ TfsOperatorNode } + +constructor TfsOperatorNode.Create(Op: TfsOperatorType); +begin + inherited Create('', fvtInt, ''); + 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 + inherited Create('', fvtInt, ''); + 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.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; + { 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/official/3.23/FastScript/fs_iextctrlsrtti.pas b/official/3.23/FastScript/fs_iextctrlsrtti.pas new file mode 100644 index 0000000..bae696b --- /dev/null +++ b/official/3.23/FastScript/fs_iextctrlsrtti.pas @@ -0,0 +1,410 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ ExtCtrls } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iextctrlsrtti; + +interface + +{$i fs.inc} + +uses SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iformsrtti +{$IFDEF CLX} +, QExtCtrls, QButtons, QCheckLst, QComCtrls +{$ELSE} +, ExtCtrls, Buttons, CheckLst, ComCtrls +{$ENDIF}; + +type + 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; + AddClass(TIconOptions, 'TPersistent'); + AddClass(TListView, 'TWinControl'); + AddClass(TToolButton, 'TGraphicControl'); + AddClass(TToolBar, 'TWinControl'); +{$IFNDEF CLX} + AddClass(TMonthCalColors, 'TPersistent'); + AddClass(TDateTimePicker, 'TWinControl'); + AddClass(TMonthCalendar, 'TWinControl'); + AddClass(TCustomRichEdit, 'TWinControl'); + AddClass(TRichEdit, 'TCustomRichEdit'); +{$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 := Integer(TPageControl(Instance).Pages[Caller.Params[0]]) + end + else if ClassType = TStatusPanels then + begin + if MethodName = 'ADD' then + Result := Integer(TStatusPanels(Instance).Add) + else if MethodName = 'ITEMS.GET' then + Result := Integer(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 := Integer(TTreeNodes(Instance).Add(TTreeNode(Integer(Caller.Params[0])), + Caller.Params[1])) + else if MethodName = 'ADDCHILD' then + Result := Integer(TTreeNodes(Instance).AddChild(TTreeNode(Integer(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(Integer(Caller.Params[0]))) + else if MethodName = 'ENDUPDATE' then + TTreeNodes(Instance).EndUpdate + else if MethodName = 'ITEM.GET' then + Result := Integer(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 := Integer(TListColumns(Instance).Add) + else if MethodName = 'ITEMS.GET' then + Result := Integer(TListColumns(Instance).Items[Caller.Params[0]]) + end + else if ClassType = TListItem then + begin + if MethodName = 'DELETE' then + TListItem(Instance).Delete +{$IFNDEF CLX} + else if MethodName = 'EDITCAPTION' then + Result := TListItem(Instance).EditCaption +{$ENDIF} + end + else if ClassType = TListItems then + begin + if MethodName = 'ADD' then + Result := Integer(TListItems(Instance).Add) + else if MethodName = 'BEGINUPDATE' then + TListItems(Instance).BeginUpdate + else if MethodName = 'CLEAR' then + TListItems(Instance).Clear + else if MethodName = 'DELETE' then + TListItems(Instance).Delete(Caller.Params[0]) + else if MethodName = 'ENDUPDATE' then + TListItems(Instance).EndUpdate + else if MethodName = 'ITEM.GET' then + Result := Integer(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 := Integer(TTabSheet(Instance).PageControl) + end + else if ClassType = TTreeNode then + begin + if PropName = 'COUNT' then + Result := TTreeNode(Instance).Count + else if PropName = 'DATA' then + Result := Integer(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 := Integer(TTreeView(Instance).Items) + else if PropName = 'SELECTED' then + Result := Integer(TTreeView(Instance).Selected) + else if PropName = 'TOPITEM' then + Result := Integer(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 := Integer(TListItem(Instance).Data) + else if PropName = 'IMAGEINDEX' then + Result := TListItem(Instance).ImageIndex + else if PropName = 'SELECTED' then + Result := TListItem(Instance).Selected +{$IFNDEF CLX} + else if PropName = 'STATEINDEX' then + Result := TListItem(Instance).StateIndex +{$ENDIF} + else if PropName = 'SUBITEMS' then + Result := Integer(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(Integer(Value)) + end + else if ClassType = TTreeNode then + begin + if PropName = 'DATA' then + TTreeNode(Instance).Data := Pointer(Integer(Value)) + else if PropName = 'IMAGEINDEX' then + TTreeNode(Instance).ImageIndex := 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(Integer(Value)) + else if PropName = 'TOPITEM' then + TTreeView(Instance).TopItem := TTreeNode(Integer(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(Integer(Value)) + else if PropName = 'IMAGEINDEX' then + TListItem(Instance).ImageIndex := Value + else if PropName = 'SELECTED' then + TListItem(Instance).Selected := Value +{$IFNDEF CLX} + else if PropName = 'STATEINDEX' then + TListItem(Instance).StateIndex := Value +{$ENDIF} + else if PropName = 'SUBITEMS' then + TListItem(Instance).SubItems := TStrings(Integer(Value)) + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iformsrtti.pas b/official/3.23/FastScript/fs_iformsrtti.pas new file mode 100644 index 0000000..07caa71 --- /dev/null +++ b/official/3.23/FastScript/fs_iformsrtti.pas @@ -0,0 +1,422 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Forms and StdCtrls } +{ } +{ (c) 2003-2005 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} +, Windows, Controls, Forms, StdCtrls +{$ENDIF}; + +type + 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 LINUX} + 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_F1', '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); + 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 + 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 := Integer(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 := Integer(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(Integer(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 + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_igraphicsrtti.pas b/official/3.23/FastScript/fs_igraphicsrtti.pas new file mode 100644 index 0000000..c3008e7 --- /dev/null +++ b/official/3.23/FastScript/fs_igraphicsrtti.pas @@ -0,0 +1,248 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Graphics.pas classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_igraphicsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti +{$IFDEF CLX} +, QGraphics +{$ELSE} +, Graphics +{$ENDIF}; + +type + 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); + AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout'); + 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 CLX} + 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 := Integer(TFont(Instance).Create) + end + else if ClassType = TPen then + begin + if MethodName = 'CREATE' then + Result := Integer(TPen(Instance).Create) + end + else if ClassType = TBrush then + begin + if MethodName = 'CREATE' then + Result := Integer(TBrush(Instance).Create) + end + else if ClassType = TCanvas then + begin + _Canvas := TCanvas(Instance); + + if MethodName = 'CREATE' then + Result := Integer(TCanvas(Instance).Create) + else if MethodName = 'DRAW' then + _Canvas.Draw(Caller.Params[0], Caller.Params[1], TGraphic(Integer(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(Integer(Caller.Params[2]))) + 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 := Integer(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 CLX} + else if ClassType = TMetafileCanvas then + begin + if MethodName = 'CREATE' then + Result := Integer(TMetafileCanvas(Instance).Create(TMetafile(Integer(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 := Integer(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 + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iibxreg.pas b/official/3.23/FastScript/fs_iibxreg.pas new file mode 100644 index 0000000..d453ceb --- /dev/null +++ b/official/3.23/FastScript/fs_iibxreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iibxreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_iibxrtti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsIBXRTTI]); +end; + +end. diff --git a/official/3.23/FastScript/fs_iibxrtti.pas b/official/3.23/FastScript/fs_iibxrtti.pas new file mode 100644 index 0000000..e24e4e0 --- /dev/null +++ b/official/3.23/FastScript/fs_iibxrtti.pas @@ -0,0 +1,80 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ IBX classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iibxrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, db, ibdatabase, + IBCustomDataSet, IBQuery, IBTable, IBStoredProc; + +type + TfsIBXRTTI = 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; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + with AScript do + begin + AddClass(TIBDataBase, 'TComponent'); + AddClass(TIBTransaction, 'TComponent'); + AddClass(TIBCustomDataSet, 'TDataSet'); + AddClass(TIBTable, 'TIBCustomDataSet'); + with AddClass(TIBQuery, 'TIBCustomDataSet') do + AddMethod('procedure ExecSQL', CallMethod); + 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 + end + else if ClassType = TIBStoredProc then + begin + if MethodName = 'EXECPROC' then + TIBStoredProc(Instance).ExecProc + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iilparser.pas b/official/3.23/FastScript/fs_iilparser.pas new file mode 100644 index 0000000..84f51b5 --- /dev/null +++ b/official/3.23/FastScript/fs_iilparser.pas @@ -0,0 +1,1975 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Intermediate Language parser } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iilparser; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_iparser, fs_iexpression, fs_xml +{$IFDEF Delphi6} +, 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 + +uses fs_itools, fs_iconst +{$IFDEF CLX} +, Types +{$ELSE} +, Windows +{$ENDIF} +{$IFDEF OLE} +, fs_idisp +{$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 = '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; + + procedure DoInclude(const Name: String); + var + sl: TStringList; + p: TfsILParser; + ss: TStringStream; + s: String; + 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 + sl.LoadFromFile(Name); + + p := TfsILParser.Create(FProgram); + p.FUnitName := Name; + ss := TStringStream.Create(''); + 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 LINUX} + while (i <= Length(Text)) and (Text[i] <> #10) do +{$ELSE} + while (i <= Length(Text)) and (Text[i] <> #13) 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); + FStream.Position := 0; + 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 := ''; + + 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 Integer; + 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, 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; + + { 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; + +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; + + 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 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(Integer(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); + if Item.Ref = nil then + raise Exception.Create(SIdUndeclared + '''' + NodeText + ''''); + 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.AddConst(Item.Ref[j].DefValue); + 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; + +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, 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); + 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 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); + + Proc := TfsProcVariable.Create(Name, fvtInt, '', Prog, False); + 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, 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, 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 := 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/official/3.23/FastScript/fs_iinirtti.pas b/official/3.23/FastScript/fs_iinirtti.pas new file mode 100644 index 0000000..cdc5a64 --- /dev/null +++ b/official/3.23/FastScript/fs_iinirtti.pas @@ -0,0 +1,179 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ IniFiles.pas classes and functions } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{ Copyright (c) 2004 by Stalker SoftWare } +{ } +{******************************************} + +unit fs_iinirtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, IniFiles; + +type + 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; + public + constructor Create(AScript: TfsScript); override; + end; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + + with AScript do + begin + with AddClass(TIniFile, 'TObject') 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); + 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); + AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod); +{$ENDIF} + AddMethod('function SectionExists(const Section: String): Boolean', CallMethod); + AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod); + AddMethod('function ValueExists(const Section, Ident: String): Boolean', 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); + AddProperty('FileName', 'String', GetProp); + end; + end; +end; + +{$HINTS OFF} +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant; +var + oTIniFile: TIniFile; + oList: TStrings; + nCou: Integer; +begin + Result := 0; + + if ClassType = TIniFile then + begin + oTIniFile := TIniFile(Instance); + if MethodName = 'CREATE' then + Result := Integer(oTIniFile.Create(Caller.Params[0])) + else if MethodName = 'WRITESTRING' then + oTIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READSTRING' then + Result := oTIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEINTEGER' then + oTIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READINTEGER' then + Result := oTIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEBOOL' then + oTIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READBOOL' then + Result := oTIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEDATE' then + oTIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READDATE' then + Result := oTIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEDATETIME' then + oTIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READDATETIME' then + Result := oTIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEFLOAT' then + oTIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READFLOAT' then + Result := oTIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITETIME' then + oTIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READTIME' then + Result := oTIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) +{$IFDEF DELPHI6} + else if MethodName = 'WRITEBINARYSTREAM' then + oTIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(Integer(Caller.Params[2]))) + else if MethodName = 'READBINARYSTREAM' then + Result := oTIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(Integer(Caller.Params[2]))) +{$ENDIF} + else if MethodName = 'SECTIONEXISTS' then + Result := oTIniFile.SectionExists(Caller.Params[0]) + else if MethodName = 'DELETEKEY' then + oTIniFile.DeleteKey(Caller.Params[0], Caller.Params[1]) + else if MethodName = 'VALUEEXISTS' then + Result := oTIniFile.ValueExists(Caller.Params[0], Caller.Params[1]) + else if MethodName = 'READSECTION' then + oTIniFile.ReadSection(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'READSECTIONS' then + oTIniFile.ReadSections(TStrings(Integer(Caller.Params[0]))) + else if MethodName = 'READSECTIONVALUES' then + oTIniFile.ReadSectionValues(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'ERASESECTION' then + oTIniFile.EraseSection(Caller.Params[0]) +{$IFDEF DELPHI6} + else if MethodName = 'READSECTIONVALUESEX' then + begin + oList := TStringList.Create; + try + oTIniFile.ReadSectionValues(Caller.Params[0], oList); + TStrings(Integer(Caller.Params[1])).Clear; + for nCou := 0 to oList.Count-1 do + TStrings(Integer(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]); + finally + oList.Free; + end; + end; +{$ENDIF} + end; +end; +{$HINTS ON} + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TIniFile then + begin + if PropName = 'FILENAME' then + Result := TIniFile(Instance).FileName + end; +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/3.23/FastScript/fs_iinterpreter.pas b/official/3.23/FastScript/fs_iinterpreter.pas new file mode 100644 index 0000000..2ca170f --- /dev/null +++ b/official/3.23/FastScript/fs_iinterpreter.pas @@ -0,0 +1,3064 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Main module } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iinterpreter; + +interface + +{$I fs.inc} + +uses + SysUtils, Classes, fs_xml +{$IFDEF Delphi6} +, Variants +{$ENDIF} +, SyncObjs; + + +type + TfsStatement = class; + TfsDesignator = class; + TfsCustomVariable = class; + TfsClassVariable = class; + TfsMethodHelper = class; + TfsScript = 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); + + TfsTypeRec = packed record + Typ: TfsVarType; + TypeName: String[32]; + 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; + 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; + +{ 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 } + + 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; + FParent: TfsScript; + FProgRunning: TfsScript; + FRTTIAdded: Boolean; + FStatement: TfsStatement; + FSyntaxType: String; + FTerminated: Boolean; + FUnitLines: TStringList; + 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); + 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; + { Adds a constant. Example: + AddConst('pi', 'Double', 3.14159) } + procedure AddConst(const Name, Typ: String; const Value: Variant); + { 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); + { 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); + { Adds a form or datamodule with all its child components } + procedure AddComponent(Form: TComponent); + procedure AddForm(Form: TComponent); + { 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; + procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent; + const Category: String = ''; const Description: String = ''); overload; + { Adds an external object. Example: + AddObject('Memo1', Memo1) } + procedure AddObject(const Name: String; Obj: TObject); + { Adds a variable. Example: + AddVariable('n', 'Variant', 0) } + procedure AddVariable(const Name, Typ: String; const Value: Variant); + { Adds a type. Example: + AddType('TDateTime', fvtFloat) } + procedure AddType(const TypeName: String; ParentType: TfsVarType); + { Calls internal procedure or function. Example: + val := CallFunction('ScriptFunc1', VarArrayOf([2003, 3])) } + function CallFunction(const Name: String; const Params: Variant): Variant; + function CallFunction1(const Name: String; var 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 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 Statement: TfsStatement read FStatement; + property Variables[Index: String]: Variant read GetVariables write SetVariables; + 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; + 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; + 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; + end; + +{ TfsVariable represents constant or variable } + + TfsVariable = class(TfsCustomVariable) + 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 } + + TfsProcVariable = class(TfsCustomVariable) + private + FExecuting: Boolean; + FIsFunc: Boolean; + FProgram: TfsScript; + protected + function GetValue: Variant; override; + public + constructor Create(const AName: String; ATyp: TfsVarType; + const ATypeName: String; AParent: TfsScript; AIsFunc: Boolean = True); + destructor Destroy; override; + + 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; + 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; + 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) + private + FComponent: TComponent; + protected + function GetValue: Variant; override; + public + constructor Create(Component: TComponent); + 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 AddComponent(c: TComponent); + 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; + { Adds a property. Example: + AddProperty('Font', 'TFont', MyGetEvent, MySetEvent) } + procedure AddProperty(const Name, Typ: String; + GetEvent: TfsGetValueEvent; SetEvent: TfsSetValueEvent = 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): 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 fsRTTIModules: TList; + + +implementation + +uses + TypInfo, fs_isysrtti, fs_iexpression, fs_iparser, fs_iilparser, + fs_itools, fs_iconst +{$IFDEF CLX} +, QForms, QDialogs, Types +{$ELSE} + {$IFDEF NOFORMS} +, Windows, Messages + {$ELSE} +, Windows, Forms, 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'; + 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; +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; + FIsFunc := AIsFunc; + FProgram := TfsScript.Create(nil); + FProgram.Parent := AParent; + 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; + inherited; +end; + +function TfsProcVariable.GetValue: Variant; +var + Temp: Boolean; + ParentProg, SaveProg: TfsScript; +begin + Temp := FExecuting; + FExecuting := True; + + 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; + try + FStatement.Execute; + finally + FExitCalled := False; + FTerminated := False; + FIsRunning := False; + end; + end; +// + + if FIsFunc then + Result := FRefItem.Value else + Result := Null; + finally + if ParentProg <> nil then + ParentProg.FProgRunning := SaveProg; + FExecuting := Temp; + end; +end; + + +{ TfsPropertyHelper } + +function TfsPropertyHelper.GetValue: Variant; +var + p: PPropInfo; + Instance: TObject; +begin + + Result := Null; + Instance := TObject(Integer(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: + Result := GetOrdProp(Instance, p); + + tkFloat: + Result := GetFloatProp(Instance, p); + + tkString, tkLString, tkWString: + Result := GetStrProp(Instance, p); + + tkChar, tkWChar: + Result := Chr(GetOrdProp(Instance, p)); + + tkVariant: + Result := GetVariantProp(Instance, p); + end; + end + else if Assigned(FOnGetValue) then + Result := FOnGetValue(Instance, FClassRef, FUppercaseName); + + 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: Integer; +begin + + if IsReadOnly then Exit; + Instance := TObject(Integer(ParentValue)); + + + + if FIsPublished then + begin + p := GetPropInfo(Instance.ClassInfo, Name); + if p <> nil then + case p.PropType^.Kind of + tkInteger, tkSet, tkEnumeration, tkClass: + begin + if Typ = fvtBool then + if Value = True then + IntVal := 1 else + IntVal := 0 + else + IntVal := Integer(Value); + SetOrdProp(Instance, p, IntVal); + end; + + tkFloat: + SetFloatProp(Instance, p, Extended(Value)); + + tkString, tkLString: + SetStrProp(Instance, p, String(Value)); + + tkWString: + SetStrProp(Instance, p, WideString(Value)); + + tkChar, tkWChar: + SetOrdProp(Instance, p, Ord(String(Value)[1])); + + tkVariant: + SetVariantProp(Instance, p, Value); + end; + end + else if Assigned(FOnSetValue) then + FOnSetValue(Instance, FClassRef, FUppercaseName, Value); + +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; + + 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(Integer(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 + if inherited Params[i].IsVarParam then + inherited Params[i].Value := FVarArray[i]; + end + else if Assigned(FOnCallNew) then + begin + Instance := nil; + if not VarIsNull(ParentValue) then + Instance := TObject(Integer(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(Integer(ParentValue)), FClassRef, FUppercaseName + '.SET', v); + v := Null; + end + else if Assigned(FOnCallNew) then + begin + FSetValue := Value; + FOnCallNew(TObject(Integer(ParentValue)), FClassRef, FUppercaseName + '.SET', Self); + FSetValue := Null; + end; +end; + + +{ TfsComponentHelper } + +constructor TfsComponentHelper.Create(Component: TComponent); +begin + inherited Create(Component.Name, fvtClass, Component.ClassName); + FComponent := Component; +end; + +function TfsComponentHelper.GetValue: Variant; +begin + Result := Integer(FComponent); +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(Integer(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.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; + +procedure TfsClassVariable.AddComponent(c: TComponent); +begin + FMembers.Add(TfsComponentHelper.Create(c)); +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; + tkSet: + begin + t := fvtEnum; + cl := PropList[i].PropType^.Name; + end; + tkEnumeration: + begin + t := fvtEnum; + cl := PropList[i].PropType^.Name; + if (CompareText(cl, 'Boolean') = 0) or (CompareText(cl, 'bool') = 0) then + t := fvtBool; + end; + tkFloat: + t := fvtFloat; + tkChar, tkWChar: + t := fvtChar; + tkString, tkLString, tkWString: + t := fvtString; + tkVariant: + t := fvtVariant; + tkClass: + begin + t := fvtClass; + FClass := GetTypeData(PropList[i].PropType^).ClassType; + cl := FClass.ClassName; + end; + end; + + p := TfsPropertyHelper.Create(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): 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; +end; + +function TfsClassVariable.GetValue: Variant; +begin + if Params[0].Value = Null then + Result := Integer(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 + inherited Create('', fvtInt, ''); + FProgram := AProgram; + FMainProg := FProgram; + ParentProg := FProgram; + while ParentProg <> nil do + if ParentProg.FMainProg then + begin + FMainProg := ParentProg; + break; + end + else + ParentProg := ParentProg.FParent; +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; + Temp, Temp1: array of Variant; + + { copy local variables to Temp } + procedure SaveLocalVariables(Item: TfsCustomVariable); + var + i: Integer; + begin + with TfsProcVariable(Item) do + begin + SetLength(Temp, Prog.Count); + + for i := 0 to Prog.Count - 1 do + if (Prog.Items[i] is TfsVariable) or (Prog.Items[i] is TfsParamItem) then + Temp[i] := Prog.Items[i].Value; + end; + end; + + { restore local variables from Temp} + procedure RestoreLocalVariables(Item: TfsCustomVariable); + var + i: Integer; + begin + with TfsProcVariable(Item) do + for i := 0 to Prog.Count - 1 do + if (Prog.Items[i] is TfsVariable) or (Prog.Items[i] is TfsParamItem) then + Prog.Items[i].Value := Temp[i]; + + Temp := nil; + end; + +begin + Ref := nil; + Val := Null; + + 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; + + { 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 + SaveLocalVariables(Item); + + 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; + + { restore proc variables if it was called from itself } + if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then + RestoreLocalVariables(Item); + + 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; + FItems := TStringList.Create; + FItems.Sorted := True; + FItems.Duplicates := dupAccept; + FLines := TStringList.Create; + FMacros := TStringList.Create; + FStatement := TfsStatement.Create(Self, '', ''); + FSyntaxType := 'PascalScript'; + FUnitLines := TStringList.Create; +end; + +destructor TfsScript.Destroy; +begin + inherited; + Clear; + ClearRTTI; + FItems.Free; + FLines.Free; + FMacros.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; + FUnitLines.Clear; + FErrorPos := ''; + FErrorMsg := ''; + FErrorUnit := ''; +end; + +procedure TfsScript.ClearItems(Owner: TObject); +begin + RemoveItems(Owner); + FStatement.Clear; + FUnitLines.Clear; +end; + +procedure TfsScript.RemoveItems(Owner: TObject); +var + i: Integer; +begin + for i := Count - 1 downto 0 do + 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.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.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, Integer(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; + Add(v.Name, v); +end; + +procedure TfsScript.AddForm(Form: TComponent); +begin + AddComponent(Form); +end; + +procedure TfsScript.AddComponent(Form: TComponent); +var + i: Integer; + v: TfsClassVariable; +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') + 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 := 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): Variant; +var + i: Integer; + v: TfsCustomVariable; + p: TfsProcVariable; +begin + v := FindLocal(Name); + if (v <> nil) and (v is TfsProcVariable) then + begin + p := TfsProcVariable(v); + + if VarIsArray(Params) then + for i := 0 to VarArrayHighBound(Params, 1) do + p.Params[i].Value := Params[i]; + Result := p.Value; + end + else + begin + Result := Null; + end +end; + +function TfsScript.CallFunction1(const Name: String; var Params: Variant): Variant; +var + i: Integer; + v: TfsCustomVariable; + p: TfsProcVariable; +begin + v := FindLocal(Name); + if (v <> nil) and (v is TfsProcVariable) then + begin + p := TfsProcVariable(v); + + 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; + end + else + Result := Null; +end; + +function TfsScript.Evaluate(const Expression: String): Variant; +var + p: TfsScript; + Prog: TfsScript; + SaveEvent: TfsRunLineEvent; +begin + Result := Null; + if FProgRunning = nil then + p := Self else + p := FProgRunning; + + Prog := TfsScript.Create(nil); + Prog.AddRTTI; + Prog.Parent := p; + SaveEvent := FOnRunLine; + FOnRunLine := nil; + try + Prog.Lines.Text := 'function __f__: Variant; begin Result := ' + Expression + + ' end; begin end.'; + if not Prog.Compile then + Result := Prog.ErrorMsg else + Result := Prog.FindLocal('__f__').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.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; +begin + if FUnitLines.IndexOfName(UnitName) = -1 then + FUnitLines.Add(UnitName + '='); + + sl := TStringList.Create; + sl.CommaText := FUnitLines.Values[UnitName]; + LineN := Copy(APos, 1, Pos(':', APos) - 1); + if sl.IndexOf(LineN) = -1 then + FUnitLines.Values[UnitName] := FUnitLines.Values[UnitName] + LineN + ','; + sl.Free; +end; + +function TfsScript.IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean; +var + sl: TStringList; +begin + Result := False; + if FUnitLines.IndexOfName(UnitName) = -1 then Exit; + + sl := TStringList.Create; + sl.CommaText := FUnitLines.Values[UnitName]; + if sl.IndexOf(IntToStr(LineN)) <> -1 then + Result := True; + sl.Free; +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 + for i := 0 to Count - 1 do + begin + if FProgram.FTerminated then break; + Items[i].Execute; + 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 + bValue := FBeginValue.Value; + eValue := FEndValue.Value; + RunLine; + 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 + ExceptStmt.Execute; + 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 + 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 + Add(TfsParamItem.Create('', fvtInt, '', False, False)); + end + else + for i := 0 to 2 do + Add(TfsParamItem.Create('', fvtInt, '', i > 0, False)); +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(Integer(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: Integer; +begin + if FHandler.Executing then Exit; + for i := 0 to FHandler.Count - 1 do + FHandler.Params[i].Value := VarRecToVariant(Params[i]); + FHandler.Value; +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 fsRTTIModules: TList; +begin + if (FRTTIModules = nil) and not FRTTIModulesDestroyed then + begin + FRTTIModules := TList.Create; + FRTTIModules.Add(TfsSysFunctions); + end; + Result := FRTTIModules; +end; + + +initialization + FGlobalUnitDestroyed := False; + FRTTIModulesDestroyed := False; + fsRTTIModules; + +finalization + if FGlobalUnit <> nil then + FGlobalUnit.Free; + FGlobalUnit := nil; + FGlobalUnitDestroyed := True; + FRTTIModules.Free; + FRTTIModules := nil; + FRTTIModulesDestroyed := True; + +end. diff --git a/official/3.23/FastScript/fs_ijs.pas b/official/3.23/FastScript/fs_ijs.pas new file mode 100644 index 0000000..b4c21b3 --- /dev/null +++ b/official/3.23/FastScript/fs_ijs.pas @@ -0,0 +1,145 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ JScript grammar } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ijs; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_itools; + +type + TfsJScript = class(TComponent); + + +implementation + +const + JS_GRAMMAR = + '' + + '<' + + 'loop text=","><' + + 'char text="!" add="op" addtext="not"/>' + + '<' + + 'char text="-" add="op"/><' + + 'expression err="err2"/>' + + '<' + + 'forstmtitem/>'; + + +initialization + fsRegisterLanguage('JScript', JS_GRAMMAR); + +end. diff --git a/official/3.23/FastScript/fs_iparser.pas b/official/3.23/FastScript/fs_iparser.pas new file mode 100644 index 0000000..3ef0ce4 --- /dev/null +++ b/official/3.23/FastScript/fs_iparser.pas @@ -0,0 +1,673 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Parser } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iparser; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, Windows; + + +type + TfsIdentifierCharset = set of Char; + + { TfsParser parser the source text and return such elements as identifiers, + keywords, punctuation, strings and numbers. } + + TfsParser = class(TObject) + private + 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; + FYList: TList; + FCaseSensitive: 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; + + { 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; + Clear; +end; + +destructor TfsParser.Destroy; +begin + FKeywords.Free; + FYList.Free; + inherited; +end; + +procedure TfsParser.Clear; +begin + FKeywords.Clear; + 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); + + FYList.Clear; + FYList.Add(TObject(0)); + for i := 1 to FSize do + if FText[i] = #10 then + FYList.Add(TObject(i)); +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; + if FText[FPosition] in [#10, #13] then + begin + Result := True; + while FText[FPosition] in [#10, #13] do + Inc(FPosition); + end + else + Result := False; +end; + +procedure TfsParser.SkipSpaces; +var + s1, s2: String; + Flag: Boolean; + Spaces: set of Char; +begin + Spaces := [#0..#32]; + if not FSkipEOL then +{$IFDEF LINUX} + Spaces := Spaces - [#10]; +{$ELSE} + Spaces := Spaces - [#13]; +{$ENDIF} + while (FPosition <= FSize) and (FText[FPosition] in Spaces) do + 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 + while (FPosition <= FSize) and (FText[FPosition] <> #10) do + Inc(FPosition); + 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; + + if (FText[FPosition] in FIdentifierCharset - ['0'..'9']) then + begin + while FText[FPosition] in FIdentifierCharset do + 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 + if FText[FPosition] in ['!', '@', '#', '$', '%', '^', '&', '|', '\', + '.', ',', ':', ';', '?', '''', '"', '~', '`', '_', '[', ']', '{', '}', + '(', ')', '+', '-', '*', '/', '=', '<', '>'] then + 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 + case Lowercase(FText[FPosition + 1])[1] of + '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]; + until FText[FPosition] in [#0..#31] - [#9]; + + 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; + +begin + Result := ''; + if FSkipSpace then + SkipSpaces; + Flag := True; + FError := False; + FCpp := FStringQuotes = '"'; + + 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; + +function TfsParser.DoDigitSequence: Boolean; +begin + Result := False; + + if FText[FPosition] in ['0'..'9'] then + begin + while FText[FPosition] in ['0'..'9'] do + Inc(FPosition); + Result := True; + end; +end; + +function TfsParser.DoHexDigitSequence: Boolean; +begin + Result := False; + + if FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] then + begin + while FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] do + 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; + + if FText[FPosition] in ['e', 'E'] then + begin + Inc(FPosition); + if FText[FPosition] in ['+', '-'] then + 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 + if FText[FPosition] in ['<', '['] then + Inc(c) + else if FText[FPosition] in ['>', ']'] then + 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. diff --git a/official/3.23/FastScript/fs_ipascal.pas b/official/3.23/FastScript/fs_ipascal.pas new file mode 100644 index 0000000..3ac2d18 --- /dev/null +++ b/official/3.23/FastScript/fs_ipascal.pas @@ -0,0 +1,182 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Pascal grammar } +{ } +{ (c) 2003-2005 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ipascal; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_itools; + +type + TfsPascal = class(TComponent); + +procedure fsModifyPascalForFR2; + +implementation + +const + PASCAL_GRAMMAR = + '
<' + + 'except/>