diff --git a/official/4.2/Dealers.rus.txt b/official/4.2/Dealers.rus.txt new file mode 100644 index 0000000..df6e733 --- /dev/null +++ b/official/4.2/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/4.2/Dealers.txt b/official/4.2/Dealers.txt new file mode 100644 index 0000000..100b191 --- /dev/null +++ b/official/4.2/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/4.2/Demos/ClientServer/CGI/fastreport.dpr b/official/4.2/Demos/ClientServer/CGI/fastreport.dpr new file mode 100644 index 0000000..b4663ed --- /dev/null +++ b/official/4.2/Demos/ClientServer/CGI/fastreport.dpr @@ -0,0 +1,57 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport CGI wrapper demo } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +program fastreport; + +{$APPTYPE CONSOLE} + +uses + Windows, SysUtils, Classes, frxCGIClient, IniFiles, frxServerUtils; + +const + CONFIG_FILENAME = 'fastreport.ini'; + DEFAULT_CONFIG_PATH = ''; + DEFAULT_PORT = 8097; + DEFAULT_HOST = '127.0.0.1'; + +var + FHost: String; + FPort: Integer; + FIni: TIniFile; + c: TfrxCGIClient; + s: String; + +begin + if DEFAULT_CONFIG_PATH = '' then + s := ExtractFilePath(ParamStr(0)) + CONFIG_FILENAME + else + s := DEFAULT_CONFIG_PATH + CONFIG_FILENAME; + if FileExists(s) then + begin + FIni := TIniFile.Create(s); + FHost := FIni.ReadString('REPORTSERVER', 'Host', DEFAULT_HOST); + FPort := FIni.ReadInteger('REPORTSERVER', 'Port', DEFAULT_PORT); + FIni.Free; + end + else begin + FHost := DEFAULT_HOST; + FPort := DEFAULT_PORT; + end; + c := TfrxCGIClient.Create; + c.Host := FHost; + c.Port := FPort; + try + c.Open; + finally + c.Free; + end; +end. diff --git a/official/4.2/Demos/ClientServer/CGI/fastreport.ini b/official/4.2/Demos/ClientServer/CGI/fastreport.ini new file mode 100644 index 0000000..e0494d4 --- /dev/null +++ b/official/4.2/Demos/ClientServer/CGI/fastreport.ini @@ -0,0 +1,3 @@ +[REPORTSERVER] +Host=127.0.0.1 +Port=8097 diff --git a/official/4.2/Demos/ClientServer/CGI/index.html b/official/4.2/Demos/ClientServer/CGI/index.html new file mode 100644 index 0000000..0c049e7 --- /dev/null +++ b/official/4.2/Demos/ClientServer/CGI/index.html @@ -0,0 +1,6 @@ + + +1. Connect to the FastReport Server through the Apache Web Server
+2. Direct connect to the FastReport Server + + \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.dpr b/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.dpr new file mode 100644 index 0000000..3bed53c --- /dev/null +++ b/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.dpr @@ -0,0 +1,14 @@ +program FRClient; + +uses + Forms, + main in 'main.pas' {main}; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'FastReport Client Demo'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.res b/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Client/Advanced/FRClient.res differ diff --git a/official/4.2/Demos/ClientServer/Client/Advanced/main.dfm b/official/4.2/Demos/ClientServer/Client/Advanced/main.dfm new file mode 100644 index 0000000..fa6f99e Binary files /dev/null and b/official/4.2/Demos/ClientServer/Client/Advanced/main.dfm differ diff --git a/official/4.2/Demos/ClientServer/Client/Advanced/main.pas b/official/4.2/Demos/ClientServer/Client/Advanced/main.pas new file mode 100644 index 0000000..cfa6cc2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Client/Advanced/main.pas @@ -0,0 +1,463 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport client demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit main; + +{$I frx.inc} + +interface + +uses + Windows, SysUtils, Classes, Controls, Forms, + Dialogs, StdCtrls, ShellApi, frxClass, frxServerClient, + frxGZip, frxDCtrl, frxChBox, frxCross, frxRich, frxChart, + frxOLE, frxBarcode, ExtCtrls, frxExportPDF, frxExportImage, + frxExportRTF, frxExportXML, frxExportXLS, frxExportHTML, + frxExportTXT, frxGradient, Graphics, ComCtrls, Menus, ImgList +{$IFDEF Delphi6} +, Variants +{$ENDIF} +, frxExportMail, frxExportText, frxExportCSV; + +type + TMainForm = class(TForm) + frxServerConnection1: TfrxServerConnection; + TestBtn: TButton; + Log: TMemo; + Rep: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ShowBtn: TButton; + CloseBtn: TButton; + Label4: TLabel; + Label5: TLabel; + Port: TEdit; + Threads: TEdit; + Label6: TLabel; + frxBarCodeObject1: TfrxBarCodeObject; + frxOLEObject1: TfrxOLEObject; + frxChartObject1: TfrxChartObject; + frxRichObject1: TfrxRichObject; + frxCrossObject1: TfrxCrossObject; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxDialogControls1: TfrxDialogControls; + Label7: TLabel; + Login: TEdit; + Label8: TLabel; + Password: TEdit; + StopBtn: TButton; + Label9: TLabel; + Label10: TLabel; + Label11: TLabel; + Image1: TImage; + frxGradientObject1: TfrxGradientObject; + frxHTMLExport1: TfrxHTMLExport; + frxXLSExport1: TfrxXLSExport; + frxXMLExport1: TfrxXMLExport; + frxRTFExport1: TfrxRTFExport; + frxBMPExport1: TfrxBMPExport; + frxJPEGExport1: TfrxJPEGExport; + frxTIFFExport1: TfrxTIFFExport; + frxPDFExport1: TfrxPDFExport; + ProxyHost: TEdit; + Label12: TLabel; + Label13: TLabel; + ProxyPort: TEdit; + Label14: TLabel; + Label15: TLabel; + Panel2: TPanel; + Panel4: TPanel; + Host: TEdit; + ReportsTree: TTreeView; + Description: TMemo; + Label16: TLabel; + Panel5: TPanel; + ExportBtn: TButton; + Label17: TLabel; + Panel10: TPanel; + ConnectBtn: TButton; + Panel11: TPanel; + Panel9: TPanel; + Panel12: TPanel; + Panel13: TPanel; + Panel14: TPanel; + Label18: TLabel; + PopupMenu1: TPopupMenu; + Clear1: TMenuItem; + frxReportClient1: TfrxReportClient; + ImageList1: TImageList; + frxCSVExport1: TfrxCSVExport; + frxSimpleTextExport1: TfrxSimpleTextExport; + frxMailExport1: TfrxMailExport; + procedure TestBtnClick(Sender: TObject); + procedure CloseBtnClick(Sender: TObject); + procedure ShowBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure StopBtnClick(Sender: TObject); + procedure ListBox1DblClick(Sender: TObject); + procedure ListBox1KeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure Label11Click(Sender: TObject); + procedure ConnectBtnClick(Sender: TObject); + procedure Clear1Click(Sender: TObject); + procedure ReportsTreeChange(Sender: TObject; Node: TTreeNode); + procedure ReportsTreeCustomDrawItem(Sender: TCustomTreeView; + Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure ExportBtnClick(Sender: TObject); + private + ThreadList: TList; + ReportsList: TStringList; + procedure ClearThreads; + end; + + TfrxClientTestThread = class (TThread) + protected + procedure Execute; override; + private + CountRep: Integer; + ErrorsCount: Integer; + Log: TMemo; + ThreadID: Integer; + FConnection: TfrxServerConnection; + FRepName: String; + procedure AppendLog; + procedure FinishLog; + public + Report: TfrxReportClient; + Done: Boolean; + constructor Create(C: TfrxServerConnection; RepName: String; + Id: Integer; Rep: Integer; L: TMemo); + end; + +var + MainForm: TMainForm; + +implementation + +{$IFDEF Delphi7} +uses XPMan; +{$ENDIF} + +{$R *.dfm} + +procedure TMainForm.TestBtnClick(Sender: TObject); +var + i, j, k: Integer; + Thread: TfrxClientTestThread; + s: String; +begin + frxServerConnection1.Host := Host.Text; + frxServerConnection1.Port := StrToInt(Port.Text); + frxServerConnection1.Login := Login.Text; + frxServerConnection1.Password := Password.Text; + if (Length(ProxyHost.Text) > 0) then + begin + frxServerConnection1.ProxyHost := ProxyHost.Text; + frxServerConnection1.ProxyPort := StrToInt(ProxyPort.Text); + end; + ClearThreads; + j := StrToInt(Threads.Text); + k := StrToInt(Rep.Text); + i := Integer(ReportsTree.Selected.Data); + if i <> -1 then + begin + Log.Lines.Add('Start test'); + s := ReportsList[i + 1]; + for i := 1 to j do + begin + Thread := TfrxClientTestThread.Create(frxServerConnection1, s, i, k, Log); + ThreadList.Add(Thread); + end; + end; +end; + +procedure TMainForm.CloseBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.ShowBtnClick(Sender: TObject); +var + t: Cardinal; + tf: Double; + i: Integer; +begin + frxServerConnection1.Host := Host.Text; + frxServerConnection1.Port := StrToInt(Port.Text); + frxServerConnection1.Login := Login.Text; + frxServerConnection1.Password := Password.Text; + if (Length(ProxyHost.Text) > 0) then + begin + frxServerConnection1.ProxyHost := ProxyHost.Text; + frxServerConnection1.ProxyPort := StrToInt(ProxyPort.Text); + end; + i := Integer(ReportsTree.Selected.Data); + if i <> -1 then + begin + frxReportClient1.LoadFromFile(ReportsList[i + 1]); + t := GetTickCount; + if frxReportClient1.PrepareReport then + begin + tf := (GetTickCount - t) / 1000; + Log.Lines.Add(frxReportClient1.ReportName + + ' Time=' + FloatToStr(tf) + ' Size=' + IntToStr(frxReportClient1.Client.StreamSize)); + frxReportClient1.ShowPreparedReport; + end; + Log.Lines.AddStrings(frxReportClient1.Errors); + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Label14.Caption := #174; + Label15.Caption := #169 + Label15.Caption; + ThreadList := TList.Create; + ReportsList := TStringList.Create; +end; + +procedure TMainForm.ClearThreads; +var + i: Integer; +begin + for i := 0 to ThreadList.Count - 1 do + if Assigned(TfrxClientTestThread(ThreadList[i])) then + begin + TfrxClientTestThread(ThreadList[i]).Terminate; + TfrxClientTestThread(ThreadList[i]).Free; + end; + ThreadList.Clear; +end; + +procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + ReportsList.Free; + ClearThreads; + ThreadList.Free; +end; + +procedure TMainForm.StopBtnClick(Sender: TObject); +begin + ClearThreads; +end; + +procedure TMainForm.ListBox1DblClick(Sender: TObject); +begin + ShowBtnClick(Sender); +end; + +procedure TMainForm.ListBox1KeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = 13 then + ShowBtnClick(Sender); +end; + +procedure TMainForm.Label11Click(Sender: TObject); +begin + ShellExecute(GetDesktopWindow, 'open', PChar(Label11.Caption), nil, nil, SW_SHOW); +end; + +procedure TMainForm.ConnectBtnClick(Sender: TObject); +var + t: Cardinal; + tf: Double; + s, s1: String; + AccessFlag: Boolean; + i: Integer; + Node: TTreeNode; + TopNode: TTreeNode; + OldName: String; + +begin + ReportsTree.Items.Clear; + ReportsList.Clear; + Log.Clear; + + frxServerConnection1.Host := Host.Text; + frxServerConnection1.Port := StrToInt(Port.Text); + frxServerConnection1.Login := Login.Text; + frxServerConnection1.Password := Password.Text; + if (Length(ProxyHost.Text) > 0) then + begin + frxServerConnection1.ProxyHost := ProxyHost.Text; + frxServerConnection1.ProxyPort := StrToInt(ProxyPort.Text); + end; + t := GetTickCount; + Log.Lines.Text := Log.Lines.Text + + frxReportClient1.GetServerVariable('SERVER_NAME'); + tf := (GetTickCount - t) / 1000; + if frxReportClient1.Errors.Count = 0 then + begin + Log.Lines.Text := Log.Lines.Text + + 'Version: ' + frxReportClient1.GetServerVariable('SERVER_SOFTWARE'); + Log.Lines.Text := Log.Lines.Text + + 'From: ' + frxReportClient1.GetServerVariable('SERVER_LAST_UPDATE'); + Log.Lines.Text := Log.Lines.Text + + 'Uptime: ' + frxReportClient1.GetServerVariable('SERVER_UPTIME'); + Log.Lines.Add('Ping:' + FloatToStr(tf) + 'ms.'); + end; + Log.Lines.AddStrings(frxReportClient1.Errors); + + AccessFlag := frxReportClient1.Errors.Count = 0; + + if AccessFlag then + begin + ReportsList.Text := frxReportClient1.GetServerVariable('SERVER_REPORTS_LIST'); + if ReportsList.Count > 0 then + begin + ReportsTree.Items.BeginUpdate; + TopNode := nil; + Oldname := ''; + for i := 0 to (ReportsList.Count div 3) - 1 do + begin + s := ReportsList[(i * 3) + 1]; + s := StringReplace(StringReplace(s, ExtractFileName(s), '', []), '\', ' ', [rfReplaceAll]); + if s <> OldName then + begin + if s = '' then + s1 := 'Reports' + else + s1 := s; + Node := ReportsTree.Items.AddChild(nil, s1); + Node.Data := Pointer(-1); + Node.ImageIndex := 0; + TopNode := Node; + OldName := s; + end; + Node := ReportsTree.Items.AddChild(TopNode, ReportsList[i * 3]); + Node.Data := Pointer((i * 3)); + Node.ImageIndex := 1; + end; + ReportsTree.Items.EndUpdate; + ReportsTree.TopItem := ReportsTree.Items[0]; + ReportsTree.Selected := ReportsTree.Items[0]; + ReportsTree.SetFocus; + end else + Log.Lines.Add('Nothing reports is available or information restricted.'); + end; +end; + +procedure TMainForm.Clear1Click(Sender: TObject); +begin + Log.Clear; +end; + +procedure TMainForm.ReportsTreeChange(Sender: TObject; Node: TTreeNode); +var + i: Integer; +begin + i := Integer(Node.Data); + if i <> -1 then + Description.Text := ReportsList[i + 2] + else + Description.Text := Node.Text; + ShowBtn.Enabled := i <> -1; + ExportBtn.Enabled := ShowBtn.Enabled; + TestBtn.Enabled := ShowBtn.Enabled; +end; + +procedure TMainForm.ReportsTreeCustomDrawItem(Sender: TCustomTreeView; + Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Node.Count <> 0 then + ReportsTree.Canvas.Font.Style := [fsBold]; +end; + +procedure TMainForm.ExportBtnClick(Sender: TObject); +var + t: Cardinal; + tf: Double; + i: Integer; +begin + frxServerConnection1.Host := Host.Text; + frxServerConnection1.Port := StrToInt(Port.Text); + frxServerConnection1.Login := Login.Text; + frxServerConnection1.Password := Password.Text; + if (Length(ProxyHost.Text) > 0) then + begin + frxServerConnection1.ProxyHost := ProxyHost.Text; + frxServerConnection1.ProxyPort := StrToInt(ProxyPort.Text); + end; + i := Integer(ReportsTree.Selected.Data); + if i <> -1 then + begin + frxReportClient1.LoadFromFile(ReportsList[i + 1]); + t := GetTickCount; + if frxReportClient1.PrepareReport then + begin + tf := (GetTickCount - t) / 1000; + Log.Lines.Add(frxReportClient1.ReportName + + ' Time=' + FloatToStr(tf) + ' Size=' + IntToStr(frxReportClient1.Client.StreamSize)); + frxReportClient1.Export(frxPDFExport1); + end; + Log.Lines.AddStrings(frxReportClient1.Errors); + end; +end; + +{ TfrxClientTestThread } + +constructor TfrxClientTestThread.Create(C: TfrxServerConnection; RepName: String; + Id: Integer; Rep: Integer; L: TMemo); +begin + inherited Create(True); + ErrorsCount := 0; + ThreadId := Id; + CountRep := Rep; + FConnection := C; + FRepName := RepName; + Log := L; + Done := False; + Resume; +end; + +procedure TfrxClientTestThread.Execute; +var + i: Integer; +begin + Done := False; + Report := TfrxReportClient.Create(nil); + Report.EngineOptions.EnableThreadSafe := True; + Report.ShowProgress := False; + Report.EngineOptions.SilentMode := True; + Report.Connection := FConnection; + Report.ReportName := FRepName; + i := 0; + while (i < CountRep) and (not Terminated) do + begin + Report.Clear; + Report.PrepareReport; + Synchronize(AppendLog); + ErrorsCount := ErrorsCount + Report.Errors.Count; + Inc(i); + end; + Synchronize(FinishLog); + Report.Free; + Done := True; +end; + +procedure TfrxClientTestThread.AppendLog; +begin + if Assigned(Log) and (Report.Errors.Count > 0) then + begin + Log.Lines.Add('Thread#' + IntToStr(ThreadID)); + Log.Lines.AddStrings(Report.Errors); + end; +end; + +procedure TfrxClientTestThread.FinishLog; +begin + if Assigned(Log) and (not Terminated) then + Log.Lines.Add('Thread#' + IntToStr(ThreadID) + ' finished. Errors:' + IntToStr(ErrorsCount)); +end; + +end. diff --git a/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.dpr b/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.dpr new file mode 100644 index 0000000..330bd0c --- /dev/null +++ b/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.dpr @@ -0,0 +1,14 @@ +program FRClientSimple; + +uses + Forms, + main in 'main.pas' {main}; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'FastReport Simple Client Demo'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.res b/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Client/Simple/FRClientSimple.res differ diff --git a/official/4.2/Demos/ClientServer/Client/Simple/main.dfm b/official/4.2/Demos/ClientServer/Client/Simple/main.dfm new file mode 100644 index 0000000..eb38516 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Client/Simple/main.dfm differ diff --git a/official/4.2/Demos/ClientServer/Client/Simple/main.pas b/official/4.2/Demos/ClientServer/Client/Simple/main.pas new file mode 100644 index 0000000..14cbfd2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Client/Simple/main.pas @@ -0,0 +1,124 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport simple client demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit main; + +{$I frx.inc} + +interface + +uses + Windows, SysUtils, Classes, Controls, Forms, + Dialogs, StdCtrls, ShellApi, frxClass, frxServerClient, + frxGZip, frxDCtrl, frxChBox, frxCross, frxRich, frxChart, + frxOLE, frxBarcode, ExtCtrls, frxExportPDF, frxExportImage, + frxExportRTF, frxExportXML, frxExportXLS, frxExportHTML, + frxExportTXT, frxGradient, Graphics +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TMainForm = class(TForm) + frxServerConnection1: TfrxServerConnection; + frxReportClient1: TfrxReportClient; + Memo1: TMemo; + Label3: TLabel; + ShowBtn: TButton; + CloseBtn: TButton; + Label4: TLabel; + Label5: TLabel; + Port: TEdit; + frxBarCodeObject1: TfrxBarCodeObject; + frxOLEObject1: TfrxOLEObject; + frxChartObject1: TfrxChartObject; + frxRichObject1: TfrxRichObject; + frxCrossObject1: TfrxCrossObject; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxDialogControls1: TfrxDialogControls; + Label7: TLabel; + Login: TEdit; + Label8: TLabel; + Password: TEdit; + Label9: TLabel; + Label10: TLabel; + Label11: TLabel; + Image1: TImage; + Panel1: TPanel; + frxHTMLExport1: TfrxHTMLExport; + frxXLSExport1: TfrxXLSExport; + frxRTFExport1: TfrxRTFExport; + frxPDFExport1: TfrxPDFExport; + Label14: TLabel; + Label15: TLabel; + Panel2: TPanel; + Host: TEdit; + Label1: TLabel; + RepName: TEdit; + Label2: TLabel; + Label6: TLabel; + Param1: TEdit; + Param1Value: TEdit; + Label12: TLabel; + Label13: TLabel; + Param2: TEdit; + Param2Value: TEdit; + procedure CloseBtnClick(Sender: TObject); + procedure ShowBtnClick(Sender: TObject); + procedure Label11Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +{$IFDEF Delphi7} +uses XPMan; +{$ENDIF} + +procedure TMainForm.CloseBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.ShowBtnClick(Sender: TObject); +begin + frxServerConnection1.Host := Host.Text; + frxServerConnection1.Port := StrToInt(Port.Text); + frxServerConnection1.Login := Login.Text; + frxServerConnection1.Password := Password.Text; + frxReportClient1.LoadFromFile(RepName.Text); + frxReportClient1.Variables.Clear; + if Length(Param1Value.Text) > 0 then + frxReportClient1.Variables[Param1.Text] := Param1Value.Text; + if Length(Param2Value.Text) > 0 then + frxReportClient1.Variables[Param2.Text] := Param2Value.Text; + if frxReportClient1.PrepareReport then + frxReportClient1.ShowPreparedReport; + Memo1.Lines.AddStrings(frxReportClient1.Errors); +end; + +procedure TMainForm.Label11Click(Sender: TObject); +begin + ShellExecute(GetDesktopWindow, 'open', PChar(Label11.Caption), nil, nil, SW_SHOW); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Label14.Caption := #174; + Label15.Caption := #169 + label15.Caption; +end; + +end. diff --git a/official/4.2/Demos/ClientServer/Server/FRServer.dpr b/official/4.2/Demos/ClientServer/Server/FRServer.dpr new file mode 100644 index 0000000..70a5bea --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/FRServer.dpr @@ -0,0 +1,15 @@ +program FRServer; + +uses + Windows, + Forms, + Main in 'Main.pas' {main}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'FastReport Server Demo'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/4.2/Demos/ClientServer/Server/FRServer.res b/official/4.2/Demos/ClientServer/Server/FRServer.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/FRServer.res differ diff --git a/official/4.2/Demos/ClientServer/Server/Main.dfm b/official/4.2/Demos/ClientServer/Server/Main.dfm new file mode 100644 index 0000000..7386c32 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/Main.dfm differ diff --git a/official/4.2/Demos/ClientServer/Server/Main.pas b/official/4.2/Demos/ClientServer/Server/Main.pas new file mode 100644 index 0000000..e7c0ae6 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/Main.pas @@ -0,0 +1,280 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport Server demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit Main; + +{$I frx.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + StdCtrls, Db, DBTables, frxDesgn, frxClass, frxDCtrl, + frxChart, frxRich, frxBarcode, ImgList, ComCtrls, ExtCtrls, frxOLE, + frxCross, frxServer, frxGradient, frxChBox, Menus, ShellApi, + frxADOComponents, ADODB, frxGZip, Dialogs, frxMD5, frxServerUtils, IniFiles, + frxServerStat, frxServerConfig; + +type + TMainForm = class(TForm) + frBarCodeObject1: TfrxBarCodeObject; + frRichObject1: TfrxRichObject; + frChartObject1: TfrxChartObject; + frDialogControls1: TfrxDialogControls; + ImageList1: TImageList; + Image1: TImage; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + frOLEObject1: TfrxOLEObject; + frCrossObject1: TfrxCrossObject; + frxCheckBoxObject1: TfrxCheckBoxObject; + PopupMenu1: TPopupMenu; + Close1: TMenuItem; + ShowWin: TMenuItem; + N1: TMenuItem; + MinimizeBtn: TButton; + CloseBtn: TButton; + GroupBox1: TGroupBox; + Label4: TLabel; + LBActive: TLabel; + LBInactive: TLabel; + GroupBox2: TGroupBox; + Label5: TLabel; + ETotalSessions: TEdit; + Label6: TLabel; + ETotalReports: TEdit; + Timer1: TTimer; + Label7: TLabel; + Label8: TLabel; + EMaxReports: TEdit; + EMaxSessions: TEdit; + Label9: TLabel; + Label10: TLabel; + ECurrentReports: TEdit; + ECurrentSessions: TEdit; + Label11: TLabel; + EErrors: TEdit; + N2: TMenuItem; + Start1: TMenuItem; + Stop1: TMenuItem; + StartBtn: TButton; + StopBtn: TButton; + DesignBtn: TButton; + frxDesigner1: TfrxDesigner; + OpenDialog1: TOpenDialog; + Label12: TLabel; + Uptime: TLabel; + frxADOComponents1: TfrxADOComponents; + Serv: TfrxReportServer; + Label13: TLabel; + DemoDatabase: TADOConnection; + procedure FormCreate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure MinimizeBtnClick(Sender: TObject); + procedure ShutBtnClick(Sender: TObject); + procedure ShowWinClick(Sender: TObject); + procedure StartBtnClick(Sender: TObject); + procedure StopBtnClick(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure DesignBtnClick(Sender: TObject); + procedure Label3Click(Sender: TObject); + protected + procedure ControlWindow(var Msg:TMessage); message WM_SYSCOMMAND; + procedure IconMouse(var Msg : TMessage); message WM_USER + 1; + private + Icon: TIcon; + frReport1: TfrxReport; + procedure TrayIcon(n: Integer; Icon: TIcon); + end; + +var + MainForm: TMainForm; + dbMd: String; + +implementation + +{$R *.DFM} + +{$IFDEF Delphi7} +uses XPMan; +{$ENDIF} + +var + DATABASE_FILE: String; + DBConnStr: String = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='; + +procedure TMainForm.TrayIcon(n:Integer;Icon:TIcon); +var + Nim: TNotifyIconData; +begin + with Nim do + begin + cbSize:=SizeOf(Nim); + Wnd:=Self.Handle; + uID:=1; + uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; + hicon:=Icon.Handle; + uCallbackMessage:=WM_USER + 1; + szTip:='FastReport Server'; + end; + case n of + 1: Shell_NotifyIcon(Nim_Add,@Nim); + 2: Shell_NotifyIcon(Nim_Delete,@Nim); + 3: Shell_NotifyIcon(Nim_Modify,@Nim); + end; +end; + +procedure TMainForm.ControlWindow(var Msg: TMessage); +begin + if Msg.WParam = SC_MINIMIZE then + begin + TrayIcon(1, Icon); + ShowWindow(Application.Handle, SW_HIDE); + ShowWindow(Handle, SW_HIDE); + end else + inherited; +end; + +procedure TMainForm.IconMouse(var Msg: TMessage); +var + p:tpoint; +begin + GetCursorPos(p); + case Msg.LParam of + WM_LBUTTONUP, WM_LBUTTONDBLCLK: + ShowWinClick(nil); + WM_RBUTTONUP: + begin + SetForegroundWindow(Handle); + PopupMenu1.Popup(p.X, p.Y); + PostMessage(Handle,WM_NULL,0,0) + end; + End; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Label13.Caption := #174; + Icon := TIcon.Create; + ImageList1.GetIcon(0, Icon); + DemoDatabase.ConnectionString := DBConnStr + frxGetAbsPath(ServerConfig.GetValue('server.database.pathtodatabase')); + try + DemoDatabase.Open; + except + ShowMessage('Error database connection!'); + end; + StartBtnClick(Sender); + MinimizeBtnClick(Sender); +end; + +procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if Serv <> nil then + StopBtnClick(Sender); + TrayIcon(2, Icon); + Icon.Free; + if DemoDatabase.Connected then + DemoDatabase.Close; +end; + +procedure TMainForm.MinimizeBtnClick(Sender: TObject); +begin + PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0); +end; + +procedure TMainForm.ShutBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.ShowWinClick(Sender: TObject); +begin + ShowWindow(Application.Handle, SW_SHOWNORMAL); + ShowWindow(Handle, SW_SHOWNORMAL); +end; + +procedure TMainForm.StartBtnClick(Sender: TObject); +begin + if DemoDatabase.Connected then + begin + Screen.Cursor := crHourGlass; + try + Serv.Open; + if Serv.Active then + begin + StartBtn.Enabled := False; + StopBtn.Enabled := True; + LBActive.Visible := True; + LBInactive.Visible := False; + Timer1.Enabled := True; + ImageList1.GetIcon(0, Icon); + TrayIcon(3, Icon); + Start1.Enabled := False; + Stop1.Enabled := True; + end; + finally + Screen.Cursor := crDefault; + end; + end; +end; + +procedure TMainForm.StopBtnClick(Sender: TObject); +begin + Screen.Cursor := crHourGlass; + try + Timer1.Enabled := False; + Serv.Close; + StartBtn.Enabled := True; + StopBtn.Enabled := False; + LBActive.Visible := False; + LBInactive.Visible := True; + ImageList1.GetIcon(1, Icon); + TrayIcon(3, Icon); + Start1.Enabled := True; + Stop1.Enabled := False; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Timer1Timer(Sender: TObject); +begin + ETotalSessions.Text := IntToStr(ServerStatistic.TotalSessionsCount); + ETotalReports.Text := IntToStr(ServerStatistic.TotalReportsCount); + EMaxSessions.Text := IntToStr(ServerStatistic.MaxSessionsCount); + EMaxReports.Text := IntToStr(ServerStatistic.MaxReportsCount); + EErrors.Text := IntToStr(ServerStatistic.TotalErrors); + ECurrentSessions.Text := IntToStr(ServerStatistic.CurrentSessionsCount); + ECurrentReports.Text := IntToStr(ServerStatistic.CurrentReportsCount); + Uptime.Caption := ServerStatistic.FormatUpTime; + Label2.Caption := 'Version: ' + Serv.Variables.GetValue('SERVER_SOFTWARE'); +end; + +procedure TMainForm.DesignBtnClick(Sender: TObject); +begin + OpenDialog1.InitialDir := Serv.Configuration.ReportPath; + if OpenDialog1.Execute then + begin + frReport1 := TfrxReport.Create(nil); + frReport1.LoadFromFile(OpenDialog1.FileName); + frReport1.Variables['PathToDataBase'] := '''' + DATABASE_FILE + ''''; + frReport1.DesignReport; + frReport1.Free; + end; +end; + +procedure TMainForm.Label3Click(Sender: TObject); +begin + ShellExecute(GetDesktopWindow, 'open', PChar(Label3.Caption), nil, nil, SW_SHOW); +end; + +end. diff --git a/official/4.2/Demos/ClientServer/Server/allow.conf b/official/4.2/Demos/ClientServer/Server/allow.conf new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/config.xml b/official/4.2/Demos/ClientServer/Server/config.xml new file mode 100644 index 0000000..9854e41 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/config.xml @@ -0,0 +1,156 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/config_demo.xml b/official/4.2/Demos/ClientServer/Server/config_demo.xml new file mode 100644 index 0000000..4062b51 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/config_demo.xml @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/deny.conf b/official/4.2/Demos/ClientServer/Server/deny.conf new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/about.html b/official/4.2/Demos/ClientServer/Server/htdocs/about.html new file mode 100644 index 0000000..e697743 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/about.html @@ -0,0 +1,35 @@ + || Short description + +Back to main page
 +
+Short description
+

1. Introduction

+

+FastReport server provides many features for server side reporting in +internet/intranet networks. FastReport 3 is the kernel of the +reporting engine. Fast and poweful server engine use +Hypertext Transfer Protocol (HTTP, RFC 2068). The FastReport Server +completely autonomous and does not require using other HTTP server (Apache, IIS etc). +Detailed expected features list you will to read here.

+

2. FastReport Server Purpose

+

+

+

+

3. Requirements

+

Operation system: Microsoft Windows NT4/2000/2003 + Server.
+ Network: based on TCP/IP protocol.
+

+

4. Feedback

+

All wishes, bug-reports and opinions send to e-mail.

+
+Back to main page
+ + + + \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/bottom.html b/official/4.2/Demos/ClientServer/Server/htdocs/bottom.html new file mode 100644 index 0000000..ee74d0b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/bottom.html @@ -0,0 +1 @@ +
diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/default.css b/official/4.2/Demos/ClientServer/Server/htdocs/default.css new file mode 100644 index 0000000..586edaf --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/default.css @@ -0,0 +1,131 @@ +.copyright { + font : 8pt Tahoma; +} + +.topcopyright { + font : 8pt Tahoma; + COLOR : #ffffff; +} + +a { + font : 10pt Tahoma; + COLOR : #2b4a7f; + FONT-WEIGHT : bold; + TEXT-DECORATION : none; +} + +a:hover { + font : 10pt Tahoma; + COLOR : #283e66; + FONT-WEIGHT : bold; + TEXT-DECORATION : underline; +} + +.nav { + font : 9pt Tahoma; + COLOR : white; + FONT-WEIGHT : bold; + TEXT-DECORATION : none; +} + +.nav:hover { + font : 9pt Tahoma; + COLOR : black; + FONT-WEIGHT : bold; + TEXT-DECORATION : underline; +} + +.bottomnav { + font : 10pt Tahoma; + COLOR : black; + FONT-WEIGHT : bold; + TEXT-DECORATION : none; +} + +.bottomnav:hover { + font : 10pt Tahoma; + COLOR : black; + FONT-WEIGHT : bold; + TEXT-DECORATION : underline; +} + +.txtbody +{ + font : 10pt Tahoma; + vertical-align: top ; + height:100%; + width :100%; +} + +.right { + font : 9pt Tahoma; + COLOR : black; + FONT-WEIGHT : bold; + padding-left : 8px; + padding-right : 6px; + text-align : center; +} + +.tit { + font : 12pt Tahoma; + COLOR : black; + FONT-WEIGHT : bold; + padding-left : 8px; + padding-right : 6px; + margin-left : 6px; + margin-right : 4px; + height : 20; + background-color : #e2e2e2; +} + + +td.title { + font : 9pt Tahoma; + COLOR : white; + FONT-WEIGHT : bold; + TEXT-DECORATION : none; + text-align : center; + height : 18; + background-color : #2b4a7f; +} + +td.down{ + font : 10pt Tahoma; + } + +th.down{ + font : 10pt Tahoma; + FONT-WEIGHT : bold; + } + + +a.copyright { + font : 8pt Tahoma; + COLOR : black; + TEXT-DECORATION : none; +} + +a.copyright:hover { + font : 8pt Tahoma; + COLOR : black; + TEXT-DECORATION : underline; +} + +PRE{ + font : 10pt Curier; + } + +.pagetitle { + font : 18pt Verdana; + color : #ffffff; + FONT-WEIGHT : bold; + FONT-style: italic; + +} + +.pageheader +{ + background-color : #2b4a7f; + background-repeat: no-repeat; + background-position:top left +} \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Adapting your applications for client-server technology.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Adapting your applications for client-server technology.htm new file mode 100644 index 0000000..1374368 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Adapting your applications for client-server technology.htm @@ -0,0 +1,50 @@ + + + +6. Adapting your applications for client-server technology + + + + + + + + + + + + + + + + + +
+ +6. Adapting your applications for client-server technology + +

When adapting previously developed applications to the client-server technology, use the following recommendations:

- Clearly define the interaction between client and server sides;

- Take into account the recommendations from topics +4.1 and +4.2 of this manual;

- When working with databases, take into account the recommendations from +topic 3.10 of this manual;

- To improve the level information security, take into account the recommendations from +topic 8 of this manual.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/Components of FastReport Enterprise Edition.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/Components of FastReport Enterprise Edition.htm new file mode 100644 index 0000000..e12f5ee --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/Components of FastReport Enterprise Edition.htm @@ -0,0 +1,54 @@ + + + +2. Components of FastReport Enterprise Edition + + + + + + + + + + + + + + +
+ +2. Components of FastReport Enterprise Edition + +

After you install the packages of FastReport 3 Enterprise, a bookmark +"FastReport 3 Client/Server" in component palette IDE Delphi/C++Builder +will be available.

+

+

Components of the "FastReport 3 Client/Server":

+

- TfrxReportServer - a server component, report server and HTTP server in a single whole;

+

- TfrxServerConnection - a client component, which contains information for connections with TfrxReportServer;

+

- TfrxReportClient - client component (a TfrxReport analogue) inquires the report on the server, and then displays the resulting report on client side;

TfrxHTTPClient - client component, intended for requests of the files over HTTP protocol.

+ +
+ +
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxHTTPClient.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxHTTPClient.htm new file mode 100644 index 0000000..bfb45b0 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxHTTPClient.htm @@ -0,0 +1,45 @@ + + + +2.4. TfrxHTTPClient + + + + + + + + + + + + + + +
+ +2.4. TfrxHTTPClient

 TfrxHTTPClient - client component for receiving any file via HTTP protocol.

TfrxHTTPClient class inherited from TComponet

Properties:

Active: Boolean - executes a query if "True" is set;

Host: String - host name or host IP address; "127.0.0.1" by default;

Port: Integer - host port, "80" by default;

ProxyHost: String - HTTP-proxy name or proxy IP address;

ProxyPort: Integer - proxy port;

RetryCount: Integer - retry count, default - 3;

RetryTimeOut: Integer - delay between retry in seconds, default - 5;

TimeOut: Integer - idle time in seconds, default - 30;

ClientFields: TfrxHTTPClientFields - fields the request's header; TfrxHTTPClientFields is described below;

ServerFields: TfrxHTTPServerFields - parsed answer header; TfrxHTTPServerFields is described below;

MIC: Boolean - checking the message's integrity checksum, "True" by default;

Header: TStrings - raw request header; it is filled in automatically from ClientFields;

Answer: TStrings - raw answer header, parsed fields will be stored in ServerFields;

Stream: TMemoryStream - data received from server;

Breaked: Boolean - sign of emergency disconnection;

Errors: TStrings - errors list.

Methods:

procedure Connect - connect to remote server and get the file, after disconnect;

procedure Disconnect - disconnect from server;

procedure Open -same as "Connect";

procedure Close - same as "Disconnect".

TfrxHTTPClientFields class inherited from TPersistent

Properties:

AcceptEncoding: String - accepted compression formats, default - 'gzip';

FileName: String - requested filename;

Host: String - address or client's hostname; fills automatically if empty;

HTTPVer: String - http protocol version, default - 'HTTP/1.1';

Login: String - user name for authentication;

Password: String - password for authentication;

QueryType: TfrxHTTPQueryType - query type, qtGet - GET query, qtPost - POST query; "qtGet" by default;

Referer: String - referencing document name; blank by default;

UserAgent: String - client program name, default - 'FastReport/3.0'.

TfrxHTTPServerFields class inherited from TPersistent

Properties:

AnswerCode: Integer - server response code;

ContentEncoding: String - received data compression format;

ContentMD5: String - MD5 checksum;

ContentLength: Integer - received data length;

Location: String - actual location of the document.

+ +
+ +
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportClient.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportClient.htm new file mode 100644 index 0000000..c785a3e --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportClient.htm @@ -0,0 +1,44 @@ + + + +2.3. TfrxReportClient + + + + + + + + + + + + + + +
+ +2.3. TfrxReportClient

 TfrxReportClient is a client component for query. It receives and shows the reports from the server. Required component: TfrxServerConnection. TfrxReportClient is analogy of TfrxReport in previous versions of the applications based on traditional architecture.

TfrxReportClient class inherited from TfrxReport

Properties:

Connection: TfrxServerConnection - link to object of TfrxServerConnection;

ReportName: String - name of the requested report, use method LoadFromFile for setting this property (see below).

Variables: TfrxVariables - contain report variables; can be used for variables transfer from client to server;

Errors: TStrings - errors list.

Methods:

procedure LoadFromFile(FileName: String) - set the name of the requested report to property ReportName; path to the file is ignored;

function PrepareReport: Boolean - performs connection to the report server, requests a report, transfers report variables to server, and downloads a report result, which then is put to the "PreviewPages" Property. Result of the function is "True" if the task is successfully accomplished, otherwise it becomes "False";

procedure ShowPreparedReport - previews the received report;

procedure ShowReport - requests and previews the report.

+ +
+ +
+ + + + + + + + +
+< previous page +main page + +next page > +
+ + + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportServer.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportServer.htm new file mode 100644 index 0000000..dd58754 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxReportServer.htm @@ -0,0 +1,52 @@ + + + +2.1. TfrxReportServer + + + + + + + + + + + + + + +
+ +2.1. TfrxReportServer + +

 TfrxReportServer component plays the role of +a report server and HTTP server. This component does not require any additional components.

+

TfrxReportServer class inherited from TComponent

+

Properties:

+

Active: Boolean - the value, which indicates activity of the server. +It may be used for starting the server by setting a value in "True";

Configuration: TfrxServerConfig - server configuration (TfrxServerConfig class is described below). Configuration changes become active only after you restart the server;

AllowIP: TStrings - list of authorized IP addresses. The format of the list is as following: one line contains one IP address. In cases when the server does not find a client's address in this list, the client will be forbidden to connect; if the list is empty, all addresses are allowed to connect;

DenyIP: TStrings - list of IP addresses forbidden to connect. The format of the list is as following: one line contains one IP address In cases when the server does not find a client's address in this list, the client will be forbidden to connect; if the list is empty, all addresses are allowed to connect;

PrintPDF: Boolean - pressing the "print" button in navigator's control panel (when viewing the resulting pages in a web browser) creates a PDF file, if this value is set to True. Otherwise, standard print action of the browser will be executed. Default setting is "True";

The following properties are inaccessible in object's inspector, but it is possible to access them from the code:

Statistic: TfrxServerStatistic - server statistics (TfrxServerStatistic is described below);

Totals: TStrings - readable form of server statistics information;

Variables: TfrxServerVariables - internal server variables (TfrxServerVariables is described below).

Methods:

constructor Create(AOwner: TComponent) - creation of an object;

procedure Open - startup of the server. At this moment all changes of configuration would be activated;

procedure Close - server shutdown;

Event handlers:

OnGetReport: TfrxServerGetReportEvent - may be used for loading the reports from any places (BLOB fields, files from any folders etc). Type of the handler:

TfrxServerGetReportEvent = procedure (ReportName: String; Report: TfrxReport) of object;

ReportName - name of the requested report; it may be used for identification of a specific report;

Report - an instance of the TfrxReport object, to which the report should be loaded.

OnGetVariables: TfrxServerGetVariablesEvent - can be used for manual processing of the parameters received from the client, as well as execution of any operations directly on a server.

TfrxServerGetVariablesEvent = procedure(const ReportName: String; Variables: TfrxVariables) of object;

ReportName - The name of the report transferred in query. It can be used for filtering one or another parameter directly in the handler;

Variables - The list of the parameters received from the client. See details about TfrxVariables in +"Programmer's guide FastReport 3" [8].

TfrxServerConfig class inherited from TPersistent

Object of this class contains information about server configuration.

Properties:

Port: Integer - TCP/IP port number for client connection, default value is 80;

IndexFileName: String - default filename, if the filename field in HTTP query is empty. Default value is 'index.html';

SessionTimeOut: Integer - time of storing report results on the server (in seconds). Default value is 300. As soon as the default time expires, the report results will be deleted. It is set depending on specificities of created reports and methods of client-server interaction;

время ожидания активности клиента после его подключения в секундах, по умолчанию равно 60, по истечении этого времени сессия клиента будет удалена;

SocketTimeOut: Integer - timeout of waiting for client's response (in seconds). Default value is 60. When time expires, the session will be terminated.

Logging: Boolean - log writing, "True" - enabled, "False" - disabled, "True" is set by default;

LogPath: String - path to folder with logs; current folder by default;

ReportPath: String - path to folder with reports; current folder by default;

RootPath: String - path to folder with HTML files and reports results;

Login: String - user name for authentication. If line is empty - authentication is not required. Empty line is a default setting;

Password: String - password for authentication, empty line by default;

Compression: Boolean - compression of transferred documents, client support required; "True" by default;

MIC: Boolean - Message Integrity Checksum using MD5 algorithm. "True" by default;

NoCacheHeader: Boolean - document is not cached by client, "True" by default;

OutputFormats: TfrxServerOutputFormats - supported formats for requested reports, one or more from set (sfHTM, sfXML, sfXLS, sfRTF, sfTXT, sfPDF, sfJPG, sfFRP). By default, all elements of set are included;

ReportCaching: Boolean - enable the reports cache on a server (see details in section 3.11);

ReportCachePath: String - path to a folder with reports cache;

DefaultCacheLatency: Integer - reports in cache default storage time (in seconds).

Methods:

procedure LoadFromFile(const FileName: String) - load configuration from a file;

procedure SaveToFile(const FileName: String) - save configuration to a file.

TfrxServerStatistic class inherited from TPersistent

Properties:

CurrentReportsCount: Integer - number of reports currently build;

CurrentSessionsCount: Integer - number of sessions currently connected;

MaxReportsCount: Integer - maximum number of reports simultaneously built;

MaxSessionsCount: Integer - maximum number of sessions simultaneously connected;

TotalErrors: Integer - number of errors;

TotalReportsCount: Integer - number of reports;

TotalSessionsCount: Integer - number of sessions;

UpTimeDays: Integer (days),

UpTimeHours: Integer (hours),

UpTimeMins: Integer (minutes),

UpTimeSecs: Integer (seconds) - up time of the report server.

TfrxServerVariables class inherited from TCollection

Contains server variables.

Used (reserved) names of the variables will describe in the part 3.4.

Methods:

function GetValue(const Name: String): String - returns value of the variable with Name;

procedure AddVariable(const Name: String; const Value: String) - adds a variable with Name and Value.

+ +
+ +
+ + + + + + + + +
+< previous page +main page + +next page > +
+ + + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxServerConnection.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxServerConnection.htm new file mode 100644 index 0000000..95faa6b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/TfrxServerConnection.htm @@ -0,0 +1,46 @@ + + + +2.2. TfrxServerConnection + + + + + + + + + + + + + + +
+ +2.2. TfrxServerConnection + +

 TfrxServerConnection - client component keeps information for connection to report server TfrxReportServer. Object of this class is required for working of one or several TfrxReportClient components.

TfrxServerConnection class inherited from TComponent

Properties:

Host: String - server host name or server IP address, by default - 127.0.0.1;

Port: Integer - server port; "80" by default;

ProxyHost: String - HTTP-proxy name or IP address, blank by default;

ProxyPort: Integer - HTTP-proxy port; "8080" by default;

Login: String - username for authentication;

Password: String - user password for authentication;

Timeout: Integer - idle time (in seconds); "120" by default;

RetryCount: Integer - retry count; "3" by default;

RetryTimeout: Integer - delay between retries in seconds, "3" by default;

Compression: Boolean - accept compressed files; "True" by default;

MIC: Boolean - checking of the message integrity checksum; "True" by default.

+ +
+ +
+ + + + + + + + +
+< previous page +main page + +next page > +
+ + + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Components of FastReport Enterprise Edition/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developers contact information.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developers contact information.htm new file mode 100644 index 0000000..06d62c8 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developers contact information.htm @@ -0,0 +1,49 @@ + + + +10. Developers' contact information + + + + + + + + + + + + + +
+ +10. Developers' contact information + +

If you have any suggestions concerning improvement and development of FastReport Enterprise, please contact us

+ + + + + +
e-mail:

news:

web site:

fediachov@fast-report.com

+

http://fast-report.com/en/support/newsgroups.php

+

http://www.fast-report.com

+ +
+
+ + + + + + + + +
+< previous page + +main page + +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Developing the reports.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Developing the reports.htm new file mode 100644 index 0000000..d4332f4 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Developing the reports.htm @@ -0,0 +1,43 @@ + + + +4. Developing the reports + + + + + + + + + + + + + + +
+ +4. Developing the reports + +

Developing of the FastReport reports was described in the "FastReport 3 - user manual." [9]

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some advices concerning the design of a report.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some advices concerning the design of a report.htm new file mode 100644 index 0000000..99d121d --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some advices concerning the design of a report.htm @@ -0,0 +1,42 @@ + + +4.2. Some advices concerning the design of a report + + + + + + + + + + + + + + +
+ +4.2. Some advices concerning the design of a report + +

Many of the document formats use table-style data representation. For representing of resulting reports, the server uses such formats as HTML, XLS, and RTF.

Table-style documents cannot have intersected cells, while FastReport document can. FastReport uses free-form data layout - there is no "lines", "table cells" like in Word, Excel or other such formats. FastReport export filters for table-style formats (RTF, HTML, and XLS) uses special algorithm to convert intersected cells into table cells and optimally arranges them. In places where FastReport objects intersect with each other, export filter may generate additional table rows and columns. It is necessary for better WYSIWYG, but may result in increased number of rows and columns in a resulting layout, which makes the table layout unusable for further analysis and slows down the export process.

Keep in mind these export limitations when developing a report, if you intend to export your report into such table-style formats. To avoid the objects' intersection, use alignment tools of the FastReport designer. Turn on the "grid align" option.

When creating tables in a report, put the table cells side-by-side, if possible, and avoid cells' intersection. If cells are intersected, the export algorithm would make clipping, and the export result may differ from the original report.

If possible, place objects along the horizontal and vertical guide lines. Use designer's guide lines to do this.

Following these instructions would help your reports to look perfect during exporting to any of the supported formats.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some client-server restrictions.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some client-server restrictions.htm new file mode 100644 index 0000000..e4c1c1a --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/Some client-server restrictions.htm @@ -0,0 +1,43 @@ + + + +4.1. Some client/server restrictions + + + + + + + + + + + + + + +
+ +4.1. Some client/server restrictions + +

When developing reports for client-server application, please remember that:

- you cannot use script event handlers for dialogue forms' controls since dialogue forms are displayed as web forms in the browser;

- you cannot use event handlers of the TfrxReportClient component (for example, OnGetValue, OnUserFunction). All such handlers should be on the server side;

- you cannot use common data access components, such as TfrxDBDataSet (common components cannot be simultaneously used by several reports). Each report should have internal data access components, such as TfrxIBXTable, Query, and so on.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Developing the reports/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side with threads.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side with threads.htm new file mode 100644 index 0000000..f7d088c --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side with threads.htm @@ -0,0 +1,47 @@ + + + +7.1.3. Client side with threads + + + + + + + + + + + + + + + +
+ +7.1.3. Client side with threads + +

You can find all source files of this example in the
"\FastReport 3\Demos\ClientServer\Client\Advanced" folder.

This example shows how you can use the "TfrxReportClient" component in the threads.

Thread class:

TfrxClientTestThread = class (TThread)

protected

procedure Execute; override;

private

CountRep: Integer;

ErrorsCount: Integer;

Log: TMemo;

ThreadID: Integer;

procedure AppendLog;

procedure FinishLog;

public

Report: TfrxReportClient;

constructor Create(C: TfrxServerConnection; RepName: String;

Id: Integer; Rep: Integer; L: TMemo);

destructor Destroy; override;

end;

Constructor of the TfrxClientTestThread class:

constructor TfrxClientTestThread.Create(C: TfrxServerConnection; RepName: String;

Id: Integer; Rep: Integer; L: TMemo);

begin

inherited Create(True);

FreeOnTerminate := False;

ErrorsCount := 0;

ThreadId := Id;

CountRep := Rep;

Log := L;

Report := TfrxReportClient.Create(nil);

Report.EngineOptions.ReportThread := Self;

Report.Connection := C;

Report.ReportName := RepName;

Resume;

end;

+

The method TfrxClientTestThread.Execute sends a request to the CountRep server. All resulting information is displayed in Memo1 by the "AppendLog" and "FinishLog" methods:

procedure TfrxClientTestThread.Execute;

var

i: Integer;

begin

inherited;

for i := 1 to CountRep do

begin

if Terminated then break;

Report.PrepareReport;

if not Terminated then

begin

Synchronize(AppendLog);

ErrorsCount := ErrorsCount + Report.Errors.Count;

end;

end;

Synchronize(FinishLog);

end;

Before starting this program, launch the server application described above (topic 7.1.1.)

On press button "Thread test" execute the code below:

procedure TMainForm.TestBtnClick(Sender: TObject);

var

i, j, k: Integer;

Thread: TfrxClientTestThread;

begin

frxServerConnection1.Host := Host.Text;

frxServerConnection1.Port := StrToInt(Port.Text);

frxServerConnection1.Login := Login.Text;

frxServerConnection1.Password := Password.Text;

frxServerConnection1.Compression := Compression.Checked;

if (Length(ProxyHost.Text) > 0) then

begin

frxServerConnection1.PrxoyHost := ProxyHost.Text;

frxServerConnection1.ProxyPort := StrToInt(ProxyPort.Text);

end;

ClearThreads;

Memo1.Lines.Add('Start test');

j := StrToInt(Threads.Text);

k := StrToInt(Rep.Text);

for i := 1 to j do

begin

Thread := TfrxClientTestThread.Create(frxServerConnection1,

ReportsList[ListBox1.ItemIndex], i, k, Memo1);

ThreadList.Add(Thread);

end;

end;

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side.htm new file mode 100644 index 0000000..b969ba2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Client side.htm @@ -0,0 +1,45 @@ + + + +7.1.2. Client side + + + + + + + + + + + + + + +
+ +7.1.2. Client side +

You can find all source files of this example in the \FastReport3\Demos\ClientServer\Client\Simple folder.

This is an example of using the TfrxReportClient component and transferring report variables to the server.

Before starting this program, launch the server application described above ( +topic 7.1.1.)

Press the "Show Report" button and type "1.fr3" in the "Report Name" field when running this example so that the program would execute the code below:

frxServerConnection1.Host := Host.Text;

frxServerConnection1.Port := StrToInt(Port.Text);

frxServerConnection1.Login := Login.Text;

frxServerConnection1.Password := Password.Text;

frxReportClient1.LoadFromFile(RepName.Text);

if Length(Param1Value.Text) > 0 then

with frxReportClient1.Variables.Add do

begin

Name := Param1.Text;

Value := Param1Value.Text;

end;

if Length(Param2Value.Text) > 0 then

with frxReportClient1.Variables.Add do

begin

Name := Param2.Text;

Value := Param2Value.Text;

end;

if frxReportClient1.PrepareReport then

frxReportClient1.ShowPreparedReport;

Memo1.Lines.AddStrings(frxReportClient1.Errors);

After successful report request, you see the preview of the result.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Example of a simple client-server application.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Example of a simple client-server application.htm new file mode 100644 index 0000000..535ca4b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Example of a simple client-server application.htm @@ -0,0 +1,42 @@ + + +7.1. Example of a simple client-server application + + + + + + + + + + + + + + +
+ +7.1. Example of a simple client-server application + +

For familiarization with methods of using component FastReport Enterprise, see demonstration examples stored in the
"\FastReport 3\Demos\ClientServer" folder.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Server side.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Server side.htm new file mode 100644 index 0000000..5e8e2f1 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/Server side.htm @@ -0,0 +1,46 @@ + + + +7.1.1. Server side + + + + + + + + + + + + + + + +
+ +7.1.1. Server side + +

You can find all source files of this example in the \FastReport 3\Demos\ClientServer\Server folder.

Components used in this demo: server component TfrxReportServer (Serv), database connection component TADOConnection and TfrxADOComponents, along with other add-on FastReport components.

For the convenience of clients, data about configuration of the server is stored in a file, which is editable by the built-in editor.

File server.conf:

[Server]

; TCP/IP port for HTTP server

Port=80

; report session timeout in seconds

SessionTimeOut=600

; client connection timeout in seconds

SocketTimeOut=600

; index page filename

IndexFileName=index.html

; path to folder with logs

LogPath=.\logs\

; enable of log writing

WriteLogs=1

; maximum log files in history

MaxLogFles=5

; maximum log file size

MaxLogSize=1024

; path to folder with the reports (*.fr3)

ReportPath=.\reports\

; public document folder for documents and results

RootPath=.\htdocs\

; disable of the caching document by the web browser

NoCacheHeader=1

; GZIP compression enable

Compression=1

; MD5 message integrity check

MIC=1

; user login

Login=

; user password

Password=

[ReportsCache]

; enable caching of the reports with same params

Enabled=1

; path to chache folder

CachePath=.\cache\

; dafault delay for cache of the report results in seconds

DefaultLatency=300

[ReportsLatency]

; cache delay for the 1.fr3 report in seconds

1.fr3=10

; cache delay for the 1.fr3 report in seconds

2.fr3=20

; add below the any reports for the custom cache delay setup

Fields of the configuration file correspond to fields' names of the "TfrxReportServer.Configuration" property.

The "allow.conf" and "deny.conf" files contain lines with allowed and restricted addresses respectively.

Database file is stored in the "\database" folder.

In the main module, the constants with names of configuration files are defined:

const

CONFIG_FILE = 'server.conf';

ALLOW_FILE = 'allow.conf';

DENY_FILE = 'deny.conf';

After program starts, the database is connected via the MicrosoftJet OLE DB interface.

In variables ConfFile, AllowFile, DenyFile we a store path to configuration files:

AppPath := ExtractFilePath(Application.ExeName);

ConfFile := AppPath + CONFIG_FILE;

AllowFile := AppPath + ALLOW_FILE;

DenyFile := AppPath + DENY_FILE;

Load config files to the Serv component:

Serv.Configuration.LoadFromFile(ConfFile);

Serv.AllowIP.LoadFromFile(AllowFile);

Serv.DenyIP.LoadFromFile(DenyFile);

Execute the server:

Serv.Open;

After all work is done, you are ready to use a powerful report server. Launch the any web browser and type http://127.0.0.1 in address line

You can design reports with the help of the internal FastReport designer:

OpenDialog1.InitialDir := Serv.Configuration.ReportPath;

if OpenDialog1.Execute then

begin

frReport1 := TfrxReport.Create(nil);

frReport1.LoadFromFile(OpenDialog1.FileName);

frReport1.DesignReport;

frReport1.Free;

end;

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/Example of the simple client-server application/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Examples/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/FastReport 3 Enterprise - Client-Server reporting tool.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/FastReport 3 Enterprise - Client-Server reporting tool.htm new file mode 100644 index 0000000..64d7e9a --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/FastReport 3 Enterprise - Client-Server reporting tool.htm @@ -0,0 +1,48 @@ + + + +1. FastReport 3 Enterprise - Client/Server reporting tool + + + + + + + + + + + + + + +
+ +1. FastReport 3 Enterprise - Client/Server reporting tool + + +

The "client-server" technology is based on interaction between a client application (which inquires, analyzes, and displays requested information) and a server application that performs basic work related to various complex calculations.

There are several serious advantages of using client-server technology in your applications:

- low hardware requirements for client PCs;

- reducing of network traffic due to reducing the amount of information transferred between a client's application and a database server;

- simplicity of system management of the existing client-server;

- higher level of information protection.

However, the client-server technology has some considerable disadvantages:

- high hardware requirements for a PC used as a server;

- certain difficulties in development of client-server applications.

When developing FastReport 3 Enterprise, we take into account all major requirements for client-server applications. FastReport 3 Enterprise allows you to:

- run any reports on the server side on client request, without necessity to directly connect the client to the database server;

- manage several client requests simultaneously in separate threads; it minimizes response time of the server;

- since we use HyperText transfer protocol (HTTP, RFC 2068 [2]), you can use different existing applications, such as web-browsers (Internet Explorer, Netscape Navigator, Mozilla, Opera etc), proxy-servers, web-servers (Internet Information Server, Apache etc), together with FastReport 3 Enterprise without any additional requirements;

- use data compression algorithms (GZip, RFC 1952 [6]). This reduces network traffic and increases client-server processing power;

- use of MD5 algorithm for the MIC (Message Integrity Checksum, RFC 1321 [4], RFC 1864 [5]) increases data integrity;

- compatibility with FastReport 3 report files (with some restrictions) allows you to easily redesign your application to use client-server technology;

- standalone server application (without necessity to apply IIS, Apache or other web-server technologies) has a high processing power, short response time, and economical use of system resources (in comparison with solutions based on CGI technology);

- you can use the server as a simple HTTP server for storing and displaying any HTML documents;

- application of the Server Side Include (SSI) technology allows you to use the server as an engine for your web-site;

- managing the connection logs, error logs, and/or any additional system information allows you to keep record of the work, quickly track down the bugs and unauthorized access attempts;

- usage of authentications and "allow/deny" IP lists allows you to restrict access to the server;

- you can use several database connections in one report simultaneously;

- you can use FastReport client components for interaction between a client application and the server. You can use any web-browser as well;

- your reports may have a dialogue forms that will be used for entering some values before running a report;

- supported formats of the prepared reports are: HTML, PDF, RTF, XML, XLS, JPEG, and Text;

- you can use several modes of displaying the prepared report in your web-browser: single-page document, page-separated with page navigator.

+ + +
+ +
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Important security issues.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Important security issues.htm new file mode 100644 index 0000000..6ed0e48 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Important security issues.htm @@ -0,0 +1,45 @@ + + + +8. Important security issues + + + + + + + + + + + + + + +
+ +8. Important security issues + +

1. When using a report server on Microsoft Windows platform over the Internet, it is recommended to use a firewall between server and internet network.

2. It is obligatory to use the authentication of the client program +(section 3.8).

3. Use the "allow/deny IP" function in local network +(section 3.9).

4. If you have any gateways to Internet in local network, then include IP addresses of these gateways to the "deny" list of the report server (section 3.9).

5. Do not pass parameters to database connection from client if you use reports with internal database components.

6. In reports folder, store only those reports, which you use in your application.

7. Do not store any private documents in the HTTP root folder.

9. If you find any bugs in security system of the FastReport Enterprise, send a note to the developers of the product.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Introduction.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Introduction.htm new file mode 100644 index 0000000..b6734f3 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Introduction.htm @@ -0,0 +1,64 @@ + + + +Introduction + + + + + + + + + + + + + + +
+Introduction + +

This programming guide contains information about FastReport library's extension. +This extension allows to build reports on client-server technology with using of +standard FastReport 3 components and additional components +(that are intended for organization of interaction between client and server).

+

FastReport 3 is a highly productive report generator with unique capabilities. +Read detailed description of FastReport at +"FastReport 3 - developer's guide" [7], +"FastReport 3 - programmer's guide" [8] +, "FastReport 3 - user's guide" [9].

+

+

This guide describes the structure of client components and server components, +their properties and methods, as well as architecture of a report server and +the principles of its functioning. Furthermore, it gives recommendations concerning +optimization and usage of new capabilities in already existing applications and +those developed anew.

+

The experienced FastReport users will be interested in recommendations +about increasing server components' speed, optimization of reports for their +correct export to various tabular formats, application of rules of information +safety for application protection from non-authorized access.

+

We have been constantly improving the FastReport 3 Enterprise components. +That is why there is a probability that some capabilities are not mentioned +in this manual. Descriptions of all changes will be necessarily included to +the next version of this manual.

 +
+
+ +
+ + + + + + + + +
  + +next page > +
+ + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/References.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/References.htm new file mode 100644 index 0000000..b8b254d --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/References.htm @@ -0,0 +1,43 @@ + + + +9. References + + + + + + + + + + + + + + +
+ +9. References + +

1. Braden, R., "Requirements for Internet hosts - application and support", STD 3, RFC 1123, IETF, October 1989.

2. Berners-Lee, T., Fielding, R., and H. Frystyk, "Hypertext Transfer Protocol - HTTP/1.1" RFC 2068, January 1997.

3. Franks, J., Hallam-Baker, P., Hostetler, J., Leach, P., Luotonen, A., Sink, E., and L. Stewart, "An Extension to HTTP: Digest Access Authentication", RFC 2069, January 1997.

4. Rivest, R., "The MD5 Message-Digest Algorithm", RFC 1321, April 1992.

5. Meyers, J., and M. Rose "The Content-MD5 Header Field", RFC 1864, Carnegie Mellon, Dover Beach Consulting, October, 1995.

6. Deutsch, P., "GZIP file format specification version 4.3." RFC 1952, Aladdin Enterprises, May 1996.

7. Tzyganenko, A., "FastReport 3 - Developer manual." Fast Reports Inc., September 2004.

http://www.fast-report.com/pbc_download/DeveloperManual-en.pdf

8. Tzyganenko, A., "FastReport 3 - Programmer manual." Fast Reports Inc., September 2004.

http://www.fast-report.com/pbc_download/ProgrammerManual-en.pdf

9. Tzyganenko, A., "FastReport 3 - User manual." Fast Reports Inc., September 2004.

http://www.fast-report.com/pbc_download/UserManual-en.pdf

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Other clients.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Other clients.htm new file mode 100644 index 0000000..f852f10 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Other clients.htm @@ -0,0 +1,43 @@ + + + +5.2. Other clients + + + + + + + + + + + + + + +
+ +5.2. Other clients + +

The FastReport server gives you wide opportunities of choosing the client program due to using standard HTTP protocol. You can use any HTTP-compatible client such as

web-browser that supports JavaScript, tables, and frames.

When using dialogue forms in your reports, the server will convert them to web-forms and pass them to a client. Client should fill in the form and return it to the server.

This is how the dialogue form looks when running a report in a simple (non-client-server) application:

The same form appears in the Mozilla web-browser, when running a report in the client-server application.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Report client.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Report client.htm new file mode 100644 index 0000000..826d4fa --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/Report client.htm @@ -0,0 +1,43 @@ + + + +5. Report client + + + + + + + + + + + + + + +
+ +5. Report client + +

There are two kinds of clients of the FastReport server:

- applications that use TfrxReportClient component;

- any stand-alone HTTP-clients, such as web-browsers.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/TfrxReportClient-based report client.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/TfrxReportClient-based report client.htm new file mode 100644 index 0000000..864575b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/TfrxReportClient-based report client.htm @@ -0,0 +1,41 @@ + + + +5.1. TfrxReportClient-based report client + + + + + + + + + + + + +
+ +5.1. TfrxReportClient-based report client + +

TfrxReportClient component is designed specially for client applications. This component allows querying a report from the server, passing some report parameters (variables) to the server. It receives prepared report in the FP3 format (native FastReport format). The prepared report can be displayed and printed on the client side. You can also export the prepared report to any of the supported formats, using export filter components. In most cases, this solution is optimal for client applications. Clients that use the TfrxReportClient component make low network traffic and use less server system resources.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/Report client/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Access restriction by IP address.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Access restriction by IP address.htm new file mode 100644 index 0000000..6b055de --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Access restriction by IP address.htm @@ -0,0 +1,62 @@ + + + +3.9. Access restriction by IP address + + + + + + + + + + + + + + + +
+ +3.9. Access restriction by IP address + +

The Server supports the restriction by client IP address.

+

Property TfrxReportServer.DenyIP can contain list of the restricted client IPs'.

+

Property TfrxReportServer.AllowIP can contain list of the allowed client IPs'.Each list must contain one IP address in one line.Here is an example of such list:

+

192.168.0.10

192.168.0.12

+

192.168.0.54

+

If the "DenyIP" and "AllowIP" lists are empty, then all clients are allowed to connect to the server.

+

If the "DenyIP" list is empty, while the "AllowIP" list contains an IP address, then only one client with this IP address can connect to the server.

+

If the IP address of a connected client is not included in the "DenyIP" list, then the server checks if this address is included in the "AllowIP" list.

+

IP addresses' masks are not supported.

+

Examples:

+

1. Only local host can connect to the server:

+

AllowIP:

+

127.0.0.1

+

DenyIP is empty.

2. IP addresses 192.168.0.2 - 192.168.0.6 can connect to the server.

+

AllowIP:

192.168.0.2

+

192.168.0.3

192.168.0.4

192.168.0.5

192.168.0.6

DenyIP is empty.

2. IP addresses from range 192.168.0.8 - 192.168.0.10 cannot be connected to the server.

AllowP is empty.

DenyIP:

192.168.0.8

192.168.0.9

192.168.0.10

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Authentication.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Authentication.htm new file mode 100644 index 0000000..36f2158 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Authentication.htm @@ -0,0 +1,44 @@ + + + +3.8. Authentication + + + + + + + + + + + + + + +
+ +3.8. Authentication + +

The server supports basic HTTP authentication. To activate authentication, set property TfrxReportServer.Configuration.Login and TfrxReportServer.Configuration.Password. If you set this properties, then request header must contain authentication info (RFC 2068 [2]). If client receives answer from server with 401 "Unauthorized" error coded, then the client must retry sending the query with correct authentication data. At that, web browser simply shows dialog window with login and password request:

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Database connections.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Database connections.htm new file mode 100644 index 0000000..8c9da5a --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Database connections.htm @@ -0,0 +1,44 @@ + + + +3.10. Database connections + + + + + + + + + + + + + + +
+ +3.10. Database connections + +

Most of reports use data from databases. To connect to a database, you should:

- specify the database connection component (for example, TADOConnection) in one of your application forms;

- use internal data access components (such as TfrxADOTable, TfrxADOQuery) in your report. To connect to the database, these components should use the application connection.

In this case, a report will be thread-safe, using single connection to the database. In case some data access components do not support simultaneous work with database through a single connection, you should use the way described below.

The other way is to use the database connection component (such as TfrxADODatabase) in each report. In this case, you will be able to connect to different databases at one time. We do not recommend this way if you do not need this functionality because each time when report starts, it will attempt to connect to the database (in some DB servers the connection may take a long time).

Read the "FastReport 3 - User manual" [9] to learn more about creating reports with internal data access components (page 134).

It is not recommended to use BDE to connect to a database. BDE has a great amount of problems when working with several threads.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Increasing servers processing power.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Increasing servers processing power.htm new file mode 100644 index 0000000..f84f1e2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Increasing servers processing power.htm @@ -0,0 +1,44 @@ + + + +3.12. Increasing server's processing power + + + + + + + + + + + + + + +
+ +3.12. Increasing server's processing power + +

Use the following recommendations to increase the report server performance:

- do not use compression component (TfrxGZipCompressor). It considerably slows down the server;

- optimize your SQL queries. In some cases running the SQL query may take a longer time than the report execution;

- do not use high-resolution bitmaps in your reports - it will increase the report execution time and network traffic;

- do not use complex scripts in your reports;

- use TfrxReportClient component in your client application. It works with FP3 native format and allows reducing the server response time (server does not perform the export to HTML or other formats) and the network traffic.

- when developing a report, keep in mind recommendations from 4.2;

- turn off the checksum, TfrxReportServer.Configuration.MIC := False;

- increase the memory size, use the faster CPU on PC used as a report server.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal architecture.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal architecture.htm new file mode 100644 index 0000000..22e7d47 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal architecture.htm @@ -0,0 +1,106 @@ + + + +3.1. Internal architecture + + + + + + + + + + + + + + +
+ +3.1. Internal architecture + +

The scheme displays the server's internal structure:

+

+

The sessions with unique identifier are created when a request from client comes. +The line of the request is analyzed. If the requested file exists, then the server sends +a positive response with the file to the client. Logs are updated with new record about this event. +If the request contains the report query, then a special report session is created. +After the report is built, the result is saved to folder with session number as a name. +The server responses to the client, and reports a new file location. +The client sends a new request to the new file location, and receives the file with the result. +Session with the resulting file is stored by server until session time expires.

+

Below is a step-by-step graphical overview of the report query transaction with the web browser:

 + +

- client sends query; the report's title is "1.fr3"

+

+

- the server creates a new FastReport instance and delivers parameters of the request

+

+

- FastReport prepares the report and exports results to a html file into the folder, the name of the folder is the same as the session's number

+

+

- server waits for the results from FastReport

+

+

- client receives redirection to the location of the resulting file

+

+

- client sends a new query with the request of results file

+

+

- server delivers the resulting file to the client

+

+

Step-by-step graphical overview of the report query transaction with the FastReport (TfrxReportClient):

 +

- a client wants to show report "1.fr3":

+

+

- client component sends a query with the name of report "1.fr3" (native result format)

+

+

...

+

- FastReport prepares the report and saves the results to a native fp3; the name of the folder is the same as the session's number

+

+

- server waits for the results from FastReport

+

+

- client receives redirection to the location of the resulting file

+

+

...

+

- server sends the result file to the client

+

+

- client displays the report

+

+

If the inquired report contains any forms, the process becomes more complicated:

 +

- client client component sends a query with the name of report "1.fr3"

+

+

- the server creates a new FastReport instance and transfers parameters of the request

+

+

- FastReport prepares report and saves the web-form into the folder name according to the session number

+

+

- server wait the results from FastReport

+

+

- server redirects the client to the web-form file

+

+

- client receives the web-form, while FastReport waits

+

+

- client sends of the web-form dialog controls states to the server

+

+

- the server transfers the values of the control elements to the server

+

+

- server delivers the received information to FastReport

+

+

Format of the server request line, logging, authentication and other issues concerning server's functioning, are described below.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal server variables.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal server variables.htm new file mode 100644 index 0000000..519b447 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Internal server variables.htm @@ -0,0 +1,44 @@ + + + +3.5. Internal server variables + + + + + + + + + + + + + + +
+ +3.5. Internal server variables + +

During server's working, the "TfrxReportServer.Variables" property contains the following automatically created and updated variables:

SERVER_NAME - server name;

SERVER_COPYRIGHT - copyright;

SERVER_SOFTWARE - server version;

SERVER_LAST_UPDATE -last update date;

SERVER_UPTIME - up time of the server;

SERVER_TOTAL_SESSIONS - sum total of sessions;

SERVER_TOTAL_REPORTS - sum total of reports;

SERVER_TOTAL_ERRORS - sum total of errors;

SERVER_MAX_SESSIONS - maximal number of simultaneous sessions;

SERVER_MAX_REPORTS - maximal number of simultaneous report generations.

Example of getting a variable SERVER_TOTAL_REPORTS:

Totals := frRepotServer1.Variables.GetValue('SERVER_TOTAL_REPORTS');

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Logs.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Logs.htm new file mode 100644 index 0000000..9108d69 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Logs.htm @@ -0,0 +1,47 @@ + + + +3.7. Logs + + + + + + + + + + + + + + + +
+ +3.7. Logs + +

If the TfrxReportServer.Configuration.Logging property setting is "True," then the server writes logs to folder described in the "TfrxReportServer.Configuration.LogPath" property.

The server supports 5 logs:
- log of the accessed clients "access.log" - contains information about date, time, session id, IP and query line. Log fragment:

10/26/2004 23:56:19 sid_f1672494035    192.168.0.2  result?report=3.fr3:

10/26/2004 23:56:23 sid_f1340767011    192.168.0.2  sid_f1672494035/index.html:

10/26/2004 23:56:23 sid_f1949776310    192.168.0.2  sid_f1672494035/index.nav.html:

10/26/2004 23:56:23 sid_f1150188690    192.168.0.2  sid_f1672494035/index.1.html

- log of the connected program type "agent.log", contains information about date, time, IP, and program name. Log fragment:

10/26/2004 23:56:19 192.168.0.2 Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)

10/26/2004 23:56:23 192.168.0.2 Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)

10/26/2004 23:56:23 192.168.0.2 Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)

- log of the referencing URLs "referer.log", contains information about date, time, IP and referencing URL. Log fragment:

10/26/2004 23:56:19 192.168.0.2  http://192.168.0.1/

10/26/2004 23:56:23 192.168.0.2  http://192.168.0.1/

10/26/2004 23:56:23 192.168.0.2  http://192.168.0.1/sid_f1672494035/index.html

- errors log "error.log", contains information about errors:

10/25/2004 13:30:52 192.168.0.2  588864044016/index.1.html document not found

10/26/2004 0:03:11  192.168.0.2  Software caused connection abort.(10053)

10/26/2004 0:43:42  192.168.0.2  Connection reset by peer.(10054)

- server log "server.log", contains summary server information:

10/25/2004 19:38:15 Started

10/25/2004 19:38:15 HTTP server created

10/25/2004 19:58:57 HTTP server closed

10/25/2004 19:58:57 Stopped

Uptime: 0 days 0 hours 20 minutes 42 seconds

Total sessions: 654

Total reports: 327

Total errors: 0

Max sessions: 84

Max reports: 42

Do not forget to archive the log files.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Query syntax.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Query syntax.htm new file mode 100644 index 0000000..d154786 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Query syntax.htm @@ -0,0 +1,77 @@ + + + +3.3. Query syntax + + + + + + + + + + + + + + +
+ +3.3. Query syntax + +

When using an ordinary web-browser as a client, +you can use parameters of the query line:

report=name

+

name - name of the report available on server

Example: /report=1.fr3 + (query report 1.fr3, resulting format - HTML).

+

format=name

+

name - format of the required file, available formats: HTM (HTML), +XML (xml table), XLS (Excel table), RTF (rich-text document), +TXT (text file), PDF(Adobe Acrobat file), JPG (jpeg image), +FRP (internal FastReport prepared report format).

+

By default format is HTM (HTML).

Example: /report=1.fr3&format=TXT +(query report 1.fr3, resulting format - text file).

+

pagerange=value

+

value - result page range (for FRP this option is inaccessible).

+

Example of the page range: 1,3,5-12.

+Example of the query line: /report=3.fr3&pagerange=20-25 +(query report 3.fr3, pages from 20 to 25, resulting format - HTML).

+

multipage=param

+

Only for HTM format. If param value is "1", then the resulting report +will be presented as several pages (one file on each page). +If param set as "0", then a single resulting page will be +generated that will contain all report pages. +Default parameter value setting is "1".

+

Example: /report=3.fr3&multipage=0 +(query report 3.fr3, resulting format - HTML, +all pages on one HTML page).

+

pagenav=param

+

Only for HTM format. To enable page navigator, set param value as "1". +If param value is "0", then page navigator is off. +For correct page displaying, use web-browser +with javascript and frames support. Default setting of this parameter is "1".

+

Example: /report=9.fr3&multipage=0&pagenav=0 +(query report 9.fr3, resulting format - HTML, +all result pages on one HTML page, page navigator is off).

+ + +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Supported formats of the report results.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Supported formats of the report results.htm new file mode 100644 index 0000000..226dba5 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Supported formats of the report results.htm @@ -0,0 +1,46 @@ + + + +3.2. Supported formats of the report results + + + + + + + + + + + + + + +
+ +3.2. Supported formats of the report results + +

FR3 is a native FastReport 3 format. It is represented as a XML document. FR3 is used during transaction between TfrxReportServer and TfrxReportClient. This format is the most appropriate one for document printing. In most cases, use of this format reduces both transaction time and size of the transferred files (except reports containing high quality images).

It is undesirable to use additional compression components (TfrxGZipCompressor) on server side, since it reduces overall server performance, especially when the traffic compression option is activated (TfrxReportServer.Configuration.Compression := True; TfrxReportClient.Connection.Compression := True).

HTML format used by most web-sites in the Internet network is intended for previewing document in low resolution. It is quite difficult to perform high-quality printing of document using this format. HTML format is convenient for most web-browsers. If you use a web-browser as a client, then this format is appropriate for you (see details in topic 5.2). +FastReport server creates web pages with a report navigator, with the help of which you can scroll the pages.

+

PDF format by Adobe is designed specially for documents intended for printing.

FastReport makes high-quality export to this format. For viewing and printing PDF documents, you should install Adobe Acrobat Reader program on your computer.

If property "TfrxReportServer.PrintPDF := True" is set, then, during previewing HTML pages with report results, a file in this format is generated (by pressing the "Print" button on report navigator panel).

The Server also supports the following formats:

- RTF format. A RichText document can be opened in most text processors;

- XLS and XML. These are the Excel spreadsheets formats;

- text file (required for dot-matrix printing);

- graphic file jpeg.

The set of the formats allowed to use in queries is configured by the "TfrxReportServer.Configuration.OutputFormats" property, which may contain one or several values from the following set: sfHTM - HTML format, sfXML - XML format, sfXLS - Excel format, sfRTF - RichText format, sfTXT - text file, sfPDF - Adobe Acrobat format, sfJPG - jpeg picture, sfFRP - native FastReport 3 (FR3) format.

If type of a returned format is not specified during request, then the server generates the result in HTML format.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/The Report server.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/The Report server.htm new file mode 100644 index 0000000..e438a2e --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/The Report server.htm @@ -0,0 +1,45 @@ + + + +3. The Report server + + + + + + + + + + + + + + +
+ +3. The Report server +

Server side (TfrxReportServer component) is represented as an autonomous HTTP server with a capability of report generating. The Report server is able to transact several reports simultaneously, logging any events, and collecting the statistics.

+ +
+ +
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Transferring parameters to the report.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Transferring parameters to the report.htm new file mode 100644 index 0000000..71d4c35 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Transferring parameters to the report.htm @@ -0,0 +1,42 @@ + + + +3.4. Transferring parameters to the report + + + + + + + + + + + + +
+ +3.4. Transferring parameters to the report + +

If other parameters are presented in the request line (not listed above), then server interprets them as parameters for building a report as internal FastReport variable.

Example:

/report=myreport.fr3&param1=Hello%20World! (query report "myreport.fr3", FastReport variable "param1" setting is "Hello World!")

Below are some restrictions concerning parameters transferred:

- all strings can be converted in Unicode UTF-8 format and can be compatible with HTTP query standard (use of standard function Untf8Encode and function HTMLCodeStr declared in frxServerUtils.pas file);

- all parameters are transferred to report as strings. Please keep in mind this when you use these parameters in the report script;

- all variables contained in TfrxReportClient.Variables are automatically sent to the server.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using HTML documents.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using HTML documents.htm new file mode 100644 index 0000000..2696dd4 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using HTML documents.htm @@ -0,0 +1,47 @@ + + + +3.6. Using HTML documents + + + + + + + + + + + + + + + +
+ +3.6. Using HTML documents + +

The Server can be used as a simple HTTP server for viewing any HTML documents or any other files.

Place the HTML documents to any folder, and then correctly set the property TfrxReportServer.Configuration.RootPath.

Name of the default document must be specified in the TfrxReportServer.Configuration.IndexFileName property (default index.html). Correspondingly, a document with this name must exist in the root folder.

SSI (Server Side Include) commands description.

Include any file in document.

<!--#include virtual="filename.html" -->

Include the file with name filename.html in current document position. Path to file is specified from RootPath.

Example:

<!--#include virtual="header.html" --> || Command line help

<!--#include virtual="top.html" -->

<font face="Tahoma" size="3"><a href="index.html"><b>Back to main page</b></a><b><br>

</b></font>

<hr>

...

Insert value of server variable.

<!--#echo var="VARIABLE"-->

Insert the value of variable with the "VARIABLE" name in current document position.

Example:

...

<tr> <td align="right" width="200"><b>Uptime:</b></td>

<td width="300"><!--#echo var="SERVER_UPTIME"--></td></tr>

<tr> <td align="right"><b>Total sessions:</b></td>

<td><!--#echo var="SERVER_TOTAL_SESSIONS"--></td></tr>

<tr> <td align="right"><b>Total reports:</b></td>

<td><!--#echo var="SERVER_TOTAL_REPORTS"--></td></tr>

<tr> <td align="right"><b>Max sessions:</b></td>

<td><!--#echo var="SERVER_MAX_SESSIONS"--></td></tr>

<tr> <td align="right"><b>Max reports:</b></td>

<td><!--#echo var="SERVER_MAX_REPORTS"--></td></tr>

...

Use of SSI commands optimizes website development.

Example of the site with SSI you can see in the "\FastReport 3\Demos\ClientServer\Server\htdocs" folder.

+ +
+
+ + + + + + + + +
+< previous page + +main page + +next page > +
+ + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the FastReport server together with other HTTP servers (Apache, IIS, etc).htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the FastReport server together with other HTTP servers (Apache, IIS, etc).htm new file mode 100644 index 0000000..4fda348 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the FastReport server together with other HTTP servers (Apache, IIS, etc).htm @@ -0,0 +1,46 @@ + + + +3.13. Using the FastReport server together with other HTTP servers (Apache, IIS, etc) + + + + + + + + + + + + + + +
+ +3.13. Using the FastReport server together with other HTTP servers (Apache, IIS, etc) + +

To use already existing solutions based on other HTTP servers, their integration with the FastReport server is possible by means of the "CGI" mechanism. It gives an advantage in comparison with using a built-in HTTP server FastReport. Reports can be built in an already-working system (site). HTTP server and a server of reports can work on different computers. Usage "SSL" encoding for operation with HTTP a server is possible (this possibility is unavailable in HTTP server FastReport yet).

Applying such method, CGI becomes an intermediate for tranfering a query to the "FastReport" server, obtaining results from a server of reports, and return of the results to the client.

You can found example of CGI wrapper in the "Demos\ClientServer\CGI" folder.

To us the CGI wrapper:

  • compile and copy file fastreport.exe to the folder /cgi-bin of the HTTP server;

  • configure the HTTP server (Apache, IIS or other) to execute the CGI application. Read more about this in HTTP server user manual;

    • If HTTP and reports servers work on same computer:

  • if TCP/IP port 80 is used by HTTP server configure the FastReport server on other port 8097 (this port is used by CGI application by default if configuration file is missed), if you want to use other TCP/IP port, read below about using the configuration file of the CGI application;

    • If HTTP and FastReport servers work on separate computers:

  • create the configuration file of the CGI application in folder /cgi-bin with name fastreport.ini:

    • [REPORTSERVER]

    ; IP address of the FastReport server

    Host=192.168.0.34

    ; IP port of the FastReport server

    Port=80

  • launch the FastReport server and check work of the CGI application.

    • Report query example with using of CGI application:
    http://127.0.0.1/cgi-bin/fastreport.exe?report=67.fr3&multipage=0&pagenav=0

    Read more about query line syntax in 3.3 topic. Replace the "result" keyword in this point at "cgi-bin/fastreport.exe" construction.

    Attention: to restrict direct access to the report server from clients, it is necessary to specify an IP address of the HTTP server, on which CGI application works (127.0.0.1 or other).

    +     +
    +
    + + + + + + + + +
    +< previous page + +main page + +next page > +
    +     + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the reports cache.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the reports cache.htm new file mode 100644 index 0000000..032e2fb --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/Using the reports cache.htm @@ -0,0 +1,49 @@ + + + +3.11. Using the reports cache + + + + + + + + + + + + + + + +
    + +3.11. Using the reports cache + +

    Caching of reports allows achieving high efficiency because of saving prepared reports in temporary files of the server. Depending on server configuration, after preparation the result can be placed in cache.

    After specified time, the result of the report will be removed from the cache.

    If during this time a query with the same name of the report and the same values of parameters is received from a client, the response will be immediately returned to it. The reply will be based on the result saved in cache, and will be represented in the format requested by the client.

    In that case, the server will waste time only on conversion of the prepared report in the requested format without building a report. It considerably increases the productivity.

    Depending on tasks performed by a server, it is possible to assign an individual storage time in cache for each particular report.

    Time value is set by the administrator of a server, according to actuality of a report, after certain period of time.

    For example, the annual report about activity of an enterprise can be stored in cache long enough, since the information will be relevant for a long period of time, and it would not become outdated very soon. On the contrary, a report about a large commercial organization warehouse would be relevant during a small period, and therefore it consequently should be stored in cache not too long.

    Reports cache properties:

    TfrxServer.Configuration.ReportCaching - enable the cache (True/False);

    TfrxServer.Configuration.ReportCachePath - path to the cache folder;

    TfrxServer.Configuration.DefaultCacheLatency - latency timeout, default setting is 300 seconds.

    Server configurations file parameters:

    [ReportsCache]

    ; enable caching of the reports with same params

    Enabled=1

    ; path to chache folder

    CachePath=.\cache\

    ; dafault delay for cache of the report results in seconds

    DefaultLatency=300

    The additional section of a configuration file of a server [ReportsLatency] is for customization of a storage time in cache results of one or another report:

    [ReportsLatency]

    ; cache delay for the 1.fr3 report in seconds +

    1.fr3=10

    ; cache delay for the 2.fr3 report in seconds +

    2.fr3=20

    ; add below the any reports for the custom cache delay setup

    Correction of parameters configuration will minimize time of working clients and will reduce total traffic on the server.

    +     +
    +
    + + + + + + + + +
    +< previous page + +main page + +next page > +
    +     + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/The Report server/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/banner.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/banner.htm new file mode 100644 index 0000000..e8d9085 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/banner.htm @@ -0,0 +1,18 @@ + +FastReport 3 Enterprise - on-line Guide + + + + + + + + + +
      + FastReport 3 Enterprise
    + Programmer's manual
    +     		+
    On-line guide
    + Copyright © 1998-2005 by Fast Reports Inc
    + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/content.htm b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/content.htm new file mode 100644 index 0000000..ff1a0c9 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/content.htm @@ -0,0 +1,51 @@ + +Contents + + + + + +Introduction +

    1. FastReport 3 Enterprise - Client-Server reporting tool +

    2. Components of FastReport Enterprise Edition +
       2.1. TfrxReportServer +
       2.2. TfrxServerConnection +
       2.3. TfrxReportClient +
       2.4. TfrxHTTPClient +

    3. The Report server +
       3.1. Internal architecture +
       3.2. Supported formats of the report results +
       3.3. Query syntax +
       3.4. Transferring parameters to the report +
       3.5. Internal server variables +
       3.6. Using HTML documents +
       3.7. Logs +
       3.8. Authentication +
       3.9. Access restriction by IP address +
       3.10. Database connections +
       3.11. Using the reports cache +
       3.12. Increasing server's processing power +
       3.13. Using the FastReport server together with other HTTP servers (Apache, IIS, etc) +

    4. Developing the reports +
       4.1. Some client/server restrictions +
       4.2. Some advices concerning the design of a report +

    5. Report client +
       5.1. TfrxReportClient-based report client +
       5.2. Other clients +

    6. Adapting your applications for client-server technology +

    7. Examples +
       7.1. Example of a simple client-server application +
         7.1.1. Server side +
         7.1.2. Client side +
         7.1.3. Client side with threads +

    8. Important security issues +

    9. References +

    10. Developers' contact information +


    +     diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_001.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_001.gif new file mode 100644 index 0000000..dce90a9 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_001.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_002.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_002.gif new file mode 100644 index 0000000..fa7c8b9 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_002.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_003.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_003.gif new file mode 100644 index 0000000..05d5eeb Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_003.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_004.png b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_004.png new file mode 100644 index 0000000..455751c Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_004.png differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_005.png b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_005.png new file mode 100644 index 0000000..e240112 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_005.png differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_006.png b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_006.png new file mode 100644 index 0000000..ee1296d Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_006.png differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_007.png b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_007.png new file mode 100644 index 0000000..f92f03f Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_007.png differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_008.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_008.gif new file mode 100644 index 0000000..8cf8692 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_008.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_009.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_009.gif new file mode 100644 index 0000000..9e4d2fb Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_009.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_010.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_010.gif new file mode 100644 index 0000000..c82a321 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_010.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_011.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_011.gif new file mode 100644 index 0000000..80adae8 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_011.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_012.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_012.gif new file mode 100644 index 0000000..1814afe Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_012.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_013.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_013.gif new file mode 100644 index 0000000..8724c46 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_013.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_014.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_014.gif new file mode 100644 index 0000000..c4d3595 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_014.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_015.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_015.gif new file mode 100644 index 0000000..6942236 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_015.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_016.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_016.gif new file mode 100644 index 0000000..bbfb08b Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_016.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_017.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_017.gif new file mode 100644 index 0000000..90674f2 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_017.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_018.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_018.gif new file mode 100644 index 0000000..33ae19a Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_018.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_019.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_019.gif new file mode 100644 index 0000000..47fd86e Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_019.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_020.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_020.gif new file mode 100644 index 0000000..ce71263 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_020.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_021.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_021.gif new file mode 100644 index 0000000..571d867 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_021.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_022.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_022.gif new file mode 100644 index 0000000..5ff7349 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_022.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_023.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_023.gif new file mode 100644 index 0000000..2d9b857 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_023.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_024.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_024.gif new file mode 100644 index 0000000..379dfc2 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_024.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_025.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_025.gif new file mode 100644 index 0000000..9b4cc4d Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_025.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_026.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_026.gif new file mode 100644 index 0000000..8d70bb1 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_026.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_027.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_027.gif new file mode 100644 index 0000000..1f0e487 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_027.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_028.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_028.gif new file mode 100644 index 0000000..ede11fb Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_028.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_029.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_029.gif new file mode 100644 index 0000000..685daa4 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_029.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_030.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_030.gif new file mode 100644 index 0000000..56f287e Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_030.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_031.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_031.gif new file mode 100644 index 0000000..1899b99 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_031.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_032.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_032.gif new file mode 100644 index 0000000..ae0b355 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_032.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_033.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_033.gif new file mode 100644 index 0000000..9766ae9 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_033.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_034.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_034.gif new file mode 100644 index 0000000..9cc3c3b Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_034.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_035.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_035.gif new file mode 100644 index 0000000..9b13c30 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_035.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_036.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_036.gif new file mode 100644 index 0000000..8c2e838 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_036.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_037.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_037.gif new file mode 100644 index 0000000..c198320 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_037.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_038.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_038.gif new file mode 100644 index 0000000..421115d Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_038.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.gif new file mode 100644 index 0000000..84897d8 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.jpg b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.jpg new file mode 100644 index 0000000..0de6242 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_039.jpg differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.gif new file mode 100644 index 0000000..2c0217c Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.jpg b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.jpg new file mode 100644 index 0000000..3584f1e Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_040.jpg differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.gif new file mode 100644 index 0000000..9897c71 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.jpg b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.jpg new file mode 100644 index 0000000..3cff2b4 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_041.jpg differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.gif b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.gif new file mode 100644 index 0000000..dd12365 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.jpg b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.jpg new file mode 100644 index 0000000..bd454b2 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/freepm_042.jpg differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/image/index.html new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/documentation/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/index.html new file mode 100644 index 0000000..b38ff6f --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/documentation/index.html @@ -0,0 +1,9 @@ + + + FastReport 3 Enterprise Edition + + + diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/favicon.ico b/official/4.2/Demos/ClientServer/Server/htdocs/favicon.ico new file mode 100644 index 0000000..bd853c0 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/favicon.ico differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/features.html b/official/4.2/Demos/ClientServer/Server/htdocs/features.html new file mode 100644 index 0000000..ac49759 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/features.html @@ -0,0 +1,33 @@ + || Expected features list + +Back to main page
     +

    +Expected features list
    +

    +

      +
    • Full FastReport 3 compatibility +
    • Hypertext transport protocol (HTTP) compatibility (RFC 2616) +
    • Standalone web-server mode +
    • Advanced security for multiple user groups and access permissions +
    • Gzip compressing support (RFC 1952) for client-server files transfer +
    • Server Side Includes (SSI) allow a webmaster to include dynamic content from the other servers +
    • Multiplatform client module +
    • Access to server from client application (with FastReport client module) +
    • Access to server from any web-browser +
    • PDF, XML, Jpeg, RTF, HTML output format support +
    • Remote administrator access to server control panel +
    • Full access and errors logging +
    • Web-forms support +
    • FastReport forms on the fly converting to web-forms +
    • Multiple database types support +
    • Multiple database connections support +
    • Network printing support (dot-matrix printers supported) +
    • Multiprocessor hardware platform support +
    +

    +
    +Back to main page
    +     + + + \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/header.html b/official/4.2/Demos/ClientServer/Server/htdocs/header.html new file mode 100644 index 0000000..e148196 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/header.html @@ -0,0 +1,3 @@ + + +<!--#echo var="SERVER_NAME"--> \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/index.html b/official/4.2/Demos/ClientServer/Server/htdocs/index.html new file mode 100644 index 0000000..85f9526 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/index.html @@ -0,0 +1,70 @@ +<!--#include virtual="header.html" --> || Test page +<!--#include virtual="top.html" --> +<b><a href="documentation/index.html" target="_blank">Documentation</a> |  +<a href="statistic.html">On-line statistic</a> |  +<a href="mailto:support@fast-report.com">Contact e-mail</a> |  +<a href="http://www.fast-report.com" target="_blank">FastReport home site</a></b> +<hr> +<p><font face="Tahoma" size="4"> +<b>List of available reports at the server</b><br></font></p> +<font face="Tahoma" size="2"> +<!--#echo var="SERVER_REPORTS_HTML"--> +</font> +<hr> +<p> +<font face="Tahoma" size="4"> +<b>Parameters testing</b> +</font> +</p> + +<table width="80%" border="0" cellspacing="2" cellpadding="2"> +<tr><td class=tit> +<b>1.Page navigator</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&multipage=0&pagenav=0" target=_blank>01.Simple list on single page without page navigator</a> +<br>  +</td></tr> +<tr><td class=tit> +<b>2.Pages view</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&multipage=0" target=_blank>01.Simple list on single page</a> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&multipage=1" target=_blank>02.Simple list on multi page</a> +<br>  +</td></tr> +<tr><td class=tit> +<b>3.Page range</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\03.Nested groups.fr3&pagerange=1-2&multipage=0&pagenav=0" target=_blank>01.Nested groups pages 1-2 on single page without pagenavigator</a> +<br>  +</td></tr> +<tr><td class=tit> +<b>4.Custom variables</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&multipage=0¶m1=Test param1¶m2=Test param2" target=_blank>01.Simple list with Param1='Test param1' and Param2='Test param2'</a> +<br>  +</td></tr> +<tr><td class=tit> +<b>5.Export to any formats</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&format=PDF">01.Simple list in PDF</a> +<br><a href="result?report=1.Basic reports\03.Nested groups.fr3&format=PDF">02.Nested groups in PDF</a> +<br><a href="result?report=2.Cross-tabs\05.Two rows, one column.fr3&format=PDF">03.Two rows, one column in PDF</a> +<br><a href="result?report=4.Misc\04.Preview outline.fr3&format=PDF">04.Outline in PDF</a> +<br><a href="result?report=3.Charts\01.Countries.fr3&format=PDF">05.Countries in PDF</a> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3&format=RTF">06.Simple list in RTF</a> +<br><a href="result?report=1.Basic reports\07.Multi-column bands.fr3&format=XML">07.Multi-column bands in XML</a> +<br><a href="result?report=1.Basic reports\07.Multi-column bands.fr3&format=XLS">08.Multi-column bands in XLS</a> +<br><a href="result?report=1.Basic reports\02.Simple group.fr3&format=TXT">09.Simple group in TXT</a> +<br><a href="result?report=1.Basic reports\02.Simple group.fr3&format=FRP">10.Simple group in FP3</a> +<br><a href="result?report=1.Basic reports\02.Simple group.fr3&format=JPG">11.Simple group in JPG</a> +<br>  +</td></tr> +</table> +<!--#include virtual="bottom.html" --> +</body> +</html> \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/index2.html b/official/4.2/Demos/ClientServer/Server/htdocs/index2.html new file mode 100644 index 0000000..b4b0243 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/index2.html @@ -0,0 +1,19 @@ +<!--#include virtual="header.html" --> || Test page +<!--#include virtual="top.html" --> +<font face="Tahoma" size="3"> +<font face="Tahoma" size="3"> +<h3><b>Test index file for group</b></h3> +</font> + +<table width="80%" border="0" cellspacing="2" cellpadding="2"> +<tr><td class=tit> +<b>Reports</b> +</td></tr> +<tr><td class=txtbody> +<br><a href="result?report=1.Basic reports\01.Simple list.fr3" target=_blank>01.Simple list</a> - Demonstrates how to create simple list report. +<br>  +</td></tr> +</table> +<!--#include virtual="bottom.html" --> +</body> +</html> \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/logo.gif b/official/4.2/Demos/ClientServer/Server/htdocs/logo.gif new file mode 100644 index 0000000..6c34d16 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Server/htdocs/logo.gif differ diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/reports.html b/official/4.2/Demos/ClientServer/Server/htdocs/reports.html new file mode 100644 index 0000000..ead3d56 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/reports.html @@ -0,0 +1,19 @@ +<!--#include virtual="header.html" --> || Reports +<!--#include virtual="top.html" --> +<font face="Tahoma" size="3"><a href="index.html"><b>Back to main page</b></a><br></font> +<hr> +<font face="Tahoma" size="4"> +<b>List of available reports at the server</b><br><br></font> +<font face="Tahoma" size="3"> + + +<!--#echo var="SERVER_REPORTS_HTML"--> + +</font> + +<hr> +<font face="Tahoma" size="3"><a href="index.html"><b>Back to main page</b></a><br> +</font> +<!--#include virtual="bottom.html" --> +</body> +</html> \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/statistic.html b/official/4.2/Demos/ClientServer/Server/htdocs/statistic.html new file mode 100644 index 0000000..80adda8 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/statistic.html @@ -0,0 +1,20 @@ +<!--#include virtual="header.html" --> || Statistic +<!--#include virtual="top.html" --> +<font face="Tahoma" size="3"><a href="index.html"><b>Back to main page</b></a><br></font> +<hr> +<font face="Tahoma" size="4"><b>On-line statistic</b><br> +<font face="Tahoma" size="3"> +<table width="500" border="1" cellspacing="2" cellpadding="2"> +<tr><td align="right" width="200"><b>Uptime:</b></td><td width="300"><!--#echo var="SERVER_UPTIME"--></td></tr> +<tr><td align="right"><b>Total sessions:</b></td><td><!--#echo var="SERVER_TOTAL_SESSIONS"--></td></tr> +<tr><td align="right"><b>Total reports:</b></td><td><!--#echo var="SERVER_TOTAL_REPORTS"--></td></tr> +<tr><td align="right"><b>Max sessions:</b></td><td><!--#echo var="SERVER_MAX_SESSIONS"--></td></tr> +<tr><td align="right"><b>Max reports:</b></td><td><!--#echo var="SERVER_MAX_REPORTS"--></td></tr> +</table> +</font> +<hr> +<font face="Tahoma" size="3"><a href="index.html"><b>Back to main page</b></a><br> +</font> +<!--#include virtual="bottom.html" --> +</body> +</html> \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/htdocs/top.html b/official/4.2/Demos/ClientServer/Server/htdocs/top.html new file mode 100644 index 0000000..3a150d1 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/htdocs/top.html @@ -0,0 +1,15 @@ +
    + + + + + + + + + + + + +
      
      
    +
    \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/readme.txt b/official/4.2/Demos/ClientServer/Server/readme.txt new file mode 100644 index 0000000..5217cd9 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/readme.txt @@ -0,0 +1,4 @@ +IMPORTANT: + +This demo can be compiled only in the version Delphi/C++Builder 5 and higher. +(ADO components used in database connection). \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/01.Simple list.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/01.Simple list.fr3 new file mode 100644 index 0000000..05d0d29 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/01.Simple list.fr3 @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/02.Simple group.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/02.Simple group.fr3 new file mode 100644 index 0000000..eff74a2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/02.Simple group.fr3 @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/03.Nested groups.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/03.Nested groups.fr3 new file mode 100644 index 0000000..a417d51 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/03.Nested groups.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/04.Master-Detail-Subdetail.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/04.Master-Detail-Subdetail.fr3 new file mode 100644 index 0000000..53bd3d0 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/04.Master-Detail-Subdetail.fr3 @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/05.Master-Detail-Detail.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/05.Master-Detail-Detail.fr3 new file mode 100644 index 0000000..7646b81 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/05.Master-Detail-Detail.fr3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/06.Multi-column list.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/06.Multi-column list.fr3 new file mode 100644 index 0000000..8389f6d --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/06.Multi-column list.fr3 @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/07.Multi-column bands.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/07.Multi-column bands.fr3 new file mode 100644 index 0000000..2cb3c69 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/07.Multi-column bands.fr3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/08.Memos and pictures.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/08.Memos and pictures.fr3 new file mode 100644 index 0000000..122b173 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/08.Memos and pictures.fr3 @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/09.Split bands.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/09.Split bands.fr3 new file mode 100644 index 0000000..7389a53 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/09.Split bands.fr3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/10.Subreports.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/10.Subreports.fr3 new file mode 100644 index 0000000..ee6c186 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/10.Subreports.fr3 @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/11.Side-by-Side subreports.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/11.Side-by-Side subreports.fr3 new file mode 100644 index 0000000..306ca6b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/11.Side-by-Side subreports.fr3 @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/12.Report with title page.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/12.Report with title page.fr3 new file mode 100644 index 0000000..d110cbb --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/12.Report with title page.fr3 @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/13.URLs, anchors.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/13.URLs, anchors.fr3 new file mode 100644 index 0000000..568f769 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/13.URLs, anchors.fr3 @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/14.Keep group together.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/14.Keep group together.fr3 new file mode 100644 index 0000000..e0365f7 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/14.Keep group together.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/15.Totals in group header.fr3 b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/15.Totals in group header.fr3 new file mode 100644 index 0000000..0ff0117 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/1.Basic reports/15.Totals in group header.fr3 @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/01.One row.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/01.One row.fr3 new file mode 100644 index 0000000..12d145a --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/01.One row.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/02.One column.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/02.One column.fr3 new file mode 100644 index 0000000..78b414b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/02.One column.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/03.One row, one column.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/03.One row, one column.fr3 new file mode 100644 index 0000000..6ed1d02 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/03.One row, one column.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/04.Two rows.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/04.Two rows.fr3 new file mode 100644 index 0000000..c5cfeda --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/04.Two rows.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/05.Two rows, one column.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/05.Two rows, one column.fr3 new file mode 100644 index 0000000..59d12cd --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/05.Two rows, one column.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/06.Two columns, one row.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/06.Two columns, one row.fr3 new file mode 100644 index 0000000..87b6039 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/06.Two columns, one row.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/07.Two cell values.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/07.Two cell values.fr3 new file mode 100644 index 0000000..bd6b821 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/07.Two cell values.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/08.Highlight.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/08.Highlight.fr3 new file mode 100644 index 0000000..5c342ac --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/08.Highlight.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/09.Two cross-tabs.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/09.Two cross-tabs.fr3 new file mode 100644 index 0000000..fd03681 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/09.Two cross-tabs.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/10.Cross from non-DB data.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/10.Cross from non-DB data.fr3 new file mode 100644 index 0000000..f841d46 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/10.Cross from non-DB data.fr3 @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/11.Cross-bands.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/11.Cross-bands.fr3 new file mode 100644 index 0000000..c34a18e --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/11.Cross-bands.fr3 @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/12.Calendar.fr3 b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/12.Calendar.fr3 new file mode 100644 index 0000000..2ad9583 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/2.Cross-tabs/12.Calendar.fr3 @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/3.Charts/01.Countries.fr3 b/official/4.2/Demos/ClientServer/Server/reports/3.Charts/01.Countries.fr3 new file mode 100644 index 0000000..c9d0a3f --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/3.Charts/01.Countries.fr3 @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/3.Charts/02.Exchange rates.fr3 b/official/4.2/Demos/ClientServer/Server/reports/3.Charts/02.Exchange rates.fr3 new file mode 100644 index 0000000..8ebc608 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/3.Charts/02.Exchange rates.fr3 @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/4.Misc/01.Rotation, fills and shapes.fr3 b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/01.Rotation, fills and shapes.fr3 new file mode 100644 index 0000000..d3fa56f --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/01.Rotation, fills and shapes.fr3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/4.Misc/02.Barcode.fr3 b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/02.Barcode.fr3 new file mode 100644 index 0000000..a7d8344 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/02.Barcode.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/4.Misc/03.HTML and text.fr3 b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/03.HTML and text.fr3 new file mode 100644 index 0000000..9bc8c8c --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/03.HTML and text.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/4.Misc/04.Preview outline.fr3 b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/04.Preview outline.fr3 new file mode 100644 index 0000000..4111eca --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/04.Preview outline.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/4.Misc/05.Unicode.fr3 b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/05.Unicode.fr3 new file mode 100644 index 0000000..a70c764 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/4.Misc/05.Unicode.fr3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/01.Ask for parameters.fr3 b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/01.Ask for parameters.fr3 new file mode 100644 index 0000000..27a5604 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/01.Ask for parameters.fr3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/02.Client-server dialogs.fr3 b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/02.Client-server dialogs.fr3 new file mode 100644 index 0000000..ffb46f6 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/02.Client-server dialogs.fr3 @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/03.Dialog query.fr3 b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/03.Dialog query.fr3 new file mode 100644 index 0000000..62448a8 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/03.Dialog query.fr3 @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/04.Dialog and script.fr3 b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/04.Dialog and script.fr3 new file mode 100644 index 0000000..0c6d402 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/reports/5.Dialogs and script/04.Dialog and script.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Server/templates/error403.html b/official/4.2/Demos/ClientServer/Server/templates/error403.html new file mode 100644 index 0000000..3820e0d --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/error403.html @@ -0,0 +1 @@ +Forbidden

    ERROR 403
    Forbidden

    diff --git a/official/4.2/Demos/ClientServer/Server/templates/error404.html b/official/4.2/Demos/ClientServer/Server/templates/error404.html new file mode 100644 index 0000000..601e238 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/error404.html @@ -0,0 +1 @@ +Not found

    ERROR 404
    Not found

    diff --git a/official/4.2/Demos/ClientServer/Server/templates/error500.html b/official/4.2/Demos/ClientServer/Server/templates/error500.html new file mode 100644 index 0000000..8cf0801 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/error500.html @@ -0,0 +1 @@ +Internal error

    ERROR 500
    Internal error

    diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_begin.html b/official/4.2/Demos/ClientServer/Server/templates/form_begin.html new file mode 100644 index 0000000..6ed15ec --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_begin.html @@ -0,0 +1,16 @@ + + + +<!--#echo var="TITLE"--> +> + + + +
    +
    +"> + + +"> +" align="center" style="border: solid 1px #000000"> + diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_button.html b/official/4.2/Demos/ClientServer/Server/templates/form_button.html new file mode 100644 index 0000000..6195d75 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_button.html @@ -0,0 +1 @@ +" value=""> diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_checkbox.html b/official/4.2/Demos/ClientServer/Server/templates/form_checkbox.html new file mode 100644 index 0000000..c89b333 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_checkbox.html @@ -0,0 +1,3 @@ +" value="" > +; font-size: px; +color: ; background-color: ;"> diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_end.html b/official/4.2/Demos/ClientServer/Server/templates/form_end.html new file mode 100644 index 0000000..9118bdf --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_end.html @@ -0,0 +1,6 @@ + + +
    ">
    ">  +
    +
    + diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_label.html b/official/4.2/Demos/ClientServer/Server/templates/form_label.html new file mode 100644 index 0000000..f6c7ec2 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_label.html @@ -0,0 +1,4 @@ +; + font-size: px; + color: ; + background-color: ;"> diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_memo.html b/official/4.2/Demos/ClientServer/Server/templates/form_memo.html new file mode 100644 index 0000000..170e237 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_memo.html @@ -0,0 +1 @@ + diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_radio.html b/official/4.2/Demos/ClientServer/Server/templates/form_radio.html new file mode 100644 index 0000000..5417771 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_radio.html @@ -0,0 +1 @@ +" value="" >; font-size: px; color: ; background-color: ;"> diff --git a/official/4.2/Demos/ClientServer/Server/templates/form_select.html b/official/4.2/Demos/ClientServer/Server/templates/form_select.html new file mode 100644 index 0000000..c8d54d9 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/form_select.html @@ -0,0 +1 @@ +" name="" value="" id="" size="" maxlength="" > diff --git a/official/4.2/Demos/ClientServer/Server/templates/list_begin.html b/official/4.2/Demos/ClientServer/Server/templates/list_begin.html new file mode 100644 index 0000000..f48b71f --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/list_begin.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/list_end.html b/official/4.2/Demos/ClientServer/Server/templates/list_end.html new file mode 100644 index 0000000..94eb82e --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/list_end.html @@ -0,0 +1 @@ +
    \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/list_header.html b/official/4.2/Demos/ClientServer/Server/templates/list_header.html new file mode 100644 index 0000000..a06ae43 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/list_header.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/list_line.html b/official/4.2/Demos/ClientServer/Server/templates/list_line.html new file mode 100644 index 0000000..ef3a499 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/list_line.html @@ -0,0 +1 @@ +" target=_blank> diff --git a/official/4.2/Demos/ClientServer/Server/templates/main.html b/official/4.2/Demos/ClientServer/Server/templates/main.html new file mode 100644 index 0000000..ef9648b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/main.html @@ -0,0 +1 @@ +// under construction \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/navigator.html b/official/4.2/Demos/ClientServer/Server/templates/navigator.html new file mode 100644 index 0000000..ef9648b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/navigator.html @@ -0,0 +1 @@ +// under construction \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/outline.html b/official/4.2/Demos/ClientServer/Server/templates/outline.html new file mode 100644 index 0000000..ef9648b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/outline.html @@ -0,0 +1 @@ +// under construction \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/readme.txt b/official/4.2/Demos/ClientServer/Server/templates/readme.txt new file mode 100644 index 0000000..bd80d99 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/readme.txt @@ -0,0 +1,21 @@ +error403.html - error 403 template +error404.html - error 404 template +error500.html - error 500 template +form_begin.html - template of form begin +form_button.html - template of form button +form_checkbox.html - template of form checkbox +form_date.html - template of form date editor +form_end.html - template of form end +form_label.html - template of form label +form_memo.html - template of form memo +form_radio.html - template of form radio button +form_select.html - template of form select +form_text.html - template of form text memo +list_begin.html - template of reports list begin +list_end.html - template of reports list end +list_header.html - template of reports list header +list_line.html - template of reports list line +main.html - template of main report file (not implemented) +navigator.html - template of report navigator (not implemented) +outline.html - template of report outline (not implemented) +report.html - template of report frame (not implemented) \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/templates/report.html b/official/4.2/Demos/ClientServer/Server/templates/report.html new file mode 100644 index 0000000..ef9648b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/templates/report.html @@ -0,0 +1 @@ +// under construction \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Server/users.xml b/official/4.2/Demos/ClientServer/Server/users.xml new file mode 100644 index 0000000..91bd552 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Server/users.xml @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Service/allow.conf b/official/4.2/Demos/ClientServer/Service/allow.conf new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Service/config.xml b/official/4.2/Demos/ClientServer/Service/config.xml new file mode 100644 index 0000000..52dd63c --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/config.xml @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/ClientServer/Service/deny.conf b/official/4.2/Demos/ClientServer/Service/deny.conf new file mode 100644 index 0000000..e69de29 diff --git a/official/4.2/Demos/ClientServer/Service/frxserv.dpr b/official/4.2/Demos/ClientServer/Service/frxserv.dpr new file mode 100644 index 0000000..3acb388 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/frxserv.dpr @@ -0,0 +1,13 @@ +program frxserv; + +uses + SvcMgr, + main in 'main.pas' {FastReport: TService}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TFastReport, FastReport); + Application.Run; +end. diff --git a/official/4.2/Demos/ClientServer/Service/frxserv.res b/official/4.2/Demos/ClientServer/Service/frxserv.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Service/frxserv.res differ diff --git a/official/4.2/Demos/ClientServer/Service/install.bat b/official/4.2/Demos/ClientServer/Service/install.bat new file mode 100644 index 0000000..a48b678 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/install.bat @@ -0,0 +1 @@ +frxserv.exe /install \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Service/main.dfm b/official/4.2/Demos/ClientServer/Service/main.dfm new file mode 100644 index 0000000..c737699 Binary files /dev/null and b/official/4.2/Demos/ClientServer/Service/main.dfm differ diff --git a/official/4.2/Demos/ClientServer/Service/main.pas b/official/4.2/Demos/ClientServer/Service/main.pas new file mode 100644 index 0000000..9f6461b --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/main.pas @@ -0,0 +1,138 @@ +unit main; + +{$I frx.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, + frxServer, DB, ADODB, frxClass, frxADOComponents, frxDBSet, frxGZip, + frxDCtrl, frxDMPExport, frxGradient, frxChBox, frxCross, frxRich, + frxChart, frxBarcode, frxServerUtils, ActiveX, Registry, IniFiles, frxUtils, + frxServerConfig; + +type + TFastReport = class(TService) + ADOConnection: TADOConnection; + Serv: TfrxReportServer; + frxBarCodeObject1: TfrxBarCodeObject; + frxChartObject1: TfrxChartObject; + frxRichObject1: TfrxRichObject; + frxCrossObject1: TfrxCrossObject; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxGradientObject1: TfrxGradientObject; + frxDotMatrixExport1: TfrxDotMatrixExport; + frxDialogControls1: TfrxDialogControls; + frxGZipCompressor1: TfrxGZipCompressor; + frxADOComponents1: TfrxADOComponents; + procedure ServiceStop(Sender: TService; var Stopped: Boolean); + procedure ServiceStart(Sender: TService; var Started: Boolean); + procedure ServicePause(Sender: TService; var Paused: Boolean); + procedure ServiceExecute(Sender: TService); + procedure ServiceContinue(Sender: TService; var Continued: Boolean); + procedure ServiceAfterInstall(Sender: TService); + private + { Private declarations } + public + function GetServiceController: TServiceController; override; + { Public declarations } + end; + +var + FastReport: TFastReport; + dbMd: String; + +implementation + +uses ComObj; + +{$R *.DFM} + +var + DBConnStr: String = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='; + + +procedure ServiceController(CtrlCode: DWord); stdcall; +begin + FastReport.Controller(CtrlCode); +end; + +function TFastReport.GetServiceController: TServiceController; +begin + Result := ServiceController; +end; + +procedure TFastReport.ServiceStart(Sender: TService; var Started: Boolean); +begin + ADOConnection.ConnectionString := DBConnStr + frxGetAbsPath(ServerConfig.GetValue('server.database.pathtodatabase')); + CoInitialize(nil); + try + ADOConnection.Open; + except + LogMessage('Database connection error'); + end; + + if ADOConnection.Connected then + begin + Serv.Open; + end else + LogMessage('Database not connected'); + Started := True; +end; + +procedure TFastReport.ServiceStop(Sender: TService; var Stopped: Boolean); +begin + if ADOConnection.Connected then + ADOConnection.Close; + Serv.Close; + Stopped := True; +end; + +procedure TFastReport.ServicePause(Sender: TService; var Paused: Boolean); +begin + Serv.Close; + Paused := True; +end; + +procedure TFastReport.ServiceExecute(Sender: TService); +begin + while not Terminated do + begin + ServiceThread.ProcessRequests(True); + Sleep(100); + end; +end; + +procedure TFastReport.ServiceContinue(Sender: TService; var Continued: Boolean); +begin + Serv.Open; + Continued := True; +end; + +procedure TFastReport.ServiceAfterInstall(Sender: TService); +var + Registry: TRegistry; + key: String; +begin + Registry := TRegistry.Create; + try +{$IFNDEF Delphi4} + Registry.Access := KEY_READ; +{$ENDIF} + Registry.RootKey := HKEY_LOCAL_MACHINE; + key := 'System\CurrentControlSet\Services\' + Name; + if Registry.KeyExists(key) then + begin +{$IFNDEF Delphi4} + Registry.Access := KEY_WRITE; +{$ENDIF} + Registry.OpenKey(key, True); + Registry.WriteString('Description', 'FastReport Server service. http://www.fast-report.com'); + Registry.CloseKey; + end; + finally + Registry.Free; + end; +end; + +end. diff --git a/official/4.2/Demos/ClientServer/Service/service.txt b/official/4.2/Demos/ClientServer/Service/service.txt new file mode 100644 index 0000000..c438b93 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/service.txt @@ -0,0 +1,8 @@ +FastReport 3 Server NT service demo. + +Install: frxserv.exe /install +Uninstall: frxserv.exe /uninstall + +Star service: net start fastreport +Stop service: net stop fastreport + diff --git a/official/4.2/Demos/ClientServer/Service/servmain.dfm b/official/4.2/Demos/ClientServer/Service/servmain.dfm new file mode 100644 index 0000000..00d631a Binary files /dev/null and b/official/4.2/Demos/ClientServer/Service/servmain.dfm differ diff --git a/official/4.2/Demos/ClientServer/Service/servmain.pas b/official/4.2/Demos/ClientServer/Service/servmain.pas new file mode 100644 index 0000000..0f0be51 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/servmain.pas @@ -0,0 +1,176 @@ +unit servmain; + +{$I frx.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, + frxServer, DB, ADODB, frxClass, frxADOComponents, frxDBSet, frxGZip, + frxDCtrl, frxDMPExport, frxGradient, frxChBox, frxCross, frxRich, + frxChart, frxBarcode, frxServerUtils, ActiveX, Registry, IniFiles, frxUtils, + frxUsers, frxConfig; + +type + TFastReport = class(TService) + ADOConnection: TADOConnection; + Serv: TfrxReportServer; + frxBarCodeObject1: TfrxBarCodeObject; + frxChartObject1: TfrxChartObject; + frxRichObject1: TfrxRichObject; + frxCrossObject1: TfrxCrossObject; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxGradientObject1: TfrxGradientObject; + frxDotMatrixExport1: TfrxDotMatrixExport; + frxDialogControls1: TfrxDialogControls; + frxGZipCompressor1: TfrxGZipCompressor; + frxADOComponents1: TfrxADOComponents; + procedure ServiceStop(Sender: TService; var Stopped: Boolean); + procedure ServiceStart(Sender: TService; var Started: Boolean); + procedure ServicePause(Sender: TService; var Paused: Boolean); + procedure ServiceExecute(Sender: TService); + procedure ServiceContinue(Sender: TService; var Continued: Boolean); + procedure ServiceAfterInstall(Sender: TService); + private + { Private declarations } + AppPath: String; + ConfFile: String; + AllowFile: String; + DenyFile: String; + public + function GetServiceController: TServiceController; override; + { Public declarations } + end; + +const + CONFIG_FILE = 'config.xml'; +// ALLOW_FILE = 'allow.conf'; +// DENY_FILE = 'deny.conf'; + +var + FastReport: TFastReport; + dbMd: String; + +implementation + +uses ComObj; + +{$R *.DFM} + +var + DATABASE_FILE: String; + DBConnStr: String = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='; + + +procedure ServiceController(CtrlCode: DWord); stdcall; +begin + FastReport.Controller(CtrlCode); +end; + +function TFastReport.GetServiceController: TServiceController; +begin + Result := ServiceController; +end; + +procedure TFastReport.ServiceStart(Sender: TService; var Started: Boolean); +var + ini: TIniFile; +begin + AppPath := GetAppPath; + ConfFile := AppPath + CONFIG_FILE; +// AllowFile := AppPath + ALLOW_FILE; +// DenyFile := AppPath + DENY_FILE; + +// ini := TIniFile.Create(ConfFile); +// try + DATABASE_FILE := AppPath + 'database\server.mdb'; //AppPath + ini.ReadString('Database', 'Connection', 'database\server.mdb'); +// finally +// ini.Free; +// end; + + ADOConnection.ConnectionString := DBConnStr + DATABASE_FILE; + CoInitialize(nil); + try + ADOConnection.Open; + except + LogMessage('Database connection error'); + end; + + if ADOConnection.Connected then + begin + if FileExists(ConfFile) then + Serv.Configuration.LoadFromFile(ConfFile); +///!!!! + ServerUsers.LoadFromFile(AppPath + ServerConfig.GetValue('server.security.usersfile')); + if FileExists(AllowFile) then + begin + Serv.AllowIP.Clear; + Serv.AllowIP.LoadFromFile(AllowFile); + end; + if FileExists(DenyFile) then + begin + Serv.DenyIP.Clear; + Serv.DenyIP.LoadFromFile(DenyFile); + end; + Serv.Open; + end else + LogMessage('Database not connected'); + Started := True; +end; + +procedure TFastReport.ServiceStop(Sender: TService; var Stopped: Boolean); +begin + if ADOConnection.Connected then + ADOConnection.Close; + Serv.Close; + Stopped := True; +end; + +procedure TFastReport.ServicePause(Sender: TService; var Paused: Boolean); +begin + Serv.Close; + Paused := True; +end; + +procedure TFastReport.ServiceExecute(Sender: TService); +begin + while not Terminated do + begin + ServiceThread.ProcessRequests(True); + Sleep(100); + end; +end; + +procedure TFastReport.ServiceContinue(Sender: TService; var Continued: Boolean); +begin + Serv.Open; + Continued := True; +end; + +procedure TFastReport.ServiceAfterInstall(Sender: TService); +var + Registry: TRegistry; + key: String; +begin + Registry := TRegistry.Create; + try +{$IFNDEF Delphi4} + Registry.Access := KEY_READ; +{$ENDIF} + Registry.RootKey := HKEY_LOCAL_MACHINE; + key := 'System\CurrentControlSet\Services\' + Name; + if Registry.KeyExists(key) then + begin +{$IFNDEF Delphi4} + Registry.Access := KEY_WRITE; +{$ENDIF} + Registry.OpenKey(key, True); + Registry.WriteString('Description', 'FastReport Server service. http://www.fast-report.com'); + Registry.CloseKey; + end; + finally + Registry.Free; + end; +end; + +end. diff --git a/official/4.2/Demos/ClientServer/Service/start.bat b/official/4.2/Demos/ClientServer/Service/start.bat new file mode 100644 index 0000000..4690300 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/start.bat @@ -0,0 +1 @@ +net start fastreport \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Service/stop.bat b/official/4.2/Demos/ClientServer/Service/stop.bat new file mode 100644 index 0000000..dce9889 --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/stop.bat @@ -0,0 +1 @@ +net stop fastreport \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/Service/uninstall.bat b/official/4.2/Demos/ClientServer/Service/uninstall.bat new file mode 100644 index 0000000..e35b3be --- /dev/null +++ b/official/4.2/Demos/ClientServer/Service/uninstall.bat @@ -0,0 +1 @@ +frxserv.exe /uninstall \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/UserManager/GroupEditor.dfm b/official/4.2/Demos/ClientServer/UserManager/GroupEditor.dfm new file mode 100644 index 0000000..1bfcfa0 Binary files /dev/null and b/official/4.2/Demos/ClientServer/UserManager/GroupEditor.dfm differ diff --git a/official/4.2/Demos/ClientServer/UserManager/GroupEditor.pas b/official/4.2/Demos/ClientServer/UserManager/GroupEditor.pas new file mode 100644 index 0000000..0830857 --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/GroupEditor.pas @@ -0,0 +1,46 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport User/Group editor demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit GroupEditor; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TGroupEditorForm = class(TForm) + Panel1: TPanel; + UserEditForm: TButton; + Button2: TButton; + Panel2: TPanel; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + EFullName: TEdit; + ELogin: TEdit; + CBActive: TCheckBox; + EIndex: TEdit; + private + { Private declarations } + public + { Public declarations } + end; + +var + GroupEditorForm: TGroupEditorForm; + +implementation + +{$R *.dfm} + +end. diff --git a/official/4.2/Demos/ClientServer/UserManager/UserEditor.dfm b/official/4.2/Demos/ClientServer/UserManager/UserEditor.dfm new file mode 100644 index 0000000..35ac53e Binary files /dev/null and b/official/4.2/Demos/ClientServer/UserManager/UserEditor.dfm differ diff --git a/official/4.2/Demos/ClientServer/UserManager/UserEditor.pas b/official/4.2/Demos/ClientServer/UserManager/UserEditor.pas new file mode 100644 index 0000000..5b23e7a --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/UserEditor.pas @@ -0,0 +1,109 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport User/Group editor demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit UserEditor; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls; + +type + TEditUserForm = class(TForm) + Panel1: TPanel; + UserEditForm: TButton; + Button2: TButton; + Panel2: TPanel; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label7: TLabel; + EFullName: TEdit; + CBActive: TCheckBox; + ELogin: TEdit; + EPassword: TEdit; + EEmail: TEdit; + MemberBox: TListBox; + AvailBox: TListBox; + LeftBtn: TButton; + RightBtn: TButton; + procedure MemberBoxDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure AvailBoxDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure MemberBoxDragDrop(Sender, Source: TObject; X, Y: Integer); + procedure LeftBtnClick(Sender: TObject); + procedure RightBtnClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + EditUserForm: TEditUserForm; + +implementation + +{$R *.dfm} + +procedure TEditUserForm.MemberBoxDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + Accept := Source = AvailBox; +end; + +procedure TEditUserForm.AvailBoxDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + Accept := Source = MemberBox; +end; + +procedure TEditUserForm.MemberBoxDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + s: String; + i: Integer; +begin + i := (Source as TListBox).ItemIndex; + s := (Source as TListBox).Items[i]; + (Sender as TListBox).Items.Add(s); + (Source as TListBox).Items.Delete(i); +end; + +procedure TEditUserForm.LeftBtnClick(Sender: TObject); +var + i: Integer; +begin + i := AvailBox.ItemIndex; + if i <> -1 then + begin + MemberBox.Items.Add(AvailBox.Items[i]); + AvailBox.Items.Delete(i); + end; +end; + +procedure TEditUserForm.RightBtnClick(Sender: TObject); +var + i: Integer; +begin + i := AvailBox.ItemIndex; + if i <> -1 then + begin + MemberBox.Items.Add(AvailBox.Items[i]); + AvailBox.Items.Delete(i); + end; +end; + +end. diff --git a/official/4.2/Demos/ClientServer/UserManager/frxUserManager.dpr b/official/4.2/Demos/ClientServer/UserManager/frxUserManager.dpr new file mode 100644 index 0000000..0543896 --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/frxUserManager.dpr @@ -0,0 +1,26 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport User/Group editor demo } +{ Copyright (c) 1998-2006 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +program frxUserManager; + +uses + Forms, + main in 'main.pas' {MainForm}, + UserEditor in 'UserEditor.pas' {EditUserForm}, + GroupEditor in 'GroupEditor.pas' {GroupEditorForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/4.2/Demos/ClientServer/UserManager/frxUserManager.res b/official/4.2/Demos/ClientServer/UserManager/frxUserManager.res new file mode 100644 index 0000000..062079f Binary files /dev/null and b/official/4.2/Demos/ClientServer/UserManager/frxUserManager.res differ diff --git a/official/4.2/Demos/ClientServer/UserManager/main.dfm b/official/4.2/Demos/ClientServer/UserManager/main.dfm new file mode 100644 index 0000000..a82e5f1 Binary files /dev/null and b/official/4.2/Demos/ClientServer/UserManager/main.dfm differ diff --git a/official/4.2/Demos/ClientServer/UserManager/main.pas b/official/4.2/Demos/ClientServer/UserManager/main.pas new file mode 100644 index 0000000..832f102 --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/main.pas @@ -0,0 +1,314 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FastReport User/Group editor demo } +{ Copyright (c) 1998-2007 } +{ by Alexander Fediachov, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit main; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ComCtrls, ExtCtrls, frxUsers; + + +type + TMainForm = class(TForm) + Panel1: TPanel; + NewBtn: TButton; + EditBtn: TButton; + DeleteBtn: TButton; + Panel3: TPanel; + PageControl: TPageControl; + UserTab: TTabSheet; + UserList: TListView; + Panel2: TPanel; + Label1: TLabel; + CBox_Group: TComboBox; + GroupTab: TTabSheet; + GroupList: TListView; + procedure FormDestroy(Sender: TObject); + procedure CBox_GroupChange(Sender: TObject); + procedure EditBtnClick(Sender: TObject); + procedure NewBtnClick(Sender: TObject); + procedure DeleteBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + ServerUsers: TfrxUsers; + procedure Clear; + procedure LoadLists; + procedure LoadUserList(const Group: String); + procedure LoadGroupList; + procedure SaveUsers; + end; + +var + MainForm: TMainForm; + +implementation + +uses Math, frxServerConfig, UserEditor, GroupEditor +{$IFDEF Delphi7} +, XPMan +{$ENDIF}; + +{$R *.dfm} + +procedure TMainForm.Clear; +begin + UserList.Items.Clear; + GroupList.Items.Clear; + CBox_Group.Clear; +end; + +procedure TMainForm.LoadGroupList; +var + i: Integer; + ListItem: TListItem; + s: String; +begin + GroupList.Items.BeginUpdate; + GroupList.Items.Clear; + for i := 0 to ServerUsers.GroupList.Count - 1 do + begin + ListItem := GroupList.Items.Add; + ListItem.Caption := ServerUsers.GroupList[i]; + ListItem.Data := ServerUsers.GroupList.Objects[i]; + ListItem.SubItems.Add(TfrxUserGroupItem(ServerUsers.GroupList.Objects[i]).FullName); + end; + GroupList.Items.EndUpdate; + s := CBox_Group.Text; + CBox_Group.Clear; + CBox_Group.Items.AddObject('All groups', nil); + for i := 0 to ServerUsers.GroupList.Count - 1 do + CBox_Group.Items.AddObject(ServerUsers.GroupList[i], ServerUsers.GroupList.Objects[i]); + if CBox_Group.Items.Count > 0 then + begin + i := CBox_Group.Items.IndexOf(s); + if i = -1 then + CBox_Group.ItemIndex := 0 + else + CBox_Group.ItemIndex := i; + end; +end; + +procedure TMainForm.LoadLists; +begin + LoadUserList(CBox_Group.Text); + LoadGroupList; +end; + +procedure TMainForm.LoadUserList(const Group: String); +var + i, j: Integer; + s: String; + ListItem: TListItem; +begin + UserList.Items.BeginUpdate; + UserList.Items.Clear; + for i := 0 to ServerUsers.UserList.Count - 1 do + begin + if (Group = 'All groups') or ServerUsers.MemberOfGroup(ServerUsers.UserList[i], Group) then + begin + ListItem := UserList.Items.Add; + ListItem.Caption := ServerUsers.UserList[i]; + ListItem.Data := ServerUsers.UserList.Objects[i]; + ListItem.SubItems.Add(TfrxUserGroupItem(ServerUsers.UserList.Objects[i]).FullName); + s := ''; + for j := 0 to TfrxUserGroupItem(ServerUsers.UserList.Objects[i]).Members.Count - 1 do + s := s + TfrxUserGroupItem(ServerUsers.UserList.Objects[i]).Members[j] + ','; + if (Length(s) > 0) and (s[Length(s)] = ',') then + SetLength(s, Length(s) - 1); + ListItem.SubItems.Add(s); + end; + end; + UserList.Items.EndUpdate; +end; + +procedure TMainForm.SaveUsers; +begin + ServerUsers.SaveToFile('users.xml'); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + Clear; + ServerUsers.Free; +end; + +procedure TMainForm.CBox_GroupChange(Sender: TObject); +begin + LoadUserList(CBox_Group.Text); +end; + +procedure TMainForm.EditBtnClick(Sender: TObject); +var + Item: TfrxUserGroupItem; + i: Integer; + FakePass: String; +begin + if (PageControl.ActivePage = UserTab) and (UserList.Items.Count > 0) + and (UserList.Selected <> nil) then + begin + EditUserForm := TEditUserForm.Create(Self); + try + Item := TfrxUserGroupItem(UserList.Selected.Data); + EditUserForm.ELogin.Text := Item.Name; + EditUserForm.ELogin.Enabled := False; + EditUserForm.EFullName.Text := Item.FullName; + EditUserForm.EEmail.Text := Item.Email; + EditUserForm.CBActive.Checked := Item.Active; + FakePass := '---------'; + EditUserForm.EPassword.Text := FakePass; + for i := 0 to Item.Members.Count - 1 do + EditUserForm.MemberBox.Items.Add(Item.Members[i]); + for i := 0 to ServerUsers.GroupList.Count - 1 do + if Item.Members.IndexOf(ServerUsers.GroupList[i]) = -1 then + EditUserForm.AvailBox.Items.Add(ServerUsers.GroupList[i]); + if EditUserForm.ShowModal = mrOk then + begin + if EditUserForm.EPassword.Text <> FakePass then + ServerUsers.ChPasswd(Item.Name, EditUserForm.EPassword.Text); + Item.Active := EditUserForm.CBActive.Checked; + Item.FullName := EditUserForm.EFullName.Text; + Item.Email := EditUserForm.EEmail.Text; + + for i := 0 to EditUserForm.AvailBox.Items.Count - 1 do + begin + ServerUsers.RemoveGroupFromUser(EditUserForm.AvailBox.Items[i], Item.Name); + ServerUsers.RemoveUserFromGroup(Item.Name, EditUserForm.AvailBox.Items[i]); + end; + for i := 0 to EditUserForm.MemberBox.Items.Count - 1 do + ServerUsers.AddUserToGroup(Item.Name, EditUserForm.MemberBox.Items[i]); + SaveUsers; + LoadLists; + end; + finally + EditUserForm.Free; + end; + end else + if (PageControl.ActivePage = GroupTab) and (GroupList.Items.Count > 0) + and (GroupList.Selected <> nil) then + begin + GroupEditorForm := TGroupEditorForm.Create(Self); + try + Item := TfrxUserGroupItem(GroupList.Selected.Data); + GroupEditorForm.ELogin.Text := Item.Name; + GroupEditorForm.ELogin.Enabled := False; + GroupEditorForm.EFullName.Text := Item.FullName; + GroupEditorForm.CBActive.Checked := Item.Active; + GroupEditorForm.EIndex.Text := Item.IndexFile; + if GroupEditorForm.ShowModal = mrOk then + begin + Item.Active := GroupEditorForm.CBActive.Checked; + Item.FullName := GroupEditorForm.EFullName.Text; + Item.IndexFile := GroupEditorForm.EIndex.Text; + SaveUsers; + LoadLists; + end; + finally + GroupEditorForm.Free; + end; + end; +end; + +procedure TMainForm.NewBtnClick(Sender: TObject); +var + Item: TfrxUserGroupItem; + i: Integer; +begin + if (PageControl.ActivePage = UserTab) then + begin + EditUserForm := TEditUserForm.Create(Self); + try + for i := 0 to ServerUsers.GroupList.Count - 1 do + EditUserForm.AvailBox.Items.Add(ServerUsers.GroupList[i]); + if EditUserForm.ShowModal = mrOk then + begin + Item := ServerUsers.AddUser(EditUserForm.ELogin.Text); + if Item <> nil then + begin + ServerUsers.ChPasswd(Item.Name, EditUserForm.EPassword.Text); + Item.Active := EditUserForm.CBActive.Checked; + Item.FullName := EditUserForm.EFullName.Text; + Item.Email := EditUserForm.EEmail.Text; + for i := 0 to EditUserForm.MemberBox.Items.Count - 1 do + ServerUsers.AddUserToGroup(Item.Name, EditUserForm.MemberBox.Items[i]); + SaveUsers; + LoadLists; + end else + MessageDlg('User name already exists!', mtError, [mbOk], 0); + end; + finally + EditUserForm.Free; + end; + end else + if PageControl.ActivePage = GroupTab then + begin + GroupEditorForm := TGroupEditorForm.Create(Self); + try + if GroupEditorForm.ShowModal = mrOk then + begin + Item := ServerUsers.AddGroup(GroupEditorForm.ELogin.Text); + if Item <> nil then + begin + Item.Active := GroupEditorForm.CBActive.Checked; + Item.FullName := GroupEditorForm.EFullName.Text; + SaveUsers; + LoadLists; + end else + MessageDlg('Group name already exists!', mtError, [mbOk], 0); + end; + finally + GroupEditorForm.Free; + end; + end; +end; + +procedure TMainForm.DeleteBtnClick(Sender: TObject); +var + s: String; +begin + if (PageControl.ActivePage = UserTab) and (UserList.Items.Count > 0) + and (UserList.Selected <> nil) then + begin + s := TfrxUserGroupItem(UserList.Selected.Data).Name; + if MessageDlg('Delete user "' + s + '"?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin + ServerUsers.DeleteUser(s); + SaveUsers; + LoadLists; + end; + end else + if (PageControl.ActivePage = GroupTab) and (GroupList.Items.Count > 0) + and (GroupList.Selected <> nil) then + begin + s := TfrxUserGroupItem(GroupList.Selected.Data).Name; + if MessageDlg('Delete group "' + s + '"?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin + ServerUsers.DeleteGroup(s); + SaveUsers; + LoadLists; + end; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + ServerUsers := TfrxUsers.Create; + ServerUsers.LoadFromFile('users.xml'); + LoadLists; +end; + +end. diff --git a/official/4.2/Demos/ClientServer/UserManager/readme.txt b/official/4.2/Demos/ClientServer/UserManager/readme.txt new file mode 100644 index 0000000..5bb481d --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/readme.txt @@ -0,0 +1 @@ +Please copy compiled application in Server folder for access to user.xml file. \ No newline at end of file diff --git a/official/4.2/Demos/ClientServer/UserManager/users.xml b/official/4.2/Demos/ClientServer/UserManager/users.xml new file mode 100644 index 0000000..413d8ca --- /dev/null +++ b/official/4.2/Demos/ClientServer/UserManager/users.xml @@ -0,0 +1,19 @@ + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Dll/CALLDLL.DPR b/official/4.2/Demos/Dll/CALLDLL.DPR new file mode 100644 index 0000000..9531170 --- /dev/null +++ b/official/4.2/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/4.2/Demos/Dll/CALLDLL.RES b/official/4.2/Demos/Dll/CALLDLL.RES new file mode 100644 index 0000000..f1bda73 Binary files /dev/null and b/official/4.2/Demos/Dll/CALLDLL.RES differ diff --git a/official/4.2/Demos/Dll/FormDLL.dfm b/official/4.2/Demos/Dll/FormDLL.dfm new file mode 100644 index 0000000..5c2b2ed Binary files /dev/null and b/official/4.2/Demos/Dll/FormDLL.dfm differ diff --git a/official/4.2/Demos/Dll/FormDLL.pas b/official/4.2/Demos/Dll/FormDLL.pas new file mode 100644 index 0000000..6187279 --- /dev/null +++ b/official/4.2/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/4.2/Demos/Dll/RPTDLL.RES b/official/4.2/Demos/Dll/RPTDLL.RES new file mode 100644 index 0000000..f1bda73 Binary files /dev/null and b/official/4.2/Demos/Dll/RPTDLL.RES differ diff --git a/official/4.2/Demos/Dll/Rptdll.dpr b/official/4.2/Demos/Dll/Rptdll.dpr new file mode 100644 index 0000000..e037fd5 --- /dev/null +++ b/official/4.2/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/4.2/Demos/Dll/TestDLL.dfm b/official/4.2/Demos/Dll/TestDLL.dfm new file mode 100644 index 0000000..58b89b8 Binary files /dev/null and b/official/4.2/Demos/Dll/TestDLL.dfm differ diff --git a/official/4.2/Demos/Dll/TestDLL.pas b/official/4.2/Demos/Dll/TestDLL.pas new file mode 100644 index 0000000..88343aa --- /dev/null +++ b/official/4.2/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/4.2/Demos/EmbedDesigner/Project1.dpr b/official/4.2/Demos/EmbedDesigner/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/Demos/EmbedDesigner/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/4.2/Demos/EmbedDesigner/Project1.res b/official/4.2/Demos/EmbedDesigner/Project1.res new file mode 100644 index 0000000..08ba56e Binary files /dev/null and b/official/4.2/Demos/EmbedDesigner/Project1.res differ diff --git a/official/4.2/Demos/EmbedDesigner/Unit1.dfm b/official/4.2/Demos/EmbedDesigner/Unit1.dfm new file mode 100644 index 0000000..026ceca Binary files /dev/null and b/official/4.2/Demos/EmbedDesigner/Unit1.dfm differ diff --git a/official/4.2/Demos/EmbedDesigner/Unit1.pas b/official/4.2/Demos/EmbedDesigner/Unit1.pas new file mode 100644 index 0000000..5a1360d --- /dev/null +++ b/official/4.2/Demos/EmbedDesigner/Unit1.pas @@ -0,0 +1,178 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + frxDesgn, frxClass, frxPreview, ComCtrls, Menus; + +type + TForm1 = class(TForm) + PageControl1: TPageControl; + DesignerSheet: TTabSheet; + PreviewSheet: TTabSheet; + frxPreview1: TfrxPreview; + frxReport1: TfrxReport; + frxDesigner1: TfrxDesigner; + MainMenu1: TMainMenu; + File1: TMenuItem; + NewMI: TMenuItem; + OpenMI: TMenuItem; + SaveMI: TMenuItem; + SaveasMI: TMenuItem; + N1: TMenuItem; + PreviewMI: TMenuItem; + PagesettingsMI: TMenuItem; + N2: TMenuItem; + ExitMI: TMenuItem; + Edit1: TMenuItem; + UndoMI: TMenuItem; + RedoMI: TMenuItem; + N3: TMenuItem; + CutMI: TMenuItem; + CopyMI: TMenuItem; + PasteMI: TMenuItem; + N4: TMenuItem; + DeleteMI: TMenuItem; + DeletePageMI: TMenuItem; + SelectAllMI: TMenuItem; + GroupMI: TMenuItem; + UngroupMI: TMenuItem; + EditMI: TMenuItem; + N5: TMenuItem; + BringtoFrontMI: TMenuItem; + SendtoBackMI: TMenuItem; + N6: TMenuItem; + FindMI: TMenuItem; + ReplaceMI: TMenuItem; + FindNextMI: TMenuItem; + Report1: TMenuItem; + DataMI: TMenuItem; + VariablesMI: TMenuItem; + StylesMI: TMenuItem; + ReportOptionsMI: TMenuItem; + View1: TMenuItem; + ToolbarsMI: TMenuItem; + N7: TMenuItem; + RulersMI: TMenuItem; + GuidesMI: TMenuItem; + DeleteGuidesMI: TMenuItem; + N8: TMenuItem; + OptionsMI: TMenuItem; + StandardMI: TMenuItem; + TextMI: TMenuItem; + FrameMI: TMenuItem; + AlignmentPaletteMI: TMenuItem; + ObjectInspectorMI: TMenuItem; + DataTreeMI: TMenuItem; + ReportTreeMI: TMenuItem; + Help1: TMenuItem; + HelpContentsMI: TMenuItem; + AboutFastReportMI: TMenuItem; + N9: TMenuItem; + NewReportMI: TMenuItem; + NewPageMI: TMenuItem; + NewDialogMI: TMenuItem; + procedure FormShow(Sender: TObject); + procedure PageControl1Change(Sender: TObject); + procedure ExitMIClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses frxRes; + +procedure TForm1.FormShow(Sender: TObject); +var + Designer: TfrxDesignerForm; +begin + // prevent saving/restoring a report when previewing. This will destroy + // objects that are loaded in the designer and will lead to AV. + frxReport1.EngineOptions.DestroyForms := False; + // set the custom preview + frxReport1.Preview := frxPreview1; + // display the designer + frxReport1.DesignReportInPanel(DesignerSheet); + + // set FR images for our menu + MainMenu1.Images := frxResources.MainButtonImages; + // get the reference to the Designer + Designer := TfrxDesignerForm(frxReport1.Designer); + + // assign FR actions to our menu items + NewMI.Action := Designer.NewItemCmd; + NewReportMI.Action := Designer.NewReportCmd; + NewPageMI.Action := Designer.NewPageCmd; + NewDialogMI.Action := Designer.NewDialogCmd; + OpenMI.Action := Designer.OpenCmd; + SaveMI.Action := Designer.SaveCmd; + SaveasMI.Action := Designer.SaveAsCmd; + PreviewMI.Action := Designer.PreviewCmd; + PageSettingsMI.Action := Designer.PageSettingsCmd; + + UndoMI.Action := Designer.UndoCmd; + RedoMI.Action := Designer.RedoCmd; + CutMI.Action := Designer.CutCmd; + CopyMI.Action := Designer.CopyCmd; + PasteMI.Action := Designer.PasteCmd; + DeleteMI.Action := Designer.DeleteCmd; + DeletePageMI.Action := Designer.DeletePageCmd; + SelectAllMI.Action := Designer.SelectAllCmd; + GroupMI.Action := Designer.GroupCmd; + UngroupMI.Action := Designer.UngroupCmd; + EditMI.Action := Designer.EditCmd; + FindMI.Action := Designer.FindCmd; + ReplaceMI.Action := Designer.ReplaceCmd; + FindNextMI.Action := Designer.FindNextCmd; + BringtoFrontMI.Action := Designer.BringToFrontCmd; + SendtoBackMI.Action := Designer.SendToBackCmd; + + DataMI.Action := Designer.ReportDataCmd; + VariablesMI.Action := Designer.VariablesCmd; + StylesMI.Action := Designer.ReportStylesCmd; + ReportOptionsMI.Action := Designer.ReportOptionsCmd; + + ToolbarsMI.Action := Designer.ToolbarsCmd; + StandardMI.Action := Designer.StandardTBCmd; + TextMI.Action := Designer.TextTBCmd; + FrameMI.Action := Designer.FrameTBCmd; + AlignmentPaletteMI.Action := Designer.AlignTBCmd; + ObjectInspectorMI.Action := Designer.InspectorTBCmd; + DataTreeMI.Action := Designer.DataTreeTBCmd; + ReportTreeMI.Action := Designer.ReportTreeTBCmd; + RulersMI.Action := Designer.ShowRulersCmd; + GuidesMI.Action := Designer.ShowGuidesCmd; + DeleteGuidesMI.Action := Designer.DeleteGuidesCmd; + OptionsMI.Action := Designer.OptionsCmd; + + HelpContentsMI.Action := Designer.HelpContentsCmd; + AboutFastReportMI.Action := Designer.AboutCmd; +end; + +procedure TForm1.PageControl1Change(Sender: TObject); +begin + if PageControl1.ActivePage = PreviewSheet then + frxReport1.PrepareReport +end; + +procedure TForm1.ExitMIClick(Sender: TObject); +begin + Close; +end; + +procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); +begin + frxReport1.Designer.Close; +end; + +end. diff --git a/official/4.2/Demos/InteractiveReport/Project1.dpr b/official/4.2/Demos/InteractiveReport/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/InteractiveReport/Project1.res b/official/4.2/Demos/InteractiveReport/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/InteractiveReport/Project1.res differ diff --git a/official/4.2/Demos/InteractiveReport/Unit1.dfm b/official/4.2/Demos/InteractiveReport/Unit1.dfm new file mode 100644 index 0000000..e39e451 Binary files /dev/null and b/official/4.2/Demos/InteractiveReport/Unit1.dfm differ diff --git a/official/4.2/Demos/InteractiveReport/Unit1.pas b/official/4.2/Demos/InteractiveReport/Unit1.pas new file mode 100644 index 0000000..3f448b1 --- /dev/null +++ b/official/4.2/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/4.2/Demos/Main/1.fr3 b/official/4.2/Demos/Main/1.fr3 new file mode 100644 index 0000000..f9e3ab8 --- /dev/null +++ b/official/4.2/Demos/Main/1.fr3 @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/10.FR3 b/official/4.2/Demos/Main/10.FR3 new file mode 100644 index 0000000..2a30316 --- /dev/null +++ b/official/4.2/Demos/Main/10.FR3 @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/100.fr3 b/official/4.2/Demos/Main/100.fr3 new file mode 100644 index 0000000..f0619eb --- /dev/null +++ b/official/4.2/Demos/Main/100.fr3 @@ -0,0 +1,19 @@ + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/101.fr3 b/official/4.2/Demos/Main/101.fr3 new file mode 100644 index 0000000..a3d524c --- /dev/null +++ b/official/4.2/Demos/Main/101.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/102.fr3 b/official/4.2/Demos/Main/102.fr3 new file mode 100644 index 0000000..c0ef308 --- /dev/null +++ b/official/4.2/Demos/Main/102.fr3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/103.fr3 b/official/4.2/Demos/Main/103.fr3 new file mode 100644 index 0000000..0483570 --- /dev/null +++ b/official/4.2/Demos/Main/103.fr3 @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/official/4.2/Demos/Main/104.fr3 b/official/4.2/Demos/Main/104.fr3 new file mode 100644 index 0000000..df05ae7 --- /dev/null +++ b/official/4.2/Demos/Main/104.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/105.fr3 b/official/4.2/Demos/Main/105.fr3 new file mode 100644 index 0000000..1e5f9f6 --- /dev/null +++ b/official/4.2/Demos/Main/105.fr3 @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/11.FR3 b/official/4.2/Demos/Main/11.FR3 new file mode 100644 index 0000000..b2f7e74 --- /dev/null +++ b/official/4.2/Demos/Main/11.FR3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/12.FR3 b/official/4.2/Demos/Main/12.FR3 new file mode 100644 index 0000000..f4a9ce1 --- /dev/null +++ b/official/4.2/Demos/Main/12.FR3 @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/13.fr3 b/official/4.2/Demos/Main/13.fr3 new file mode 100644 index 0000000..cf59944 --- /dev/null +++ b/official/4.2/Demos/Main/13.fr3 @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/official/4.2/Demos/Main/2.FR3 b/official/4.2/Demos/Main/2.FR3 new file mode 100644 index 0000000..b8dee3f --- /dev/null +++ b/official/4.2/Demos/Main/2.FR3 @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/21.FR3 b/official/4.2/Demos/Main/21.FR3 new file mode 100644 index 0000000..1481b74 --- /dev/null +++ b/official/4.2/Demos/Main/21.FR3 @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/22.FR3 b/official/4.2/Demos/Main/22.FR3 new file mode 100644 index 0000000..a7d8344 --- /dev/null +++ b/official/4.2/Demos/Main/22.FR3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/23.FR3 b/official/4.2/Demos/Main/23.FR3 new file mode 100644 index 0000000..4602809 --- /dev/null +++ b/official/4.2/Demos/Main/23.FR3 @@ -0,0 +1,6 @@ + + + + + + diff --git a/official/4.2/Demos/Main/24.FR3 b/official/4.2/Demos/Main/24.FR3 new file mode 100644 index 0000000..f0d8417 --- /dev/null +++ b/official/4.2/Demos/Main/24.FR3 @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/25.fr3 b/official/4.2/Demos/Main/25.fr3 new file mode 100644 index 0000000..8ebc608 --- /dev/null +++ b/official/4.2/Demos/Main/25.fr3 @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/3.FR3 b/official/4.2/Demos/Main/3.FR3 new file mode 100644 index 0000000..54f8981 --- /dev/null +++ b/official/4.2/Demos/Main/3.FR3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/31.FR3 b/official/4.2/Demos/Main/31.FR3 new file mode 100644 index 0000000..d3fa56f --- /dev/null +++ b/official/4.2/Demos/Main/31.FR3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/32.FR3 b/official/4.2/Demos/Main/32.FR3 new file mode 100644 index 0000000..2d5219a --- /dev/null +++ b/official/4.2/Demos/Main/32.FR3 @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/33.FR3 b/official/4.2/Demos/Main/33.FR3 new file mode 100644 index 0000000..860355b --- /dev/null +++ b/official/4.2/Demos/Main/33.FR3 @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/34.FR3 b/official/4.2/Demos/Main/34.FR3 new file mode 100644 index 0000000..bbab78a --- /dev/null +++ b/official/4.2/Demos/Main/34.FR3 @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/35.fr3 b/official/4.2/Demos/Main/35.fr3 new file mode 100644 index 0000000..0674088 --- /dev/null +++ b/official/4.2/Demos/Main/35.fr3 @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/36.fr3 b/official/4.2/Demos/Main/36.fr3 new file mode 100644 index 0000000..a70c764 --- /dev/null +++ b/official/4.2/Demos/Main/36.fr3 @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/4.FR3 b/official/4.2/Demos/Main/4.FR3 new file mode 100644 index 0000000..c12d517 --- /dev/null +++ b/official/4.2/Demos/Main/4.FR3 @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/41.FR3 b/official/4.2/Demos/Main/41.FR3 new file mode 100644 index 0000000..5338a78 --- /dev/null +++ b/official/4.2/Demos/Main/41.FR3 @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/42.FR3 b/official/4.2/Demos/Main/42.FR3 new file mode 100644 index 0000000..27a5604 --- /dev/null +++ b/official/4.2/Demos/Main/42.FR3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/43.FR3 b/official/4.2/Demos/Main/43.FR3 new file mode 100644 index 0000000..6c445f6 --- /dev/null +++ b/official/4.2/Demos/Main/43.FR3 @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/44.fr3 b/official/4.2/Demos/Main/44.fr3 new file mode 100644 index 0000000..c7c36ca --- /dev/null +++ b/official/4.2/Demos/Main/44.fr3 @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/45.fr3 b/official/4.2/Demos/Main/45.fr3 new file mode 100644 index 0000000..726914e --- /dev/null +++ b/official/4.2/Demos/Main/45.fr3 @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/5.FR3 b/official/4.2/Demos/Main/5.FR3 new file mode 100644 index 0000000..60dcbf5 --- /dev/null +++ b/official/4.2/Demos/Main/5.FR3 @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/51.FR3 b/official/4.2/Demos/Main/51.FR3 new file mode 100644 index 0000000..a166485 --- /dev/null +++ b/official/4.2/Demos/Main/51.FR3 @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/52.FR3 b/official/4.2/Demos/Main/52.FR3 new file mode 100644 index 0000000..0e92260 --- /dev/null +++ b/official/4.2/Demos/Main/52.FR3 @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/6.FR3 b/official/4.2/Demos/Main/6.FR3 new file mode 100644 index 0000000..f8f8483 --- /dev/null +++ b/official/4.2/Demos/Main/6.FR3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/60.fr3 b/official/4.2/Demos/Main/60.fr3 new file mode 100644 index 0000000..32afe7c --- /dev/null +++ b/official/4.2/Demos/Main/60.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/61.FR3 b/official/4.2/Demos/Main/61.FR3 new file mode 100644 index 0000000..3f78734 --- /dev/null +++ b/official/4.2/Demos/Main/61.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/62.FR3 b/official/4.2/Demos/Main/62.FR3 new file mode 100644 index 0000000..748b093 --- /dev/null +++ b/official/4.2/Demos/Main/62.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/63.FR3 b/official/4.2/Demos/Main/63.FR3 new file mode 100644 index 0000000..b56e858 --- /dev/null +++ b/official/4.2/Demos/Main/63.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/64.FR3 b/official/4.2/Demos/Main/64.FR3 new file mode 100644 index 0000000..33d5273 --- /dev/null +++ b/official/4.2/Demos/Main/64.FR3 @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/65.FR3 b/official/4.2/Demos/Main/65.FR3 new file mode 100644 index 0000000..1c54b37 --- /dev/null +++ b/official/4.2/Demos/Main/65.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/66.FR3 b/official/4.2/Demos/Main/66.FR3 new file mode 100644 index 0000000..1f6478f --- /dev/null +++ b/official/4.2/Demos/Main/66.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/67.FR3 b/official/4.2/Demos/Main/67.FR3 new file mode 100644 index 0000000..f0b3505 --- /dev/null +++ b/official/4.2/Demos/Main/67.FR3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/68.FR3 b/official/4.2/Demos/Main/68.FR3 new file mode 100644 index 0000000..147e68e --- /dev/null +++ b/official/4.2/Demos/Main/68.FR3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/69.FR3 b/official/4.2/Demos/Main/69.FR3 new file mode 100644 index 0000000..1e4b3fa --- /dev/null +++ b/official/4.2/Demos/Main/69.FR3 @@ -0,0 +1,7 @@ + + + + + + + diff --git a/official/4.2/Demos/Main/7.FR3 b/official/4.2/Demos/Main/7.FR3 new file mode 100644 index 0000000..4e25511 --- /dev/null +++ b/official/4.2/Demos/Main/7.FR3 @@ -0,0 +1,12 @@ + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/70.fr3 b/official/4.2/Demos/Main/70.fr3 new file mode 100644 index 0000000..978e81d --- /dev/null +++ b/official/4.2/Demos/Main/70.fr3 @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/71.fr3 b/official/4.2/Demos/Main/71.fr3 new file mode 100644 index 0000000..ed3c83d --- /dev/null +++ b/official/4.2/Demos/Main/71.fr3 @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/72.fr3 b/official/4.2/Demos/Main/72.fr3 new file mode 100644 index 0000000..c0864c6 --- /dev/null +++ b/official/4.2/Demos/Main/72.fr3 @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/73.fr3 b/official/4.2/Demos/Main/73.fr3 new file mode 100644 index 0000000..ef85858 --- /dev/null +++ b/official/4.2/Demos/Main/73.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/8.FR3 b/official/4.2/Demos/Main/8.FR3 new file mode 100644 index 0000000..4a6b83f --- /dev/null +++ b/official/4.2/Demos/Main/8.FR3 @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/80.fr3 b/official/4.2/Demos/Main/80.fr3 new file mode 100644 index 0000000..21d4dca --- /dev/null +++ b/official/4.2/Demos/Main/80.fr3 @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/81.fr3 b/official/4.2/Demos/Main/81.fr3 new file mode 100644 index 0000000..8299f81 --- /dev/null +++ b/official/4.2/Demos/Main/81.fr3 @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/82.fr3 b/official/4.2/Demos/Main/82.fr3 new file mode 100644 index 0000000..48950b2 --- /dev/null +++ b/official/4.2/Demos/Main/82.fr3 @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/official/4.2/Demos/Main/9.FR3 b/official/4.2/Demos/Main/9.FR3 new file mode 100644 index 0000000..3d41490 --- /dev/null +++ b/official/4.2/Demos/Main/9.FR3 @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/90.fr3 b/official/4.2/Demos/Main/90.fr3 new file mode 100644 index 0000000..d1df06c --- /dev/null +++ b/official/4.2/Demos/Main/90.fr3 @@ -0,0 +1,13 @@ + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/91.fr3 b/official/4.2/Demos/Main/91.fr3 new file mode 100644 index 0000000..649c56e --- /dev/null +++ b/official/4.2/Demos/Main/91.fr3 @@ -0,0 +1,16 @@ + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/92.fr3 b/official/4.2/Demos/Main/92.fr3 new file mode 100644 index 0000000..be5506d Binary files /dev/null and b/official/4.2/Demos/Main/92.fr3 differ diff --git a/official/4.2/Demos/Main/93.fr3 b/official/4.2/Demos/Main/93.fr3 new file mode 100644 index 0000000..b3b6460 --- /dev/null +++ b/official/4.2/Demos/Main/93.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/94.fr3 b/official/4.2/Demos/Main/94.fr3 new file mode 100644 index 0000000..1b017f5 --- /dev/null +++ b/official/4.2/Demos/Main/94.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/95.fr3 b/official/4.2/Demos/Main/95.fr3 new file mode 100644 index 0000000..8c194fc --- /dev/null +++ b/official/4.2/Demos/Main/95.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/96.fr3 b/official/4.2/Demos/Main/96.fr3 new file mode 100644 index 0000000..2a9474f --- /dev/null +++ b/official/4.2/Demos/Main/96.fr3 @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/97.fr3 b/official/4.2/Demos/Main/97.fr3 new file mode 100644 index 0000000..f1f49ca --- /dev/null +++ b/official/4.2/Demos/Main/97.fr3 @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/98.fr3 b/official/4.2/Demos/Main/98.fr3 new file mode 100644 index 0000000..efd66d8 --- /dev/null +++ b/official/4.2/Demos/Main/98.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/99.fr3 b/official/4.2/Demos/Main/99.fr3 new file mode 100644 index 0000000..e62c649 --- /dev/null +++ b/official/4.2/Demos/Main/99.fr3 @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/4.2/Demos/Main/FRDemo.bdsproj b/official/4.2/Demos/Main/FRDemo.bdsproj new file mode 100644 index 0000000..8fe126b --- /dev/null +++ b/official/4.2/Demos/Main/FRDemo.bdsproj @@ -0,0 +1,175 @@ +п»ї + + + + + + + + + + + FRDemo.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 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 + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + vcl;rtl;dbrtl;adortl;vcldb;vclx;bdertl;vcldbx;ibxpress;dsnap;cds;bdecds;qrpt;teeui;teedb;dss;teeqr;visualclx;visualdbclx;dsnapcrba;dsnapcon;VclSmp;vclshlctrls;dbexpress;dbxcds;dclaxserver;Tee;TeeGL;TeeLanguage;TeePro;TeeImage;fsTee6;frxTee6;fsIBX6;fs6;fqb60;frx6;frxADO6;frxBDE6;frxcs6;frxDB6;frxDBX6;frxe6;frxIBX6;fsADO6;fsBDE6;fsDB6 + + + False + + + + + + False + + + True + False + + + + $00000000 + + + + 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/4.2/Demos/Main/FRDemo.dpr b/official/4.2/Demos/Main/FRDemo.dpr new file mode 100644 index 0000000..86680b9 --- /dev/null +++ b/official/4.2/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/4.2/Demos/Main/FRDemo.res b/official/4.2/Demos/Main/FRDemo.res new file mode 100644 index 0000000..06b79d7 Binary files /dev/null and b/official/4.2/Demos/Main/FRDemo.res differ diff --git a/official/4.2/Demos/Main/Unit1.dfm b/official/4.2/Demos/Main/Unit1.dfm new file mode 100644 index 0000000..9444fc8 Binary files /dev/null and b/official/4.2/Demos/Main/Unit1.dfm differ diff --git a/official/4.2/Demos/Main/Unit1.pas b/official/4.2/Demos/Main/Unit1.pas new file mode 100644 index 0000000..aadaab9 --- /dev/null +++ b/official/4.2/Demos/Main/Unit1.pas @@ -0,0 +1,136 @@ +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, + frxChBox, frxExportText, frxExportCSV, frxExportMail, + frxADOComponents, frxCrypt, frxExportODF, frxPrinter; + +type + TForm1 = class(TForm) + frxDesigner1: TfrxDesigner; + frxBarCodeObject1: TfrxBarCodeObject; + frxRichObject1: TfrxRichObject; + frxDialogControls1: TfrxDialogControls; + ImageList1: TImageList; + Image1: TImage; + Label1: TLabel; + Label3: TLabel; + frxOLEObject1: TfrxOLEObject; + frxCrossObject1: TfrxCrossObject; + frxDotMatrixExport1: TfrxDotMatrixExport; + frxBMPExport1: TfrxBMPExport; + frxJPEGExport1: TfrxJPEGExport; + frxTIFFExport1: TfrxTIFFExport; + frxHTMLExport1: TfrxHTMLExport; + frxXLSExport1: TfrxXLSExport; + frxXMLExport1: TfrxXMLExport; + frxRTFExport1: TfrxRTFExport; + frxGZipCompressor1: TfrxGZipCompressor; + frxPDFExport1: TfrxPDFExport; + Label4: TLabel; + frxCheckBoxObject1: TfrxCheckBoxObject; + frxMailExport1: TfrxMailExport; + frxCSVExport1: TfrxCSVExport; + frxGIFExport1: TfrxGIFExport; + frxSimpleTextExport1: TfrxSimpleTextExport; + frxADOComponents1: TfrxADOComponents; + frxCrypt1: TfrxCrypt; + GroupBox1: TGroupBox; + Tree: TTreeView; + GroupBox2: TGroupBox; + DescriptionM: TMemo; + DesignB: TButton; + PreviewB: TButton; + Label5: TLabel; + Label7: TLabel; + Label2: TLabel; + FileNameL: TLabel; + Shape1: TShape; + frxODSExport1: TfrxODSExport; + frxODTExport1: TfrxODTExport; + frxReport1: TfrxReport; + 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); + procedure Label3Click(Sender: TObject); + private + { Private declarations } + WPath: String; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +uses Unit2, ShellApi +{$IFDEF Delphi7} +, XPMan +{$ENDIF}; + +{$R *.DFM} + +procedure TForm1.FormShow(Sender: TObject); +begin + WPath := ExtractFilePath(Application.ExeName); + Tree.Items[0].Item[0].Selected := True; + Label2.Caption := 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'); + FileNameL.Caption := ' Report file: ' + IntToStr(Node.StateIndex) + '.fr3'; + DescriptionM.Lines := frxReport1.ReportOptions.Description; + end; +end; + +procedure TForm1.Label3Click(Sender: TObject); +begin + ShellExecute(GetDesktopWindow, 'open', + PChar(TLabel(Sender).Caption), nil, nil, sw_ShowNormal); +end; + +end. + + diff --git a/official/4.2/Demos/Main/Unit2.dfm b/official/4.2/Demos/Main/Unit2.dfm new file mode 100644 index 0000000..b164919 Binary files /dev/null and b/official/4.2/Demos/Main/Unit2.dfm differ diff --git a/official/4.2/Demos/Main/Unit2.pas b/official/4.2/Demos/Main/Unit2.pas new file mode 100644 index 0000000..5513fde --- /dev/null +++ b/official/4.2/Demos/Main/Unit2.pas @@ -0,0 +1,154 @@ +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); + ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + ExtractFilePath(Application.ExeName) + 'demo.mdb'; + ADOConnection1.Open; +end; + +end. diff --git a/official/4.2/Demos/Main/crosstest.db b/official/4.2/Demos/Main/crosstest.db new file mode 100644 index 0000000..1865ed1 Binary files /dev/null and b/official/4.2/Demos/Main/crosstest.db differ diff --git a/official/4.2/Demos/Main/demo.mdb b/official/4.2/Demos/Main/demo.mdb new file mode 100644 index 0000000..d959714 Binary files /dev/null and b/official/4.2/Demos/Main/demo.mdb differ diff --git a/official/4.2/Demos/MasterDetailUDS/Project1.dpr b/official/4.2/Demos/MasterDetailUDS/Project1.dpr new file mode 100644 index 0000000..08b344c --- /dev/null +++ b/official/4.2/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/4.2/Demos/MasterDetailUDS/Project1.res b/official/4.2/Demos/MasterDetailUDS/Project1.res new file mode 100644 index 0000000..1228533 Binary files /dev/null and b/official/4.2/Demos/MasterDetailUDS/Project1.res differ diff --git a/official/4.2/Demos/MasterDetailUDS/Unit1.dfm b/official/4.2/Demos/MasterDetailUDS/Unit1.dfm new file mode 100644 index 0000000..fadf0d7 --- /dev/null +++ b/official/4.2/Demos/MasterDetailUDS/Unit1.dfm @@ -0,0 +1,132 @@ +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 = '4.0a' + 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' + PrintOptions.PrintOnSheet = 0 + 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 = 18.89765 + 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 = 60.47248 + 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/4.2/Demos/MasterDetailUDS/Unit1.pas b/official/4.2/Demos/MasterDetailUDS/Unit1.pas new file mode 100644 index 0000000..4c9acfe --- /dev/null +++ b/official/4.2/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 + ('1', 'detail 1.1'), ('1', 'detail 1.2'), ('1', 'detail 1.3'), + ('1', 'detail 1.4'), ('1', 'detail 1.5'), ('2', 'detail 2.1'), + ('2', 'detail 2.2'), ('2', 'detail 2.3'), ('2', 'detail 2.4'), + ('2', 'detail 2.5'), ('3', 'detail 3.1'), ('3', 'detail 3.2'), + ('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/4.2/Demos/PrintArray/Project1.dpr b/official/4.2/Demos/PrintArray/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintArray/Project1.res b/official/4.2/Demos/PrintArray/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/PrintArray/Project1.res differ diff --git a/official/4.2/Demos/PrintArray/Unit1.dfm b/official/4.2/Demos/PrintArray/Unit1.dfm new file mode 100644 index 0000000..18df611 Binary files /dev/null and b/official/4.2/Demos/PrintArray/Unit1.dfm differ diff --git a/official/4.2/Demos/PrintArray/Unit1.pas b/official/4.2/Demos/PrintArray/Unit1.pas new file mode 100644 index 0000000..b5d3953 --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintFile/Project1.dpr b/official/4.2/Demos/PrintFile/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintFile/Project1.res b/official/4.2/Demos/PrintFile/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/PrintFile/Project1.res differ diff --git a/official/4.2/Demos/PrintFile/Unit1.dfm b/official/4.2/Demos/PrintFile/Unit1.dfm new file mode 100644 index 0000000..d221ca5 Binary files /dev/null and b/official/4.2/Demos/PrintFile/Unit1.dfm differ diff --git a/official/4.2/Demos/PrintFile/Unit1.pas b/official/4.2/Demos/PrintFile/Unit1.pas new file mode 100644 index 0000000..90c23dd --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintStringGrid/Project1.dpr b/official/4.2/Demos/PrintStringGrid/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintStringGrid/Project1.res b/official/4.2/Demos/PrintStringGrid/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/PrintStringGrid/Project1.res differ diff --git a/official/4.2/Demos/PrintStringGrid/Unit1.dfm b/official/4.2/Demos/PrintStringGrid/Unit1.dfm new file mode 100644 index 0000000..eb34965 Binary files /dev/null and b/official/4.2/Demos/PrintStringGrid/Unit1.dfm differ diff --git a/official/4.2/Demos/PrintStringGrid/Unit1.pas b/official/4.2/Demos/PrintStringGrid/Unit1.pas new file mode 100644 index 0000000..94899d1 --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintStringList/Project1.dpr b/official/4.2/Demos/PrintStringList/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintStringList/Project1.res b/official/4.2/Demos/PrintStringList/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/PrintStringList/Project1.res differ diff --git a/official/4.2/Demos/PrintStringList/Unit1.dfm b/official/4.2/Demos/PrintStringList/Unit1.dfm new file mode 100644 index 0000000..a0480f8 Binary files /dev/null and b/official/4.2/Demos/PrintStringList/Unit1.dfm differ diff --git a/official/4.2/Demos/PrintStringList/Unit1.pas b/official/4.2/Demos/PrintStringList/Unit1.pas new file mode 100644 index 0000000..5c379c3 --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintTable/Project1.dpr b/official/4.2/Demos/PrintTable/Project1.dpr new file mode 100644 index 0000000..79c301d --- /dev/null +++ b/official/4.2/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/4.2/Demos/PrintTable/Project1.res b/official/4.2/Demos/PrintTable/Project1.res new file mode 100644 index 0000000..6d7afb5 Binary files /dev/null and b/official/4.2/Demos/PrintTable/Project1.res differ diff --git a/official/4.2/Demos/PrintTable/Unit1.dfm b/official/4.2/Demos/PrintTable/Unit1.dfm new file mode 100644 index 0000000..301a481 Binary files /dev/null and b/official/4.2/Demos/PrintTable/Unit1.dfm differ diff --git a/official/4.2/Demos/PrintTable/Unit1.pas b/official/4.2/Demos/PrintTable/Unit1.pas new file mode 100644 index 0000000..e2b1d57 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Main.dfm b/official/4.2/Extra/New DB Engine/Main.dfm new file mode 100644 index 0000000..1f71b9d Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Main.dfm differ diff --git a/official/4.2/Extra/New DB Engine/Main.pas b/official/4.2/Extra/New DB Engine/Main.pas new file mode 100644 index 0000000..6c8719a --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/NewEngine.dpr b/official/4.2/Extra/New DB Engine/NewEngine.dpr new file mode 100644 index 0000000..d9ecaad --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/NewEngine.res b/official/4.2/Extra/New DB Engine/NewEngine.res new file mode 100644 index 0000000..c832058 Binary files /dev/null and b/official/4.2/Extra/New DB Engine/NewEngine.res differ diff --git a/official/4.2/Extra/New DB Engine/Template/dclfrxXXX4.dpk b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX4.dpk new file mode 100644 index 0000000..d42154b --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/dclfrxXXX5.dpk b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX5.dpk new file mode 100644 index 0000000..2b8265d --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/dclfrxXXX6.dpk b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX6.dpk new file mode 100644 index 0000000..e00f322 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/dclfrxXXX7.dpk b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX7.dpk new file mode 100644 index 0000000..b52d81a --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/dclfrxXXX9.bdsproj b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX9.bdsproj new file mode 100644 index 0000000..f9ecffb --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/dclfrxXXX9.dpk b/official/4.2/Extra/New DB Engine/Template/dclfrxXXX9.dpk new file mode 100644 index 0000000..60d4955 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/file_id.diz b/official/4.2/Extra/New DB Engine/Template/file_id.diz new file mode 100644 index 0000000..a5c17f8 --- /dev/null +++ b/official/4.2/Extra/New DB Engine/Template/file_id.diz @@ -0,0 +1,3 @@ +IdComments + +IdCopyright \ No newline at end of file diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXX4.bpk b/official/4.2/Extra/New DB Engine/Template/frxXXX4.bpk new file mode 100644 index 0000000..793756c --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX4.cpp b/official/4.2/Extra/New DB Engine/Template/frxXXX4.cpp new file mode 100644 index 0000000..b2b7a42 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX4.dpk b/official/4.2/Extra/New DB Engine/Template/frxXXX4.dpk new file mode 100644 index 0000000..65001c7 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX4.res b/official/4.2/Extra/New DB Engine/Template/frxXXX4.res new file mode 100644 index 0000000..eb2597a Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Template/frxXXX4.res differ diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXX5.bpk b/official/4.2/Extra/New DB Engine/Template/frxXXX5.bpk new file mode 100644 index 0000000..a1f8fc6 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX5.cpp b/official/4.2/Extra/New DB Engine/Template/frxXXX5.cpp new file mode 100644 index 0000000..88b89f8 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX5.dpk b/official/4.2/Extra/New DB Engine/Template/frxXXX5.dpk new file mode 100644 index 0000000..db72b8d --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX5.res b/official/4.2/Extra/New DB Engine/Template/frxXXX5.res new file mode 100644 index 0000000..da3d366 Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Template/frxXXX5.res differ diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXX6.bpk b/official/4.2/Extra/New DB Engine/Template/frxXXX6.bpk new file mode 100644 index 0000000..261f387 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX6.cpp b/official/4.2/Extra/New DB Engine/Template/frxXXX6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX6.dpk b/official/4.2/Extra/New DB Engine/Template/frxXXX6.dpk new file mode 100644 index 0000000..4770ce9 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX6.res b/official/4.2/Extra/New DB Engine/Template/frxXXX6.res new file mode 100644 index 0000000..2bbdbc1 Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Template/frxXXX6.res differ diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXX7.dpk b/official/4.2/Extra/New DB Engine/Template/frxXXX7.dpk new file mode 100644 index 0000000..3a14558 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX9.bdsproj b/official/4.2/Extra/New DB Engine/Template/frxXXX9.bdsproj new file mode 100644 index 0000000..f21e329 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXX9.dpk b/official/4.2/Extra/New DB Engine/Template/frxXXX9.dpk new file mode 100644 index 0000000..6a761bc --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXXComponents.pas b/official/4.2/Extra/New DB Engine/Template/frxXXXComponents.pas new file mode 100644 index 0000000..d96e46b --- /dev/null +++ b/official/4.2/Extra/New DB Engine/Template/frxXXXComponents.pas @@ -0,0 +1,497 @@ + +{******************************************} +{ } +{ 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; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + 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; + +procedure TfrxXXXComponents.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited; + if (AComponent = FDefaultDatabase) and (Operation = opRemove) then + FDefaultDatabase := nil; +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 + BeforeConnect(Value); + 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} + + +initialization + 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/4.2/Extra/New DB Engine/Template/frxXXXComponents.res b/official/4.2/Extra/New DB Engine/Template/frxXXXComponents.res new file mode 100644 index 0000000..5003505 Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Template/frxXXXComponents.res differ diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXXEditor.pas b/official/4.2/Extra/New DB Engine/Template/frxXXXEditor.pas new file mode 100644 index 0000000..933c527 --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXXRTTI.pas b/official/4.2/Extra/New DB Engine/Template/frxXXXRTTI.pas new file mode 100644 index 0000000..d9e22dd --- /dev/null +++ b/official/4.2/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/4.2/Extra/New DB Engine/Template/frxXXXReg.dcr b/official/4.2/Extra/New DB Engine/Template/frxXXXReg.dcr new file mode 100644 index 0000000..afd0cd9 Binary files /dev/null and b/official/4.2/Extra/New DB Engine/Template/frxXXXReg.dcr differ diff --git a/official/4.2/Extra/New DB Engine/Template/frxXXXReg.pas b/official/4.2/Extra/New DB Engine/Template/frxXXXReg.pas new file mode 100644 index 0000000..8a72a7c --- /dev/null +++ b/official/4.2/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/4.2/FastQB/adler32.zobj b/official/4.2/FastQB/adler32.zobj new file mode 100644 index 0000000..04e2028 Binary files /dev/null and b/official/4.2/FastQB/adler32.zobj differ diff --git a/official/4.2/FastQB/compress.zobj b/official/4.2/FastQB/compress.zobj new file mode 100644 index 0000000..4de94fa Binary files /dev/null and b/official/4.2/FastQB/compress.zobj differ diff --git a/official/4.2/FastQB/crc32.zobj b/official/4.2/FastQB/crc32.zobj new file mode 100644 index 0000000..4b7261c Binary files /dev/null and b/official/4.2/FastQB/crc32.zobj differ diff --git a/official/4.2/FastQB/deflate.zobj b/official/4.2/FastQB/deflate.zobj new file mode 100644 index 0000000..8cf3759 Binary files /dev/null and b/official/4.2/FastQB/deflate.zobj differ diff --git a/official/4.2/FastQB/fqb.dcr b/official/4.2/FastQB/fqb.dcr new file mode 100644 index 0000000..1f3ca4c Binary files /dev/null and b/official/4.2/FastQB/fqb.dcr differ diff --git a/official/4.2/FastQB/fqb.inc b/official/4.2/FastQB/fqb.inc new file mode 100644 index 0000000..6ec0138 --- /dev/null +++ b/official/4.2/FastQB/fqb.inc @@ -0,0 +1,120 @@ +{*******************************************} +{ } +{ 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 VER185} // Delphi 11.0 (Spacely) + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$DEFINE Delphi11} + {$WARN UNSAFE_CODE OFF} +{$ENDIF} + +{$IFDEF VER190} // Delphi 11.0 (Highlander) + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$DEFINE Delphi11} + {$WARN UNSAFE_CODE OFF} +{$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/4.2/FastQB/fqb.lrs b/official/4.2/FastQB/fqb.lrs new file mode 100644 index 0000000..f9246f9 --- /dev/null +++ b/official/4.2/FastQB/fqb.lrs @@ -0,0 +1,434 @@ +LazarusResources.Add('TFQBDIALOG','BMP',[ + 'BM'#248#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 + +#194#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#156'7'#14#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#155'7'#15#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#156'7'#14#255#255#255#255#255#255#255#255#255#255#255#255#187's' + +'B'#186'o@'#184'l='#182'h:'#181'e7'#178'b4'#177'_1'#175'\/'#174'Y,'#171'U)' + +#170'S'''#168'O$'#166'L!'#165'J'#31#163'G'#29#161'D'#27#160'A'#24#157'<'#19 + +#156'9'#15#156'7'#14#156'8'#16#155'7'#15#255#255#255#255#255#255#189'uE'#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#155'7'#15#228 + +#172#142#155'8'#15#255#255#255#255#255#255#191'xG'#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#14'z'#27#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#155'7'#15#156'7'#14#255#255 + +#255#255#255#255#192'zI'#248#248#248#248#248#248#248#248#248#248#248#248#14 + +'z'#27#14'z'#27'N'#210'x'#14'z'#27#248#248#248#175'Z-'#173'W+'#171'T('#169'Q' + +'&'#168'N#'#166'K '#164'H'#30#162'E'#28#160'B'#25#156':'#16#248#248#248#156 + +'8'#15#163'D'#30#255#255#255#193'}K'#248#248#248#248#248#248#248#248#248#28 + +#142'0N'#210'xZ'#226#137']'#230#142'R'#217'~'#14'z'#27#176']0'#248#248#248 + +#180'e7'#248#248#248#234#179#139#224#162'z'#155'7'#15#248#248#248#234#179#139 + +#160'A'#24#248#248#248#156'9'#15#156'7'#14#255#255#255#195#128'M'#248#248#248 + +#248#248#248#28#142'0.'#180'O%'#161'>'#24#151'#^'#231#143'/'#154'@'#248#248 + +#248#178'`3'#248#248#248#180'e7'#248#248#248#217'vN'#213'rJ'#160';'#18#176'L' + +'#'#248#248#248#162'D'#27#248#248#248#155'8'#15#156'7'#14#255#255#255#197#130 + +'P'#248#248#248#248#248#248#24#151'#;'#163'J'#248#248#248#248#248#248'/'#154 + +'@'#248#248#248#248#248#248#179'c5'#248#248#248#180'e7'#248#248#248#234#179 + +#139#234#179#139#248#248#248#156'7'#14#155'7'#15#160'@'#22#155'7'#15#156'7' + +#14#202#148'~'#255#255#255#197#133'R'#248#248#248#248#248#248#18#130#28#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#180'e7' + +#174'[.'#174'[.'#174'[.'#174'[.'#174'[.'#174'[.'#169'Q%'#176']0'#156':'#18 + +#155'7'#15#156'9'#15#255#255#255#255#255#255#199#135'S'#248#248#248#196#130 + +'O'#194'L'#193'|J'#191'yG'#190'uD'#188'sB'#186'o?'#184'l='#182'h:'#228#172 + +#142#180'e7'#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#156';'#17#248#248#248#156':'#16#255#255#255#255#255#255#200#138'V' + +#248#248#248#198#132'Q'#248#248#248#202#141'Y'#248#248#248#234#179#139#234 + +#179#139#234#179#139#234#179#139#248#248#248#182'h9'#179'e6'#178'a3'#176'^1' + +#163'G'#28#157'<'#18#156':'#16#156':'#16#156':'#16#248#248#248#156':'#16#255 + +#255#255#255#255#255#202#139'X'#248#248#248#198#134'T'#248#248#248#202#141'Y' + +#248#248#248#217'vN'#217'vN'#217'vN'#217'vN'#248#248#248#183'k<'#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#165'K '#255#255#255#255#255#255#203#142'Z'#248#248#248 + +#200#136'V'#248#248#248#202#141'Y'#234#179#139#234#179#139#234#179#139#234 + +#179#139#234#179#139#248#248#248#185'm>'#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#167 + +'N#'#255#255#255#255#255#255#204#144'['#248#248#248#202#139'W'#195'M'#195'' + +'M'#195'M'#195'M'#195'M'#195'M'#195'M'#195'M'#187'pA'#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#168'P%'#255#255#255#255#255#255#205#145'\'#248#248#248#202 + +#141'Y'#248#248#248#202#141'Y'#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#188'tB'#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#170'R''' + ,#255#255#255#255#255#255#206#147'^'#248#248#248#203#143'['#202#140'X'#201#138 + +'W'#200#136'T'#198#133'R'#196#130'P'#195'M'#193'|J'#192'yH'#190'vE'#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#172'U)'#255#255#255#255#255#255#207#149'`'#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248#248 + +#248#173'Y,'#255#255#255#255#255#255#207#150'a'#206#149'_'#205#147'^'#205#144 + +'\'#203#143'Z'#202#140'X'#201#138'V'#199#135'S'#197#132'R'#196#129'O'#194'L' + +#193'{I'#190'xG'#189'uD'#188'rA'#186'o?'#184'l<'#181'h9'#180'e6'#178'b3'#177 + +'^1'#175'[/'#255#255#255#255#255#255#208#152'b'#208#150'`'#207#148'_'#206#146 + +'^'#204#144'['#203#142'Z'#201#140'X'#200#137'V'#198#135'S'#197#132'Q'#196#128 + +'N'#194'~L'#192'zI'#191'xF'#189'tD'#187'qA'#186'n?'#184'k<'#182'h9'#179'd6' + +#178'a3'#176']1'#255#255#255#255#255#255#209#153'c'#208#151'a'#207#150'a'#206 + +#148'_'#205#146'^'#204#144'['#203#141'Y'#201#139'W'#200#137'V'#199#134'S'#197 + +#131'Q'#195#129'N'#194'}L'#192'zI'#190'wG'#188'tD'#187'qA'#185'n?'#183'k<' + +#181'g9'#179'd6'#178'`3'#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#0#0 +]); +LazarusResources.Add('TFQBTABLEAREA','BMP',[ + 'BM'#248#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 + +#194#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#185'n>'#184'k<'#182'i:'#181'f8' + +#179'd5'#178'a3'#177'^0'#175'[.'#174'Y-'#173'V*'#171'T('#169'R&'#168'P$'#167 + +'M"'#166'K '#165'I'#30#164'F'#29#163'E'#27#162'C'#25#161'A'#24#160'@'#23#159 + +'>'#21#255#255#255#255#255#255#187'q@'#250#244#234#159'>'#21#250#243#231#250 + +#243#229#250#242#228#250#241#227#249#241#226#250#240#224#249#240#224#249#239 + +#222#249#238#221#248#238#220#249#238#219#248#237#218#248#236#218#248#236#216 + +#159'>'#21#247#235#215#159'>'#21#247#235#213#160'?'#22#255#255#255#255#255 + +#255#188'sC'#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159 + +'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21 + +#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#161'@'#24#255 + +#255#255#255#255#255#190'uD'#251#245#234#250#244#233#250#244#231#250#244#230 + +#250#242#229#249#242#228#249#242#227#249#241#225#249#240#224#249#240#222#249 + +#240#222#248#239#221#248#238#220#247#238#219#248#237#218#247#237#217#247#237 + +#216#247#237#215#159'>'#21#247#236#214#161'B'#25#255#255#255#255#255#255#191 + +'xG'#251#246#235#251#245#234#250#245#233#250#244#231#250#244#231#249#243#229 + +#249#242#228#249#242#227#249#241#226#249#241#224#248#240#223#248#240#222#248 + +#239#221#248#238#220#248#238#218#248#237#217#248#237#216#248#237#216#159'>' + +#21#159'>'#21#162'D'#26#255#255#255#255#255#255#192'{I'#251#247#237#251#246 + +#235#251#245#235#250#244#233#250#244#232#250#243#230#250#243#229#250#242#227 + +#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#248 + +#238#217#159'>'#21#247#236#216#164'F'#29#255#255#255#255#255#255#193'}K'#252 + +#246#239#251#247#237#251#245#235#251#246#234#250#244#233#250#243#231#250#243 + +#231#250#243#229#173'V*'#249#242#226#249#241#226#249#241#224#249#240#222#248 + +#240#222#249#239#221#248#238#220#173'V*'#248#238#217#159'>'#21#248#236#217 + +#165'I'#30#255#255#255#255#255#255#194'M'#252#247#240#251#246#238#251#246 + +#237#251#246#236#251#245#235#250#244#233#250#244#232#250#243#230#173'V*'#249 + +#242#228#199'm@'#199'm@'#199'm@'#199'm@'#199'm@'#248#238#221#173'V*'#248#238 + +#219#159'>'#21#249#237#218#166'J'#31#255#255#255#255#255#255#196#129'O'#252 + +#248#241#252#247#239#251#247#238#249#243#229#249#243#229'$'#141'4'#249#243 + +#229#249#243#229#173'V*'#249#243#229#173'V*'#173'V*'#173'V*'#173'V*'#173'V*' + +#248#239#222#173'V*'#248#239#219#159'>'#21#248#238#219#167'L!'#255#255#255 + +#255#255#255#198#132'Q'#252#248#242#252#248#241#239#242#229'7'#152'E'#22#133 + +'&R'#216'~&'#156'?'#249#243#229#173'V*'#250#243#230#249#243#229#250#242#227 + +#250#241#227#250#241#226#249#241#224#249#240#222#173'V*'#248#239#221#159'>' + +#21#249#238#220#169'N#'#255#255#255#255#255#255#198#134'S'#252#249#243#239 + +#243#231'8'#156'HE'#199'kU'#221#129'`'#234#146'\'#228#138#25#137'+'#173'V*' + +#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#249#239#222 + +#159'>'#21#249#238#221#170'Q%'#255#255#255#255#255#255#200#136'T'#252#250#245 + +'?'#159'L0'#177'MC'#174'Y:'#159'=P'#212'xB'#168'T'#252#249#242#252#249#242 + +#250#245#233#250#244#232#250#243#231#250#243#230#250#242#228#249#241#227#249 + +#241#226#249#240#224#248#240#223#159'>'#21#248#239#223#171'S'''#255#255#255 + +#255#255#255#201#138'W'#253#250#245'7'#162'=@'#163'K'#252#249#242#252#248#241 + +'W'#169'^'#252#249#242#251#246#237#251#245#235#251#245#234#251#244#233#250 + +#244#231#250#243#230#250#243#229#249#242#227#249#242#226#249#241#226#249#241 + +#224#159'>'#21#249#239#224#171'U)'#255#255#255#255#255#255#201#140'X'#253#250 + +#246#31#136'('#252#249#242#253#249#243#252#249#242#251#248#241#252#247#240 + +#251#247#238#251#246#237#251#246#236#251#246#234#251#245#233#251#244#232#250 + +#244#230#250#243#229#249#242#228#249#242#226#249#242#226#159'>'#21#249#240 + +#225#173'X+'#255#255#255#255#255#255#203#142'Z'#253#251#247#173'V*'#173'V*' + +#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#251#245#235#251#245 + +#235#250#244#233#250#244#232#250#244#231#250#243#229#250#242#228#249#241#226 + +#159'>'#21#249#240#226#175'Z-'#255#255#255#255#255#255#204#144'['#253#251#248 + +#173'V*'#253#250#247#253#250#246#252#249#245#252#249#243#252#249#242#252#248 + +#241#252#247#240#173'V*'#251#246#237#251#246#236#251#245#234#251#244#233#250 + +#244#231#250#243#230#250#243#229#250#243#228#159'>'#21#250#241#227#175']/' + +#255#255#255#255#255#255#205#146']'#254#252#249#173'V*'#253#251#247#199'm@' + +#199'm@'#199'm@'#199'm@'#199'm@'#252#248#240#173'V*'#252#247#238#251#246#237 + +#251#246#235#251#245#234#250#244#233#250#243#232#250#243#230#250#242#229#159 + +'>'#21#250#241#228#177'_1'#255#255#255#255#255#255#206#147'^'#253#252#250#173 + ,'V*'#254#251#248#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#252#248#242#173'V*' + +#252#248#240#251#247#238#251#247#237#251#246#235#251#245#235#251#244#233#251 + +#244#231#250#243#230#159'>'#21#250#242#229#179'a3'#255#255#255#255#255#255 + +#206#148'^'#254#252#251#173'V*'#253#251#249#254#251#248#253#251#248#253#251 + +#247#253#250#245#253#249#244#252#249#243#173'V*'#252#248#241#252#247#239#252 + +#247#239#251#246#237#251#246#236#251#245#234#251#245#233#250#244#232#159'>' + +#21#250#243#231#180'd6'#255#255#255#255#255#255#206#149'`'#254#252#251#173'V' + +'*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#173'V*'#253#248 + +#242#251#248#241#252#248#240#251#247#238#252#246#236#251#246#236#251#245#234 + +#251#245#233#159'>'#21#159'>'#21#181'f8'#255#255#255#255#255#255#207#151'a' + +#254#253#252#254#252#252#254#252#251#253#252#250#254#252#249#254#252#249#253 + +#251#247#253#250#246#253#250#245#253#250#244#252#249#243#253#249#242#252#248 + +#241#252#248#240#251#247#238#251#246#237#251#246#235#250#245#234#159'>'#21 + +#251#244#234#182'i:'#255#255#255#255#255#255#208#152'b'#207#151'a'#206#149'`' + +#206#148'_'#205#147']'#204#145'\'#203#143'['#202#141'Y'#201#139'X'#200#137'V' + +#199#136'T'#197#133'R'#196#131'O'#195#128'N'#194'~L'#192'{J'#192'yH'#189'vF' + +#188'sC'#186'qA'#186'n?'#184'l='#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#0#0 +]); +LazarusResources.Add('TFQBTABLELISTBOX','BMP',[ + 'BM'#248#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 + +#194#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#185'm='#183'j;'#182'h8'#180'e6' + +#179'c5'#178'`3'#176'^0'#175'[.'#174'Y,'#172'W*'#171'U('#169'R&'#169'P$'#168 + +'M#'#167'L '#166'J '#164'H'#29#163'F'#28#162'E'#26#161'C'#25#161'B'#24#160'@' + +#23#255#255#255#255#255#255#185'o?'#250#244#233#251#243#232#250#243#231#250 + +#243#230#250#242#228#250#242#227#249#242#227#249#241#227#249#240#225#249#240 + +#225#248#240#224#248#239#224#248#238#223#248#238#221#248#238#220#248#238#220 + +#247#237#220#247#237#219#159'>'#21#247#237#218#160'A'#24#255#255#255#255#255 + +#255#187'rA'#251#244#234#250#244#233#250#244#232#250#243#231#250#242#230#250 + +#242#230#250#242#229#250#241#228#249#240#227#249#240#226#248#240#225#249#239 + +#224#248#239#223#248#238#222#248#238#222#248#237#222#248#237#221#247#238#220 + +#159'>'#21#159'>'#21#162'C'#25#255#255#255#255#255#255#189'tC'#251#245#235 + +#176'X'#0#176'X'#0#176'X'#0#176'X'#0#249#243#231#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#248 + +#238#220#159'>'#21#247#237#220#163'E'#26#255#255#255#255#255#255#189'wF'#251 + +#245#237#251#245#236#251#244#235#250#244#233#250#243#232#250#243#232#250#243 + +#231#249#242#230#250#242#229#250#242#228#250#241#227#249#240#226#249#240#226 + +#249#240#225#249#239#223#249#239#222#248#239#222#248#238#222#159'>'#21#248 + +#238#220#163'G'#28#255#255#255#255#255#255#191'yH'#251#246#238#176'X'#0#176 + +'X'#0#176'X'#0#176'X'#0#250#243#232#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176 + +'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#248#238#222#159 + +'>'#21#248#238#221#164'H'#30#255#255#255#255#255#255#193'|J'#251#246#239#251 + +#245#238#251#245#237#250#244#236#251#244#234#251#244#234#250#244#234#250#243 + +#233#250#243#232#250#243#230#250#242#230#249#241#228#249#241#227#249#241#226 + +#248#241#225#248#239#225#248#239#224#248#239#223#159'>'#21#248#239#222#165'J' + +#31#255#255#255#255#255#255#194'~L'#252#247#240#209#153'c'#209#153'c'#209#153 + +'c'#209#153'c'#251#245#236#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209 + +#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#249 + +#240#225#159'>'#21#248#238#223#167'L '#255#255#255#255#255#255#195#129'N'#251 + +#247#241#252#247#240#252#246#239#252#246#238#251#245#237#251#245#237#251#245 + +#236#251#244#235#251#244#234#250#243#232#250#243#231#249#242#230#250#242#229 + +#249#242#228#249#242#227#249#240#227#249#240#226#249#240#225#159'>'#21#249 + +#240#224#168'M"'#255#255#255#255#255#255#196#131'P'#252#248#242#209#153'c' + +#209#153'c'#209#153'c'#209#153'c'#251#246#238#209#153'c'#209#153'c'#209#153 + +'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153 + +'c'#209#153'c'#249#241#226#159'>'#21#249#240#224#169'P%'#255#255#255#255#255 + +#255#197#133'R'#253#248#243#252#248#242#252#248#241#252#247#241#252#246#240 + +#252#246#238#251#246#238#251#245#237#251#245#236#250#245#235#251#244#234#250 + +#243#233#250#243#232#250#242#231#250#242#230#250#242#230#249#242#229#249#241 + +#228#159'>'#21#248#240#226#170'R&'#255#255#255#255#255#255#198#135'T'#253#249 + +#244#209#153'c'#209#153'c'#209#153'c'#209#153'c'#252#247#240#209#153'c'#209 + +#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209 + +#153'c'#209#153'c'#209#153'c'#250#241#229#159'>'#21#249#240#227#171'U('#255 + +#255#255#255#255#255#199#137'U'#253#250#246#252#248#244#252#249#243#252#248 + +#242#252#247#241#252#247#241#252#247#240#252#247#239#252#246#238#251#246#238 + +#251#245#236#251#245#235#251#244#234#250#244#234#250#244#233#250#244#231#250 + +#243#231#250#242#230#159'>'#21#250#241#228#172'W*'#255#255#255#255#255#255 + +#200#139'W'#253#249#246'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2#253#248#241'Z'#2#2'Z'#2#2 + +'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2'Z'#2#2#250#243#231 + +#159'>'#21#250#241#229#174'Y,'#255#255#255#255#255#255#201#141'Y'#253#250#247 + +#253#250#246#253#249#245#253#249#244#252#248#244#252#248#244#252#248#243#252 + +#248#242#252#247#241#252#246#239#251#246#238#251#246#238#251#246#237#251#245 + +#235#251#244#235#251#244#234#250#244#233#250#243#232#159'>'#21#249#242#230 + +#175'[.'#255#255#255#255#255#255#202#143'Z'#253#251#248#176'X'#0#176'X'#0#176 + +'X'#0#176'X'#0#253#249#244#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176 + +'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#250#244#234#159'>'#21#250 + +#243#232#176'^0'#255#255#255#255#255#255#203#145'\'#254#251#249#254#250#248 + +#253#250#247#253#250#247#253#250#247#253#250#246#253#249#244#252#249#243#252 + +#248#243#253#247#241#252#247#240#252#247#240#252#246#239#251#246#238#251#245 + +#237#250#245#237#250#245#236#251#244#235#159'>'#21#250#243#232#178'a2'#255 + ,#255#255#255#255#255#204#146'\'#253#251#250#176'X'#0#176'X'#0#176'X'#0#176'X' + +#0#253#250#245#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#176'X'#0#176'X'#0#251#245#236#159'>'#21#250#244#234#179'c' + +'4'#255#255#255#255#255#255#205#148'^'#253#251#250#254#251#249#254#251#249 + +#253#250#248#253#251#247#253#251#246#253#250#246#253#249#246#253#249#245#252 + +#249#244#252#248#243#252#248#242#252#247#241#252#247#240#252#247#239#252#247 + +#239#252#246#238#251#246#237#159'>'#21#251#245#235#180'e7'#255#255#255#255 + +#255#255#206#148'_'#254#252#250#176'X'#0#176'X'#0#176'X'#0#176'X'#0#254#250 + +#248#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#176'X'#0#252#246#238#159'>'#21#159'>'#21#182'h9'#255#255 + +#255#255#255#255#207#150'`'#254#252#251#254#252#250#254#251#250#254#251#250 + +#253#251#250#253#251#248#253#251#248#254#251#248#253#250#247#253#250#246#253 + +#250#245#252#248#244#253#248#243#252#248#242#252#248#241#252#248#241#252#247 + +#241#251#247#239#159'>'#21#251#245#237#183'k;'#255#255#255#255#255#255#207 + +#151'a'#206#150'`'#206#148'_'#205#147'^'#205#146']'#203#144'\'#203#143'Z'#201 + +#141'X'#201#140'W'#199#137'U'#199#135'S'#197#133'Q'#196#131'P'#195#128'N'#194 + +'~L'#193'|I'#191'zH'#189'wE'#189'uD'#188'rB'#186'p@'#185'm>'#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0 +]); +LazarusResources.Add('TFQBSYNTAXMEMO','BMP',[ + 'BM'#248#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 + +#194#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#183'k;'#181'g8'#180'd7'#179'b4' + +#177'`1'#175']/'#174'Z-'#172'W+'#171'U('#170'R&'#168'O$'#167'M"'#166'K'#31 + +#165'I'#30#163'F'#28#162'D'#26#161'B'#24#160'@'#23#159'?'#21#158'<'#20#158';' + +#18#157':'#17#255#255#255#255#255#255#184'm='#251#245#237#251#245#236#251#244 + +#235#251#244#234#250#244#233#250#243#232#249#243#231#250#242#230#250#241#229 + +#249#241#229#249#241#227#248#241#227#249#240#226#248#240#225#248#240#224#248 + +#239#224#248#238#223#248#238#222#247#238#221#247#238#221#158';'#18#255#255 + +#255#255#255#255#186'p@'#251#246#238#251#245#237'QPBQPBQPBQPBQPB'#250#243#231 + +#249#243#230#249#242#229#250#241#228#249#241#227#249#241#227#248#240#226#248 + +#240#225#249#239#225#248#239#223#248#239#223#247#238#222#247#238#222#158'<' + +#20#255#255#255#255#255#255#187'rB'#251#246#238#252#246#238'cfRcfRcfRcfRcfR' + +#250#243#233#249#243#231#249#242#230#249#242#229#249#241#228#249#241#228#249 + +#240#226#249#240#226#248#240#225#248#239#224#248#239#223#248#238#223#247#238 + +#222#159'>'#21#255#255#255#255#255#255#189'uD'#252#246#239#251#246#239#251 + +#246#237#251#245#236#251#245#236#251#245#235#250#244#234#250#244#233#249#243 + +#232#249#242#231#250#242#231#250#242#229#249#242#229#248#241#227#249#241#227 + +#248#240#226#248#240#225#248#240#224#248#239#223#248#238#223#160'@'#23#255 + +#255#255#255#255#255#191'xF'#252#247#241#251#247#239#251#246#239#251#246#238 + +#251#245#237#251#245#236'QPBQPBQPBQPBQPBQPBQPB'#249#242#228#249#241#227#248 + +#241#227#249#241#226#248#240#225#248#240#225#248#239#223#161'B'#25#255#255 + +#255#255#255#255#192'zI'#252#248#241#251#247#241#252#246#240#251#246#239#251 + +#246#238#251#245#236'cfRcfRcfRcfRcfRcfRcfR'#249#242#229#249#241#229#249#241 + +#227#249#241#227#248#240#226#248#240#225#249#239#224#162'D'#26#255#255#255 + +#255#255#255#194'}K'#252#248#242#252#248#241#251#247#241#251#247#240#251#246 + +#238#252#246#238#251#245#237#251#245#236#251#244#235#250#244#234#250#243#233 + +#250#244#232#250#243#231#250#242#230#249#242#229#250#241#228#248#241#227#248 + +#240#227#249#240#226#248#240#225#164'F'#28#255#255#255#255#255#255#195'M' + +#252#249#243#252#248#243#252#247#242#252#248#240#252#247#240#251#246#239#251 + +#246#238#3' '#250#251#245#236#3' '#250#3' '#250#3' '#250#3' '#250#3' '#250#3 + +' '#250#4#6#232#4#6#232#4#6#232#4#6#232#248#241#226#164'H'#30#255#255#255#255 + +#255#255#196#130'O'#252#249#245#252#249#243#252#248#242#252#248#241#252#248 + +#241#252#246#240#252#246#239#3' '#250#250#245#237#3' '#250#3' '#250#3' '#250 + +#3' '#250#3' '#250#4#6#232#4#6#232#4#6#232#4#6#232#4#6#232#249#241#227#166'J' + +' '#255#255#255#255#255#255#198#132'Q'#253#249#245#252#248#244#252#248#243 + +#252#248#242#252#248#241#251#247#240#251#246#240#251#246#239#251#246#238#251 + +#245#237#250#245#236#251#244#235#250#244#234#250#244#233#250#243#232#250#243 + +#232#249#242#231#250#242#229#249#242#229#249#241#228#167'M"'#255#255#255#255 + +#255#255#199#135'S'#253#249#246#253#249#245#252#248#244#252#249#243#253#248 + +#242#251#248#241'QPBQPBQPBQPBQPBQPBQPBQPBQPBQPB'#250#243#231#250#242#231#249 + +#241#229#249#242#229#168'P$'#255#255#255#255#255#255#200#136'U'#253#250#246 + +#253#250#246#253#249#245#253#249#244#252#249#243#252#248#243'cfRcfRcfRcfRcfR' + +'cfRcfRcfRcfRcfR'#249#243#232#249#243#231#249#242#230#249#242#230#170'R&'#255 + +#255#255#255#255#255#201#139'W'#253#250#248#253#250#247#253#250#245#253#249 + +#245#252#249#244#252#248#243#252#248#242#252#248#242#252#247#240#252#247#240 + +#251#246#239#251#246#238#251#246#237#251#245#236#250#244#235#250#244#235#250 + +#243#233#250#243#233#250#243#231#249#242#230#171'U('#255#255#255#255#255#255 + +#202#141'Y'#254#251#248#254#250#247#253#250#246#253#249#246#253#249#245#195 + +'ta'#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#252#246#239#251#245#238#251#246 + +#237#251#245#236#250#244#235#250#244#234#250#243#234#250#244#232#249#243#232 + +#172'W+'#255#255#255#255#255#255#203#143'Z'#253#251#248#254#251#248#253#250 + +#247#253#250#247#253#249#245#253#249#245#252#249#245#253#248#244#252#248#242 + +#252#247#241#251#247#240#252#247#240#251#246#239#251#245#238#251#245#237#251 + +#245#236#251#244#235#250#244#234#250#243#233#250#244#232#174'Z-'#255#255#255 + +#255#255#255#204#144'['#254#251#249#253#251#249#253#251#248#253#250#247#253 + +#250#246#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#251#247#240 + +#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#195'ta'#250#244#233#175'\/'#255#255 + +#255#255#255#255#205#147']'#254#252#250#254#251#249#253#251#249#253#250#248 + +#254#250#247#253#250#247#253#250#246#252#249#245#253#249#244#252#248#243#252 + +#248#243#252#248#242#252#247#241#252#246#240#252#246#239#251#245#238#251#245 + ,#237#251#244#236#251#244#235#250#244#234#177'_2'#255#255#255#255#255#255#206 + +#148'_'#254#252#250#254#251#249'QPBQPBQPBQPBQPBQPB'#252#249#245#252#249#244 + +#253#248#243#252#248#242#252#247#242#252#247#240#251#247#240#251#246#239#251 + +#246#238#251#246#237#251#245#236#251#244#235#179'b4'#255#255#255#255#255#255 + +#207#149'_'#254#252#251#254#252#250'cfRcfRcfRcfRcfRcfR'#253#250#246#253#249 + +#245#252#249#244#252#248#243#253#248#243#252#247#241#252#247#241#251#247#240 + +#252#246#238#251#246#238#251#245#237#251#245#236#180'e7'#255#255#255#255#255 + +#255#208#151'a'#254#252#251#254#251#251#254#252#250#254#251#250#253#251#250 + +#253#251#248#253#251#248#253#250#247#253#250#246#253#249#246#253#249#245#252 + +#248#245#252#248#243#252#248#243#252#248#242#252#247#241#252#247#240#251#246 + +#239#251#246#237#251#246#237#181'h8'#255#255#255#255#255#255#208#152'b'#207 + +#151'a'#207#150'`'#206#148'_'#205#146']'#204#144'\'#203#143'Z'#202#141'X'#201 + +#139'W'#200#137'U'#198#135'T'#197#132'R'#196#130'O'#194'M'#194'}K'#192'zI' + +#191'xF'#189'uD'#188'rB'#186'o?'#184'm>'#183'k;'#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#0#0 +]); +LazarusResources.Add('TFQBGRID','BMP',[ + 'BM'#248#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 + +#194#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#177'a2'#178'c4'#180'e6'#181'h9'#182'j;'#184'm='#185'p?'#186'sB' + +#188'uD'#190'xF'#191'{H'#192'}K'#193'M'#195#129'N'#196#132'Q'#197#134'R'#199 + +#137'T'#199#138'V'#200#140'W'#201#142'X'#202#143'Z'#203#145'['#255#255#255 + +#255#255#255#176'^0'#252#247#241#159'>'#21#251#246#239#251#245#237#250#245 + +#236#250#244#235#250#243#233#250#243#233#249#243#231#249#242#230#249#242#229 + +#249#241#228#248#240#226#249#240#226#249#240#225#248#239#224#248#239#223#248 + +#239#222#248#238#222#247#238#221#202#144'Z'#255#255#255#255#255#255#175'\.' + +#252#247#242#159'>'#21#252#246#239#252#246#238#251#246#237#251#245#236#251 + +#245#235#250#243#234#250#242#232#250#242#231#249#242#229#249#241#229#249#241 + +#228#248#240#226#248#240#226#248#240#225#248#238#224#247#239#223#248#238#222 + +#247#238#221#201#142'Y'#255#255#255#255#255#255#174'[-'#252#248#243#159'>'#21 + +#252#247#241#176'X'#0#176'X'#0#176'X'#0#250#244#236#176'X'#0#176'X'#0#176'X' + +#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#247#238#222#201#141'X'#255#255#255#255#255#255#173'Y+'#253#248#244 + +#159'>'#21#251#247#241#251#247#240#252#246#238#251#245#237#251#245#236#251 + +#245#235#251#244#234#250#244#233#250#242#232#250#242#231#249#241#230#249#241 + +#229#249#241#227#248#240#227#248#240#225#248#239#225#248#238#223#248#238#222 + +#200#140'W'#255#255#255#255#255#255#172'W*'#253#249#244#159'>'#21#252#247#242 + +#176'X'#0#176'X'#0#176'X'#0#251#246#238#176'X'#0#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#247 + +#239#223#199#138'U'#255#255#255#255#255#255#170'U('#252#249#245#159'>'#21#253 + +#248#243#252#247#242#251#247#241#252#246#239#251#246#239#251#246#237#251#244 + +#236#251#244#235#250#244#234#249#243#232#249#243#232#250#241#230#249#241#229 + +#249#241#228#248#240#227#249#240#226#248#240#225#248#239#224#198#137'T'#255 + +#255#255#255#255#255#169'S'''#253#249#246#159'>'#21#252#248#243#209#153'c' + +#209#153'c'#209#153'c'#251#247#239#209#153'c'#209#153'c'#209#153'c'#209#153 + +'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153 + +'c'#209#153'c'#248#239#225#198#134'S'#255#255#255#255#255#255#168'Q%'#253#249 + +#246#159'>'#21#252#249#245#252#249#243#252#248#243#252#248#242#251#246#240 + +#252#246#239#251#246#238#250#245#237#250#245#235#251#244#234#250#243#233#250 + +#243#232#249#242#230#249#241#229#249#241#228#248#241#227#249#241#227#249#239 + +#225#197#132'Q'#255#255#255#255#255#255#168'O#'#254#250#248#159'>'#21#253#249 + +#245#209#153'c'#209#153'c'#209#153'c'#252#247#242#209#153'c'#209#153'c'#209 + +#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209#153'c'#209 + +#153'c'#209#153'c'#248#241#228#248#240#226#196#131'P'#255#255#255#255#255#255 + +#167'N#'#253#251#248#159'>'#21#253#250#246#253#249#245#252#248#244#252#248 + +#243#252#247#242#251#247#241#252#247#240#251#246#239#251#246#238#251#245#236 + +#250#245#235#251#243#234#249#243#232#250#243#232#249#242#231#249#241#230#249 + +#241#228#248#240#227#194#129'N'#255#255#255#255#255#255#165'L!'#254#250#248 + +#159'>'#21#253#250#247#176'X'#0#176'X'#0#176'X'#0#252#248#243#176'X'#0#176'X' + +#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#248#241#228#194'L'#255#255#255#255#255#255#165'K'#31#253 + +#251#249#159'>'#21#253#250#248#253#250#247#253#250#245#253#249#245#253#249 + +#244#252#248#243#251#248#241#252#246#240#252#246#239#251#245#239#250#245#237 + +#251#244#236#250#244#235#250#244#233#250#243#232#249#242#231#249#241#230#249 + +#241#229#192'}K'#255#255#255#255#255#255#165'I'#31#253#251#249#159'>'#21#253 + +#251#248#176'X'#0#176'X'#0#176'X'#0#252#249#245#176'X'#0#176'X'#0#176'X'#0 + +#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#176'X'#0#250 + +#242#231#250#242#229#191'{I'#255#255#255#255#255#255#164'I'#30#254#252#251 + +#159'>'#21#253#251#249#253#251#248#254#250#247#253#250#246#253#249#245#252 + +#249#244#252#249#243#252#248#242#251#248#241#252#246#240#251#246#239#251#245 + ,#238#251#245#237#251#245#235#250#244#234#249#243#233#249#242#232#249#242#231 + +#190'yG'#255#255#255#255#255#255#163'G'#29#159'>'#21#159'>'#21#159'>'#21#159 + +'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21 + +#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>'#21#159'>' + +#21#159'>'#21#189'wF'#255#255#255#255#255#255#163'F'#28#254#252#251#159'>'#21 + +#253#251#250#254#251#249#253#251#248#253#250#248#253#250#247#253#250#246#252 + +#249#245#252#249#244#252#248#243#252#248#242#252#247#241#251#247#239#251#246 + +#238#251#245#237#250#244#236#250#244#234#250#243#234#250#243#232#188'uC'#255 + +#255#255#255#255#255#162'E'#27#163'F'#28#163'H'#29#164'I'#30#165'K'#31#166'L' + +'"'#167'N#'#168'Q$'#169'R'''#170'T('#172'W*'#173'Y,'#174'\.'#175'^0'#177'a2' + +#178'c5'#180'f7'#181'i9'#183'k;'#184'n='#186'q@'#187'sA'#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#0#0 +]); diff --git a/official/4.2/FastQB/fqb100.bdsproj b/official/4.2/FastQB/fqb100.bdsproj new file mode 100644 index 0000000..d28461b --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb100.dpk b/official/4.2/FastQB/fqb100.dpk new file mode 100644 index 0000000..60eebc3 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb110.bdsproj b/official/4.2/FastQB/fqb110.bdsproj new file mode 100644 index 0000000..8ca5fc2 --- /dev/null +++ b/official/4.2/FastQB/fqb110.bdsproj @@ -0,0 +1,161 @@ +п»ї + + + + + + + + + + + fqb110.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/4.2/FastQB/fqb110.dpk b/official/4.2/FastQB/fqb110.dpk new file mode 100644 index 0000000..34e5dc4 --- /dev/null +++ b/official/4.2/FastQB/fqb110.dpk @@ -0,0 +1,47 @@ +package fqb110; + +{$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/4.2/FastQB/fqb40.bpk b/official/4.2/FastQB/fqb40.bpk new file mode 100644 index 0000000..4622d63 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb40.cpp b/official/4.2/FastQB/fqb40.cpp new file mode 100644 index 0000000..a0e4ed2 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb40.dpk b/official/4.2/FastQB/fqb40.dpk new file mode 100644 index 0000000..b5e14a3 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb50.bpk b/official/4.2/FastQB/fqb50.bpk new file mode 100644 index 0000000..3fc8999 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb50.cpp b/official/4.2/FastQB/fqb50.cpp new file mode 100644 index 0000000..9b34e80 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb50.dpk b/official/4.2/FastQB/fqb50.dpk new file mode 100644 index 0000000..a612a4d --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb60.bpk b/official/4.2/FastQB/fqb60.bpk new file mode 100644 index 0000000..5ee1914 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb60.cpp b/official/4.2/FastQB/fqb60.cpp new file mode 100644 index 0000000..55bebe9 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb60.dpk b/official/4.2/FastQB/fqb60.dpk new file mode 100644 index 0000000..ed6a741 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb70.dpk b/official/4.2/FastQB/fqb70.dpk new file mode 100644 index 0000000..0413133 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb90.bdsproj b/official/4.2/FastQB/fqb90.bdsproj new file mode 100644 index 0000000..ec17ecc --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqb90.dpk b/official/4.2/FastQB/fqb90.dpk new file mode 100644 index 0000000..afda5e0 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbClass.pas b/official/4.2/FastQB/fqbClass.pas new file mode 100644 index 0000000..53d3da4 --- /dev/null +++ b/official/4.2/FastQB/fqbClass.pas @@ -0,0 +1,2276 @@ +{*******************************************} +{ } +{ 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; + procedure CreateWnd; 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.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; +end; + +procedure TfqbTableListBox.CreateWnd; +begin + Style := lbOwnerDrawFixed; + ItemHeight := 18; + inherited; +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; + BMPRect: TRect; +begin + inherited DrawItem(Index, Rect, State); + Canvas.FillRect(Rect); + Bitmap := TBitmap.Create; + Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1'); + if Bitmap <> nil then + begin + BMPRect := Bounds(Rect.Left + 3, Rect.Top + 1, 16, 16); + Canvas.BrushCopy(BMPRect,Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), + Bitmap.Canvas.Pixels[0, Bitmap.Height-1]); + end; + Canvas.TextOut(Rect.Left+24, Rect.Top+2, 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 + if not Assigned(FVisibleList) then + Exit; + 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/4.2/FastQB/fqbDesign.dfm b/official/4.2/FastQB/fqbDesign.dfm new file mode 100644 index 0000000..f1289ce Binary files /dev/null and b/official/4.2/FastQB/fqbDesign.dfm differ diff --git a/official/4.2/FastQB/fqbDesign.lfm b/official/4.2/FastQB/fqbDesign.lfm new file mode 100644 index 0000000..039c609 --- /dev/null +++ b/official/4.2/FastQB/fqbDesign.lfm @@ -0,0 +1,680 @@ +object fqbDesigner: TfqbDesigner + Left = 213 + Top = 101 + Width = 828 + Height = 614 + Caption = 'Fast Query Builder Designer' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poDefaultPosOnly + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 820 + Height = 28 + AutoSize = True + BorderWidth = 1 + EdgeBorders = [ebBottom] + Flat = True + Images = ImageList2 + Indent = 2 + TabOrder = 1 + object ToolButton3: TToolButton + Left = 2 + Top = 0 + Hint = 'Open' + ImageIndex = 0 + OnClick = ToolButton3Click + end + object ToolButton4: TToolButton + Left = 25 + Top = 0 + Hint = 'Save' + ImageIndex = 1 + OnClick = ToolButton4Click + end + object ToolButton5: TToolButton + Left = 48 + Top = 0 + Width = 8 + Caption = 'ToolButton5' + ImageIndex = 3 + Style = tbsSeparator + end + object ToolButton6: TToolButton + Left = 56 + Top = 0 + Hint = 'Clear' + ImageIndex = 2 + OnClick = ToolButton6Click + end + object ToolButton8: TToolButton + Left = 79 + Top = 0 + Width = 8 + Caption = 'ToolButton8' + ImageIndex = 7 + Style = tbsSeparator + end + object ToolButton10: TToolButton + Left = 87 + Top = 0 + Hint = 'Cancel' + ImageIndex = 3 + OnClick = ToolButton10Click + end + object ToolButton7: TToolButton + Left = 110 + Top = 0 + Hint = 'Ok' + ImageIndex = 4 + OnClick = ToolButton7Click + end + end + object PageControl1: TPageControl + Left = 0 + Top = 28 + Width = 820 + Height = 552 + ActivePage = TabSheet1 + Align = alClient + TabOrder = 0 + object TabSheet1: TTabSheet + Caption = 'Model' + object Splitter2: TSplitter + Left = 629 + Top = 0 + Width = 3 + Height = 524 + Cursor = crHSplit + Align = alRight + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 629 + Height = 524 + Align = alClient + BevelOuter = bvNone + Caption = 'Panel1' + TabOrder = 1 + object Splitter1: TSplitter + Left = 0 + Top = 360 + Width = 629 + Height = 3 + Cursor = crVSplit + Align = alBottom + end + object fqbTableArea1: TfqbTableArea + Left = 0 + Top = 0 + Width = 629 + Height = 360 + Align = alClient + BorderStyle = bsNone + Color = clAppWorkSpace + ParentColor = False + TabOrder = 0 + end + object fqbGrid1: TfqbGrid + Left = 0 + Top = 363 + Width = 629 + Height = 161 + Align = alBottom + BorderStyle = bsNone + Columns = < + item + Caption = 'Collumn' + Width = 104 + end + item + Caption = 'Visible' + Width = 104 + end + item + Caption = 'Where' + Width = 104 + end + item + Caption = 'Sort' + Width = 104 + end + item + Caption = 'Function' + Width = 104 + end + item + Caption = 'Group' + Width = 105 + end> + ColumnClick = False + DragMode = dmAutomatic + GridLines = True + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + end + end + object fqbTableListBox1: TfqbTableListBox + Left = 632 + Top = 0 + Width = 180 + Height = 524 + Align = alRight + BorderStyle = bsNone + DragMode = dmAutomatic + ItemHeight = 18 + Style = lbOwnerDrawFixed + TabOrder = 0 + end + end + object TabSheet2: TTabSheet + Caption = 'SQL' + ImageIndex = 1 + OnShow = TabSheet2Show + object fqbSyntaxMemo1: TfqbSyntaxMemo + Left = 0 + Top = 0 + Width = 812 + Height = 524 + Cursor = crIBeam + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + ParentColor = False + ParentFont = False + TabOrder = 0 + TabStop = True + BlockColor = clHighlight + BlockFontColor = clHighlightText + CommentAttr.Charset = DEFAULT_CHARSET + CommentAttr.Color = clNavy + CommentAttr.Height = -13 + CommentAttr.Name = 'Courier New' + CommentAttr.Style = [fsItalic] + KeywordAttr.Charset = DEFAULT_CHARSET + KeywordAttr.Color = clWindowText + KeywordAttr.Height = -13 + KeywordAttr.Name = 'Courier New' + KeywordAttr.Style = [fsBold] + StringAttr.Charset = DEFAULT_CHARSET + StringAttr.Color = clNavy + StringAttr.Height = -13 + StringAttr.Name = 'Courier New' + StringAttr.Style = [] + TextAttr.Charset = DEFAULT_CHARSET + TextAttr.Color = clWindowText + TextAttr.Height = -13 + TextAttr.Name = 'Courier New' + TextAttr.Style = [] + Lines.Strings = ( + '') + ReadOnly = True + SyntaxType = stSQL + ShowFooter = True + ShowGutter = True + end + end + object TabSheet3: TTabSheet + Caption = 'Result' + ImageIndex = 2 + OnHide = TabSheet3Hide + OnShow = TabSheet3Show + object DBGrid1: TDBGrid + Left = 0 + Top = 0 + Width = 812 + Height = 524 + Align = alClient + BorderStyle = bsNone + DataSource = DataSource1 + TabOrder = 0 + TitleFont.Charset = DEFAULT_CHARSET + TitleFont.Color = clWindowText + TitleFont.Height = -11 + TitleFont.Name = 'Tahoma' + TitleFont.Style = [] + end + end + end + object DataSource1: TDataSource + Left = 232 + Top = 72 + end + object OpenDialog1: TOpenDialog + DefaultExt = 'sql' + Filter = 'SQL files|*.sql' + Left = 264 + Top = 72 + end + object SaveDialog1: TSaveDialog + Tag = -1 + DefaultExt = 'sql' + Filter = 'SQL files|*.sql' + Left = 296 + Top = 72 + end + object ImageList2: TImageList + Left = 277 + Top = 156 + Bitmap = { + 494C010105000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000E8C3E000D893E0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000001090 + 40000F8E3F000E8C3F000D8A3E00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000119542001192 + 41000F9040000F8E3F000E8B3F000D893E000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000149A4300139743001295 + 410000000000109040000F8E40000E8B3E000C893E0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000159E4500159B4400139943000000 + 000000000000000000000F9041000F8D3F000D8B3E000C883E00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000159D4500000000000000 + 00000000000000000000000000000F8F40000F8D3F000E8B3E000D883E000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000108F40000F8E3F000E8B3F000D88 + 3D00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000F8F40000E8D3F000E8A + 3E000D883E000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000F8F40000E8D + 3F000D8B3F000C883D0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000F8F + 3F000E8C3F000D8A3E000D883E00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000F8F40000E8C3F000D893E000C873D000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000F8F3F000E8C3F00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007088900060809000607880005070 + 8000506070004058600040485000303840002030300020203000101820001010 + 1000101020000000000000000000000000000000000000000000C0686000B058 + 5000A0505000A0505000A0505000904850009048400090484000804040008038 + 4000803840007038400070383000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007088900090A0B00070B0D0000090 + D0000090D0000090D0000090C0001088C0001080B0001080B0002078A0002070 + 90002048600091A1A300000000000000000000000000D0687000F0909000E080 + 8000B048200040302000C0B8B000C0B8B000D0C0C000D0C8C00050505000A040 + 3000A0403000A038300070384000000000000000000000000000D5C0AE008070 + 6000907860009070600000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000B0ADD000A0A + D900000000000000000000000000000000000000000000000000000000000000 + 00000707BD000807BB0000000000000000008088900080C0D00090A8B00080E0 + FF0060D0FF0050C8FF0050C8FF0040C0F00030B0F00030A8F00020A0E0001090 + D00020688000545E6500000000000000000000000000D0707000FF98A000F088 + 8000E0808000705850004040300090787000F0E0E000F0E8E00090807000A040 + 3000A0404000A0403000803840000000000000000000A0807000A0887000D0B0 + A000D0B0A000C0B0A000B098800060483000ACA2990000000000000000000000 + 00000000000000000000000000000000000000000000000000000B0AE0000A0A + DD000A0AD9000000000000000000000000000000000000000000000000000708 + C1000708BF000708BD0000000000000000008090A00080D0F00090A8B00090C0 + D00070D8FF0060D0FF0060D0FF0050C8FF0050C0FF0040B8F00030B0F00030A8 + F0001088D00020486000B7C5C9000000000000000000D0787000FFA0A000F090 + 9000F0888000705850000000000040403000F0D8D000F0E0D00080786000B048 + 4000B0484000A04040008040400000000000C0988000E0C0B000D0C0B000E0D0 + C000F0E0E000FFF8F000B0988000A090800060483000ACA29900000000000000 + 0000000000000000000000000000000000000000000000000000000000000B0B + E1000A0BDD000A0AD900000000000000000000000000000000000809C8000808 + C5000808C1000000000000000000000000008090A00080D8F00080C8E00090A8 + B00080E0FF0070D0FF0060D8FF0060D0FF0060D0FF0050C8FF0040C0F00040B8 + F00030B0F00020688000658A99000000000000000000D0788000FFA8B000FFA0 + A000F0909000705850007058500070585000705850007060500080686000C058 + 5000B0505000B04840008040400000000000D0B0A000F0F0E000F0E8E000F0F0 + F000FFF8FF00FFF8F000FFFFFF00B0988000A090800060483000ACA299000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000B0AE0000A0ADC000A0AD90000000000000000000909CE000808CA000808 + C800000000000000000000000000000000008098A00090E0F00090E0FF0090A8 + B00090B8C00070D8FF0060D8FF0060D8FF0060D8FF0060D0FF0050D0FF0050C8 + FF0040B8F00030A0E00049677700C0CAD10000000000E0808000FFB0B000FFB0 + B000FFA0A000F0909000F0888000E0808000E0788000D0707000D0687000C060 + 6000C0585000B05050009048400000000000D0A89000FFF8FF00FFFFFF00FFFF + FF00F0F0F000F0E8E000F0E0E000FFFFFF00B0988000A090800060483000ACA2 + 9900000000000000000000000000000000000000000000000000000000000000 + 0000000000000A0AE1000A0ADD000A0AD9000A09D5000A0AD1000909CE000000 + 0000000000000000000000000000000000008098A00090E0F000A0E8FF0080C8 + E00090A8B00080E0FF0080E0FF0080E0FF0080E0FF0080E0FF0080E0FF0080E0 + FF0070D8FF0070D8FF0050A8D00085929D0000000000E0889000FFB8C000FFB8 + B000D0606000C0605000C0585000C0504000B0503000B0483000A0402000A038 + 1000C0606000C05850009048400000000000BECBCD00D0A89000FFFFFF00FFFF + FF00FFF8FF00F0F0F000F0E8E000F0E0E000FFFFFF00B0988000A09080006048 + 3000ACA299000000000000000000000000000000000000000000000000000000 + 000000000000000000000B0BE1000A0ADD000A0AD9000A0AD500000000000000 + 00000000000000000000000000000000000090A0A000A0E8F000A0E8FF00A0E8 + FF0090B0C00090B0C00090A8B00090A8B00080A0B00080A0B0008098A0008098 + A0008090A0008090A000808890007088900000000000E0909000FFC0C000D068 + 6000FFFFFF00FFFFFF00FFF8F000F0F0F000F0E8E000F0D8D000E0D0C000E0C8 + C000A0381000C0606000904850000000000000000000BECBCD00D0A89000FFFF + FF00FFFFFF00FFF8FF00F0F0F000F0E8E000F0E0E000FFFFFF00B0988000A090 + 8000604830000000000000000000000000000000000000000000000000000000 + 000000000000000000000B0BE4000B0BE0000A0ADC000A0AD900000000000000 + 00000000000000000000000000000000000090A0B000A0E8F000A0F0FF00A0E8 + FF00A0E8FF0080D8FF0060D8FF0060D8FF0060D8FF0060D8FF0060D8FF0060D8 + FF007088900000000000000000000000000000000000E098A000FFC0C000D070 + 7000FFFFFF00FFFFFF00FFFFFF00FFF8F000F0F0F000F0E8E000F0D8D000E0D0 + C000A0402000D0686000A0505000000000000000000000000000BECBCD00D0A8 + 9000FFFFFF00FFFFFF00FFF8FF00F0F0F000F0E8E000F0E0E000FFFFFF00B098 + 8000806050000000000000000000000000000000000000000000000000000000 + 0000000000000C0CEB000B0BE7000B0BE4000A0BE0000A0BDD000A0AD9000000 + 00000000000000000000000000000000000090A0B000A0F0F000B0F0F000A0F0 + FF00A0E8FF00A0E8FF0070D8FF0090A0A0008098A0008098A0008090A0008090 + 90007088900000000000000000000000000000000000F0A0A000FFC0C000E078 + 7000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF8F000F0F0F000F0E8E000F0D8 + D000B0483000D0707000A050500000000000000000000000000000000000BECB + CD00D0A89000FFFFFF00FFFFFF00FFF8FF00F0F0F000F0E8E000F0E0E000FFFF + FF00A08070000000000000000000000000000000000000000000000000000000 + 00000C0CF1000C0CEE000B0CEB0000000000000000000B0BE0000A0ADD000A0A + D9000000000000000000000000000000000090A8B000A0D0E000B0F0F000B0F0 + F000A0F0FF00A0E8FF0090A0B000B2C9CF000000000000000000000000000000 + 00000000000090685000906850009068500000000000F0A8A000FFC0C000E080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF8F000F0F0F000F0E8 + E000B0503000E0788000A0505000000000000000000000000000000000000000 + 0000BECBCD00D0A89000FFFFFF00FFFFFF00FFF8FF00FFF0F000FFF8FF00E0D0 + C000B09080000000000000000000000000000000000000000000000000000C0C + F5000C0CF3000C0CF100000000000000000000000000000000000B0BE1000A0B + DD000A0AD900000000000000000000000000CBD7DC0090A8B00090A8B00090A8 + B00090A8B00090A8B000B5C6CC00000000000000000000000000000000000000 + 000000000000D0C8C800906850009068500000000000F0B0B000FFC0C000F088 + 9000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF8F000F0F0 + F000C050400060303000B0585000000000000000000000000000000000000000 + 000000000000BECBCD00D0A89000FFFFFF00FFFFFF00FFF8FF00E0D0D000B088 + 7000BECBCD0000000000000000000000000000000000000000000D0CF7000D0D + F7000C0CF5000000000000000000000000000000000000000000000000000B0B + E0000A0ADD000A0AD90000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000090786000C7BCB5000000 + 000000000000A0908000D2CEC9009078600000000000F0B0B000FFC0C000FF90 + 9000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF8 + F000C0585000B0586000B0586000000000000000000000000000000000000000 + 00000000000000000000BECBCD00D0A89000C0A09000B0907000B4938300BECB + CD000000000000000000000000000000000000000000000000000D0CF7000D0C + F700000000000000000000000000000000000000000000000000000000000000 + 00000B0BE0000A0BDD0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000D8D9D600A0908000A088 + 8000B0988000C5BFB900000000000000000000000000F0B8B000F0B8B000F0B0 + B000F0B0B000F0A8B000F0A0A000E098A000E0909000E0909000E0889000E080 + 8000D0788000D0787000D0707000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF000000000000FFFF000000000000 + F3FF000000000000E1FF000000000000C0FF000000000000887F000000000000 + 1C3F000000000000BE1F000000000000FF0F000000000000FF87000000000000 + FFC3000000000000FFE1000000000000FFF0000000000000FFF9000000000000 + FFFF000000000000FFFF000000000000FFFFFFFFFFFFFFFF0007C001FFFFFFFF + 00038001C003CFF300038001807FC7E300018001003FE3C700018001001FF18F + 00008001000FF81F000080010007FC3F000080018007FC3F00078001C007F81F + 00078001E007F18F00F88001F007E3C701F88001F807C7E3FF988001FC0FCFF3 + FF838001FFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000 + 000000000000} + end +end diff --git a/official/4.2/FastQB/fqbDesign.lrs b/official/4.2/FastQB/fqbDesign.lrs new file mode 100644 index 0000000..057214d --- /dev/null +++ b/official/4.2/FastQB/fqbDesign.lrs @@ -0,0 +1,453 @@ +LazarusResources.Add('TfqbDesigner','FORMDATA',[ + 'TPF0'#12'TfqbDesigner'#11'fqbDesigner'#4'Left'#3#213#0#3'Top'#2'e'#5'Width'#3 + +'<'#3#6'Height'#3'f'#2#7'Caption'#6#28'Fast Query Builder Designer'#5'Color' + +#7#9'clBtnFace'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'c' + +'lWindowText'#11'Font.Height'#2#245#9'Font.Name'#6#6'Tahoma'#10'Font.Style' + +#11#0#8'Position'#7#16'poDefaultPosOnly'#8'ShowHint'#9#8'OnCreate'#7#10'Form' + +'Create'#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'`'#10'TextHeight' + +#2#13#0#8'TToolBar'#8'ToolBar1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'4'#3#6'Hei' + +'ght'#2#28#8'AutoSize'#9#11'BorderWidth'#2#1#11'EdgeBorders'#11#8'ebBottom'#0 + +#4'Flat'#9#6'Images'#7#10'ImageList2'#6'Indent'#2#2#8'TabOrder'#2#1#0#11'TTo' + +'olButton'#11'ToolButton3'#4'Left'#2#2#3'Top'#2#0#4'Hint'#6#4'Open'#10'Image' + +'Index'#2#0#7'OnClick'#7#16'ToolButton3Click'#0#0#11'TToolButton'#11'ToolBut' + +'ton4'#4'Left'#2#25#3'Top'#2#0#4'Hint'#6#4'Save'#10'ImageIndex'#2#1#7'OnClic' + +'k'#7#16'ToolButton4Click'#0#0#11'TToolButton'#11'ToolButton5'#4'Left'#2'0'#3 + +'Top'#2#0#5'Width'#2#8#7'Caption'#6#11'ToolButton5'#10'ImageIndex'#2#3#5'Sty' + +'le'#7#12'tbsSeparator'#0#0#11'TToolButton'#11'ToolButton6'#4'Left'#2'8'#3'T' + +'op'#2#0#4'Hint'#6#5'Clear'#10'ImageIndex'#2#2#7'OnClick'#7#16'ToolButton6Cl' + +'ick'#0#0#11'TToolButton'#11'ToolButton8'#4'Left'#2'O'#3'Top'#2#0#5'Width'#2 + +#8#7'Caption'#6#11'ToolButton8'#10'ImageIndex'#2#7#5'Style'#7#12'tbsSeparato' + +'r'#0#0#11'TToolButton'#12'ToolButton10'#4'Left'#2'W'#3'Top'#2#0#4'Hint'#6#6 + +'Cancel'#10'ImageIndex'#2#3#7'OnClick'#7#17'ToolButton10Click'#0#0#11'TToolB' + +'utton'#11'ToolButton7'#4'Left'#2'n'#3'Top'#2#0#4'Hint'#6#2'Ok'#10'ImageInde' + +'x'#2#4#7'OnClick'#7#16'ToolButton7Click'#0#0#0#12'TPageControl'#12'PageCont' + +'rol1'#4'Left'#2#0#3'Top'#2#28#5'Width'#3'4'#3#6'Height'#3'('#2#10'ActivePag' + +'e'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabOrder'#2#0#0#9'TTabSheet'#9'T' + +'abSheet1'#7'Caption'#6#5'Model'#0#9'TSplitter'#9'Splitter2'#4'Left'#3'u'#2#3 + +'Top'#2#0#5'Width'#2#3#6'Height'#3#12#2#6'Cursor'#7#8'crHSplit'#5'Align'#7#7 + +'alRight'#0#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'u'#2#6'H' + +'eight'#3#12#2#5'Align'#7#8'alClient'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6 + +#6'Panel1'#8'TabOrder'#2#1#0#9'TSplitter'#9'Splitter1'#4'Left'#2#0#3'Top'#3 + +'h'#1#5'Width'#3'u'#2#6'Height'#2#3#6'Cursor'#7#8'crVSplit'#5'Align'#7#8'alB' + +'ottom'#0#0#13'TfqbTableArea'#13'fqbTableArea1'#4'Left'#2#0#3'Top'#2#0#5'Wid' + +'th'#3'u'#2#6'Height'#3'h'#1#5'Align'#7#8'alClient'#11'BorderStyle'#7#6'bsNo' + +'ne'#5'Color'#7#14'clAppWorkSpace'#11'ParentColor'#8#8'TabOrder'#2#0#0#0#8'T' + +'fqbGrid'#8'fqbGrid1'#4'Left'#2#0#3'Top'#3'k'#1#5'Width'#3'u'#2#6'Height'#3 + +#161#0#5'Align'#7#8'alBottom'#11'BorderStyle'#7#6'bsNone'#7'Columns'#14#1#7 + +'Caption'#6#7'Collumn'#5'Width'#2'h'#0#1#7'Caption'#6#7'Visible'#5'Width'#2 + +'h'#0#1#7'Caption'#6#5'Where'#5'Width'#2'h'#0#1#7'Caption'#6#4'Sort'#5'Width' + +#2'h'#0#1#7'Caption'#6#8'Function'#5'Width'#2'h'#0#1#7'Caption'#6#5'Group'#5 + +'Width'#2'i'#0#0#11'ColumnClick'#8#8'DragMode'#7#11'dmAutomatic'#9'GridLines' + +#9#13'HideSelection'#8#8'ReadOnly'#9#9'RowSelect'#9#8'TabOrder'#2#1#9'ViewSt' + +'yle'#7#8'vsReport'#0#0#0#16'TfqbTableListBox'#16'fqbTableListBox1'#4'Left'#3 + +'x'#2#3'Top'#2#0#5'Width'#3#180#0#6'Height'#3#12#2#5'Align'#7#7'alRight'#11 + +'BorderStyle'#7#6'bsNone'#8'DragMode'#7#11'dmAutomatic'#10'ItemHeight'#2#18#5 + +'Style'#7#16'lbOwnerDrawFixed'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#9'TabSheet' + +'2'#7'Caption'#6#3'SQL'#10'ImageIndex'#2#1#6'OnShow'#7#13'TabSheet2Show'#0#14 + +'TfqbSyntaxMemo'#14'fqbSyntaxMemo1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3','#3#6 + +'Height'#3#12#2#6'Cursor'#7#7'crIBeam'#5'Align'#7#8'alClient'#12'Font.Charse' + +'t'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2 + +#243#9'Font.Name'#6#11'Courier New'#10'Font.Style'#11#0#11'ParentColor'#8#10 + +'ParentFont'#8#8'TabOrder'#2#0#7'TabStop'#9#10'BlockColor'#7#11'clHighlight' + +#14'BlockFontColor'#7#15'clHighlightText'#19'CommentAttr.Charset'#7#15'DEFAU' + +'LT_CHARSET'#17'CommentAttr.Color'#7#6'clNavy'#18'CommentAttr.Height'#2#243 + +#16'CommentAttr.Name'#6#11'Courier New'#17'CommentAttr.Style'#11#8'fsItalic' + +#0#19'KeywordAttr.Charset'#7#15'DEFAULT_CHARSET'#17'KeywordAttr.Color'#7#12 + +'clWindowText'#18'KeywordAttr.Height'#2#243#16'KeywordAttr.Name'#6#11'Courie' + +'r New'#17'KeywordAttr.Style'#11#6'fsBold'#0#18'StringAttr.Charset'#7#15'DEF' + +'AULT_CHARSET'#16'StringAttr.Color'#7#6'clNavy'#17'StringAttr.Height'#2#243 + +#15'StringAttr.Name'#6#11'Courier New'#16'StringAttr.Style'#11#0#16'TextAttr' + +'.Charset'#7#15'DEFAULT_CHARSET'#14'TextAttr.Color'#7#12'clWindowText'#15'Te' + +'xtAttr.Height'#2#243#13'TextAttr.Name'#6#11'Courier New'#14'TextAttr.Style' + +#11#0#13'Lines.Strings'#1#6#0#0#8'ReadOnly'#9#10'SyntaxType'#7#5'stSQL'#10'S' + +'howFooter'#9#10'ShowGutter'#9#0#0#0#9'TTabSheet'#9'TabSheet3'#7'Caption'#6#6 + +'Result'#10'ImageIndex'#2#2#6'OnHide'#7#13'TabSheet3Hide'#6'OnShow'#7#13'Tab' + +'Sheet3Show'#0#7'TDBGrid'#7'DBGrid1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3','#3#6 + ,'Height'#3#12#2#5'Align'#7#8'alClient'#11'BorderStyle'#7#6'bsNone'#10'DataSo' + +'urce'#7#11'DataSource1'#8'TabOrder'#2#0#17'TitleFont.Charset'#7#15'DEFAULT_' + +'CHARSET'#15'TitleFont.Color'#7#12'clWindowText'#16'TitleFont.Height'#2#245 + +#14'TitleFont.Name'#6#6'Tahoma'#15'TitleFont.Style'#11#0#0#0#0#0#11'TDataSou' + +'rce'#11'DataSource1'#4'Left'#3#232#0#3'Top'#2'H'#0#0#11'TOpenDialog'#11'Ope' + +'nDialog1'#10'DefaultExt'#6#3'sql'#6'Filter'#6#15'SQL files|*.sql'#4'Left'#3 + +#8#1#3'Top'#2'H'#0#0#11'TSaveDialog'#11'SaveDialog1'#3'Tag'#2#255#10'Default' + +'Ext'#6#3'sql'#6'Filter'#6#15'SQL files|*.sql'#4'Left'#3'('#1#3'Top'#2'H'#0#0 + +#10'TImageList'#10'ImageList2'#4'Left'#3#21#1#3'Top'#3#156#0#6'Bitmap'#10'&2' + +#0#0'IL'#1#1#5#0#9#0#4#0#16#0#16#0#255#255#255#255#255#16#255#255#255#255#255 + +#255#255#255'BM6'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0'@'#0#0#0'0'#0#0#0#1#0' '#0 + +#0#0#0#0#0'0'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#14#140'>'#0#13#137'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#16#144'@'#0#15#142'?'#0#14#140'?'#0#13#138'>'#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#17#149 + +'B'#0#17#146'A'#0#15#144'@'#0#15#142'?'#0#14#139'?'#0#13#137'>'#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#20#154'C'#0 + +#19#151'C'#0#18#149'A'#0#0#0#0#0#16#144'@'#0#15#142'@'#0#14#139'>'#0#12#137 + +'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#21#158'E'#0 + +#21#155'D'#0#19#153'C'#0#0#0#0#0#0#0#0#0#0#0#0#0#15#144'A'#0#15#141'?'#0#13 + +#139'>'#0#12#136'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#21#157'E'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15#143'@'#0#15#141 + +'?'#0#14#139'>'#0#13#136'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#16#143'@'#0#15 + +#142'?'#0#14#139'?'#0#13#136'='#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15#143'@'#0 + +#14#141'?'#0#14#138'>'#0#13#136'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15#143 + +'@'#0#14#141'?'#0#13#139'?'#0#12#136'='#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15 + +#143'?'#0#14#140'?'#0#13#138'>'#0#13#136'>'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#15#143'@'#0#14#140'?'#0#13#137'>'#0#12#135'='#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#15#143'?'#0#14#140'?'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'p'#136#144#0'`'#128 + +#144#0'`x'#128#0'Pp'#128#0'P`p'#0'@X`'#0'@HP'#0'08@'#0' 00'#0' 0'#0#16#24' ' + +#0#16#16#16#0#16#16' '#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192'h`'#0 + +#176'XP'#0#160'PP'#0#160'PP'#0#160'PP'#0#144'HP'#0#144'H@'#0#144'H@'#0#128'@' + +'@'#0#128'8@'#0#128'8@'#0'p8@'#0'p80'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'p' + +#136#144#0#144#160#176#0'p'#176#208#0#0#144#208#0#0#144#208#0#0#144#208#0#0 + +#144#192#0#16#136#192#0#16#128#176#0#16#128#176#0' x'#160#0' p'#144#0' H`'#0 + +#145#161#163#0#0#0#0#0#0#0#0#0#0#0#0#0#208'hp'#0#240#144#144#0#224#128#128#0 + +#176'H '#0'@0 '#0#192#184#176#0#192#184#176#0#208#192#192#0#208#200#192#0'PP' + +'P'#0#160'@0'#0#160'@0'#0#160'80'#0'p8@'#0#0#0#0#0#0#0#0#0#0#0#0#0#213#192 + +#174#0#128'p`'#0#144'x`'#0#144'p`'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#11#10#221#0#10#10 + +#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#7 + +#189#0#8#7#187#0#0#0#0#0#0#0#0#0#128#136#144#0#128#192#208#0#144#168#176#0 + +#128#224#255#0'`'#208#255#0'P'#200#255#0'P'#200#255#0'@'#192#240#0'0'#176#240 + +#0'0'#168#240#0' '#160#224#0#16#144#208#0' h'#128#0'T^e'#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#208'pp'#0#255#152#160#0#240#136#128#0#224#128#128#0'pXP'#0'@@0'#0#144 + ,'xp'#0#240#224#224#0#240#232#224#0#144#128'p'#0#160'@0'#0#160'@@'#0#160'@0'#0 + +#128'8@'#0#0#0#0#0#0#0#0#0#160#128'p'#0#160#136'p'#0#208#176#160#0#208#176 + +#160#0#192#176#160#0#176#152#128#0'`H0'#0#172#162#153#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#11#10#224#0#10#10#221#0#10 + +#10#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#8#193#0#7#8#191#0 + +#7#8#189#0#0#0#0#0#0#0#0#0#128#144#160#0#128#208#240#0#144#168#176#0#144#192 + +#208#0'p'#216#255#0'`'#208#255#0'`'#208#255#0'P'#200#255#0'P'#192#255#0'@' + +#184#240#0'0'#176#240#0'0'#168#240#0#16#136#208#0' H`'#0#183#197#201#0#0#0#0 + +#0#0#0#0#0#208'xp'#0#255#160#160#0#240#144#144#0#240#136#128#0'pXP'#0#0#0#0#0 + +'@@0'#0#240#216#208#0#240#224#208#0#128'x`'#0#176'H@'#0#176'H@'#0#160'@@'#0 + +#128'@@'#0#0#0#0#0#192#152#128#0#224#192#176#0#208#192#176#0#224#208#192#0 + +#240#224#224#0#255#248#240#0#176#152#128#0#160#144#128#0'`H0'#0#172#162#153#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#11 + +#11#225#0#10#11#221#0#10#10#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#9#200#0#8 + +#8#197#0#8#8#193#0#0#0#0#0#0#0#0#0#0#0#0#0#128#144#160#0#128#216#240#0#128 + +#200#224#0#144#168#176#0#128#224#255#0'p'#208#255#0'`'#216#255#0'`'#208#255#0 + +'`'#208#255#0'P'#200#255#0'@'#192#240#0'@'#184#240#0'0'#176#240#0' h'#128#0 + +'e'#138#153#0#0#0#0#0#0#0#0#0#208'x'#128#0#255#168#176#0#255#160#160#0#240 + +#144#144#0'pXP'#0'pXP'#0'pXP'#0'pXP'#0'p`P'#0#128'h`'#0#192'XP'#0#176'PP'#0 + +#176'H@'#0#128'@@'#0#0#0#0#0#208#176#160#0#240#240#224#0#240#232#224#0#240 + +#240#240#0#255#248#255#0#255#248#240#0#255#255#255#0#176#152#128#0#160#144 + +#128#0'`H0'#0#172#162#153#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#11#10#224#0#10#10#220#0#10#10#217#0#0#0#0#0#0#0#0#0#9 + +#9#206#0#8#8#202#0#8#8#200#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#152#160#0 + +#144#224#240#0#144#224#255#0#144#168#176#0#144#184#192#0'p'#216#255#0'`'#216 + +#255#0'`'#216#255#0'`'#216#255#0'`'#208#255#0'P'#208#255#0'P'#200#255#0'@' + +#184#240#0'0'#160#224#0'Igw'#0#192#202#209#0#0#0#0#0#224#128#128#0#255#176 + +#176#0#255#176#176#0#255#160#160#0#240#144#144#0#240#136#128#0#224#128#128#0 + +#224'x'#128#0#208'pp'#0#208'hp'#0#192'``'#0#192'XP'#0#176'PP'#0#144'H@'#0#0#0 + +#0#0#208#168#144#0#255#248#255#0#255#255#255#0#255#255#255#0#240#240#240#0 + +#240#232#224#0#240#224#224#0#255#255#255#0#176#152#128#0#160#144#128#0'`H0'#0 + +#172#162#153#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#10#10#225#0#10#10#221#0#10#10#217#0#10#9#213#0#10#10#209#0#9#9#206 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#152#160#0#144#224#240#0#160 + +#232#255#0#128#200#224#0#144#168#176#0#128#224#255#0#128#224#255#0#128#224 + +#255#0#128#224#255#0#128#224#255#0#128#224#255#0#128#224#255#0'p'#216#255#0 + +'p'#216#255#0'P'#168#208#0#133#146#157#0#0#0#0#0#224#136#144#0#255#184#192#0 + +#255#184#176#0#208'``'#0#192'`P'#0#192'XP'#0#192'P@'#0#176'P0'#0#176'H0'#0 + +#160'@ '#0#160'8'#16#0#192'``'#0#192'XP'#0#144'H@'#0#0#0#0#0#190#203#205#0 + +#208#168#144#0#255#255#255#0#255#255#255#0#255#248#255#0#240#240#240#0#240 + +#232#224#0#240#224#224#0#255#255#255#0#176#152#128#0#160#144#128#0'`H0'#0#172 + +#162#153#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#11#11#225#0#10#10#221#0#10#10#217#0#10#10#213#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#144#160#160#0#160#232#240#0#160#232#255#0#160#232 + +#255#0#144#176#192#0#144#176#192#0#144#168#176#0#144#168#176#0#128#160#176#0 + +#128#160#176#0#128#152#160#0#128#152#160#0#128#144#160#0#128#144#160#0#128 + +#136#144#0'p'#136#144#0#0#0#0#0#224#144#144#0#255#192#192#0#208'h`'#0#255#255 + +#255#0#255#255#255#0#255#248#240#0#240#240#240#0#240#232#224#0#240#216#208#0 + +#224#208#192#0#224#200#192#0#160'8'#16#0#192'``'#0#144'HP'#0#0#0#0#0#0#0#0#0 + +#190#203#205#0#208#168#144#0#255#255#255#0#255#255#255#0#255#248#255#0#240 + +#240#240#0#240#232#224#0#240#224#224#0#255#255#255#0#176#152#128#0#160#144 + +#128#0'`H0'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#11#11#228#0#11#11#224#0#10#10#220#0#10#10#217#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#160#176#0#160#232#240#0#160#240#255#0#160 + +#232#255#0#160#232#255#0#128#216#255#0'`'#216#255#0'`'#216#255#0'`'#216#255#0 + +'`'#216#255#0'`'#216#255#0'`'#216#255#0'p'#136#144#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#224#152#160#0#255#192#192#0#208'pp'#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#248#240#0#240#240#240#0#240#232#224#0#240#216#208#0#224 + +#208#192#0#160'@ '#0#208'h`'#0#160'PP'#0#0#0#0#0#0#0#0#0#0#0#0#0#190#203#205 + +#0#208#168#144#0#255#255#255#0#255#255#255#0#255#248#255#0#240#240#240#0#240 + +#232#224#0#240#224#224#0#255#255#255#0#176#152#128#0#128'`P'#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#12#12#235#0#11#11#231#0#11 + +#11#228#0#10#11#224#0#10#11#221#0#10#10#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#144#160#176#0#160#240#240#0#176#240#240#0#160#240#255#0#160#232#255 + ,#0#160#232#255#0'p'#216#255#0#144#160#160#0#128#152#160#0#128#152#160#0#128 + +#144#160#0#128#144#144#0'p'#136#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#160 + +#160#0#255#192#192#0#224'xp'#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#248#240#0#240#240#240#0#240#232#224#0#240#216#208#0#176'H0'#0 + +#208'pp'#0#160'PP'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#190#203#205#0#208#168 + +#144#0#255#255#255#0#255#255#255#0#255#248#255#0#240#240#240#0#240#232#224#0 + +#240#224#224#0#255#255#255#0#160#128'p'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#12#12#241#0#12#12#238#0#11#12#235#0#0#0#0#0#0#0#0#0#11 + +#11#224#0#10#10#221#0#10#10#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#168#176 + +#0#160#208#224#0#176#240#240#0#176#240#240#0#160#240#255#0#160#232#255#0#144 + +#160#176#0#178#201#207#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144'hP'#0 + +#144'hP'#0#144'hP'#0#0#0#0#0#240#168#160#0#255#192#192#0#224#128#128#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#248 + +#240#0#240#240#240#0#240#232#224#0#176'P0'#0#224'x'#128#0#160'PP'#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#190#203#205#0#208#168#144#0#255#255#255#0#255 + +#255#255#0#255#248#255#0#255#240#240#0#255#248#255#0#224#208#192#0#176#144 + +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#12#12#245#0#12#12#243 + +#0#12#12#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#11#11#225#0#10#11#221#0#10#10 + +#217#0#0#0#0#0#0#0#0#0#0#0#0#0#203#215#220#0#144#168#176#0#144#168#176#0#144 + +#168#176#0#144#168#176#0#144#168#176#0#181#198#204#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#208#200#200#0#144'hP'#0#144'hP'#0#0#0#0#0#240#176 + +#176#0#255#192#192#0#240#136#144#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#248#240#0#240#240#240#0#192'P' + +'@'#0'`00'#0#176'XP'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#190 + +#203#205#0#208#168#144#0#255#255#255#0#255#255#255#0#255#248#255#0#224#208 + +#208#0#176#136'p'#0#190#203#205#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#13 + +#12#247#0#13#13#247#0#12#12#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#11#11#224#0#10#10#221#0#10#10#217#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144'x`'#0#199#188#181#0 + +#0#0#0#0#0#0#0#0#160#144#128#0#210#206#201#0#144'x`'#0#0#0#0#0#240#176#176#0 + +#255#192#192#0#255#144#144#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#248#240#0#192'XP'#0 + +#176'X`'#0#176'X`'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#190#203#205#0#208#168#144#0#192#160#144#0#176#144'p'#0#180#147#131#0#190#203 + +#205#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#13#12#247#0#13#12#247 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#11#11#224 + +#0#10#11#221#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#216#217#214#0#160#144#128#0#160#136#128#0#176#152 + +#128#0#197#191#185#0#0#0#0#0#0#0#0#0#0#0#0#0#240#184#176#0#240#184#176#0#240 + +#176#176#0#240#176#176#0#240#168#176#0#240#160#160#0#224#152#160#0#224#144 + +#144#0#224#144#144#0#224#136#144#0#224#128#128#0#208'x'#128#0#208'xp'#0#208 + +'pp'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0'BM>'#0#0#0#0#0#0#0'>'#0#0#0'('#0#0#0'@'#0#0#0'0'#0#0#0 + +#1#0#1#0#0#0#0#0#128#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255 + +#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#255#255#0#0#0#0#0#0 + +#243#255#0#0#0#0#0#0#225#255#0#0#0#0#0#0#192#255#0#0#0#0#0#0#136''#0#0#0#0#0 + +#0#28'?'#0#0#0#0#0#0#190#31#0#0#0#0#0#0#255#15#0#0#0#0#0#0#255#135#0#0#0#0#0 + +#0#255#195#0#0#0#0#0#0#255#225#0#0#0#0#0#0#255#240#0#0#0#0#0#0#255#249#0#0#0 + +#0#0#0#255#255#0#0#0#0#0#0#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255 + +#255#0#7#192#1#255#255#255#255#0#3#128#1#192#3#207#243#0#3#128#1#128''#199 + +#227#0#1#128#1#0'?'#227#199#0#1#128#1#0#31#241#143#0#0#128#1#0#15#248#31#0#0 + +#128#1#0#7#252'?'#0#0#128#1#128#7#252'?'#0#7#128#1#192#7#248#31#0#7#128#1#224 + ,#7#241#143#0#248#128#1#240#7#227#199#1#248#128#1#248#7#199#227#255#152#128#1 + +#252#15#207#243#255#131#128#1#255#255#255#255#255#255#255#255#255#255#255#255 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +]); diff --git a/official/4.2/FastQB/fqbDesign.pas b/official/4.2/FastQB/fqbDesign.pas new file mode 100644 index 0000000..afbe985 --- /dev/null +++ b/official/4.2/FastQB/fqbDesign.pas @@ -0,0 +1,210 @@ +{*******************************************} +{ } +{ 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; + 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; + +type + THackWinControl = class(TWinControl); + + +{----------------------- 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); + + THackWinControl(fqbTableArea1).BevelKind := bkFlat; + THackWinControl(fqbTableListBox1).BevelKind := bkFlat; + THackWinControl(fqbGrid1).BevelKind := bkFlat; + THackWinControl(fqbGrid1).BevelKind := bkFlat; + THackWinControl(fqbSyntaxMemo1).BevelKind := bkFlat; + THackWinControl(DBGrid1).BevelKind := bkFlat; + + 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/4.2/FastQB/fqbLinkForm.dfm b/official/4.2/FastQB/fqbLinkForm.dfm new file mode 100644 index 0000000..b14f10e Binary files /dev/null and b/official/4.2/FastQB/fqbLinkForm.dfm differ diff --git a/official/4.2/FastQB/fqbLinkForm.lfm b/official/4.2/FastQB/fqbLinkForm.lfm new file mode 100644 index 0000000..4380170 --- /dev/null +++ b/official/4.2/FastQB/fqbLinkForm.lfm @@ -0,0 +1,159 @@ +object fqbLinkForm: TfqbLinkForm + Left = 385 + Height = 193 + Top = 195 + Width = 369 + HorzScrollBar.Page = 368 + VertScrollBar.Page = 192 + ActiveControl = RadioOpt + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'Link Options' + Font.CharSet = RUSSIAN_CHARSET + Font.Height = -11 + Font.Name = 'Tahoma' + object Label1: TLabel + Left = 2 + Height = 17 + Top = 7 + Width = 38 + Caption = 'Table 1' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 2 + Height = 17 + Top = 46 + Width = 38 + Caption = 'Table 2' + Color = clNone + ParentColor = False + end + object Label3: TLabel + Left = 3 + Height = 17 + Top = 24 + Width = 51 + Caption = 'Column 1' + Color = clNone + ParentColor = False + end + object Label4: TLabel + Left = 2 + Height = 17 + Top = 62 + Width = 51 + Caption = 'Column 2' + Color = clNone + ParentColor = False + end + object RadioOpt: TRadioGroup + Left = 3 + Height = 103 + Top = 85 + Width = 126 + Anchors = [akTop, akLeft, akBottom] + AutoFill = True + Caption = 'Join Operator' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ItemIndex = 0 + Items.Strings = ( + '=' + '<' + '>' + '<=' + '>=' + '<>' + ) + TabOrder = 0 + end + object RadioType: TRadioGroup + Left = 136 + Height = 103 + Top = 85 + Width = 139 + Anchors = [akTop, akLeft, akBottom] + AutoFill = True + Caption = 'Join Type' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ItemIndex = 0 + Items.Strings = ( + 'Inner' + 'Left Outer' + 'Right Outer' + 'Full Outer' + ) + TabOrder = 1 + end + object txtTable1: TStaticText + Left = 55 + Height = 16 + Top = 7 + Width = 308 + Anchors = [akTop, akLeft, akRight] + BorderStyle = sbsSunken + TabOrder = 2 + end + object txtTable2: TStaticText + Left = 55 + Height = 16 + Top = 46 + Width = 308 + Anchors = [akTop, akLeft, akRight] + BorderStyle = sbsSunken + TabOrder = 3 + end + object txtCol1: TStaticText + Left = 55 + Height = 16 + Top = 23 + Width = 308 + Anchors = [akTop, akLeft, akRight] + BorderStyle = sbsSunken + TabOrder = 4 + end + object txtCol2: TStaticText + Left = 55 + Height = 16 + Top = 62 + Width = 308 + Anchors = [akTop, akLeft, akRight] + BorderStyle = sbsSunken + TabOrder = 5 + end + object BitBtn1: TBitBtn + Left = 290 + Height = 25 + Top = 130 + Width = 75 + Anchors = [akRight, akBottom] + Kind = bkOK + NumGlyphs = 0 + TabOrder = 6 + end + object BitBtn2: TBitBtn + Left = 290 + Height = 25 + Top = 162 + Width = 75 + Anchors = [akRight, akBottom] + Kind = bkCancel + NumGlyphs = 0 + TabOrder = 7 + end +end diff --git a/official/4.2/FastQB/fqbLinkForm.lrs b/official/4.2/FastQB/fqbLinkForm.lrs new file mode 100644 index 0000000..99e0719 --- /dev/null +++ b/official/4.2/FastQB/fqbLinkForm.lrs @@ -0,0 +1,50 @@ +{ Это - файл ресурсов, автоматически созданный lazarus } + +LazarusResources.Add('TfqbLinkForm','FORMDATA',[ + 'TPF0'#12'TfqbLinkForm'#11'fqbLinkForm'#4'Left'#3#129#1#6'Height'#3#193#0#3'T' + +'op'#3#195#0#5'Width'#3'q'#1#18'HorzScrollBar.Page'#3'p'#1#18'VertScrollBar.' + +'Page'#3#192#0#13'ActiveControl'#7#8'RadioOpt'#11'BorderIcons'#11#12'biSyste' + +'mMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#12'Link Options'#12'Fon' + +'t.CharSet'#7#15'RUSSIAN_CHARSET'#11'Font.Height'#2#245#9'Font.Name'#6#6'Tah' + +'oma'#0#6'TLabel'#6'Label1'#4'Left'#2#2#6'Height'#2#17#3'Top'#2#7#5'Width'#2 + +'&'#7'Caption'#6#7'Table 1'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLa' + +'bel'#6'Label2'#4'Left'#2#2#6'Height'#2#17#3'Top'#2'.'#5'Width'#2'&'#7'Capti' + +'on'#6#7'Table 2'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Lab' + +'el3'#4'Left'#2#3#6'Height'#2#17#3'Top'#2#24#5'Width'#2'3'#7'Caption'#6#8'Co' + +'lumn 1'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label4'#4'Le' + +'ft'#2#2#6'Height'#2#17#3'Top'#2'>'#5'Width'#2'3'#7'Caption'#6#8'Column 2'#5 + +'Color'#7#6'clNone'#11'ParentColor'#8#0#0#11'TRadioGroup'#8'RadioOpt'#4'Left' + +#2#3#6'Height'#2'g'#3'Top'#2'U'#5'Width'#2'~'#7'Anchors'#11#5'akTop'#6'akLef' + +'t'#8'akBottom'#0#8'AutoFill'#9#7'Caption'#6#13'Join Operator'#28'ChildSizin' + +'g.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing' + +'.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVe' + +'rtical'#7#24'crsHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14 + +'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'Chil' + +'dSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.Controls' + +'PerLine'#2#1#9'ItemIndex'#2#0#13'Items.Strings'#1#6#1'='#6#1'<'#6#1'>'#6#2 + +'<='#6#2'>='#6#2'<>'#0#8'TabOrder'#2#0#0#0#11'TRadioGroup'#9'RadioType'#4'Le' + +'ft'#3#136#0#6'Height'#2'g'#3'Top'#2'U'#5'Width'#3#139#0#7'Anchors'#11#5'akT' + +'op'#6'akLeft'#8'akBottom'#0#8'AutoFill'#9#7'Caption'#6#9'Join Type'#28'Chil' + +'dSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'Child' + +'Sizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'ChildSizing.Enl' + +'argeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.ShrinkHorizonta' + +'l'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds' + +#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.C' + +'ontrolsPerLine'#2#1#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Inner'#6#10'Le' + +'ft Outer'#6#11'Right Outer'#6#10'Full Outer'#0#8'TabOrder'#2#1#0#0#11'TStat' + +'icText'#9'txtTable1'#4'Left'#2'7'#6'Height'#2#16#3'Top'#2#7#5'Width'#3'4'#1 + +#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#11'BorderStyle'#7#9'sbsSunken' + +#8'TabOrder'#2#2#0#0#11'TStaticText'#9'txtTable2'#4'Left'#2'7'#6'Height'#2#16 + +#3'Top'#2'.'#5'Width'#3'4'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#11 + +'BorderStyle'#7#9'sbsSunken'#8'TabOrder'#2#3#0#0#11'TStaticText'#7'txtCol1'#4 + +'Left'#2'7'#6'Height'#2#16#3'Top'#2#23#5'Width'#3'4'#1#7'Anchors'#11#5'akTop' + +#6'akLeft'#7'akRight'#0#11'BorderStyle'#7#9'sbsSunken'#8'TabOrder'#2#4#0#0#11 + +'TStaticText'#7'txtCol2'#4'Left'#2'7'#6'Height'#2#16#3'Top'#2'>'#5'Width'#3 + +'4'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#11'BorderStyle'#7#9'sbsS' + +'unken'#8'TabOrder'#2#5#0#0#7'TBitBtn'#7'BitBtn1'#4'Left'#3'"'#1#6'Height'#2 + +#25#3'Top'#3#130#0#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#4'Ki' + +'nd'#7#4'bkOK'#9'NumGlyphs'#2#0#8'TabOrder'#2#6#0#0#7'TBitBtn'#7'BitBtn2'#4 + +'Left'#3'"'#1#6'Height'#2#25#3'Top'#3#162#0#5'Width'#2'K'#7'Anchors'#11#7'ak' + +'Right'#8'akBottom'#0#4'Kind'#7#8'bkCancel'#9'NumGlyphs'#2#0#8'TabOrder'#2#7 + +#0#0#0 +]); diff --git a/official/4.2/FastQB/fqbLinkForm.pas b/official/4.2/FastQB/fqbLinkForm.pas new file mode 100644 index 0000000..fcf4257 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbReg.pas b/official/4.2/FastQB/fqbReg.pas new file mode 100644 index 0000000..a0fe66b --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbRes.pas b/official/4.2/FastQB/fqbRes.pas new file mode 100644 index 0000000..1a06128 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbSynmemo.dfm b/official/4.2/FastQB/fqbSynmemo.dfm new file mode 100644 index 0000000..05d74a8 Binary files /dev/null and b/official/4.2/FastQB/fqbSynmemo.dfm differ diff --git a/official/4.2/FastQB/fqbSynmemo.lfm b/official/4.2/FastQB/fqbSynmemo.lfm new file mode 100644 index 0000000..6640491 --- /dev/null +++ b/official/4.2/FastQB/fqbSynmemo.lfm @@ -0,0 +1,54 @@ +object fqbSynMemoSearch: TfqbSynMemoSearch + Left = 289 + Height = 50 + Top = 229 + Width = 243 + HorzScrollBar.Page = 242 + VertScrollBar.Page = 49 + ActiveControl = Edit1 + BorderStyle = bsToolWindow + Caption = 'Search' + Font.Height = -11 + Font.Name = 'MS Sans Serif' + KeyPreview = True + OnKeyPress = FormKeyPress + Position = poScreenCenter + object Label1: TLabel + Left = 6 + Height = 13 + Top = 7 + Width = 69 + AutoSize = False + Caption = 'Text to find' + Color = clNone + ParentColor = False + end + object Search: TButton + Left = 111 + Height = 17 + Top = 31 + Width = 58 + BorderSpacing.InnerBorder = 4 + Caption = 'Search' + ModalResult = 1 + TabOrder = 0 + end + object Button1: TButton + Left = 175 + Height = 17 + Top = 31 + Width = 61 + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object Edit1: TEdit + Left = 80 + Height = 21 + Top = 4 + Width = 156 + TabOrder = 2 + end +end diff --git a/official/4.2/FastQB/fqbSynmemo.lrs b/official/4.2/FastQB/fqbSynmemo.lrs new file mode 100644 index 0000000..ff3cd6b --- /dev/null +++ b/official/4.2/FastQB/fqbSynmemo.lrs @@ -0,0 +1,18 @@ +{ Это - файл ресурсов, автоматически созданный lazarus } + +LazarusResources.Add('TfqbSynMemoSearch','FORMDATA',[ + 'TPF0'#17'TfqbSynMemoSearch'#16'fqbSynMemoSearch'#4'Left'#3'!'#1#6'Height'#2 + +'2'#3'Top'#3#229#0#5'Width'#3#243#0#18'HorzScrollBar.Page'#3#242#0#18'VertSc' + +'rollBar.Page'#2'1'#13'ActiveControl'#7#5'Edit1'#11'BorderStyle'#7#12'bsTool' + +'Window'#7'Caption'#6#6'Search'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS S' + +'ans Serif'#10'KeyPreview'#9#10'OnKeyPress'#7#12'FormKeyPress'#8'Position'#7 + +#14'poScreenCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#6#6'Height'#2#13#3'Top'#2 + +#7#5'Width'#2'E'#8'AutoSize'#8#7'Caption'#6#12'Text to find'#5'Color'#7#6'cl' + +'None'#11'ParentColor'#8#0#0#7'TButton'#6'Search'#4'Left'#2'o'#6'Height'#2#17 + +#3'Top'#2#31#5'Width'#2':'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#6 + +'Search'#11'ModalResult'#2#1#8'TabOrder'#2#0#0#0#7'TButton'#7'Button1'#4'Lef' + +'t'#3#175#0#6'Height'#2#17#3'Top'#2#31#5'Width'#2'='#25'BorderSpacing.InnerB' + +'order'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrde' + +'r'#2#1#0#0#5'TEdit'#5'Edit1'#4'Left'#2'P'#6'Height'#2#21#3'Top'#2#4#5'Width' + +#3#156#0#8'TabOrder'#2#2#0#0#0 +]); diff --git a/official/4.2/FastQB/fqbSynmemo.pas b/official/4.2/FastQB/fqbSynmemo.pas new file mode 100644 index 0000000..0459804 --- /dev/null +++ b/official/4.2/FastQB/fqbSynmemo.pas @@ -0,0 +1,2005 @@ +{*******************************************} +{ } +{ 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 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.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/4.2/FastQB/fqbUtils.pas b/official/4.2/FastQB/fqbUtils.pas new file mode 100644 index 0000000..c42a21d --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbZLib.pas b/official/4.2/FastQB/fqbZLib.pas new file mode 100644 index 0000000..00d6d33 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/fqbrcDesign.pas b/official/4.2/FastQB/fqbrcDesign.pas new file mode 100644 index 0000000..18b0839 --- /dev/null +++ b/official/4.2/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/4.2/FastQB/images.res b/official/4.2/FastQB/images.res new file mode 100644 index 0000000..a3895b6 Binary files /dev/null and b/official/4.2/FastQB/images.res differ diff --git a/official/4.2/FastQB/infback.zobj b/official/4.2/FastQB/infback.zobj new file mode 100644 index 0000000..1f6ff57 Binary files /dev/null and b/official/4.2/FastQB/infback.zobj differ diff --git a/official/4.2/FastQB/inffast.zobj b/official/4.2/FastQB/inffast.zobj new file mode 100644 index 0000000..ba4ae54 Binary files /dev/null and b/official/4.2/FastQB/inffast.zobj differ diff --git a/official/4.2/FastQB/inflate.zobj b/official/4.2/FastQB/inflate.zobj new file mode 100644 index 0000000..0bf06b1 Binary files /dev/null and b/official/4.2/FastQB/inflate.zobj differ diff --git a/official/4.2/FastQB/inftrees.zobj b/official/4.2/FastQB/inftrees.zobj new file mode 100644 index 0000000..1da0225 Binary files /dev/null and b/official/4.2/FastQB/inftrees.zobj differ diff --git a/official/4.2/FastQB/trees.zobj b/official/4.2/FastQB/trees.zobj new file mode 100644 index 0000000..274284e Binary files /dev/null and b/official/4.2/FastQB/trees.zobj differ diff --git a/official/4.2/FastReports.url b/official/4.2/FastReports.url new file mode 100644 index 0000000..eb4aee1 --- /dev/null +++ b/official/4.2/FastReports.url @@ -0,0 +1,2 @@ +[InternetShortcut] +URL=http://www.fast-report.com diff --git a/official/4.2/FastScript/bitmaps/TFSADORTTI.bmp b/official/4.2/FastScript/bitmaps/TFSADORTTI.bmp new file mode 100644 index 0000000..f966d42 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSADORTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSBASIC.bmp b/official/4.2/FastScript/bitmaps/TFSBASIC.bmp new file mode 100644 index 0000000..13d4c8d Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSBASIC.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSBDERTTI.bmp b/official/4.2/FastScript/bitmaps/TFSBDERTTI.bmp new file mode 100644 index 0000000..49a8dbc Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSBDERTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSCHARTRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSCHARTRTTI.bmp new file mode 100644 index 0000000..d1f6f41 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSCHARTRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSCLASSESRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSCLASSESRTTI.bmp new file mode 100644 index 0000000..cf81c5b Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSCLASSESRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSCPP.bmp b/official/4.2/FastScript/bitmaps/TFSCPP.bmp new file mode 100644 index 0000000..0ce02dc Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSCPP.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp new file mode 100644 index 0000000..059d207 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSDBRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSDBRTTI.bmp new file mode 100644 index 0000000..bbcbb34 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSDBRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSDIALOGSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSDIALOGSRTTI.bmp new file mode 100644 index 0000000..0b5a565 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSDIALOGSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp new file mode 100644 index 0000000..7e6fe4d Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSFORMSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSFORMSRTTI.bmp new file mode 100644 index 0000000..1075a16 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSFORMSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp new file mode 100644 index 0000000..46c7042 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSIBXRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSIBXRTTI.bmp new file mode 100644 index 0000000..240339d Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSIBXRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSINIRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSINIRTTI.bmp new file mode 100644 index 0000000..3dd1e56 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSINIRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSJSCRIPT.bmp b/official/4.2/FastScript/bitmaps/TFSJSCRIPT.bmp new file mode 100644 index 0000000..24e7cd8 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSJSCRIPT.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSMENUSRTTI.bmp b/official/4.2/FastScript/bitmaps/TFSMENUSRTTI.bmp new file mode 100644 index 0000000..ad308c3 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSMENUSRTTI.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSPASCAL.bmp b/official/4.2/FastScript/bitmaps/TFSPASCAL.bmp new file mode 100644 index 0000000..aee07d9 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSPASCAL.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSSCRIPT.bmp b/official/4.2/FastScript/bitmaps/TFSSCRIPT.bmp new file mode 100644 index 0000000..df880d1 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSSCRIPT.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSSYNTAXMEMO.bmp b/official/4.2/FastScript/bitmaps/TFSSYNTAXMEMO.bmp new file mode 100644 index 0000000..f06f89f Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSSYNTAXMEMO.bmp differ diff --git a/official/4.2/FastScript/bitmaps/TFSTREE.bmp b/official/4.2/FastScript/bitmaps/TFSTREE.bmp new file mode 100644 index 0000000..9885c37 Binary files /dev/null and b/official/4.2/FastScript/bitmaps/TFSTREE.bmp differ diff --git a/official/4.2/FastScript/bitmaps/build_fstree.bat b/official/4.2/FastScript/bitmaps/build_fstree.bat new file mode 100644 index 0000000..660e124 --- /dev/null +++ b/official/4.2/FastScript/bitmaps/build_fstree.bat @@ -0,0 +1 @@ +lazres ..\fs_tree.lrs FSTREE.BMP diff --git a/official/4.2/FastScript/bitmaps/build_lrs.bat b/official/4.2/FastScript/bitmaps/build_lrs.bat new file mode 100644 index 0000000..ad44851 --- /dev/null +++ b/official/4.2/FastScript/bitmaps/build_lrs.bat @@ -0,0 +1 @@ +lazres ..\fs_ireg.lrs TFSADORTTI.bmp TFSBASIC.bmp TFSBDERTTI.bmp TFSCHARTRTTI.bmp TFSCLASSESRTTI.bmp TFSINIRTTI.bmp TFSMENUSRTTI.bmp TFSCPP.bmp TFSDBCTRLSRTTI.bmp TFSDBRTTI.bmp TFSDIALOGSRTTI.bmp TFSEXTCTRLSRTTI.bmp TFSFORMSRTTI.bmp TFSGRAPHICSRTTI.bmp TFSIBXRTTI.bmp TFSJSCRIPT.bmp TFSPASCAL.bmp TFSSCRIPT.bmp TFSSYNTAXMEMO.bmp TFSTREE.bmp diff --git a/official/4.2/FastScript/bitmaps/fstree.bmp b/official/4.2/FastScript/bitmaps/fstree.bmp new file mode 100644 index 0000000..3e3fcdf Binary files /dev/null and b/official/4.2/FastScript/bitmaps/fstree.bmp differ diff --git a/official/4.2/FastScript/dclfs10.bdsproj b/official/4.2/FastScript/dclfs10.bdsproj new file mode 100644 index 0000000..50df875 --- /dev/null +++ b/official/4.2/FastScript/dclfs10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfs10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfs10.dpk b/official/4.2/FastScript/dclfs10.dpk new file mode 100644 index 0000000..ee58326 --- /dev/null +++ b/official/4.2/FastScript/dclfs10.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 2006 + +package dclfs10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs11.bdsproj b/official/4.2/FastScript/dclfs11.bdsproj new file mode 100644 index 0000000..7a8513d --- /dev/null +++ b/official/4.2/FastScript/dclfs11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfs11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfs11.dpk b/official/4.2/FastScript/dclfs11.dpk new file mode 100644 index 0000000..ef818c5 --- /dev/null +++ b/official/4.2/FastScript/dclfs11.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 2007 + +package dclfs11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs4.dpk b/official/4.2/FastScript/dclfs4.dpk new file mode 100644 index 0000000..9858ea0 --- /dev/null +++ b/official/4.2/FastScript/dclfs4.dpk @@ -0,0 +1,39 @@ +// Package file for Delphi 4 + +package dclfs4; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + fs4; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs5.dpk b/official/4.2/FastScript/dclfs5.dpk new file mode 100644 index 0000000..3cfbd14 --- /dev/null +++ b/official/4.2/FastScript/dclfs5.dpk @@ -0,0 +1,39 @@ +// Package file for Delphi 5 + +package dclfs5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs6.dpk b/official/4.2/FastScript/dclfs6.dpk new file mode 100644 index 0000000..484be3f --- /dev/null +++ b/official/4.2/FastScript/dclfs6.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 6 + +package dclfs6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs7.dpk b/official/4.2/FastScript/dclfs7.dpk new file mode 100644 index 0000000..554e22b --- /dev/null +++ b/official/4.2/FastScript/dclfs7.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 7 + +package dclfs7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfs9.bdsproj b/official/4.2/FastScript/dclfs9.bdsproj new file mode 100644 index 0000000..8b1acd0 --- /dev/null +++ b/official/4.2/FastScript/dclfs9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfs9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfs9.dpk b/official/4.2/FastScript/dclfs9.dpk new file mode 100644 index 0000000..e64ed1e --- /dev/null +++ b/official/4.2/FastScript/dclfs9.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 2005 + +package dclfs9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO10.bdsproj b/official/4.2/FastScript/dclfsADO10.bdsproj new file mode 100644 index 0000000..957918a --- /dev/null +++ b/official/4.2/FastScript/dclfsADO10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsADO10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsADO10.dpk b/official/4.2/FastScript/dclfsADO10.dpk new file mode 100644 index 0000000..d21c660 --- /dev/null +++ b/official/4.2/FastScript/dclfsADO10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package dclfsADO10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10, + fsADO10; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO11.bdsproj b/official/4.2/FastScript/dclfsADO11.bdsproj new file mode 100644 index 0000000..3baa552 --- /dev/null +++ b/official/4.2/FastScript/dclfsADO11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsADO11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsADO11.dpk b/official/4.2/FastScript/dclfsADO11.dpk new file mode 100644 index 0000000..394cf98 --- /dev/null +++ b/official/4.2/FastScript/dclfsADO11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package dclfsADO11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11, + fsADO11; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO5.dpk b/official/4.2/FastScript/dclfsADO5.dpk new file mode 100644 index 0000000..83fa0f8 --- /dev/null +++ b/official/4.2/FastScript/dclfsADO5.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 5 + +package dclfsADO5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5, + fsADO5; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO6.dpk b/official/4.2/FastScript/dclfsADO6.dpk new file mode 100644 index 0000000..5fa1b3f --- /dev/null +++ b/official/4.2/FastScript/dclfsADO6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package dclfsADO6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6, + fsADO6; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO7.dpk b/official/4.2/FastScript/dclfsADO7.dpk new file mode 100644 index 0000000..654692b --- /dev/null +++ b/official/4.2/FastScript/dclfsADO7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package dclfsADO7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7, + fsADO7; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsADO9.bdsproj b/official/4.2/FastScript/dclfsADO9.bdsproj new file mode 100644 index 0000000..42ee713 --- /dev/null +++ b/official/4.2/FastScript/dclfsADO9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsADO9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsADO9.dpk b/official/4.2/FastScript/dclfsADO9.dpk new file mode 100644 index 0000000..9ebdf0d --- /dev/null +++ b/official/4.2/FastScript/dclfsADO9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package dclfsADO9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 ADO Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9, + fsADO9; + +contains + fs_iadoreg in 'fs_iadoreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE10.bdsproj b/official/4.2/FastScript/dclfsBDE10.bdsproj new file mode 100644 index 0000000..bd86a0b --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsBDE10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsBDE10.dpk b/official/4.2/FastScript/dclfsBDE10.dpk new file mode 100644 index 0000000..bb801e1 --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package dclfsBDE10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10, + fsBDE10; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE11.bdsproj b/official/4.2/FastScript/dclfsBDE11.bdsproj new file mode 100644 index 0000000..1b1f5aa --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsBDE11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsBDE11.dpk b/official/4.2/FastScript/dclfsBDE11.dpk new file mode 100644 index 0000000..c0c9f2e --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package dclfsBDE11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11, + fsBDE11; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE4.dpk b/official/4.2/FastScript/dclfsBDE4.dpk new file mode 100644 index 0000000..50b1256 --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE4.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 4 + +package dclfsBDE4; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + fs4, + fsBDE4; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE5.dpk b/official/4.2/FastScript/dclfsBDE5.dpk new file mode 100644 index 0000000..b800eea --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE5.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 5 + +package dclfsBDE5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5, + fsBDE5; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE6.dpk b/official/4.2/FastScript/dclfsBDE6.dpk new file mode 100644 index 0000000..32ff035 --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package dclfsBDE6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6, + fsBDE6; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE7.dpk b/official/4.2/FastScript/dclfsBDE7.dpk new file mode 100644 index 0000000..2a4a41d --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package dclfsBDE7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7, + fsBDE7; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsBDE9.bdsproj b/official/4.2/FastScript/dclfsBDE9.bdsproj new file mode 100644 index 0000000..8ff5e78 --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsBDE9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsBDE9.dpk b/official/4.2/FastScript/dclfsBDE9.dpk new file mode 100644 index 0000000..2a9fdc9 --- /dev/null +++ b/official/4.2/FastScript/dclfsBDE9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package dclfsBDE9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 BDE Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9, + fsBDE9; + +contains + fs_ibdereg in 'fs_ibdereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB10.bdsproj b/official/4.2/FastScript/dclfsDB10.bdsproj new file mode 100644 index 0000000..4b0941c --- /dev/null +++ b/official/4.2/FastScript/dclfsDB10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsDB10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsDB10.dpk b/official/4.2/FastScript/dclfsDB10.dpk new file mode 100644 index 0000000..94f1794 --- /dev/null +++ b/official/4.2/FastScript/dclfsDB10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package dclfsDB10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10, + fsDB10; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB11.bdsproj b/official/4.2/FastScript/dclfsDB11.bdsproj new file mode 100644 index 0000000..cf54521 --- /dev/null +++ b/official/4.2/FastScript/dclfsDB11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsDB11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsDB11.dpk b/official/4.2/FastScript/dclfsDB11.dpk new file mode 100644 index 0000000..0f6556c --- /dev/null +++ b/official/4.2/FastScript/dclfsDB11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package dclfsDB11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11, + fsDB11; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB4.dpk b/official/4.2/FastScript/dclfsDB4.dpk new file mode 100644 index 0000000..872a4b9 --- /dev/null +++ b/official/4.2/FastScript/dclfsDB4.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 4 + +package dclfsDB4; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + fs4, + fsDB4; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB5.dpk b/official/4.2/FastScript/dclfsDB5.dpk new file mode 100644 index 0000000..01d155e --- /dev/null +++ b/official/4.2/FastScript/dclfsDB5.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 5 + +package dclfsDB5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5, + fsDB5; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB6.dpk b/official/4.2/FastScript/dclfsDB6.dpk new file mode 100644 index 0000000..973438d --- /dev/null +++ b/official/4.2/FastScript/dclfsDB6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package dclfsDB6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6, + fsDB6; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB7.dpk b/official/4.2/FastScript/dclfsDB7.dpk new file mode 100644 index 0000000..dcda2cb --- /dev/null +++ b/official/4.2/FastScript/dclfsDB7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package dclfsDB7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7, + fsDB7; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsDB9.bdsproj b/official/4.2/FastScript/dclfsDB9.bdsproj new file mode 100644 index 0000000..c9a5e68 --- /dev/null +++ b/official/4.2/FastScript/dclfsDB9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsDB9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsDB9.dpk b/official/4.2/FastScript/dclfsDB9.dpk new file mode 100644 index 0000000..30844d6 --- /dev/null +++ b/official/4.2/FastScript/dclfsDB9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package dclfsDB9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 DB Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9, + fsDB9; + +contains + fs_idbreg in 'fs_idbreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX10.bdsproj b/official/4.2/FastScript/dclfsIBX10.bdsproj new file mode 100644 index 0000000..706b834 --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsIBX10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsIBX10.dpk b/official/4.2/FastScript/dclfsIBX10.dpk new file mode 100644 index 0000000..5209b7f --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package dclfsIBX10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10, + fsIBX10; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX11.bdsproj b/official/4.2/FastScript/dclfsIBX11.bdsproj new file mode 100644 index 0000000..79b6c8f --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsIBX11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsIBX11.dpk b/official/4.2/FastScript/dclfsIBX11.dpk new file mode 100644 index 0000000..d7acc37 --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package dclfsIBX11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11, + fsIBX11; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX5.dpk b/official/4.2/FastScript/dclfsIBX5.dpk new file mode 100644 index 0000000..1c6e40b --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX5.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 5 + +package dclfsIBX5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5, + fsIBX5; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX6.dpk b/official/4.2/FastScript/dclfsIBX6.dpk new file mode 100644 index 0000000..5e09acd --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package dclfsIBX6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6, + fsIBX6; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX7.dpk b/official/4.2/FastScript/dclfsIBX7.dpk new file mode 100644 index 0000000..04ff045 --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package dclfsIBX7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7, + fsIBX7; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsIBX9.bdsproj b/official/4.2/FastScript/dclfsIBX9.bdsproj new file mode 100644 index 0000000..e5dfa3d --- /dev/null +++ b/official/4.2/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/4.2/FastScript/dclfsIBX9.dpk b/official/4.2/FastScript/dclfsIBX9.dpk new file mode 100644 index 0000000..bda27bc --- /dev/null +++ b/official/4.2/FastScript/dclfsIBX9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package dclfsIBX9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 IBX Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9, + fsIBX9; + +contains + fs_iibxreg in 'fs_iibxreg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee10.bdsproj b/official/4.2/FastScript/dclfsTee10.bdsproj new file mode 100644 index 0000000..c61771e --- /dev/null +++ b/official/4.2/FastScript/dclfsTee10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsTee10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsTee10.dpk b/official/4.2/FastScript/dclfsTee10.dpk new file mode 100644 index 0000000..26394bf --- /dev/null +++ b/official/4.2/FastScript/dclfsTee10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package dclfsTee10; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs10, + fsTee10; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee11.bdsproj b/official/4.2/FastScript/dclfsTee11.bdsproj new file mode 100644 index 0000000..613cb95 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsTee11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsTee11.dpk b/official/4.2/FastScript/dclfsTee11.dpk new file mode 100644 index 0000000..8521499 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package dclfsTee11; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs11, + fsTee11; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee4.dpk b/official/4.2/FastScript/dclfsTee4.dpk new file mode 100644 index 0000000..c38f46e --- /dev/null +++ b/official/4.2/FastScript/dclfsTee4.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 4 + +package dclfsTee4; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + fs4, + fsTee4; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee5.dpk b/official/4.2/FastScript/dclfsTee5.dpk new file mode 100644 index 0000000..d7c96c8 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee5.dpk @@ -0,0 +1,40 @@ +// Package file for Delphi 5 + +package dclfsTee5; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + fs5, + fsTee5; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee6.dpk b/official/4.2/FastScript/dclfsTee6.dpk new file mode 100644 index 0000000..2b187c0 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package dclfsTee6; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs6, + fsTee6; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee7.dpk b/official/4.2/FastScript/dclfsTee7.dpk new file mode 100644 index 0000000..a0bd3d5 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package dclfsTee7; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs7, + fsTee7; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsTee9.bdsproj b/official/4.2/FastScript/dclfsTee9.bdsproj new file mode 100644 index 0000000..06055e2 --- /dev/null +++ b/official/4.2/FastScript/dclfsTee9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + dclfsTee9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/dclfsTee9.dpk b/official/4.2/FastScript/dclfsTee9.dpk new file mode 100644 index 0000000..98f07bd --- /dev/null +++ b/official/4.2/FastScript/dclfsTee9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package dclfsTee9; + +{$R 'fs_ireg.dcr'} + +{$DESCRIPTION 'FastScript 1.9 Tee Components'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + DESIGNIDE, + fs9, + fsTee9; + +contains + fs_iteereg in 'fs_iteereg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsx.dpk b/official/4.2/FastScript/dclfsx.dpk new file mode 100644 index 0000000..83340eb --- /dev/null +++ b/official/4.2/FastScript/dclfsx.dpk @@ -0,0 +1,46 @@ +// Package file for CLX + +package dclfsx; + +{$R *.res} +{$R 'fs_ireg.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'FastScript 1.9 Components'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + designide, + visualclx, + fsx +{$IFNDEF LINUX} +, bdertl, + adortl, + tee +{$ENDIF}; + +contains + fs_ireg in 'fs_ireg.pas'; + +end. diff --git a/official/4.2/FastScript/dclfsx.res b/official/4.2/FastScript/dclfsx.res new file mode 100644 index 0000000..fa40de9 Binary files /dev/null and b/official/4.2/FastScript/dclfsx.res differ diff --git a/official/4.2/FastScript/fs.inc b/official/4.2/FastScript/fs.inc new file mode 100644 index 0000000..0b562ba --- /dev/null +++ b/official/4.2/FastScript/fs.inc @@ -0,0 +1,157 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Include file } +{ } +{ (c) 2003, 2004 by Alexander Tzyganenko, } +{ Fast Reports, Inc } +{ } +{******************************************} + + +{$R-} {- Range-Checking } +{$H+} {- Use long strings by default } +{$B-} {- Complete Boolean Evaluation } +{$T-} {- Typed @ operator } +{$P+} {- Open string params } + +{$IFNDEF FPC} + {$V-} {- Var-String Checking } + {$X+} {- Extended syntax } + {$J+} {- Writeable structured consts } +{$ENDIF} + +{$IFDEF VER120} // Delphi 4.0 + {$DEFINE Delphi4} +{$ENDIF} + +{$IFDEF VER130} // Delphi 5.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} +{$ENDIF} + +{$IFDEF VER140} // Delphi 6.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} +{$ENDIF} + +{$IFDEF VER150} // Delphi 7.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} +{$ENDIF} + +{$IFDEF VER170} // Delphi 9.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + +{$IFDEF VER180} // Delphi 10.0 + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + +{$IFDEF VER185} // Delphi 11.0 (Spacely) + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$DEFINE Delphi11} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + +{$IFDEF VER190} // Delphi 11.0 (Highlander) + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE Delphi7} + {$DEFINE Delphi9} + {$DEFINE Delphi10} + {$DEFINE Delphi11} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CAST OFF} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + +{$IFDEF VER125} // Borland C++ Builder 4.0 + {$DEFINE Delphi4} + {$ObjExportAll on} +{$ENDIF} + +{$IFDEF VER130} // Borland C++ Builder 5.0 + {$IFDEF BCB} + {$ObjExportAll on} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER140} // Borland C++ Builder 6.0 + {$IFDEF BCB} + {$ObjExportAll on} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER150} // Borland C++ Builder 7.0 + {$IFDEF BCB} + {$ObjExportAll on} + {$ENDIF} +{$ENDIF} + +{$IFDEF FPC} // Free pascal compiler + {$MODE DELPHI} + + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} +{$ELSE} + {$IFDEF LINUX} // KYLIX + {$DEFINE Delphi4} + {$DEFINE Delphi5} + {$DEFINE Delphi6} + {$DEFINE CLX} + {$IFDEF BCB} + {$DEFINE CLXCPP} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +{$IFDEF FPC} + {$DEFINE CROSS_COMPILE} +{$ENDIF} + +{$IFDEF CLX} + {$DEFINE CROSS_COMPILE} +{$ENDIF} + +// Uncomment below line for CLX compilation +//{$DEFINE CLX} + +// include ole dispatch module +{$IFNDEF CROSS_COMPILE} + {$DEFINE OLE} +{$ENDIF} diff --git a/official/4.2/FastScript/fs10.bdsproj b/official/4.2/FastScript/fs10.bdsproj new file mode 100644 index 0000000..78c733f --- /dev/null +++ b/official/4.2/FastScript/fs10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fs10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fs10.dpk b/official/4.2/FastScript/fs10.dpk new file mode 100644 index 0000000..44f0b04 --- /dev/null +++ b/official/4.2/FastScript/fs10.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 2006 + +package fs10; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLX; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fs11.bdsproj b/official/4.2/FastScript/fs11.bdsproj new file mode 100644 index 0000000..b3494e9 --- /dev/null +++ b/official/4.2/FastScript/fs11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fs11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fs11.dpk b/official/4.2/FastScript/fs11.dpk new file mode 100644 index 0000000..b993ab0 --- /dev/null +++ b/official/4.2/FastScript/fs11.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 2007 + +package fs11; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLX; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fs4.bpk b/official/4.2/FastScript/fs4.bpk new file mode 100644 index 0000000..fd7b16a --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs4.cpp b/official/4.2/FastScript/fs4.cpp new file mode 100644 index 0000000..43953d6 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs4.dpk b/official/4.2/FastScript/fs4.dpk new file mode 100644 index 0000000..0397c54 --- /dev/null +++ b/official/4.2/FastScript/fs4.dpk @@ -0,0 +1,65 @@ +// Package file for Delphi 4 + +package fs4; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLX40; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + +end. diff --git a/official/4.2/FastScript/fs4.res b/official/4.2/FastScript/fs4.res new file mode 100644 index 0000000..eb2597a Binary files /dev/null and b/official/4.2/FastScript/fs4.res differ diff --git a/official/4.2/FastScript/fs5.bpk b/official/4.2/FastScript/fs5.bpk new file mode 100644 index 0000000..8b10919 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs5.cpp b/official/4.2/FastScript/fs5.cpp new file mode 100644 index 0000000..daadee8 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs5.dpk b/official/4.2/FastScript/fs5.dpk new file mode 100644 index 0000000..c803adb --- /dev/null +++ b/official/4.2/FastScript/fs5.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 5 + +package fs5; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLX50; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fs5.res b/official/4.2/FastScript/fs5.res new file mode 100644 index 0000000..da3d366 Binary files /dev/null and b/official/4.2/FastScript/fs5.res differ diff --git a/official/4.2/FastScript/fs6.bpk b/official/4.2/FastScript/fs6.bpk new file mode 100644 index 0000000..822a6d2 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs6.cpp b/official/4.2/FastScript/fs6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fs6.dpk b/official/4.2/FastScript/fs6.dpk new file mode 100644 index 0000000..425a1b9 --- /dev/null +++ b/official/4.2/FastScript/fs6.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 6 + +package fs6; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLX; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fs6.res b/official/4.2/FastScript/fs6.res new file mode 100644 index 0000000..2bbdbc1 Binary files /dev/null and b/official/4.2/FastScript/fs6.res differ diff --git a/official/4.2/FastScript/fs7.dpk b/official/4.2/FastScript/fs7.dpk new file mode 100644 index 0000000..623a47e --- /dev/null +++ b/official/4.2/FastScript/fs7.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 7 + +package fs7; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLX; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fs9.bdsproj b/official/4.2/FastScript/fs9.bdsproj new file mode 100644 index 0000000..6cd3ca1 --- /dev/null +++ b/official/4.2/FastScript/fs9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fs9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fs9.dpk b/official/4.2/FastScript/fs9.dpk new file mode 100644 index 0000000..7dfd9b9 --- /dev/null +++ b/official/4.2/FastScript/fs9.dpk @@ -0,0 +1,66 @@ +// Package file for Delphi 2005 + +package fs9; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLX; + + +contains + fs_ipascal in 'fs_ipascal.pas', + fs_icpp in 'fs_icpp.pas', + fs_ijs in 'fs_ijs.pas', + fs_ibasic in 'fs_ibasic.pas', + + fs_iclassesrtti in 'fs_iclassesrtti.pas', + fs_iconst in 'fs_iconst.pas', + fs_idialogsrtti in 'fs_idialogsrtti.pas', +{$IFDEF OLE} + fs_idisp in 'fs_idisp.pas', +{$ENDIF} + fs_ievents in 'fs_ievents.pas', + fs_iexpression in 'fs_iexpression.pas', + fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas', + fs_iformsrtti in 'fs_iformsrtti.pas', + fs_igraphicsrtti in 'fs_igraphicsrtti.pas', + fs_iilparser in 'fs_iilparser.pas', + fs_iinirtti in 'fs_iinirtti.pas', + fs_iinterpreter in 'fs_iinterpreter.pas', + fs_iparser in 'fs_iparser.pas', + fs_isysrtti in 'fs_isysrtti.pas', + fs_imenusrtti in 'fs_imenusrtti.pas', + fs_itools in 'fs_itools.pas', + fs_xml in 'fs_xml.pas', + fs_synmemo in 'fs_synmemo.pas', + fs_tree in 'fs_tree.pas'; + + + +end. diff --git a/official/4.2/FastScript/fsADO10.bdsproj b/official/4.2/FastScript/fsADO10.bdsproj new file mode 100644 index 0000000..34727e5 --- /dev/null +++ b/official/4.2/FastScript/fsADO10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsADO10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsADO10.dpk b/official/4.2/FastScript/fsADO10.dpk new file mode 100644 index 0000000..d44b469 --- /dev/null +++ b/official/4.2/FastScript/fsADO10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsADO10; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs10, + fsDB10; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsADO11.bdsproj b/official/4.2/FastScript/fsADO11.bdsproj new file mode 100644 index 0000000..79495ed --- /dev/null +++ b/official/4.2/FastScript/fsADO11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsADO11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsADO11.dpk b/official/4.2/FastScript/fsADO11.dpk new file mode 100644 index 0000000..3a61b1e --- /dev/null +++ b/official/4.2/FastScript/fsADO11.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2007 + +package fsADO11; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs11, + fsDB11; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsADO5.bpk b/official/4.2/FastScript/fsADO5.bpk new file mode 100644 index 0000000..5aa3c2b --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsADO5.cpp b/official/4.2/FastScript/fsADO5.cpp new file mode 100644 index 0000000..1701cde --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsADO5.dpk b/official/4.2/FastScript/fsADO5.dpk new file mode 100644 index 0000000..9e0732a --- /dev/null +++ b/official/4.2/FastScript/fsADO5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsADO5; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLADO50, + fs5, + fsDB5; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsADO6.bpk b/official/4.2/FastScript/fsADO6.bpk new file mode 100644 index 0000000..324e945 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsADO6.cpp b/official/4.2/FastScript/fsADO6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsADO6.dpk b/official/4.2/FastScript/fsADO6.dpk new file mode 100644 index 0000000..0397a08 --- /dev/null +++ b/official/4.2/FastScript/fsADO6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsADO6; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs6, + fsDB6; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsADO7.dpk b/official/4.2/FastScript/fsADO7.dpk new file mode 100644 index 0000000..3975c14 --- /dev/null +++ b/official/4.2/FastScript/fsADO7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsADO7; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs7, + fsDB7; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsADO9.bdsproj b/official/4.2/FastScript/fsADO9.bdsproj new file mode 100644 index 0000000..9d0a211 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsADO9.dpk b/official/4.2/FastScript/fsADO9.dpk new file mode 100644 index 0000000..92811e4 --- /dev/null +++ b/official/4.2/FastScript/fsADO9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsADO9; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + ADORTL, + fs9, + fsDB9; + +contains + fs_iadortti in 'fs_iadortti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE10.bdsproj b/official/4.2/FastScript/fsBDE10.bdsproj new file mode 100644 index 0000000..f085ba5 --- /dev/null +++ b/official/4.2/FastScript/fsBDE10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsBDE10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsBDE10.dpk b/official/4.2/FastScript/fsBDE10.dpk new file mode 100644 index 0000000..b731095 --- /dev/null +++ b/official/4.2/FastScript/fsBDE10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsBDE10; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs10, + fsDB10; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE11.bdsproj b/official/4.2/FastScript/fsBDE11.bdsproj new file mode 100644 index 0000000..7ec05f1 --- /dev/null +++ b/official/4.2/FastScript/fsBDE11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsBDE11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsBDE11.dpk b/official/4.2/FastScript/fsBDE11.dpk new file mode 100644 index 0000000..999e182 --- /dev/null +++ b/official/4.2/FastScript/fsBDE11.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2007 + +package fsBDE11; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs11, + fsDB11; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE4.bpk b/official/4.2/FastScript/fsBDE4.bpk new file mode 100644 index 0000000..72be8ad --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE4.cpp b/official/4.2/FastScript/fsBDE4.cpp new file mode 100644 index 0000000..cb7bb1d --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE4.dpk b/official/4.2/FastScript/fsBDE4.dpk new file mode 100644 index 0000000..6047735 --- /dev/null +++ b/official/4.2/FastScript/fsBDE4.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 4 + +package fsBDE4; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLDB40, + fs4, + fsDB4; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE5.bpk b/official/4.2/FastScript/fsBDE5.bpk new file mode 100644 index 0000000..17a4c8d --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE5.cpp b/official/4.2/FastScript/fsBDE5.cpp new file mode 100644 index 0000000..b2619a0 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE5.dpk b/official/4.2/FastScript/fsBDE5.dpk new file mode 100644 index 0000000..3953b88 --- /dev/null +++ b/official/4.2/FastScript/fsBDE5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsBDE5; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLBDE50, + fs5, + fsDB5; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE6.bpk b/official/4.2/FastScript/fsBDE6.bpk new file mode 100644 index 0000000..5db87d1 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE6.cpp b/official/4.2/FastScript/fsBDE6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE6.dpk b/official/4.2/FastScript/fsBDE6.dpk new file mode 100644 index 0000000..df93c1c --- /dev/null +++ b/official/4.2/FastScript/fsBDE6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsBDE6; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs6, + fsDB6; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE7.dpk b/official/4.2/FastScript/fsBDE7.dpk new file mode 100644 index 0000000..98314cb --- /dev/null +++ b/official/4.2/FastScript/fsBDE7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsBDE7; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs7, + fsDB7; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsBDE9.bdsproj b/official/4.2/FastScript/fsBDE9.bdsproj new file mode 100644 index 0000000..acd77ea --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsBDE9.dpk b/official/4.2/FastScript/fsBDE9.dpk new file mode 100644 index 0000000..8d1fc5b --- /dev/null +++ b/official/4.2/FastScript/fsBDE9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsBDE9; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + BDERTL, + fs9, + fsDB9; + +contains + fs_ibdertti in 'fs_ibdertti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB10.bdsproj b/official/4.2/FastScript/fsDB10.bdsproj new file mode 100644 index 0000000..7627517 --- /dev/null +++ b/official/4.2/FastScript/fsDB10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsDB10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsDB10.dpk b/official/4.2/FastScript/fsDB10.dpk new file mode 100644 index 0000000..b313981 --- /dev/null +++ b/official/4.2/FastScript/fsDB10.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2006 + +package fsDB10; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs10; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB11.bdsproj b/official/4.2/FastScript/fsDB11.bdsproj new file mode 100644 index 0000000..d69a33c --- /dev/null +++ b/official/4.2/FastScript/fsDB11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsDB11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsDB11.dpk b/official/4.2/FastScript/fsDB11.dpk new file mode 100644 index 0000000..118eaf9 --- /dev/null +++ b/official/4.2/FastScript/fsDB11.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2007 + +package fsDB11; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs11; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB4.bpk b/official/4.2/FastScript/fsDB4.bpk new file mode 100644 index 0000000..a4df936 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB4.cpp b/official/4.2/FastScript/fsDB4.cpp new file mode 100644 index 0000000..4fe67af --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB4.dpk b/official/4.2/FastScript/fsDB4.dpk new file mode 100644 index 0000000..e5e5f62 --- /dev/null +++ b/official/4.2/FastScript/fsDB4.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 4 + +package fsDB4; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL40, + VCLDB40, + fs4; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB5.bpk b/official/4.2/FastScript/fsDB5.bpk new file mode 100644 index 0000000..f12ab61 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB5.cpp b/official/4.2/FastScript/fsDB5.cpp new file mode 100644 index 0000000..d782c17 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB5.dpk b/official/4.2/FastScript/fsDB5.dpk new file mode 100644 index 0000000..d9761da --- /dev/null +++ b/official/4.2/FastScript/fsDB5.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 5 + +package fsDB5; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + fs5; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB6.bpk b/official/4.2/FastScript/fsDB6.bpk new file mode 100644 index 0000000..8a6dc71 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB6.cpp b/official/4.2/FastScript/fsDB6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsDB6.dpk b/official/4.2/FastScript/fsDB6.dpk new file mode 100644 index 0000000..8c41f34 --- /dev/null +++ b/official/4.2/FastScript/fsDB6.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 6 + +package fsDB6; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs6; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB7.dpk b/official/4.2/FastScript/fsDB7.dpk new file mode 100644 index 0000000..672282e --- /dev/null +++ b/official/4.2/FastScript/fsDB7.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 7 + +package fsDB7; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs7; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsDB9.bdsproj b/official/4.2/FastScript/fsDB9.bdsproj new file mode 100644 index 0000000..4f121f2 --- /dev/null +++ b/official/4.2/FastScript/fsDB9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsDB9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsDB9.dpk b/official/4.2/FastScript/fsDB9.dpk new file mode 100644 index 0000000..4769461 --- /dev/null +++ b/official/4.2/FastScript/fsDB9.dpk @@ -0,0 +1,41 @@ +// Package file for Delphi 2005 + +package fsDB9; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + fs9; + +contains + fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas', + fs_idbrtti in 'fs_idbrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX10.bdsproj b/official/4.2/FastScript/fsIBX10.bdsproj new file mode 100644 index 0000000..4e8e760 --- /dev/null +++ b/official/4.2/FastScript/fsIBX10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsIBX10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsIBX10.dpk b/official/4.2/FastScript/fsIBX10.dpk new file mode 100644 index 0000000..6281b11 --- /dev/null +++ b/official/4.2/FastScript/fsIBX10.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2006 + +package fsIBX10; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs10, + fsDB10; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX11.bdsproj b/official/4.2/FastScript/fsIBX11.bdsproj new file mode 100644 index 0000000..1cbf2d6 --- /dev/null +++ b/official/4.2/FastScript/fsIBX11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsIBX11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsIBX11.dpk b/official/4.2/FastScript/fsIBX11.dpk new file mode 100644 index 0000000..1b0d14f --- /dev/null +++ b/official/4.2/FastScript/fsIBX11.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2007 + +package fsIBX11; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs11, + fsDB11; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX5.bpk b/official/4.2/FastScript/fsIBX5.bpk new file mode 100644 index 0000000..f58100b --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsIBX5.cpp b/official/4.2/FastScript/fsIBX5.cpp new file mode 100644 index 0000000..3b8be05 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsIBX5.dpk b/official/4.2/FastScript/fsIBX5.dpk new file mode 100644 index 0000000..c3f4244 --- /dev/null +++ b/official/4.2/FastScript/fsIBX5.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 5 + +package fsIBX5; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL50, + VCLDB50, + VCLIB50, + fs5, + fsDB5; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX6.bpk b/official/4.2/FastScript/fsIBX6.bpk new file mode 100644 index 0000000..3ece52b --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsIBX6.cpp b/official/4.2/FastScript/fsIBX6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsIBX6.dpk b/official/4.2/FastScript/fsIBX6.dpk new file mode 100644 index 0000000..2961327 --- /dev/null +++ b/official/4.2/FastScript/fsIBX6.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 6 + +package fsIBX6; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs6, + fsDB6; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX7.dpk b/official/4.2/FastScript/fsIBX7.dpk new file mode 100644 index 0000000..6ec8ab0 --- /dev/null +++ b/official/4.2/FastScript/fsIBX7.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 7 + +package fsIBX7; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs7, + fsDB7; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsIBX9.bdsproj b/official/4.2/FastScript/fsIBX9.bdsproj new file mode 100644 index 0000000..013ea63 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsIBX9.dpk b/official/4.2/FastScript/fsIBX9.dpk new file mode 100644 index 0000000..bdc5c57 --- /dev/null +++ b/official/4.2/FastScript/fsIBX9.dpk @@ -0,0 +1,42 @@ +// Package file for Delphi 2005 + +package fsIBX9; + +{$I fs.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, + VCLDB, + IBXPRESS, + fs9, + fsDB9; + +contains + fs_iibxrtti in 'fs_iibxrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsTee10.bdsproj b/official/4.2/FastScript/fsTee10.bdsproj new file mode 100644 index 0000000..49aba99 --- /dev/null +++ b/official/4.2/FastScript/fsTee10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsTee10.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsTee10.dpk b/official/4.2/FastScript/fsTee10.dpk new file mode 100644 index 0000000..a1e0383 --- /dev/null +++ b/official/4.2/FastScript/fsTee10.dpk @@ -0,0 +1,48 @@ +// Package file for Delphi 2006 + +package fsTee10; + +{$I fs.inc} +{$I tee.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, {$ENDIF} +{$IFDEF TeeChartStd7}TEE710, {$ENDIF} +{$IFDEF 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/4.2/FastScript/fsTee11.bdsproj b/official/4.2/FastScript/fsTee11.bdsproj new file mode 100644 index 0000000..4526b0a --- /dev/null +++ b/official/4.2/FastScript/fsTee11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsTee11.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsTee11.dpk b/official/4.2/FastScript/fsTee11.dpk new file mode 100644 index 0000000..b00465d --- /dev/null +++ b/official/4.2/FastScript/fsTee11.dpk @@ -0,0 +1,48 @@ +// Package file for Delphi 2007 + +package fsTee11; + +{$I fs.inc} +{$I tee.inc} + +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, {$ENDIF} +{$IFDEF TeeChartStd7}TEE710, {$ENDIF} +{$IFDEF TeeChart4} TEE410, {$ENDIF} +{$IFDEF TeeChart5} TEE510, {$ENDIF} +{$IFDEF TeeChart6} TEE610, {$ENDIF} +{$IFDEF TeeChart7} TEE710, {$ENDIF} + VCLX, + fs11; + + +contains + fs_ichartrtti in 'fs_ichartrtti.pas'; + + +end. diff --git a/official/4.2/FastScript/fsTee4.bpk b/official/4.2/FastScript/fsTee4.bpk new file mode 100644 index 0000000..cd082cc --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee4.cpp b/official/4.2/FastScript/fsTee4.cpp new file mode 100644 index 0000000..396b5fd --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee4.dpk b/official/4.2/FastScript/fsTee4.dpk new file mode 100644 index 0000000..24b32f9 --- /dev/null +++ b/official/4.2/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} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$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/4.2/FastScript/fsTee5.bpk b/official/4.2/FastScript/fsTee5.bpk new file mode 100644 index 0000000..f19b65b --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee5.cpp b/official/4.2/FastScript/fsTee5.cpp new file mode 100644 index 0000000..1f8f0ba --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee5.dpk b/official/4.2/FastScript/fsTee5.dpk new file mode 100644 index 0000000..1c89308 --- /dev/null +++ b/official/4.2/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} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$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/4.2/FastScript/fsTee6.bpk b/official/4.2/FastScript/fsTee6.bpk new file mode 100644 index 0000000..2d92b4c --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee6.cpp b/official/4.2/FastScript/fsTee6.cpp new file mode 100644 index 0000000..59b8711 --- /dev/null +++ b/official/4.2/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/4.2/FastScript/fsTee6.dpk b/official/4.2/FastScript/fsTee6.dpk new file mode 100644 index 0000000..6f63b06 --- /dev/null +++ b/official/4.2/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} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$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/4.2/FastScript/fsTee7.dpk b/official/4.2/FastScript/fsTee7.dpk new file mode 100644 index 0000000..c3ce936 --- /dev/null +++ b/official/4.2/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} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$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/4.2/FastScript/fsTee9.bdsproj b/official/4.2/FastScript/fsTee9.bdsproj new file mode 100644 index 0000000..5baa922 --- /dev/null +++ b/official/4.2/FastScript/fsTee9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + fsTee9.dpk + + + 7.0 + + + diff --git a/official/4.2/FastScript/fsTee9.dpk b/official/4.2/FastScript/fsTee9.dpk new file mode 100644 index 0000000..9806b15 --- /dev/null +++ b/official/4.2/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} + +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$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/4.2/FastScript/fs_iadoreg.pas b/official/4.2/FastScript/fs_iadoreg.pas new file mode 100644 index 0000000..ed795c1 --- /dev/null +++ b/official/4.2/FastScript/fs_iadoreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iadoreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_iadortti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsADORTTI]); +end; + +end. diff --git a/official/4.2/FastScript/fs_iadortti.pas b/official/4.2/FastScript/fs_iadortti.pas new file mode 100644 index 0000000..cf204c9 --- /dev/null +++ b/official/4.2/FastScript/fs_iadortti.pas @@ -0,0 +1,126 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ ADO classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iadortti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, + 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; + function GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; + procedure SetProp(Instance: TObject; ClassType: TClass; + const PropName: String; Value: Variant); + public + constructor Create(AScript: TfsScript); override; + end; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + with AScript do + begin + AddType('TDataType', fvtInt); + AddClass(TADOConnection, 'TComponent'); + AddClass(TParameter, 'TCollectionItem'); + with AddClass(TParameters, 'TCollection') do + begin + AddMethod('function AddParameter: TParameter', CallMethod); + AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True); + end; + with AddClass(TCustomADODataSet, 'TDataSet') do + begin + AddProperty('Sort', 'WideString', GetProp, SetProp); + end; + AddClass(TADOTable, 'TCustomADODataSet'); + with AddClass(TADOQuery, 'TCustomADODataSet') do + AddMethod('procedure ExecSQL', CallMethod); + with AddClass(TADOStoredProc, 'TCustomADODataSet') do + AddMethod('procedure ExecProc', CallMethod); + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +begin + Result := 0; + + if ClassType = TParameters then + begin + if MethodName = 'ADDPARAMETER' then + Result := 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; + + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TCustomADODataSet then + begin + if PropName = 'SORT' then + Result := TCustomADODataSet(Instance).Sort; + end +end; + +procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; + const PropName: String; Value: Variant); +begin + + if ClassType = TCustomADODataSet then + begin + if PropName = 'SORT' then + TCustomADODataSet(Instance).Sort := Value; + end + +end; + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. + diff --git a/official/4.2/FastScript/fs_ibasic.pas b/official/4.2/FastScript/fs_ibasic.pas new file mode 100644 index 0000000..48e3a50 --- /dev/null +++ b/official/4.2/FastScript/fs_ibasic.pas @@ -0,0 +1,171 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Basic grammar } +{ } +{ (c) 2003-2007 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/4.2/FastScript/fs_ibdereg.pas b/official/4.2/FastScript/fs_ibdereg.pas new file mode 100644 index 0000000..515b5da --- /dev/null +++ b/official/4.2/FastScript/fs_ibdereg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ibdereg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_ibdertti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsBDERTTI]); +end; + +end. diff --git a/official/4.2/FastScript/fs_ibdertti.pas b/official/4.2/FastScript/fs_ibdertti.pas new file mode 100644 index 0000000..f1c0782 --- /dev/null +++ b/official/4.2/FastScript/fs_ibdertti.pas @@ -0,0 +1,164 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ BDE classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ibdertti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, + DB, DBTables; + +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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_ichartrtti.pas b/official/4.2/FastScript/fs_ichartrtti.pas new file mode 100644 index 0000000..4b396d1 --- /dev/null +++ b/official/4.2/FastScript/fs_ichartrtti.pas @@ -0,0 +1,121 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Chart } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ichartrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti, 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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iclassesrtti.pas b/official/4.2/FastScript/fs_iclassesrtti.pas new file mode 100644 index 0000000..c8523fe --- /dev/null +++ b/official/4.2/FastScript/fs_iclassesrtti.pas @@ -0,0 +1,476 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Classes.pas classes and functions } +{ } +{ (c) 2003-2007 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 Root: TfsXMLItem', CallMethod); + AddProperty('Data', 'Integer', GetProp, SetProp); + AddProperty('Count', 'Integer', GetProp, nil); + AddDefaultProperty('Items', 'Integer', 'TfsXMLItem', CallMethod, True); + AddIndexProperty('Prop', 'String', 'String', CallMethod); + AddProperty('Name', 'String', GetProp, SetProp); + AddProperty('Parent', 'TfsXMLItem', GetProp, nil); + AddProperty('Text', 'String', GetProp, SetProp); + end; + with AddClass(TfsXMLDocument, 'TObject') do + begin + AddConstructor('constructor Create', CallMethod); + AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod); + AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod); + AddMethod('procedure SaveToFile(const FileName: String)', CallMethod); + AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod); + AddProperty('Root', 'TfsXMLItem', GetProp, nil); + end; + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +var + i: Integer; + s: String; + _TList: TList; + _TStrings: TStrings; + _TStream: TStream; + _TMemoryStream: TMemoryStream; + _TfsXMLItem: TfsXMLItem; + _TfsXMLDocument: TfsXMLDocument; +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.GET' then + Result := _TfsXMLItem.Prop[Caller.Params[0]] + else if MethodName = 'PROP.SET' then + _TfsXMLItem.Prop[Caller.Params[0]] := Caller.Params[1] + else if MethodName = 'ROOT' then + Result := 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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iconst.pas b/official/4.2/FastScript/fs_iconst.pas new file mode 100644 index 0000000..bbcdd0e --- /dev/null +++ b/official/4.2/FastScript/fs_iconst.pas @@ -0,0 +1,59 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Resources } +{ } +{ (c) 2003-2007 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/4.2/FastScript/fs_icpp.pas b/official/4.2/FastScript/fs_icpp.pas new file mode 100644 index 0000000..df80918 --- /dev/null +++ b/official/4.2/FastScript/fs_icpp.pas @@ -0,0 +1,159 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ C++ grammar } +{ } +{ (c) 2003-2007 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 = + '' + + '<' + + 'err20 text="''>'' expected"/>' + + '' + + '' + + '<' + + 'sequence>' + + '<' + + 'sequence>' + + '' + + '' + + '' + + ''; + + +initialization + fsRegisterLanguage('C++Script', CPP_GRAMMAR); + +end. diff --git a/official/4.2/FastScript/fs_idbctrlsrtti.pas b/official/4.2/FastScript/fs_idbctrlsrtti.pas new file mode 100644 index 0000000..0948213 --- /dev/null +++ b/official/4.2/FastScript/fs_idbctrlsrtti.pas @@ -0,0 +1,182 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ DB controls } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idbctrlsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti, fs_idbrtti, DB +{$IFDEF CLX} +, QDBCtrls, QDBGrids +{$ELSE} +, DBCtrls, DBGrids +{$ENDIF}; + + +type + TfsDBCtrlsRTTI = class(TComponent); // fake component + + +implementation + +type +{$IFNDEF FPC} + THackDBLookupControl = class(TDBLookupControl); +{$ENDIF} + + TFunctions = class(TfsRTTIModule) + private + function CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; + function GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; + procedure SetProp(Instance: TObject; ClassType: TClass; + const PropName: String; Value: Variant); + public + constructor Create(AScript: TfsScript); override; + end; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + with AScript do + begin + AddEnumSet('TButtonSet', 'nbFirst, nbPrior, nbNext, nbLast,' + + 'nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh'); + AddEnum('TColumnButtonStyle', 'cbsAuto, cbsEllipsis, cbsNone'); + AddEnumSet('TDBGridOptions', 'dgEditing, dgAlwaysShowEditor, dgTitles,' + + 'dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,' + + 'dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect'); + + AddClass(TDBEdit, 'TWinControl'); + AddClass(TDBText, 'TGraphicControl'); + with AddClass(TDBCheckBox, 'TWinControl') do + AddProperty('Checked', 'Boolean', GetProp, nil); + with AddClass(TDBComboBox, 'TCustomComboBox') do + AddProperty('Text', 'String', GetProp, nil); + AddClass(TDBListBox, 'TCustomListBox'); + with AddClass(TDBRadioGroup, 'TWinControl') do + begin + AddProperty('ItemIndex', 'Integer', GetProp, nil); + AddProperty('Value', 'String', GetProp, nil); + end; + AddClass(TDBMemo, 'TWinControl'); + AddClass(TDBImage, 'TCustomControl'); + AddClass(TDBNavigator, 'TWinControl'); +{$IFNDEF FPC} + with AddClass(TDBLookupControl, 'TCustomControl') do + AddProperty('KeyValue', 'Variant', GetProp, SetProp); + with AddClass(TDBLookupListBox, 'TDBLookupControl') do + AddProperty('SelectedItem', 'String', GetProp, nil); + with AddClass(TDBLookupComboBox, 'TDBLookupControl') do + AddProperty('Text', 'String', GetProp, nil); +{$ENDIF} + AddClass(TColumnTitle, 'TPersistent'); + AddClass(TColumn, 'TPersistent'); + with AddClass(TDBGridColumns, 'TCollection') do + begin + AddMethod('function Add: TColumn', CallMethod); + AddMethod('procedure RebuildColumns', CallMethod); + AddMethod('procedure RestoreDefaults', CallMethod); + AddDefaultProperty('Items', 'Integer', 'TColumn', CallMethod, True); + end; + AddClass(TDBGrid, 'TWinControl'); + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +begin + Result := 0; + + if ClassType = TDBGridColumns then + begin + if MethodName = 'ADD' then + Result := Integer(TDBGridColumns(Instance).Add) + else if MethodName = 'ITEMS.GET' then + Result := Integer(TDBGridColumns(Instance).Items[Caller.Params[0]]) +{$IFNDEF FPC} + else if MethodName = 'REBUILDCOLUMNS' then + TDBGridColumns(Instance).RebuildColumns + else if MethodName = 'RESTOREDEFAULTS' then + TDBGridColumns(Instance).RestoreDefaults +{$ENDIF} + end +end; + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TDBCheckBox then + begin + if PropName = 'CHECKED' then + Result := TDBCheckBox(Instance).Checked + end + else if ClassType = TDBComboBox then + begin + if PropName = 'TEXT' then + Result := TDBComboBox(Instance).Text + end + else if ClassType = TDBRadioGroup then + begin + if PropName = 'ITEMINDEX' then + Result := TDBRadioGroup(Instance).ItemIndex + else if PropName = 'VALUE' then + Result := TDBRadioGroup(Instance).Value + end +{$IFNDEF FPC} + else if ClassType = TDBLookupControl then + begin + if PropName = 'KEYVALUE' then + Result := THackDBLookupControl(Instance).KeyValue + end + else if ClassType = TDBLookupListBox then + begin + if PropName = 'SELECTEDITEM' then + Result := TDBLookupListBox(Instance).SelectedItem + end + else if ClassType = TDBLookupComboBox then + begin + if PropName = 'TEXT' then + Result := TDBLookupComboBox(Instance).Text + end +{$ENDIF} +end; + +procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; + const PropName: String; Value: Variant); +begin +{$IFNDEF FPC} + if ClassType = TDBLookupControl then + begin + if PropName = 'KEYVALUE' then + THackDBLookupControl(Instance).KeyValue := Value + end +{$ENDIF} +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_idbreg.pas b/official/4.2/FastScript/fs_idbreg.pas new file mode 100644 index 0000000..54d6231 --- /dev/null +++ b/official/4.2/FastScript/fs_idbreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idbreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_idbrtti, fs_idbctrlsrtti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsDBRTTI, TfsDBCtrlsRTTI]); +end; + +end. diff --git a/official/4.2/FastScript/fs_idbrtti.pas b/official/4.2/FastScript/fs_idbrtti.pas new file mode 100644 index 0000000..421f796 --- /dev/null +++ b/official/4.2/FastScript/fs_idbrtti.pas @@ -0,0 +1,562 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ DB.pas classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idbrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iclassesrtti, fs_ievents, + DB; + +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, SetProp); + 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 + else if PropName = 'SIZE' then + _TField.Size := Value + end + else if ClassType = TDataSet then + begin + _TDataSet := TDataSet(Instance); + if PropName = 'FILTER' then + _TDataSet.Filter := Value + else if PropName = 'FILTERED' then + _TDataSet.Filtered := Value + else if PropName = 'FILTEROPTIONS' then + _TDataSet.FilterOptions := IntToFilterOptions(Value) + else if PropName = 'ACTIVE' then + _TDataSet.Active := Value + end + else if ClassType = TParam then + begin + _TParam := TParam(Instance); + if PropName = 'ASBOOLEAN' then + _TParam.AsBoolean := Value + else if PropName = 'ASCURRENCY' then + _TParam.AsCurrency := Value + else if PropName = 'ASDATETIME' then + _TParam.AsDateTime := Value + else if PropName = 'ASFLOAT' then + _TParam.AsFloat := Value + else if PropName = 'ASINTEGER' then + _TParam.AsInteger := Value + else if PropName = 'ASDATE' then + _TParam.AsDate := Value + else if PropName = 'ASTIME' then + _TParam.AsTime := Value + else if PropName = 'ASSTRING' then + _TParam.AsString := Value + else if PropName = 'BOUND' then + _TParam.Bound := Value + else if PropName = 'TEXT' then + _TParam.Text := Value + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_idialogsrtti.pas b/official/4.2/FastScript/fs_idialogsrtti.pas new file mode 100644 index 0000000..2018f24 --- /dev/null +++ b/official/4.2/FastScript/fs_idialogsrtti.pas @@ -0,0 +1,157 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Dialogs.pas classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idialogsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti +{$IFDEF 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} + {$IFNDEF FPC} + // todo: wait lazarus 1.0 TPrintDialog is targeted in Mantis to 1.0 + AddClass(TPrintDialog, dlg); + AddClass(TPrinterSetupDialog, dlg); + {$ENDIF} +{$ENDIF} + AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther'); + AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther'); + AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther'); + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +var + s: String; + b: TMsgDlgButtons; +begin + Result := 0; + +{$IFDEF CLX} + if ClassType = TDialog then +{$ELSE} + if ClassType = TCommonDialog then +{$ENDIF} + begin + if MethodName = 'EXECUTE' then + Result := THackDialog(Instance).Execute + end + else if MethodName = 'INPUTBOX' then + Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'INPUTQUERY' then + begin + s := Caller.Params[2]; + Result := InputQuery(Caller.Params[0], Caller.Params[1], s); + Caller.Params[2] := s; + end + else if MethodName = 'MESSAGEDLG' then + begin + {$IFNDEF FPC} + Word(PWordSet(@b)^) := Caller.Params[2]; + {$ELSE} + Integer(PWordSet(@b)^) := Caller.Params[2]; + {$ENDIF} + Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]); + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_idisp.pas b/official/4.2/FastScript/fs_idisp.pas new file mode 100644 index 0000000..512d05d --- /dev/null +++ b/official/4.2/FastScript/fs_idisp.pas @@ -0,0 +1,126 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ OLE dispatch module } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_idisp; + +interface + +{$I fs.inc} + +uses + Windows, Classes, SysUtils, ActiveX, ComObj, fs_iinterpreter +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfsOLEHelper = class(TfsCustomHelper) + private + function DispatchInvoke(const ParamArray: Variant; ParamCount: Integer; + Flags: Word): Variant; + protected + procedure SetValue(const Value: Variant); override; + function GetValue: Variant; override; + public + constructor Create(const AName: String); + end; + + +implementation + + +constructor TfsOLEHelper.Create(const AName: String); +begin + inherited Create(AName, fvtVariant, ''); +end; + +function TfsOLEHelper.DispatchInvoke(const ParamArray: Variant; ParamCount: Integer; + Flags: Word): Variant; +const + DispIDArgs: Longint = DISPID_PROPERTYPUT; +var + DispId: TDispId; + Params: TDISPPARAMS; + pName: WideString; + ExcepMess: WideString; + Args: array[0..63] of Variant; + i: Integer; + PResult: PVariant; + Status: Integer; + ExcepInfo: TExcepInfo; +begin + ExcepMess := ''; + pName := 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/4.2/FastScript/fs_ievents.pas b/official/4.2/FastScript/fs_ievents.pas new file mode 100644 index 0000000..777b637 --- /dev/null +++ b/official/4.2/FastScript/fs_ievents.pas @@ -0,0 +1,228 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Standard events } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_ievents; + +interface + +{$i fs.inc} + +uses SysUtils, Classes, fs_iinterpreter +{$IFDEF CLX} +, QControls, QForms +{$ELSE} +, Controls, Forms +{$ENDIF}; + +type + TfsNotifyEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject); + function GetMethod: Pointer; override; + end; + + TfsMouseEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + function GetMethod: Pointer; override; + end; + + TfsMouseMoveEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Integer); + function GetMethod: Pointer; override; + end; + + TfsKeyEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; var Key: Word; Shift: TShiftState); + function GetMethod: Pointer; override; + end; + + TfsKeyPressEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; var Key: Char); + function GetMethod: Pointer; override; + end; + + TfsCloseEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; var Action: TCloseAction); + function GetMethod: Pointer; override; + end; + + TfsCloseQueryEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; var CanClose: Boolean); + function GetMethod: Pointer; override; + end; + + TfsCanResizeEvent = class(TfsCustomEvent) + public + procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer; + var Resize: Boolean); + function GetMethod: Pointer; override; + end; + + +implementation + + +type + TByteSet = set of 0..7; + PByteSet = ^TByteSet; + + +{ TfsNotifyEvent } + +procedure TfsNotifyEvent.DoEvent(Sender: TObject); +begin + CallHandler([Sender]); +end; + +function TfsNotifyEvent.GetMethod: Pointer; +begin + Result := @TfsNotifyEvent.DoEvent; +end; + +{ TfsMouseEvent } + +procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var +{$IFNDEF FPC} + b: Byte; +{$ELSE} + i: integer; +{$ENDIF} +begin +{$IFNDEF FPC} + b := Byte(PByteSet(@Shift)^); + CallHandler([Sender, Integer(Button), b, X, Y]); +{$ELSE} + i := Integer(PByteSet(@Shift)^); + CallHandler([Sender, Integer(Button), i, X, Y]); +{$ENDIF} +end; + +function TfsMouseEvent.GetMethod: Pointer; +begin + Result := @TfsMouseEvent.DoEvent; +end; + +{ TfsMouseMoveEvent } + +procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +var +{$IFNDEF FPC} + b: Byte; +{$ELSE} + i: integer; +{$ENDIF} +begin +{$IFNDEF FPC} + b := Byte(PByteSet(@Shift)^); + CallHandler([Sender, b, X, Y]); +{$ELSE} + i := Integer(PByteSet(@Shift)^); + CallHandler([Sender, i, X, Y]); +{$ENDIF} +end; + +function TfsMouseMoveEvent.GetMethod: Pointer; +begin + Result := @TfsMouseMoveEvent.DoEvent; +end; + +{ TfsKeyEvent } + +procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word; + Shift: TShiftState); +var +{$IFNDEF FPC} + b: Byte; +{$ELSE} + i: integer; +{$ENDIF} +begin +{$IFNDEF FPC} + b := Byte(PByteSet(@Shift)^); + CallHandler([Sender, Key, b]); +{$ELSE} + i := Integer(PByteSet(@Shift)^); + CallHandler([Sender, Key, i]); +{$ENDIF} + 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/4.2/FastScript/fs_iexpression.pas b/official/4.2/FastScript/fs_iexpression.pas new file mode 100644 index 0000000..e83b6b7 --- /dev/null +++ b/official/4.2/FastScript/fs_iexpression.pas @@ -0,0 +1,878 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Expression parser } +{ } +{ (c) 2003-2007 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; + 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/4.2/FastScript/fs_iextctrlsrtti.pas b/official/4.2/FastScript/fs_iextctrlsrtti.pas new file mode 100644 index 0000000..a256d01 --- /dev/null +++ b/official/4.2/FastScript/fs_iextctrlsrtti.pas @@ -0,0 +1,425 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ ExtCtrls } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iextctrlsrtti; + +interface + +{$i fs.inc} + +uses SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iformsrtti +{$IFDEF 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; +{$IFNDEF FPC} + AddClass(TIconOptions, 'TPersistent'); +{$ENDIF} + AddClass(TListView, 'TWinControl'); + AddClass(TToolButton, 'TGraphicControl'); + AddClass(TToolBar, 'TWinControl'); +{$IFNDEF CLX} + {$IFNDEF FPC} + AddClass(TMonthCalColors, 'TPersistent'); + AddClass(TDateTimePicker, 'TWinControl'); + AddClass(TMonthCalendar, 'TWinControl'); + AddClass(TCustomRichEdit, 'TWinControl'); + AddClass(TRichEdit, 'TCustomRichEdit'); + {$ENDIF} +{$ENDIF} + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +begin + Result := 0; + + if ClassType = TCheckListBox then + begin + if MethodName = 'CHECKED.GET' then + Result := TCheckListBox(Instance).Checked[Caller.Params[0]] + else if MethodName = 'CHECKED.SET' then + TCheckListBox(Instance).Checked[Caller.Params[0]] := Caller.Params[1] + end + else if ClassType = TPageControl then + begin + if MethodName = 'SELECTNEXTPAGE' then + TPageControl(Instance).SelectNextPage(Caller.Params[0]) + else if MethodName = 'PAGES.GET' then + Result := 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} + {$IFNDEF FPC} + else if MethodName = 'EDITCAPTION' then + Result := TListItem(Instance).EditCaption + {$ENDIF} +{$ENDIF} + end + else if ClassType = TListItems then + begin + if MethodName = 'ADD' then + Result := Integer(TListItems(Instance).Add) +{$IFNDEF FPC} + else if MethodName = 'BEGINUPDATE' then + TListItems(Instance).BeginUpdate +{$ENDIF} + else if MethodName = 'CLEAR' then + TListItems(Instance).Clear + else if MethodName = 'DELETE' then + TListItems(Instance).Delete(Caller.Params[0]) +{$IFNDEF FPC} + else if MethodName = 'ENDUPDATE' then + TListItems(Instance).EndUpdate +{$ENDIF} + else if MethodName = 'ITEM.GET' then + Result := 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} + {$IFNDEF FPC} + else if PropName = 'STATEINDEX' then + Result := TListItem(Instance).StateIndex + {$ENDIF} +{$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} + {$IFNDEF FPC} + else if PropName = 'STATEINDEX' then + TListItem(Instance).StateIndex := Value + {$ENDIF} +{$ENDIF} + else if PropName = 'SUBITEMS' then + TListItem(Instance).SubItems := TStrings(Integer(Value)) + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iformsrtti.pas b/official/4.2/FastScript/fs_iformsrtti.pas new file mode 100644 index 0000000..5058a94 --- /dev/null +++ b/official/4.2/FastScript/fs_iformsrtti.pas @@ -0,0 +1,428 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Forms and StdCtrls } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iformsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iclassesrtti, + fs_igraphicsrtti +{$IFDEF CLX} + , QControls, QForms, QStdCtrls +{$ELSE} + {$IFNDEF FPC} + , Windows + {$ELSE} + , LCLType, Buttons + {$ENDIF} + , Controls, Forms, StdCtrls +{$ENDIF}; + +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 CLX} + AddConst('bsNone', 'Integer', fbsNone); + AddConst('bsSingle', 'Integer', fbsSingle); + AddConst('bsSizeable', 'Integer', fbsSizeable); + AddConst('bsDialog', 'Integer', fbsDialog); + AddConst('bsToolWindow', 'Integer', fbsToolWindow); + AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin); +{$ELSE} + AddConst('bsNone', 'Integer', bsNone); + AddConst('bsSingle', 'Integer', bsSingle); + AddConst('bsSizeable', 'Integer', bsSizeable); + AddConst('bsDialog', 'Integer', bsDialog); + AddConst('bsToolWindow', 'Integer', bsToolWindow); + AddConst('bsSizeToolWin', 'Integer', bsSizeToolWin); +{$ENDIF} + +{$IFNDEF CLX} + AddConst('VK_RBUTTON', 'Integer', VK_RBUTTON); + AddConst('VK_CANCEL', 'Integer', VK_CANCEL); + AddConst('VK_MBUTTON', 'Integer', VK_MBUTTON); + AddConst('VK_BACK', 'Integer', VK_BACK);//Backspace key + AddConst('VK_TAB', 'Integer', VK_TAB);//Tab key + AddConst('VK_RETURN', 'Integer', VK_RETURN);//Enter key + AddConst('VK_SHIFT', 'Integer', VK_SHIFT);//Shift key + AddConst('VK_CONTROL', 'Integer', VK_CONTROL);//Ctrl key + AddConst('VK_MENU', 'Integer', VK_MENU);//Alt key + AddConst('VK_PAUSE', 'Integer', VK_PAUSE);//Pause key + AddConst('VK_CAPITAL', 'Integer', VK_CAPITAL);//Caps Lock key + AddConst('VK_ESCAPE', 'Integer', VK_ESCAPE);//Esc key + AddConst('VK_SPACE', 'Integer', VK_SPACE);//Space bar + AddConst('VK_PRIOR', 'Integer', VK_PRIOR);//Page Up key + AddConst('VK_NEXT', 'Integer', VK_NEXT);// Page Down key + AddConst('VK_END', 'Integer', VK_END);// End key + AddConst('VK_HOME', 'Integer', VK_HOME);// Home key + AddConst('VK_LEFT', 'Integer', VK_LEFT);// Left Arrow key + AddConst('VK_UP', 'Integer', VK_UP);// Up Arrow key + AddConst('VK_RIGHT', 'Integer', VK_RIGHT);// Right Arrow key + AddConst('VK_DOWN', 'Integer', VK_DOWN);// Down Arrow key + AddConst('VK_INSERT', 'Integer', VK_INSERT);// Insert key + AddConst('VK_DELETE', 'Integer', VK_DELETE);// Delete key + AddConst('VK_HELP', 'Integer', VK_HELP);// Help key + AddConst('VK_LWIN', 'Integer', VK_LWIN);// Left Windows key (Microsoft keyboard) + AddConst('VK_RWIN', 'Integer', VK_RWIN);// Right Windows key (Microsoft keyboard) + AddConst('VK_APPS', 'Integer', VK_APPS);// Applications key (Microsoft keyboard) + AddConst('VK_NUMPAD0', 'Integer', VK_NUMPAD0);// 0 key (numeric keypad) + AddConst('VK_NUMPAD1', 'Integer', VK_NUMPAD1);// 1 key (numeric keypad) + AddConst('VK_NUMPAD2', 'Integer', VK_NUMPAD2);// 2 key (numeric keypad) + AddConst('VK_NUMPAD3', 'Integer', VK_NUMPAD3);// 3 key (numeric keypad) + AddConst('VK_NUMPAD4', 'Integer', VK_NUMPAD4);// 4 key (numeric keypad) + AddConst('VK_NUMPAD5', 'Integer', VK_NUMPAD5);// 5 key (numeric keypad) + AddConst('VK_NUMPAD6', 'Integer', VK_NUMPAD6);// 6 key (numeric keypad) + AddConst('VK_NUMPAD7', 'Integer', VK_NUMPAD7);// 7 key (numeric keypad) + AddConst('VK_NUMPAD8', 'Integer', VK_NUMPAD8);// 8 key (numeric keypad) + AddConst('VK_NUMPAD9', 'Integer', VK_NUMPAD9);// 9 key (numeric keypad) + AddConst('VK_MULTIPLY', 'Integer', VK_MULTIPLY);// Multiply key (numeric keypad) + AddConst('VK_ADD', 'Integer', VK_ADD);// Add key (numeric keypad) + AddConst('VK_SEPARATOR', 'Integer', VK_SEPARATOR);// Separator key (numeric keypad) + AddConst('VK_SUBTRACT', 'Integer', VK_SUBTRACT);// Subtract key (numeric keypad) + AddConst('VK_DECIMAL', 'Integer', VK_DECIMAL);// Decimal key (numeric keypad) + AddConst('VK_DIVIDE', 'Integer', VK_DIVIDE);// Divide key (numeric keypad) + AddConst('VK_F1', 'Integer', VK_F1);// F1 key + AddConst('VK_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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_igraphicsrtti.pas b/official/4.2/FastScript/fs_igraphicsrtti.pas new file mode 100644 index 0000000..172a41b --- /dev/null +++ b/official/4.2/FastScript/fs_igraphicsrtti.pas @@ -0,0 +1,249 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Graphics.pas classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_igraphicsrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti +{$IFDEF 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 CROSS_COMPILE} + AddClass(TMetafile, 'TGraphic'); + with AddClass(TMetafileCanvas, 'TCanvas') do + AddConstructor('constructor Create(AMetafile: TMetafile; ReferenceDevice: Integer)', CallMethod); +{$ENDIF} + with AddClass(TBitmap, 'TGraphic') do + AddProperty('Canvas', 'TCanvas', GetProp); + end; +end; + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; + const MethodName: String; Caller: TfsMethodHelper): Variant; +var + _Canvas: TCanvas; +begin + Result := 0; + + if ClassType = TFont then + begin + if MethodName = 'CREATE' then + Result := 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 CROSS_COMPILE} + 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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iibxreg.pas b/official/4.2/FastScript/fs_iibxreg.pas new file mode 100644 index 0000000..1ceab8b --- /dev/null +++ b/official/4.2/FastScript/fs_iibxreg.pas @@ -0,0 +1,39 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Registration unit } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iibxreg; + +{$i fs.inc} + +interface + + +procedure Register; + +implementation + +uses + Classes +{$IFNDEF Delphi6} +, DsgnIntf +{$ELSE} +, DesignIntf +{$ENDIF} +, fs_iibxrtti; + +{-----------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('FastScript', [TfsIBXRTTI]); +end; + +end. diff --git a/official/4.2/FastScript/fs_iibxrtti.pas b/official/4.2/FastScript/fs_iibxrtti.pas new file mode 100644 index 0000000..f61a9e0 --- /dev/null +++ b/official/4.2/FastScript/fs_iibxrtti.pas @@ -0,0 +1,81 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ IBX classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iibxrtti; + +interface + +{$i fs.inc} + +uses + SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, db, 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 + if fsRTTIModules <> nil then + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iilparser.pas b/official/4.2/FastScript/fs_iilparser.pas new file mode 100644 index 0000000..d0b2d9a --- /dev/null +++ b/official/4.2/FastScript/fs_iilparser.pas @@ -0,0 +1,2014 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Intermediate Language parser } +{ } +{ (c) 2003-2007 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 CROSS_COMPILE} +, 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; + Component: TComponent; + + function FindInWithList(const Name: String; ResultDS: TfsDesignator; + Item: TfsDesignatorItem): Boolean; + var + i: Integer; + WithStmt: TfsWithStmt; + WithItem: TfsDesignatorItem; + ClassVar: TfsClassVariable; + xi1: TfsXMLItem; + begin + Result := False; + LateBinding := False; + for i := FWithList.Count - 1 downto 0 do + begin + { prevent checking non-local 'with' } + if Prog.FindLocal(FWithList[i]) = nil then + continue; + + WithStmt := TfsWithStmt(FWithList.Objects[i]); + + if WithStmt.Variable.Typ = fvtVariant then + begin + { first check all known variables } + if Prog.Find(Name) <> nil then + Exit; + { if nothing found, create late binding information } + Item.Ref := WithStmt.Variable; + ResultDS.Finalize; + ResultDS.LateBindingXMLSource := TfsXMLItem.Create; + ResultDS.LateBindingXMLSource.Assign(xi); + xi1 := TfsXMLItem.Create; + xi1.Name := 'node'; + xi1.Text := 'text="' + FWithList[i] + '"'; + ResultDS.LateBindingXMLSource.InsertItem(0, xi1); + LateBinding := True; + Result := True; + break; + end + else + begin + ClassVar := FindClass(WithStmt.Variable.TypeName); + Item.Ref := ClassVar.Find(NodeText); + end; + + if Item.Ref <> nil then + begin + WithItem := TfsDesignatorItem.Create; + WithItem.Ref := WithStmt.Variable; + WithItem.SourcePos := Item.SourcePos; + + ResultDS.Remove(Item); + ResultDS.Add(WithItem); + ResultDS.Add(Item); + Result := True; + break; + end; + end; + end; + +{$IFDEF OLE} + procedure CreateOLEHelpers(Index: Integer); + var + i: Integer; + OLEHelper: TfsOLEHelper; + begin + for i := Index to xi.Count - 1 do + begin + ErrorPos(xi[i]); + NodeName := LowerCase(xi[i].Name); + NodeText := xi[i].Prop['text']; + + if (NodeName = 'node') and (NodeText <> '[') then + begin + Item := TfsDesignatorItem.Create; + Result.Add(Item); + Item.SourcePos := FErrorPos; + OLEHelper := TfsOLEHelper.Create(NodeText); + Prog.Add('', OLEHelper); + Item.Ref := OLEHelper; + end + else if NodeName = 'expr' then + begin + Expr := DoExpression(xi[i], Prog); + PriorItem := Result.Items[Result.Count - 1]; + PriorItem.Add(Expr); + PriorItem.Ref.Add(TfsParamItem.Create('', fvtVariant, '', False, False)); + end + end; + end; +{$ENDIF} + +begin + Result := TfsDesignator.Create(Prog); + try + + for i := 0 to xi.Count - 1 do + begin + ErrorPos(xi[i]); + NodeName := LowerCase(xi[i].Name); + NodeText := xi[i].Prop['text']; + + if NodeName = 'node' then + begin + Item := TfsDesignatorItem.Create; + Result.Add(Item); + Item.SourcePos := FErrorPos; + + if Result.Count = 1 then + begin + if not FindInWithList(NodeText, Result, Item) then + Item.Ref := FindVar(Prog, NodeText); + + { LateBinding flag turned on in the FindInWithList } + if LateBinding then + Exit; + { add .Create for cpp NEW statement, i.e convert o = new TObject + to o = TObject.Create } + if EmitOp = emCreate then + begin + if not (Item.Ref is TfsClassVariable) then + raise Exception.Create(SClassRequired); + ClassVar := TfsClassVariable(Item.Ref); + Item := TfsDesignatorItem.Create; + Result.Add(Item); + Item.Ref := ClassVar.Find('Create'); + end; + end + else + begin + PriorItem := Result.Items[Result.Count - 2]; + PriorIsIndex := (PriorItem.Ref is TfsMethodHelper) and + TfsMethodHelper(PriorItem.Ref).IndexMethod and not PriorItem.Flag; + Typ := PriorItem.Ref.Typ; + { late binding } + if (Typ = fvtVariant) and not PriorIsIndex then + begin + PriorValue := PriorItem.Ref.Value; + if VarIsNull(PriorValue) then + begin + Result.Remove(Item); + Item.Free; + Result.Finalize; + Result.LateBindingXMLSource := TfsXMLItem.Create; + Result.LateBindingXMLSource.Assign(xi); + Exit; + end + else + begin + if TVarData(PriorValue).VType = varString 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); + { property not found. Probably it's a form element such as button? } + if Item.Ref = nil then + begin + PriorValue := PriorItem.Ref.Value; + if VarIsNull(PriorValue) or (PriorValue = 0) then + begin + { at compile time, we don't know anything about form elements. + So clear the designator items and use the late binding. } + Result.Remove(Item); + Item.Free; + while Result.Count > 1 do + begin + Item := Result.Items[Result.Count - 1]; + Result.Remove(Item); + Item.Free; + end; + Item := Result.Items[0]; + Result.Finalize; + Result.Typ := fvtVariant; + Result.LateBindingXMLSource := TfsXMLItem.Create; + Result.LateBindingXMLSource.Assign(xi); + Exit; + end + else + begin + { we at run time now. Try to search in the form's elements. } + if TObject(Integer(PriorValue)) is TComponent then + begin + Component := TComponent(Integer(PriorValue)).FindComponent(NodeText); + if Component <> nil then + begin + Item.Ref := TfsCustomVariable.Create('', fvtClass, Component.ClassName); + Item.Ref.Value := Integer(Component); + end; + end; + if Item.Ref = nil then + raise Exception.Create(SIdUndeclared + '''' + NodeText + ''''); + end + end; + end; + end + else if Typ = fvtArray then { set ref to array helper } + Item.Ref := PriorItem.Ref.RefItem + else + raise Exception.Create(SArrayRequired); + end; + end + else if NodeName = 'expr' then + begin + Expr := DoExpression(xi[i], Prog); + Result.Items[Result.Count - 1].Add(Expr); + end + else if NodeName = 'addr' then { @ operator } + begin + if xi.Count <> 2 then + raise Exception.Create(SVarRequired); + + Item := TfsDesignatorItem.Create; + Result.Add(Item); + ErrorPos(xi[1]); + Item.SourcePos := FErrorPos; + + { we just return the string containing a referenced item name. For + example, var s: String; procedure B1; begin end; s := @B1 + will assign 'B1' to the s } + StringVar := TfsStringVariable.Create('', fvtString, ''); + StringVar.Value := xi[1].Prop['text']; + Prog.Add('', StringVar); + Item.Ref := StringVar; + + break; + end; + end; + + if EmitOp = emFree then + begin + PriorItem := Result.Items[Result.Count - 1]; + if (PriorItem.Ref.Typ <> fvtClass) and (PriorItem.Ref.Typ <> fvtVariant) then + raise Exception.Create(SClassRequired); + Item := TfsDesignatorItem.Create; + Result.Add(Item); + ClassVar := FindClass('TObject'); + Item.Ref := ClassVar.Find('Free'); + end; + + Result.Finalize; + if Result.Kind <> dkOther then + begin + NewDesignator := nil; + if Result.Kind = dkVariable then + NewDesignator := TfsVariableDesignator.Create(Prog) + else if Result.Kind = dkStringArray then + NewDesignator := TfsStringDesignator.Create(Prog) + else if Result.Kind = dkArray then + NewDesignator := TfsArrayDesignator.Create(Prog); + + NewDesignator.Borrow(Result); + Result.Free; + Result := NewDesignator; + end; + + for i := 0 to Result.Count - 1 do + begin + Item := Result[i]; + FErrorPos := Item.SourcePos; + if Item.Ref is TfsDesignator then continue; + + if Item.Count < Item.Ref.GetNumberOfRequiredParams then + raise Exception.Create(SNotEnoughParams) + else if Item.Count > Item.Ref.Count then + raise Exception.Create(STooManyParams) + else if Item.Count <> Item.Ref.Count then { construct the default params } + for j := Item.Count to Item.Ref.Count - 1 do + begin + Expr := TfsExpression.Create(FProgram); + Item.Add(Expr); + Expr.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); + if (OpName = ')') or (i < xi.Count - 1) then + Expression.AddOperator(OpName); + end + else if (NodeName = 'number') or (NodeName = 'string') then + Expression.AddConst(ParserStringToVariant(OpName)) + else if NodeName = 'dsgn' then + Expression.AddDesignator(DoDesignator(xi[i], Prog)) + else if NodeName = 'set' then + Expression.AddSet(DoSet(xi[i], Prog)) + else if NodeName = 'new' then + Expression.AddDesignator(DoDesignator(xi[i][0], Prog, emCreate)) + else if NodeName = 'expr' then + DoExpressionItems(xi[i], Expression); + + Inc(i); + end; + end; + + function GetSource(pt1, pt2: TPoint): String; + var + i1, i2: Integer; + begin + i1 := FParser.GetPlainPosition(pt1); + i2 := FParser.GetPlainPosition(pt2); + if (i1 = -1) or (i2 = -1) then + Result := '' + else + Result := Copy(FParser.Text, i1, i2 - i1); + end; + +begin + Result := TfsExpression.Create(FProgram); + try + DoExpressionItems(xi, Result); + SourcePos1 := fsPosToPoint(PropPos(xi)); + SourcePos2 := fsPosToPoint(xi.Prop['pos1']); + Result.Source := GetSource(SourcePos1, SourcePos2); + + ErPos := Result.Finalize; + if ErPos <> '' then + begin + FErrorPos := ErPos; + raise Exception.Create(SIncompatibleTypes); + end; + + except + on e: Exception do + begin + Result.Free; + raise; + end; + end; +end; + +procedure TfsILParser.DoUses(xi: TfsXMLItem; Prog: TfsScript); +var + i: Integer; + SaveUnitName: String; + s: String; + sl: TStringList; + ms: TMemoryStream; + xd: TfsXMLDocument; +begin + SaveUnitName := FUnitName; + FUnitName := xi.Prop['unit']; + xd := nil; + + if 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/4.2/FastScript/fs_iinirtti.pas b/official/4.2/FastScript/fs_iinirtti.pas new file mode 100644 index 0000000..5d060a4 --- /dev/null +++ b/official/4.2/FastScript/fs_iinirtti.pas @@ -0,0 +1,327 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ IniFiles.pas classes and functions } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{ Copyright (c) 2004-2006 } +{ 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; + procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream); + procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream); + public + constructor Create(AScript: TfsScript); override; + end; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + + with AScript do + begin + with AddClass(TCustomIniFile, 'TObject') do + begin + AddConstructor('constructor Create(const FileName: String)', CallMethod); + AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod); + AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod); + AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod); + AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod); + AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod); + AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod); + AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod); + AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod); + AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod); + AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod); + AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod); + AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod); +{$IFDEF DELPHI6} + AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod); + AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod); +{$ENDIF} + AddMethod('function SectionExists(const Section: String): Boolean', CallMethod); + AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod); + + AddProperty('FileName', 'String', GetProp); + end; + + with AddClass(TMemIniFile, 'TCustomIniFile') do + begin + AddConstructor('constructor Create(const FileName: String)', CallMethod); + AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod); + AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod); +{$IFDEF DELPHI6} + AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod); +{$ENDIF} + AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod); + AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod); + AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod); + AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod); + AddMethod('procedure EraseSection(const Section: String)', CallMethod); + AddMethod('procedure Clear', CallMethod); + AddMethod('procedure GetStrings(List: TStrings)', CallMethod); + AddMethod('procedure SetStrings(List: TStrings)', CallMethod); + AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod); + AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod); + end; + + with AddClass(TIniFile, 'TCustomIniFile') do + begin + AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod); + AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod); +{$IFDEF DELPHI6} + AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod); +{$ENDIF} + AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod); + AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod); + AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod); + AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod); + AddMethod('procedure EraseSection(const Section: String)', CallMethod); + AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod); + AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod); + end; + + end; + +end; + +{$HINTS OFF} +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant; +var + oCustomIniFile: TCustomIniFile; + oMemIniFile: TMemIniFile; + oIniFile: TIniFile; + oList: TStrings; + nCou: Integer; + +begin + + Result := 0; + + if ClassType = TCustomIniFile then + begin + oCustomIniFile := TCustomIniFile(Instance); + if MethodName = 'CREATE' then + Result := Integer(oCustomIniFile.Create(Caller.Params[0])) + else if MethodName = 'WRITEINTEGER' then + oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READINTEGER' then + Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEBOOL' then + oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READBOOL' then + Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEDATE' then + oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READDATE' then + Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEDATETIME' then + oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READDATETIME' then + Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITEFLOAT' then + oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READFLOAT' then + Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'WRITETIME' then + oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READTIME' then + Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2]) +{$IFDEF DELPHI6} + else if MethodName = 'WRITEBINARYSTREAM' then + oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(Integer(Caller.Params[2]))) + else if MethodName = 'READBINARYSTREAM' then + Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(Integer(Caller.Params[2]))) +{$ENDIF} + else if MethodName = 'SECTIONEXISTS' then + Result := oCustomIniFile.SectionExists(Caller.Params[0]) + else if MethodName = 'VALUEEXISTS' then + Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1]) + end; + + if ClassType = TMemIniFile then + begin + oMemIniFile := TMemIniFile(Instance); + if MethodName = 'CREATE' then + Result := Integer(oMemIniFile.Create(Caller.Params[0])) + else if MethodName = 'WRITESTRING' then + oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READSTRING' then + Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'DELETEKEY' then + oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1]) + else if MethodName = 'READSECTION' then + oMemIniFile.ReadSection(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'READSECTIONS' then + oMemIniFile.ReadSections(TStrings(Integer(Caller.Params[0]))) + else if MethodName = 'READSECTIONVALUES' then + oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'ERASESECTION' then + oMemIniFile.EraseSection(Caller.Params[0]) +{$IFDEF DELPHI6} + else if MethodName = 'READSECTIONVALUESEX' then + begin + oList := TStringList.Create; + try + oMemIniFile.ReadSectionValues(Caller.Params[0], oList); + TStrings(Integer(Caller.Params[1])).Clear; + for nCou := 0 to oList.Count-1 do +// TStrings(Integer(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]); + TStrings(Integer(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]); + finally + oList.Free; + end; + end +{$ENDIF} + else if MethodName = 'CLEAR' then + oMemIniFile.Clear + else if MethodName = 'GETSTRINGS' then + oMemIniFile.GetStrings(TStrings(Integer(Caller.Params[0]))) + else if MethodName = 'SETSTRINGS' then + oMemIniFile.SetStrings(TStrings(Integer(Caller.Params[0]))) + else if MethodName = 'SAVEINIFILETOSTREAM' then + SaveIniFileToStream(oMemIniFile, TStream(Integer(Caller.Params[0]))) + else if MethodName = 'LOADINIFILEFROMSTREAM' then + LoadIniFileFromStream(oMemIniFile, TStream(Integer(Caller.Params[0]))) + end; + + if ClassType = TIniFile then + begin + oIniFile := TIniFile(Instance); + if MethodName = 'WRITESTRING' then + oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'READSTRING' then + Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2]) + else if MethodName = 'DELETEKEY' then + oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1]) + else if MethodName = 'READSECTION' then + oIniFile.ReadSection(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'READSECTIONS' then + oIniFile.ReadSections(TStrings(Integer(Caller.Params[0]))) + else if MethodName = 'READSECTIONVALUES' then + oIniFile.ReadSectionValues(Caller.Params[0], TStrings(Integer(Caller.Params[1]))) + else if MethodName = 'ERASESECTION' then + oIniFile.EraseSection(Caller.Params[0]) +{$IFDEF DELPHI6} + else if MethodName = 'READSECTIONVALUESEX' then + begin + oList := TStringList.Create; + try + oIniFile.ReadSectionValues(Caller.Params[0], oList); + TStrings(Integer(Caller.Params[1])).Clear; + for nCou := 0 to oList.Count-1 do +// TStrings(Integer(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]); + TStrings(Integer(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]); + finally + oList.Free; + end; + end +{$ENDIF} + else if MethodName = 'SAVEINIFILETOSTREAM' then + SaveIniFileToStream(oIniFile, TStream(Integer(Caller.Params[0]))) + else if MethodName = 'LOADINIFILEFROMSTREAM' then + LoadIniFileFromStream(oIniFile, TStream(Integer(Caller.Params[0]))) + end; + +end; +{$HINTS ON} + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TCustomIniFile then + begin + if PropName = 'FILENAME' then + Result := TIniFile(Instance).FileName + end; +end; + +procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream); +var + oStrings :TStrings; + +begin + + if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit; + + if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit; + + oStrings:= TStringList.Create; + try + + if oIniFile is TIniFile then + oStrings.LoadFromFile(oIniFile.FileName) + else + if oIniFile is TMemIniFile then + TMemIniFile(oIniFile).GetStrings(oStrings); + + oStrings.SaveToStream(oStream); + + finally + oStrings.Free; + end; + +end; + +procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream); +var + oStrings :TStrings; + +begin + + if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit; + + if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit; + + oStrings:= TStringList.Create; + try + + oStrings.LoadFromStream(oStream); + + if oIniFile is TIniFile then + oStrings.SaveToFile(oIniFile.FileName) + else + if oIniFile is TMemIniFile then + TMemIniFile(oIniFile).SetStrings(oStrings); + + finally + oStrings.Free; + end; + +end; + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. diff --git a/official/4.2/FastScript/fs_iinterpreter.pas b/official/4.2/FastScript/fs_iinterpreter.pas new file mode 100644 index 0000000..2c75585 --- /dev/null +++ b/official/4.2/FastScript/fs_iinterpreter.pas @@ -0,0 +1,3128 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Main module } +{ } +{ (c) 2003-2007 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; + TfsProcVariable = 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; dynamic; + { Adds a constant. Example: + AddConst('pi', 'Double', 3.14159) } + procedure AddConst(const Name, Typ: String; const Value: Variant); dynamic; + { Adds an enumeration constant. Example: + AddEnum('TFontPitch', 'fpDefault, fpFixed, fpVariable') + all constants gets type fvtEnum and values 0,1,2,3.. } + procedure AddEnum(const Typ, Names: String); dynamic; + { Adds an set constant. Example: + AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline') + all constants gets type fvtEnum and values 1,2,4,8,.. } + procedure AddEnumSet(const Typ, Names: String); dynamic; + { Adds a form or datamodule with all its child components } + procedure AddComponent(Form: TComponent); dynamic; + procedure AddForm(Form: TComponent); dynamic; + { Adds a method. Syntax is the same as for TfsClassVariable.AddMethod } + procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent; + const Category: String = ''; const Description: String = ''); overload; dynamic; + procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent; + const Category: String = ''; const Description: String = ''); overload; dynamic; + { Adds an external object. Example: + AddObject('Memo1', Memo1) } + procedure AddObject(const Name: String; Obj: TObject); dynamic; + { Adds a variable. Example: + AddVariable('n', 'Variant', 0) } + procedure AddVariable(const Name, Typ: String; const Value: Variant); dynamic; + { Adds a type. Example: + AddType('TDateTime', fvtFloat) } + procedure AddType(const TypeName: String; ParentType: TfsVarType); dynamic; + { Calls internal procedure or function. Example: + val := CallFunction('ScriptFunc1', VarArrayOf([2003, 3])) } + function CallFunction(const Name: String; const Params: Variant): Variant; + function CallFunction1(const Name: String; var Params: Variant): Variant; + function CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant; + + { Compiles the source code. Example: + Lines.Text := 'begin i := 0 end.'; + SyntaxType := 'PascalScript'; + if Compile then ... } + function Compile: Boolean; + { Executes compiled code } + procedure Execute; + { Same as if Compile then Execute. Returns False if compile failed } + function Run: Boolean; + { terminates the script } + procedure Terminate; + { Evaluates an expression (useful for debugging purposes). Example: + val := Evaluate('i+1'); } + function Evaluate(const Expression: String): Variant; + { checks whether is the line is executable } + function IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean; + + { Generates intermediate language. You can save it and compile later + by SetILCode method } + function GetILCode(Stream: TStream): Boolean; + { Compiles intermediate language } + function SetILCode(Stream: TStream): Boolean; + + function Find(const Name: String): TfsCustomVariable; + function FindClass(const Name: String): TfsClassVariable; + function FindLocal(const Name: String): TfsCustomVariable; + + property AddedBy: TObject read FAddedBy write FAddedBy; + property 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 FPC} + {$IFDEF NOFORMS} + .TODO. + {$ELSE} + , Forms, Dialogs + {$ENDIF} + {$ELSE} + , Windows + {$IFDEF NOFORMS} + , Messages + {$ELSE} + , Forms, Dialogs + {$ENDIF} + {$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 +{$IFNDEF Delphi4} + if VarType(Value) <> varInteger then + begin + SetSetProp(Instance, p, fsSetToString(p, Value)); + end + else +{$ENDIF} + begin + if Typ = fvtBool then + if Value = True then + IntVal := 1 else + IntVal := 0 + else + IntVal := Integer(Value); + SetOrdProp(Instance, p, IntVal); + end; + 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; + + // FPC and Delphi do this different way. FPC implementation more honest, so + // if Count = 0 then we get exception about bad bounds + if Count > 0 then + FVarArray := VarArrayCreate([0, Count - 1], varVariant); +end; + +destructor TfsMethodHelper.Destroy; +begin + FVarArray := Null; + inherited; +end; + +function TfsMethodHelper.GetVParam(Index: Integer): Variant; +begin + if Index = Count then + Result := FSetValue + else + Result := TfsParamItem(FItems[Index]).Value; +end; + +procedure TfsMethodHelper.SetVParam(Index: Integer; const Value: Variant); +begin + TfsParamItem(FItems[Index]).Value := Value; +end; + +function TfsMethodHelper.GetValue: Variant; +var + i: Integer; + Instance: TObject; +begin + if Assigned(FOnCall) then + begin + for i := 0 to Count - 1 do + FVarArray[i] := inherited Params[i].Value; + + Instance := nil; + if not VarIsNull(ParentValue) then + Instance := TObject(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; + {$IFNDEF FPC} + FClass := GetTypeData(PropList[i].PropType^).ClassType; + {$ELSE} + FClass := GetTypeData(PropList[i].PropType).ClassType; + {$ENDIF} + 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; + + try + { we're trying to call the local procedure that is already executing - + i.e. we have a recursion } + if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then + 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; + + finally + { restore proc variables if it was called from itself } + if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then + RestoreLocalVariables(Item); + end; + end; + + Result := Val; +end; + +procedure TfsDesignator.CheckLateBinding; +var + NewDesignator: TfsDesignator; + Parser: TfsILParser; +begin + if FLateBindingXMLSource <> nil then + begin + Parser := TfsILParser.Create(FProgram); + try + NewDesignator := Parser.DoDesignator(FLateBindingXMLSource, FProgram); + Borrow(NewDesignator); + NewDesignator.Free; + finally + Parser.Free; + FLateBindingXMLSource.Free; + FLateBindingXMLSource := nil; + end; + end; +end; + +function TfsDesignator.GetValue: Variant; +begin + CheckLateBinding; + Result := DoCalc(Null, False); +end; + +procedure TfsDesignator.SetValue(const Value: Variant); +begin + CheckLateBinding; + DoCalc(Value, True); +end; + + +{ TfsVariableDesignator } + +function TfsVariableDesignator.GetValue: Variant; +begin + Result := RefItem.Value; +end; + +procedure TfsVariableDesignator.SetValue(const Value: Variant); +begin + RefItem.Value := Value; +end; + + +{ TfsStringDesignator } + +function TfsStringDesignator.GetValue: Variant; +begin + Result := TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)]; +end; + +procedure TfsStringDesignator.SetValue(const Value: Variant); +begin + TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)] := VarToStr(Value)[1]; +end; + + +{ TfsArrayDesignator } + +function TfsArrayDesignator.GetValue: Variant; +var + i: Integer; +begin + TfsCustomHelper(FRef1).ParentRef := RefItem; + for i := 0 to FRef2.Count - 1 do + FRef1.Params[i].Value := FRef2[i].Value; + Result := FRef1.Value; +end; + +procedure TfsArrayDesignator.SetValue(const Value: Variant); +var + i: Integer; +begin + TfsCustomHelper(FRef1).ParentRef := RefItem; + for i := 0 to FRef2.Count - 1 do + FRef1.Params[i].Value := FRef2[i].Value; + FRef1.Value := Value; +end; + + +{ TfsSetExpression } + +function TfsSetExpression.Check(const Value: Variant): Boolean; +var + i: Integer; + Expr: TfsCustomExpression; +begin + Result := False; + + (* TfsSetExpression encapsulates the set like [1,2,3..10] + In the example above we'll have the following Items: + TfsExpression {1} + TfsExpression {2} + TfsExpression {3} + nil (indicates the range ) + TfsExpression {10} *) + + i := 0; + while i < Count do + begin + Expr := Items[i]; + + if (i < Count - 1) and (Items[i + 1] = nil) then { subrange } + begin + Result := (Value >= Expr.Value) and (Value <= Items[i + 2].Value); + Inc(i, 2); + end + else + Result := Value = Expr.Value; + + if Result then break; + Inc(i); + end; +end; + +function TfsSetExpression.GetItem(Index: Integer): TfsCustomExpression; +begin + Result := FItems[Index]; +end; + +function TfsSetExpression.GetValue: Variant; +var + i: Integer; +begin + Result := VarArrayCreate([0, Count - 1], varVariant); + + for i := 0 to Count - 1 do + if Items[i] = nil then + Result[i] := Null else + Result[i] := Items[i].Value; +end; + + +{ TfsScript } + +constructor TfsScript.Create(AOwner: TComponent); +begin + inherited; + 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 := TClass(FRTTIModules[i]); + rtti := TfsRTTIModule(obj.NewInstance); + rtti.Create(Self); + Add('', rtti); + end; + AddedBy := nil; + + FRTTIAdded := True; +end; + +procedure TfsScript.ClearRTTI; +var + i: Integer; + item: TObject; +begin + if not FRTTIAdded then Exit; + + i := 0; + while i < FItems.Count do + begin + item := FItems.Objects[i]; + if (item is TfsRTTIModule) or + ((item is TfsCustomVariable) and + (TfsCustomVariable(item).AddedBy = TObject(1))) then + begin + item.Free; + FItems.Delete(i); + end + else + Inc(i); + end; + + FRTTIAdded := False; +end; + +function TfsScript.CallFunction(const Name: String; const Params: Variant): 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.CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant; +var + i: Integer; +begin + if (Func <> nil) then + begin + if VarIsArray(Params) then + for i := 0 to VarArrayHighBound(Params, 1) do + Func.Params[i].Value := Params[i]; + Result := Func.Value; + end + else + begin + Result := Null; + end +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.SyntaxType := SyntaxType; + if CompareText(SyntaxType, 'PascalScript') = 0 then + Prog.Lines.Text := 'function __f__: Variant; begin Result := ' + Expression + ' end; begin end.' + else if CompareText(SyntaxType, 'C++Script') = 0 then + Prog.Lines.Text := 'Variant __f__() { return ' + Expression + '; } {}' + else if CompareText(SyntaxType, 'BasicScript') = 0 then + Prog.Lines.Text := 'function __f__' + #13#10 + 'return ' + Expression + #13#10 + 'end function' + else if CompareText(SyntaxType, 'JScript') = 0 then + Prog.Lines.Text := 'function __f__() { return (' + Expression + '); }'; + 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 + on E: Exception do + begin + FProgram.SetVariables('ExceptionClassName', E.ClassName); + FProgram.SetVariables('ExceptionMessage', E.Message); + ExceptStmt.Execute; + end; + end; + end + else + begin + try + inherited Execute; + finally + SaveExitCalled := FProgram.FExitCalled; + FProgram.FExitCalled := False; + ExceptStmt.Execute; + FProgram.FExitCalled := SaveExitCalled; + end + end; +end; + + +{ TfsBreakStmt } + +procedure TfsBreakStmt.Execute; +begin + FProgram.FBreakCalled := True; +end; + + +{ TfsContinueStmt } + +procedure TfsContinueStmt.Execute; +begin + FProgram.FContinueCalled := True; +end; + + +{ TfsExitStmt } + +procedure TfsExitStmt.Execute; +begin + RunLine; + FProgram.FExitCalled := True; +end; + + +{ TfsWithStmt } + +destructor TfsWithStmt.Destroy; +begin + FDesignator.Free; + inherited; +end; + +procedure TfsWithStmt.Execute; +begin + inherited; + FVariable.Value := FDesignator.Value; +end; + + +{ TfsArrayHelper } + +constructor TfsArrayHelper.Create(const AName: String; DimCount: Integer; + Typ: TfsVarType; const TypeName: String); +var + i: Integer; +begin + inherited Create(AName, Typ, TypeName); + + if DimCount <> -1 then + begin + for i := 0 to DimCount - 1 do + 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/4.2/FastScript/fs_ijs.pas b/official/4.2/FastScript/fs_ijs.pas new file mode 100644 index 0000000..b248c2c --- /dev/null +++ b/official/4.2/FastScript/fs_ijs.pas @@ -0,0 +1,145 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ JScript grammar } +{ } +{ (c) 2003-2007 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/4.2/FastScript/fs_imenusrtti.pas b/official/4.2/FastScript/fs_imenusrtti.pas new file mode 100644 index 0000000..eed5da5 --- /dev/null +++ b/official/4.2/FastScript/fs_imenusrtti.pas @@ -0,0 +1,176 @@ +{**********************************************} +{ } +{ FastScript v1.9 } +{ Menus } +{ } +{ Copyright (c) 1998-2007 } +{ by Fast Reports Inc. } +{ } +{ Copyright (c) 2006 by Кропотин Иван } +{ Copyright (c) 2006-2007 by Stalker SoftWare } +{ } +{**********************************************} + +unit fs_imenusrtti; + +interface + +{$I fs.inc} + +uses + SysUtils, Classes, Menus, fs_iinterpreter, fs_ievents, ImgList +{$IFDEF Delphi6} +, Types , Variants +{$ENDIF}; + +type + TfsMenusRTTI = class(TComponent); // fake component + +implementation + +type + TFunctions = class(TfsRTTIModule) + private + function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: + string; Caller: TfsMethodHelper): Variant; + function GetProp(Instance: TObject; ClassType: TClass; const PropName: + string): Variant; + procedure SetProp(Instance: TObject; ClassType: TClass; const PropName: + string; Value: Variant); + public + constructor Create(AScript: TfsScript); override; + end; + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + + with AScript do + begin + + AddType('TPopupAlignment', fvtInt); + + AddClass(TCustomImageList, 'TComponent'); + + with AddClass(TMenuItem, 'TComponent') do + begin + AddMethod('procedure Add(Item: TMenuItem)', CallMethod); + AddMethod('procedure Clear', CallMethod); + AddMethod('procedure Delete(Index: Integer)', CallMethod); + AddMethod('procedure Insert(Index: Integer; Item: TMenuItem)', + CallMethod); + AddMethod('procedure Remove(Item: TMenuItem)', CallMethod); + AddMethod('function GetParentMenu: TMenu', CallMethod); + AddEvent('OnClick', TfsNotifyEvent); + AddProperty('Count', 'Integer', GetProp); + AddDefaultProperty('Items', 'Integer', 'TMenuItem', CallMethod, True); + end; { with } + + with AddClass(TMenu, 'TComponent') do + AddIndexProperty('Items', 'Integer', 'TMenuItem', CallMethod, True); + + with AddClass(TPopupMenu, 'TMenu') do + begin + AddEvent('OnPopup', TfsNotifyEvent); + AddMethod('procedure Popup(X, Y: Extended)', CallMethod); + AddProperty('PopupComponent', 'TComponent', GetProp, SetProp); + AddProperty('Images', 'TCustomImageList', GetProp, SetProp); + end; { with } + + end; { with } + +end; { Create } + +function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const + MethodName: string; Caller: TfsMethodHelper): Variant; +var + oMenuItem: TMenuItem; +begin + Result := 0; + + if ClassType = TMenuItem then + begin + + oMenuItem := TMenuItem(Instance); + + if MethodName = 'ADD' then + oMenuItem.Add(TMenuItem(Integer(Caller.Params[0]))) +{$IFDEF Delphi5} + else if MethodName = 'CLEAR' then + oMenuItem.Clear +{$ENDIF} + else if MethodName = 'DELETE' then + oMenuItem.Delete(Caller.Params[0]) + else if MethodName = 'INSERT' then + oMenuItem.Insert(Caller.Params[0], TMenuItem(Integer(Caller.Params[1]))) + else if MethodName = 'REMOVE' then + oMenuItem.Remove(TMenuItem(Integer(Caller.Params[0]))) + else if MethodName = 'ITEMS.GET' then + Result := Integer(oMenuItem.Items[Caller.Params[0]]) + else if MethodName = 'GETPARENTMENU' then + Result := Integer(oMenuItem.GetParentMenu()); + + end + else if ClassType = TMenu then + begin + + if MethodName = 'ITEMS.GET' then + Result := Integer(TMenu(Instance).Items[Caller.Params[0]]) + + end + else if ClassType = TPopupMenu then + begin + + if MethodName = 'POPUP' then + TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]); + + end; { if } + +end; { CallMethod } + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const + PropName: string): Variant; +begin + Result := 0; + + if ClassType = TMenuItem then + begin + + if PropName = 'COUNT' then + Result := TMenuItem(Instance).Count; + + end + else if ClassType = TPopupMenu then + begin + + if PropName = 'POPUPCOMPONENT' then + Result := Integer(TPopupMenu(Instance).PopupComponent) + else if PropName = 'IMAGES' then + Result := Integer(TPopupMenu(Instance).Images) + + end; { if } + +end; { GetProp } + +procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; const + PropName: string; Value: Variant); +begin + if ClassType = TPopupMenu then + begin + if PropName = 'IMAGES' then + TPopupMenu(Instance).Images := TCustomImageList(Integer(Value)) + else if PropName = 'POPUPCOMPONENT' then + TPopupMenu(Instance).PopupComponent := TComponent(Integer(Value)) + + end; { if } + +end; { SetProp } + +initialization + fsRTTIModules.Add(TFunctions); + +finalization + fsRTTIModules.Remove(TFunctions); + +end. + diff --git a/official/4.2/FastScript/fs_iparser.pas b/official/4.2/FastScript/fs_iparser.pas new file mode 100644 index 0000000..47dfc68 --- /dev/null +++ b/official/4.2/FastScript/fs_iparser.pas @@ -0,0 +1,686 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Parser } +{ } +{ (c) 2003-2007 by Alexander Tzyganenko, } +{ Fast Reports Inc } +{ } +{******************************************} + +unit fs_iparser; + +interface + +{$i fs.inc} + +uses +{$IFNDEF CROSS_COMPILE} + Windows, +{$ENDIF} + SysUtils, Classes; + + +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 + FCaseSensitive: Boolean; + FCommentBlock1: String; + FCommentBlock11: String; + FCommentBlock12: String; + FCommentBlock2: String; + FCommentBlock21: String; + FCommentBlock22: String; + FCommentLine1: String; + FCommentLine2: String; + FHexSequence: String; + FIdentifierCharset: TfsIdentifierCharset; + FKeywords: TStrings; + FLastPosition: Integer; + FPosition: Integer; + FSize: Integer; + FSkipChar: String; + FSkipEOL: Boolean; + FSkipSpace: Boolean; + FStringQuotes: String; + FText: String; + FUseY: Boolean; + FYList: TList; + function DoDigitSequence: Boolean; + function DoHexDigitSequence: Boolean; + function DoScaleFactor: Boolean; + function DoUnsignedInteger: Boolean; + function DoUnsignedReal: Boolean; + procedure SetPosition(const Value: Integer); + procedure SetText(const Value: String); + function Ident: String; + procedure SetCommentBlock1(const Value: String); + procedure SetCommentBlock2(const Value: String); + public + constructor Create; + destructor Destroy; override; + procedure Clear; + procedure ConstructCharset(const s: String); + + { skip all #0..#31 symbols } + procedure SkipSpaces; + { get EOL symbol } + function GetEOL: Boolean; + { get any valid ident except keyword } + function GetIdent: String; + { get any valid punctuation symbol like ,.;: } + function GetChar: String; + { get any valid ident or keyword } + function GetWord: String; + { get valid hex/int/float number } + function GetNumber: String; + { get valid quoted/control string like 'It''s'#13#10'working' } + function GetString: String; + { get FR-specific string - variable or db field like [main data."field 1"] } + function GetFRString: String; + { get Y:X position } + function GetXYPosition: String; + { get plain position from X:Y } + function GetPlainPosition(pt: TPoint): Integer; + { is this keyword? } + function IsKeyWord(const s: String): Boolean; + + // Language-dependent elements + // For Pascal: + // CommentLine1 := '//'; + // CommentBlock1 := '{,}'; + // CommentBlock2 := '(*,*)'; + // HexSequence := '$' + // IdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z']; + // Keywords: 'begin','end', ... + // StringQuotes := '''' + property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive; + property CommentBlock1: String read FCommentBlock1 write SetCommentBlock1; + property CommentBlock2: String read FCommentBlock2 write SetCommentBlock2; + property CommentLine1: String read FCommentLine1 write FCommentLine1; + property CommentLine2: String read FCommentLine2 write FCommentLine2; + property HexSequence: String read FHexSequence write FHexSequence; + property IdentifierCharset: TfsIdentifierCharset read FIdentifierCharset + write FIdentifierCharset; + property Keywords: TStrings read FKeywords; + property SkipChar: String read FSkipChar write FSkipChar; + property SkipEOL: Boolean read FSkipEOL write FSkipEOL; + property SkipSpace: Boolean read FSkipSpace write FSkipSpace; + property StringQuotes: String read FStringQuotes write FStringQuotes; + property UseY: Boolean read FUseY write FUseY; + + { Current position } + property Position: Integer read FPosition write SetPosition; + { Text to parse } + property Text: String read FText write SetText; + end; + + +implementation + + +{ TfsParser } + +constructor TfsParser.Create; +begin + FKeywords := TStringList.Create; + TStringList(FKeywords).Sorted := True; + FYList := TList.Create; + FUseY := True; + Clear; +end; + +destructor TfsParser.Destroy; +begin + FKeywords.Free; + FYList.Free; + inherited; +end; + +procedure TfsParser.Clear; +begin + FKeywords.Clear; + FCommentLine1 := '//'; + CommentBlock1 := '{,}'; + CommentBlock2 := '(*,*)'; + FHexSequence := '$'; + FIdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z']; + FSkipChar := ''; + FSkipEOL := True; + FStringQuotes := ''''; + FSkipSpace := True; +end; + +procedure TfsParser.SetCommentBlock1(const Value: String); +var + sl: TStringList; +begin + FCommentBlock1 := Value; + FCommentBlock11 := ''; + FCommentBlock12 := ''; + + sl := TStringList.Create; + sl.CommaText := FCommentBlock1; + if sl.Count > 0 then + FCommentBlock11 := sl[0]; + if sl.Count > 1 then + FCommentBlock12 := sl[1]; + sl.Free; +end; + +procedure TfsParser.SetCommentBlock2(const Value: String); +var + sl: TStringList; +begin + FCommentBlock2 := Value; + FCommentBlock21 := ''; + FCommentBlock22 := ''; + + sl := TStringList.Create; + sl.CommaText := FCommentBlock2; + if sl.Count > 0 then + FCommentBlock21 := sl[0]; + if sl.Count > 1 then + FCommentBlock22 := sl[1]; + sl.Free; +end; + +procedure TfsParser.SetPosition(const Value: Integer); +begin + FPosition := Value; + FLastPosition := Value; +end; + +procedure TfsParser.SetText(const Value: String); +var + i: Integer; +begin + FText := Value + #0; + FLastPosition := 1; + FPosition := 1; + FSize := Length(Value); + + if FUseY then + begin + FYList.Clear; + FYList.Add(TObject(0)); + for i := 1 to FSize do + if FText[i] = #10 then + FYList.Add(TObject(i)); + end; +end; + +procedure TfsParser.ConstructCharset(const s: String); +var + i: Integer; +begin + FIdentifierCharset := []; + for i := 1 to Length(s) do + FIdentifierCharset := FIdentifierCharset + [s[i]]; +end; + +function TfsParser.GetEOL: Boolean; +begin + SkipSpaces; + 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 + {$IFNDEF FPC} + case Lowercase(FText[FPosition + 1])[1] of + {$ELSE} + case Lowercase(FText[FPosition + 1]) of + {$ENDIF} + 'n': + begin + Str := Str + #10; + Inc(FPosition); + end; + 'r': + begin + Str := Str + #13; + Inc(FPosition); + end; + 'x': + begin + Inc(FPosition, 2); + j := FPosition; + Result := DoHexDigitSequence; + if Result then + Str := Str + Chr(StrToInt('$' + Copy(FText, j, FPosition - j))) else + FPosition := j; + Dec(FPosition); + end + else + begin + Str := Str + FText[FPosition + 1]; + Inc(FPosition); + end; + end; + end + else if FText[FPosition] = FStringQuotes[1] then + begin + if not FCpp and (FText[FPosition + 1] = FStringQuotes[1]) then + begin + Str := Str + FStringQuotes[1]; + Inc(FPosition); + end + else + break + end + else + Str := Str + FText[FPosition]; + 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/4.2/FastScript/fs_ipascal.pas b/official/4.2/FastScript/fs_ipascal.pas new file mode 100644 index 0000000..db4a941 --- /dev/null +++ b/official/4.2/FastScript/fs_ipascal.pas @@ -0,0 +1,183 @@ + +{******************************************} +{ } +{ FastScript v1.9 } +{ Pascal grammar } +{ } +{ (c) 2003-2007 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/>, , tags + else if (i + 1 <= Length(s)) and (s[i + 1] = '/') then + begin + if (i + 3 <= Length(s)) and (s[i + 3] = '>') then + begin + case s[i + 2] of + 'b','B': FStyle := FStyle - [fsBold]; + 'i','I': FStyle := FStyle - [fsItalic]; + 'u','U': FStyle := FStyle - [fsUnderline]; + else + b := False; + end; + if b then + begin + System.Delete(s, i, 4); + Inc(FPosition, 4); + continue; + end; + end + else if (Pos('STRIKE>', AnsiUpperCase(s)) = i + 2) then + begin + FStyle := FStyle - [fsStrikeOut]; + System.Delete(s, i, 9); + Inc(FPosition, 9); + continue; + end + else if Pos('FONT>', AnsiUpperCase(s)) = i + 2 then + begin + FColor := FDefColor; + System.Delete(s, i, 7); + Inc(FPosition, 7); + continue; + end + else if (Pos('SUB>', AnsiUpperCase(s)) = i + 2) or + (Pos('SUP>', AnsiUpperCase(s)) = i + 2) then + begin + FSize := FDefSize; + FAddY := 0; + System.Delete(s, i, 6); + Inc(FPosition, 6); + continue; + end + end + + // tag + else if Pos('FONT COLOR', AnsiUpperCase(s)) = i + 1 then + begin + j := i + 11; + while (j <= Length(s)) and (s[j] <> '=') do + Inc(j); + Inc(j); + while (j <= Length(s)) and (s[j] = ' ') do + Inc(j); + j1 := j; + while (j <= Length(s)) and (s[j] <> '>') do + Inc(j); + + cl := Copy(s, j1, j - j1); + if cl <> '' then + begin + if (Length(cl) > 3) and (cl[1] = '"') and (cl[2] = '#') and + (cl[Length(cl)] = '"') then + begin + cl := '$' + Copy(cl, 3, Length(cl) - 3); + FColor := StrToInt(cl); + FColor := (FColor and $00FF0000) div 65536 + + (FColor and $000000FF) * 65536 + + (FColor and $0000FF00); + System.Delete(s, i, j - i + 1); + Inc(FPosition, j - i + 1); + continue; + end + else if IdentToColor('cl' + cl, FColor) then + begin + System.Delete(s, i, j - i + 1); + Inc(FPosition, j - i + 1); + continue; + end; + end; + end + end; + + AddTag; + Inc(i); + Inc(FPosition); + end; + + if Length(s) = 0 then + begin + AddTag; + s := ' '; + end; +end; + +function TfrxHTMLTagsList.FillCharSpacingArray(var ar: PIntArray; const s: WideString; + Canvas: TCanvas; LineIndex, Add: Integer; Convert: Boolean): Integer; +var + i, n: Integer; + Tags: TfrxHTMLTags; + Tag: TfrxHTMLTag; + + procedure BreakArray; + var + i, j, offs: Integer; + Size: TSize; + ansis: String; + begin + if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Canvas.Font.Charset <> DEFAULT_CHARSET) then + begin + ansis := s; + GetTextExtentExPoint(Canvas.Handle, PChar(ansis), n, 0, nil, + @FTempArray[0], Size); + end + else + GetTextExtentExPointW(Canvas.Handle, PWideChar(s), n, 0, nil, + @FTempArray[0], Size); + i := 0; + repeat + if FTempArray[i] = 32767 then + begin + offs := FTempArray[i - 1]; + if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Canvas.Font.Charset <> DEFAULT_CHARSET) then + begin + ansis := s; + GetTextExtentExPoint(Canvas.Handle, PChar(ansis) + i, n - i, 0, nil, + @FTempArray[i], Size); + end + else + GetTextExtentExPointW(Canvas.Handle, PWideChar(s) + i, n - i, 0, nil, + @FTempArray[i], Size); + for j := i to n - 1 do + if FTempArray[j] = 32767 then + begin + i := j - 1; + break; + end + else + FTempArray[j] := FTempArray[j] + offs; + end; + Inc(i); + until i >= n; + end; + +begin + Result := 0; + n := Length(s); + + Tags := Items[LineIndex]; + Tag := Tags.Items[0]; + if not Tag.Default then + Canvas.Font.Style := Tag.Style; + + BreakArray; + + for i := 0 to n - 1 do + begin + Tag := Tags.Items[i]; + if (i <> 0) and not Tag.Default then + begin + Canvas.Font.Style := Tag.Style; + BreakArray; + end; + + if i > 0 then + Ar[i] := FTempArray[i] - FTempArray[i - 1] + Add else + Ar[i] := FTempArray[i] + Add; + if Tag.Small then + Ar[i] := Round(Ar[i] / 1.5); + Inc(Result, Ar[i]); + if Convert and (i > 0) then + Inc(Ar[i], Ar[i - 1]); + end; +end; + + +{ TfrxDrawText } + +constructor TfrxDrawText.Create; +begin + FBMP := TBitmap.Create; + FCanvas := FBMP.Canvas; + FDefPPI := 600; + FScrPpi := 96; + FHTMLTags := TfrxHTMLTagsList.Create; + FText := TWideStrings.Create; + FWysiwyg := True; + GetMem(FTempArray, SizeOf(Integer) * 32768); +end; + +destructor TfrxDrawText.Destroy; +begin + FBMP.Free; + FHTMLTags.Free; + FText.Free; + FreeMem(FTempArray, SizeOf(Integer) * 32768); + inherited; +end; + +procedure TfrxDrawText.SetFont(Font: TFont); +var + h: Integer; +begin + FFontSize := Font.Size; + h := -Round(FFontSize * FDefPPI / 72); // height is as in the 600 dpi printer + FCanvas.Lock; + try + with FCanvas.Font do + begin + if Name <> Font.Name then + Name := Font.Name; + if Height <> h then + Height := h; + if Style <> Font.Style then + Style := Font.Style; + if Charset <> Font.Charset then + Charset := Font.Charset; + if Color <> Font.Color then + Color := Font.Color; + end; + finally + FCanvas.Unlock; + end; +end; + +procedure TfrxDrawText.SetOptions(WordWrap, HTMLTags, RTLReading, + WordBreak, Clipped, Wysiwyg: Boolean; Rotation: Integer); +begin + FWordWrap := WordWrap; + FHTMLTags.AllowTags := HTMLTags; + FRTLReading := RTLReading; + FOptions := 0; + if RTLReading then + FOptions := ETO_RTLREADING; + if Clipped then + FOptions := FOptions or ETO_CLIPPED; + FWordBreak := WordBreak; + FRotation := Rotation mod 360; + FWysiwyg := Wysiwyg; +end; + +procedure TfrxDrawText.SetDimensions(ScaleX, ScaleY, PrintScale: Extended; + OriginalRect, ScaledRect: TRect); +begin + FScaleX := ScaleX; + FScaleY := ScaleY; + FPrintScale := PrintScale; + FOriginalRect := OriginalRect; + FScaledRect := ScaledRect; +end; + +procedure TfrxDrawText.SetGaps(ParagraphGap, CharSpacing, LineSpacing: Extended); +begin + FParagraphGap := ParagraphGap; + FCharSpacing := CharSpacing; + FLineSpacing := LineSpacing; +end; + +procedure TfrxDrawText.SetText(Text: TWideStrings); +var + i, j, n, Width: Integer; + s: WideString; + Style: TFontStyles; + FPPI: Extended; +begin + FCanvas.Lock; + try + FPlainText := ''; + FText.Clear; + finally + FCanvas.Unlock; + end; + + n := Text.Count; + if n = 0 then Exit; + + FCanvas.Lock; + try + // set up html engine + FHTMLTags.SetDefaults(FCanvas.Font.Color, FFontSize, FCanvas.Font.Style); + Style := FCanvas.Font.Style; + + // width of the wrap area + Width := FOriginalRect.Right - FOriginalRect.Left; + if ((FRotation >= 90) and (FRotation < 180)) or + ((FRotation >= 270) and (FRotation < 360)) then + Width := FOriginalRect.Bottom - FOriginalRect.Top; + + for i := 0 to n - 1 do + begin + j := FText.Count; + s := Text[i]; + if s = '' then + s := ' '; + FPlainText := FPlainText + s + #13#10; + FPPI := FDefPPI / FScrPPI; + WrapTextLine(s, + Round(Width * FPPI), + Round((Width - FParagraphGap) * FPPI), + Round(FCharSpacing * FPPI)); + if FText.Count <> j then + begin + FText.Objects[j] := Pointer(1); // mark the begin of paragraph: + if FText.Count - 1 = j then // it will be needed in DrawText + FText.Objects[j] := Pointer(3) else // both begin and end at one line + FText.Objects[FText.Count - 1] := Pointer(2); // mark the end of paragraph + end; + end; + + FCanvas.Font.Style := Style; + finally + FCanvas.Unlock; + end; +end; + +procedure TfrxDrawText.SetParaBreaks(FirstParaBreak, LastParaBreak: Boolean); +begin + if FText.Count = 0 then Exit; + + if FirstParaBreak then + FText.Objects[0] := Pointer(Integer(FText.Objects[0]) and not 1); + if LastParaBreak then + FText.Objects[FText.Count - 1] := Pointer(Integer(FText.Objects[FText.Count - 1]) and not 2); +end; + +function TfrxDrawText.DeleteTags(const Txt: WideString): WideString; +begin + Result := Txt; + FHTMLTags.ExpandHTMLTags(Result); +end; + +procedure TfrxDrawText.WrapTextLine(s: WideString; + Width, FirstLineWidth, CharSpacing: Integer); +var + n, i, Offset, LineBegin, LastSpace, BreakPos: Integer; + sz: TSize; + TheWord: WideString; + WasBreak: Boolean; + + function BreakWord(const s: WideString; LineBegin, CurPos, LineEnd: Integer): WideString; + var + i, BreakPos: Integer; + TheWord, Breaks: WideString; + begin + // get the whole word + i := CurPos; + while (i <= LineEnd) and (Pos(s[i], ' .,-;') = 0) do + Inc(i); + TheWord := Copy(s, LineBegin, i - LineBegin); + // get available break positions + Breaks := BreakRussianWord(AnsiUpperCase(TheWord)); + // find the closest position + BreakPos := CurPos - LineBegin; + for i := Length(Breaks) downto 1 do + if Ord(Breaks[i]) < BreakPos then + begin + BreakPos := Ord(Breaks[i]); + break; + end; + if BreakPos <> CurPos - LineBegin then + Result := Copy(TheWord, 1, BreakPos) else + Result := ''; + end; + +begin +// remove all HTML tags and build the tag list + FHTMLTags.NewLine; + FHTMLTags.ExpandHTMLTags(s); + FHTMLTags.FPosition := FHTMLTags.FPosition + 2; + + n := Length(s); + if (n < 2) or not FWordWrap then // no need to wrap a string with 0 or 1 symbol + begin + FText.Add(s); + Exit; + end; + +// get the intercharacter spacing table and calculate the width + FCanvas.Lock; + try + sz.cx := FHTMLTags.FillCharSpacingArray(FTempArray, s, FCanvas, + FHTMLTags.Count - 1, CharSpacing, True); + finally + FCanvas.Unlock; + end; + +// text fits, no need to wrap it + if sz.cx < FirstLineWidth then + begin + FText.Add(s); + Exit; + end; + + Offset := 0; + i := 1; + LineBegin := 1; // index of the first symbol in the current line + LastSpace := 1; // index of the last space symbol in the current line + + while i <= n do + begin + if s[i] = ' ' then + LastSpace := i; + + if FTempArray[i - 1] - Offset > FirstLineWidth then // need wrap + begin + if LastSpace = LineBegin then // there is only one word without spaces... + begin + if i <> LineBegin then // ... and it has more than 1 symbol + begin + if FWordBreak then + begin + TheWord := BreakWord(s, LineBegin, i, n); + WasBreak := TheWord <> ''; + if not WasBreak then + TheWord := Copy(s, LineBegin, i - LineBegin); + if WasBreak then + FText.Add(TheWord + '-') else + FText.Add(TheWord); + BreakPos := Length(TheWord); + FHTMLTags.Wrap(BreakPos, WasBreak); + LastSpace := LineBegin + BreakPos - 1; + end + else + begin + FText.Add(Copy(s, LineBegin, i - LineBegin)); + FHTMLTags.Wrap(i - LineBegin, False); + LastSpace := i - 1; + end; + end + else + begin + FText.Add(s[LineBegin]); // can't wrap 1 symbol, just add it to the new line + FHTMLTags.Wrap(1, False); + end; + end + else // we have a space symbol inside + begin + if FWordBreak then + begin + TheWord := BreakWord(s, LastSpace + 1, i, n); + WasBreak := TheWord <> ''; + if WasBreak then + FText.Add(Copy(s, LineBegin, LastSpace - LineBegin + 1) + TheWord + '-') else + FText.Add(Copy(s, LineBegin, LastSpace - LineBegin)); + BreakPos := LastSpace - LineBegin + Length(TheWord) + 1; + FHTMLTags.Wrap(BreakPos, WasBreak); + if WasBreak then + LastSpace := LineBegin + BreakPos - 1; + end + else + begin + FText.Add(Copy(s, LineBegin, LastSpace - LineBegin)); + FHTMLTags.Wrap(LastSpace - LineBegin + 1, False); + end; + end; + + Offset := FTempArray[LastSpace - 1]; // starting a new line + i := LastSpace; + Inc(LastSpace); + LineBegin := LastSpace; + FirstLineWidth := Width; // this line is not first, so use Width + end; + + Inc(i); + end; + + if n - LineBegin + 1 > 0 then // put the rest of line to FText + FText.Add(Copy(s, LineBegin, n - LineBegin + 1)); +end; + +procedure TfrxDrawText.DrawTextLine(C: TCanvas; const s: WideString; + X, Y, DX, LineIndex: Integer; Align: TfrxHAlign; var fh, oldfh: HFont); +var + spaceAr: PIntArray; + n, i, j, cw, neededSize, extraSize, spaceCount: Integer; + add1, add2, add3, addCount: Integer; + ratio: Extended; + Sz, prnSz, PPI: Integer; + Tag: TfrxHTMLTag; + CosA, SinA: Extended; + Style: TFontStyles; + FPPI: Extended; + + function CountSpaces: Integer; + var + i: Integer; + begin + Result := 0; + for i := 0 to n - 1 do + begin + spaceAr[i] := 0; + if (s[i + 1] = ' ') or (s[i + 1] = #$A0) then + begin + Inc(Result); + spaceAr[i] := 1; + end; + end; + end; + + function CalcWidth(Index, Count: Integer): Integer; + var + i: Integer; + begin + Result := 0; + for i := Index to Index + Count - 1 do + Result := Result + FTempArray[i]; + end; + +begin + n := Length(s); + if n = 0 then Exit; + + spaceAr := nil; + FCanvas.Lock; + + try + Style := C.Font.Style; + FHTMLTags.FDefStyle := Style; + FCanvas.Font.Style := Style; + FPPI := FDefPPI / FScrPPI; + + PrnSz := FHTMLTags.FillCharSpacingArray(FTempArray, s, FCanvas, LineIndex, + Round(FCharSpacing * FPPI), False) - Round(FCharSpacing * FPPI); + Sz := FHTMLTags.FillCharSpacingArray(FTempArray, s, C, LineIndex, + Round(FCharSpacing * FScaleX), False) - Round(FCharSpacing * FScaleX); //!Den + + C.Font.Style := Style; + if FHTMLTags.AllowTags and (FRotation <> 0) then + begin + SelectObject(C.Handle, oldfh); + DeleteObject(fh); + fh := CreateRotatedFont(C.Font, FRotation); + oldfh := SelectObject(C.Handle, fh); + end; + + PPI := GetDeviceCaps(C.Handle, LOGPIXELSX); + ratio := FDefPPI / PPI; + if IsPrinter(C) then + neededSize := Round(prnSz * FPrintScale / ratio) else + neededSize := Round(prnSz / (FDefPPI / 96) * FScaleX); + if not FWysiwyg then + neededSize := Sz; + extraSize := neededSize - Sz; + + CosA := Cos(pi / 180 * FRotation); + SinA := Sin(pi / 180 * FRotation); + if Align = haRight then + begin + X := x + Round((dx - neededSize + 1) * CosA); + Y := y - Round((dx - neededSize + 1) * SinA); + + Dec(X, 1); + if (fsBold in Style) or (fsItalic in Style) then + if FRotation = 0 then + Dec(X, 1); + end + else if Align = haCenter then + begin + X := x + Round((dx - neededSize) / 2 * CosA); + Y := y - Round((dx - neededSize) / 2 * SinA); + end; + + + if Align = haBlock then + begin + GetMem(spaceAr, SizeOf(Integer) * n); + spaceCount := CountSpaces; + if spaceCount = 0 then + Align := haLeft else + extraSize := Abs(dx) - Sz; + end + else + spaceCount := 0; + + if extraSize < 0 then + begin + extraSize := -extraSize; + add3 := -1; + end + else + add3 := 1; + + if Align <> haBlock then + begin + if extraSize < n then + IncArray(FTempArray, 0, n - 1, extraSize, add3) + else + begin + add1 := extraSize div n * add3; + for i := 0 to n - 1 do + Inc(FTempArray[i], add1); + IncArray(FTempArray, 0, n - 1, extraSize - add1 * n * add3, add3) + end; + end + else + begin + add1 := extraSize div spaceCount; + add2 := extraSize mod spaceCount; + addCount := 0; + for i := 0 to n - 1 do + if spaceAr[i] = 1 then + begin + Inc(FTempArray[i], add1 * add3); + if addCount <= add2 then + begin + Inc(FTempArray[i], add3); + Inc(addCount); + end; + end; + end; + + + i := 0; + Tag := FHTMLTags[LineIndex].Items[0]; + add1 := Round(Tag.AddY * Tag.Size * FScaleY); + + repeat + j := i; + while i < n do + begin + Tag := FHTMLTags[LineIndex].Items[i]; + if not Tag.Default then + begin + Tag.Default := True; + break; + end; + Inc(i); + end; + + if (C.Font.Charset = DEFAULT_CHARSET) and (Win32Platform = VER_PLATFORM_WIN32_NT) then + if FWysiwyg then + ExtTextOutW(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA), + FOptions, @FScaledRect, PWideChar(s) + j, i - j, @FTempArray[j]) + else + ExtTextOutW(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA), + FOptions, @FScaledRect, PWideChar(s) + j, i - j, nil) + else + if FWysiwyg then + ExtTextOut(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA), + FOptions, @FScaledRect, PChar(String(s)) + j, i - j, @FTempArray[j]) + else + ExtTextOut(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA), + FOptions, @FScaledRect, PChar(String(s)) + j, i - j, nil); + + if i < n then + begin + if IsPrinter(C) then + C.Font.Height := -Round(Tag.Size * PPI * FPrintScale / 72) else + C.Font.Height := -Round(Tag.Size * FScaleY * 96 / 72); + C.Font.Style := Tag.Style; + C.Font.Color := Tag.Color; + add1 := Round(Tag.AddY * Tag.Size * FScaleY); + + cw := CalcWidth(j, i - j); + if FRotation = 0 then + X := X + cw + else + begin + X := X + Round(cw * CosA); + Y := Y - Round(cw * SinA); + + SelectObject(C.Handle, oldfh); + DeleteObject(fh); + fh := CreateRotatedFont(C.Font, FRotation); + oldfh := SelectObject(C.Handle, fh); + end; + end; + until i >= n; + + if spaceAr <> nil then + FreeMem(spaceAr, SizeOf(Integer) * n); + + finally + FCanvas.Unlock; + end; +end; + +procedure TfrxDrawText.DrawText(C: TCanvas; HAlign: TfrxHAlign; VAlign: TfrxVAlign); +var + Ar: PIntArray; + i, n, neededSize, extraSize, add1, add3: Integer; + ratio: Extended; + al: TfrxHAlign; + x, y, par: Integer; + Sz, prnSz: Integer; + Tag: TfrxHTMLTag; + fh, oldfh: HFont; + h, PPI, dx, gx: Integer; + CosA, SinA: Extended; + + procedure CalcRotatedCoords; + var + AbsCosA, AbsSinA: Extended; + dy: Integer; + begin + CosA := Cos(pi / 180 * FRotation); + SinA := Sin(pi / 180 * FRotation); + AbsCosA := Abs(CosA); + AbsSinA := Abs(SinA); + + dy := 0; + with FScaledRect do + case FRotation of + 0: + begin + x := Left; + y := Top; + dx := Right - Left; + dy := Bottom - Top; + end; + + 1..89: + begin + x := Left; + dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA); + y := Top + Round(dx * AbsSinA); + dy := Bottom - y - Round(neededsize * AbsCosA) + neededsize; + CosA := 1; SinA := 0; + end; + + 90: + begin + x := Left; + y := Bottom; + dx := Bottom - Top; + dy := Right - Left; + end; + + 91..179: + begin + y := Bottom; + dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA); + x := Left + Round(dx * AbsCosA); + dy := Bottom - Top - Round(neededsize * AbsCosA + dx * AbsSinA) + neededsize; + CosA := -1; SinA := 0; + end; + + 180: + begin + x := Right; + y := Bottom; + dx := Right - Left; + dy := Bottom - Top; + end; + + 181..269: + begin + x := Right; + dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA); + y := Bottom - Round(dx * AbsSinA); + dy := y - Top - Round(neededsize * AbsCosA) + neededsize; + CosA := -1; SinA := 0; + end; + + 270: + begin + x := Right; + y := Top; + dx := Bottom - Top; + dy := Right - Left; + end; + + 271..359: + begin + y := Top; + dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA); + x := Left + Round(neededsize * AbsSinA); + dy := Bottom - Top - Round(dx * AbsSinA + neededsize * AbsCosA) + neededsize; + CosA := 1; SinA := 0; + end; + end; + + if VAlign = vaBottom then + begin + y := y + Round(CosA * (dy - neededSize)); + x := x + Round(SinA * (dy - neededSize)); + end + else if VAlign = vaCenter then + begin + y := y + Round(CosA * (dy - neededSize) / 2); + x := x + Round(SinA * (dy - neededSize) / 2); + end; + + CosA := cos(pi / 180 * FRotation); + SinA := sin(pi / 180 * FRotation); + end; + +begin + n := FText.Count; + if (n = 0) or (FHTMLTags.Count = 0) then exit; // no text to draw + + FCanvas.Lock; + try + PPI := GetDeviceCaps(C.Handle, LOGPIXELSY); + if IsPrinter(C) then + h := -Round(FFontSize * PPI * FPrintScale / 72) else + h := -Round(FFontSize * FScaleY * 96 / 72); + C.Font := FCanvas.Font; + C.Font.Height := h; + + if FHTMLTags[0].Count > 0 then + begin + Tag := FHTMLTags[0].Items[0]; + if not Tag.Default then + begin + C.Font.Style := Tag.Style; + C.Font.Color := Tag.Color; + if IsPrinter(C) then + C.Font.Height := -Round(Tag.Size * PPI * FPrintScale / 72) else + C.Font.Height := -Round(Tag.Size * FScaleY * 96 / 72); + end; + Tag.Default := True; + end; + + fh := 0; oldfh := 0; + if FRotation <> 0 then + begin + fh := CreateRotatedFont(C.Font, FRotation); + oldfh := SelectObject(C.Handle, fh); + end; + + Sz := -C.Font.Height; + PrnSz := -FCanvas.Font.Height; + if IsPrinter(C) then + begin + ratio := FDefPPI / PPI / FPrintScale; + neededSize := Round((prnSz * n + FLineSpacing * FScaleY * ratio * n) / ratio) + end + else + begin + ratio := FDefPPI / 96; + neededSize := Round((prnSz * n + FLineSpacing * ratio * n) / ratio * FScaleY); + end; + extraSize := neededSize - (Sz * n + Round(FLineSpacing * FScaleY) * n); + + if not FWysiwyg then + extraSize := 0; + + CalcRotatedCoords; + + GetMem(Ar, SizeOf(Integer) * n); + for i := 0 to n - 2 do + Ar[i] := Round(FLineSpacing * FScaleY) + Sz; + + if extraSize < 0 then + begin + extraSize := -extraSize; + add3 := -1; + end + else + add3 := 1; + + if n > 1 then + if extraSize < n then + IncArray(Ar, 0, n - 2, extraSize, add3) + else if n > 1 then + begin + add1 := extraSize div (n - 1) * add3; + for i := 0 to n - 2 do + Inc(Ar[i], add1); + IncArray(Ar, 0, n - 2, extraSize - add1 * (n - 1) * add3, add3) + end; + + SetBkMode(C.Handle, Transparent); + + for i := 0 to n - 1 do + begin + gx := 0; + al := HAlign; + par := Integer(FText.Objects[i]); + if (par and 1) <> 0 then + if HAlign in [haLeft, haBlock] then + gx := Round(FParagraphGap * FScaleX); + if (par and 2) <> 0 then + if HAlign = haBlock then + if FRTLReading then + al := haRight else + al := haLeft; + + DrawTextLine(C, FText[i], x + gx, y, dx - gx, i, al, fh, oldfh); + Inc(y, Round(Ar[i] * CosA)); + Inc(x, Round(Ar[i] * SinA)); + end; + + FreeMem(Ar, SizeOf(Integer) * n); + + if FRotation <> 0 then + begin + SelectObject(C.Handle, oldfh); + DeleteObject(fh); + end; + + finally + FCanvas.Unlock; + end; +end; + +function TfrxDrawText.UnusedSpace: Extended; +var + PrnSz: Integer; + n: Integer; + ratio: Extended; +begin + FCanvas.Lock; + try + PrnSz := -FCanvas.Font.Height; + ratio := FDefPPI / FScrPPI; + + // number of lines that will fit in the bounds + n := Trunc((FOriginalRect.Bottom - FOriginalRect.Top + 1) / + (PrnSz / ratio + FLineSpacing)); + if n = 0 then + Result := 0 + else + begin + Result := (FOriginalRect.Bottom - FOriginalRect.Top + 1) - + (PrnSz / ratio + FLineSpacing) * n; + if Result = 0 then + Result := 1e-4; + end; + finally + FCanvas.Unlock; + end; +end; + +function TfrxDrawText.CalcHeight: Extended; +var + PrnSz: Integer; + n: Integer; + ratio: Extended; +begin + n := FText.Count; + if n = 0 then + begin + Result := 0; + Exit; + end; + FCanvas.Lock; + try + PrnSz := -FCanvas.Font.Height; + finally + FCanvas.Unlock; + end; + ratio := FDefPPI / FScrPPI; + Result := (PrnSz / ratio + FLineSpacing) * n; +end; + +function TfrxDrawText.CalcWidth: Extended; +var + Sz: TSize; + s: WideString; + i, maxWidth, par: Integer; + ratio: Extended; +begin + if FText.Count = 0 then + begin + Result := 0; + Exit; + end; + + ratio := FDefPPI / FScrPPI; + maxWidth := 0; + FCanvas.Lock; + try + for i := 0 to FText.Count - 1 do + begin + s := FText[i]; + GetTextExtentPointW(FCanvas.Handle, PWideChar(s), Length(s), Sz); + Inc(Sz.cx, Round(Length(s) * FCharSpacing * ratio)); + + par := Integer(FText.Objects[i]); + if (par and 1) <> 0 then + Inc(Sz.cx, Round(FParagraphGap * ratio)); + + if maxWidth < Sz.cx then + maxWidth := Sz.cx; + end; + finally + FCanvas.Unlock; + end; + + Result := maxWidth / ratio; +end; + +function TfrxDrawText.LineHeight: Extended; +var + PrnSz: Integer; + ratio: Extended; +begin + FCanvas.Lock; + try + PrnSz := -FCanvas.Font.Height; + finally + FCanvas.Unlock; + end; + ratio := FDefPPI / FScrPPI; + Result := PrnSz / ratio + FLineSpacing; +end; + +function TfrxDrawText.GetOutBoundsText(var ParaBreak: Boolean): WideString; +var + PrnSz: Integer; + n, vl: Integer; + ratio: Extended; + Tag: TfrxHTMLTags; + cl: LongInt; +begin + ParaBreak := False; + Result := ''; + n := FText.Count; + if n = 0 then Exit; + + FCanvas.Lock; + try + PrnSz := -FCanvas.Font.Height; + ratio := FDefPPI / FScrPPI; + + // number of lines that will fit in the bounds + vl := Trunc((FOriginalRect.Bottom - FOriginalRect.Top + 1) / (PrnSz / ratio + FLineSpacing)); + if vl > n then + vl := n; + + if vl < FHTMLTags.Count then + begin + // deleting all outbounds text + while FText.Count > vl do + FText.Delete(FText.Count - 1); + + if Integer(FText.Objects[vl - 1]) in [0, 1] then + ParaBreak := True; + + Tag := FHTMLTags[vl]; + Result := Copy(FPlainText, Tag[0].Position, Length(FPlainText) - Tag[0].Position + 1); + if ParaBreak then + if (Length(Result) > 0) and (Result[1] = ' ') then + Delete(Result, 1, 1); + Delete(FPlainText, Tag[0].Position, Length(FPlainText) - Tag[0].Position + 1); + + if FHTMLTags.AllowTags then + begin + if fsBold in Tag[0].Style then + Result := '' + Result; + if fsItalic in Tag[0].Style then + Result := '' + Result; + if fsUnderline in Tag[0].Style then + Result := '' + Result; + cl := ColorToRGB(Tag[0].Color); + cl := (cl and $00FF0000) div 65536 + (cl and $000000FF) * 65536 + (cl and $0000FF00); + Result := '' + Result; + end; + end; + finally + FCanvas.Unlock; + end; +end; + +function TfrxDrawText.GetInBoundsText: WideString; +begin + Result := FPlainText; +end; + +function TfrxDrawText.IsPrinter(C: TCanvas): Boolean; +begin + Result := C is TfrxPrinterCanvas; +end; + +procedure TfrxDrawText.Lock; +begin + while FLocked do + Application.ProcessMessages; + FLocked := True; +end; + +procedure TfrxDrawText.Unlock; +begin + FLocked := False; +end; + +function TfrxDrawText.GetWrappedText: WideString; +begin + Result := FText.Text; +end; + +function TfrxDrawText.TextHeight: Extended; +var + PrnSz: Integer; + ratio: Extended; +begin + FCanvas.Lock; + try + PrnSz := -FCanvas.Font.Height; + finally + FCanvas.Unlock; + end; + ratio := FDefPPI / FScrPPI; + Result := PrnSz / ratio; +end; + +initialization + frxDrawText := TfrxDrawText.Create; + + +finalization + frxDrawText.Free; + + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxIBO4.bpk b/official/4.2/Source/frxIBO4.bpk new file mode 100644 index 0000000..22710e8 --- /dev/null +++ b/official/4.2/Source/frxIBO4.bpk @@ -0,0 +1,190 @@ +# --------------------------------------------------------------------------- +!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 = frxIBO4.bpl +OBJFILES = frxRegIBO.obj frxIBO4.obj +RESFILES = frx4.res frxReg.dcr +RESDEPEN = $(RESFILES) +LIBFILES = +LIBRARIES = +SPARELIBS = VCL40.lib +PACKAGES = vcl40.bpi vclsmp40.bpi fs4.bpi frx4.bpi IBO40CRT_C4.bpi IBO40FRT_C4.bpi IBO40TRT_C4.bpi IBO40VRT_C4.bpi IBO40XRT_C4.bpi + +DEFFILE = +# --------------------------------------------------------------------------- +PATHCPP = .; +PATHASM = .; +PATHPAS = .; +PATHRC = .; +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release;..\FastScript +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 4.0 IBO 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/4.2/Source/frxIBO4.cpp b/official/4.2/Source/frxIBO4.cpp new file mode 100644 index 0000000..3fcbcba --- /dev/null +++ b/official/4.2/Source/frxIBO4.cpp @@ -0,0 +1,24 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("frx4.res"); +USEPACKAGE("vcl40.bpi"); +USEUNIT("frxRegIBO.pas"); +USERES("frxReg.dcr"); +USEPACKAGE("IBO40CRT_C4.bpi"); +USEPACKAGE("IBO40FRT_C4.bpi"); +USEPACKAGE("IBO40TRT_C4.bpi"); +USEPACKAGE("IBO40VRT_C4.bpi"); +USEPACKAGE("IBO40XRT_C4.bpi"); +USEPACKAGE("fs4.bpi"); +USEPACKAGE("frx4.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/4.2/Source/frxIBO4.dpk b/official/4.2/Source/frxIBO4.dpk new file mode 100644 index 0000000..22ef3d8 --- /dev/null +++ b/official/4.2/Source/frxIBO4.dpk @@ -0,0 +1,44 @@ +// Package file for Delphi 4 + +package frxIBO4; + +{$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, + IBO40CRT_D4, + IBO40FRT_D4, + IBO40TRT_D4, + IBO40VRT_D4, + IBO40XRT_D4, + frx4, + fs4; + +contains + frxIBOSet in 'frxIBOSet.pas'; + +end. diff --git a/official/4.2/Source/frxIBO5.bpk b/official/4.2/Source/frxIBO5.bpk new file mode 100644 index 0000000..2257ae9 --- /dev/null +++ b/official/4.2/Source/frxIBO5.bpk @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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 + + \ No newline at end of file diff --git a/official/4.2/Source/frxIBO5.cpp b/official/4.2/Source/frxIBO5.cpp new file mode 100644 index 0000000..0439cc5 --- /dev/null +++ b/official/4.2/Source/frxIBO5.cpp @@ -0,0 +1,24 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("frx5.res"); +USEUNIT("frxRegIBO.pas"); +USERES("frxReg.dcr"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("IBO40CRT_C5.bpi"); +USEPACKAGE("IBO40FRT_C5.bpi"); +USEPACKAGE("IBO40TRT_C5.bpi"); +USEPACKAGE("IBO40VRT_C5.bpi"); +USEPACKAGE("IBO40XRT_C5.bpi"); +USEPACKAGE("fs5.bpi"); +USEPACKAGE("frx5.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/4.2/Source/frxIBO5.dpk b/official/4.2/Source/frxIBO5.dpk new file mode 100644 index 0000000..ddc33e4 --- /dev/null +++ b/official/4.2/Source/frxIBO5.dpk @@ -0,0 +1,44 @@ +// Package file for Delphi 5 + +package frxIBO5; + +{$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, + IBO40CRT_D5, + IBO40FRT_D5, + IBO40TRT_D5, + IBO40VRT_D5, + IBO40XRT_D5, + frx5, + fs5; + +contains + frxIBOSet in 'frxIBOSet.pas'; + +end. diff --git a/official/4.2/Source/frxIBO6.bpk b/official/4.2/Source/frxIBO6.bpk new file mode 100644 index 0000000..e615af5 --- /dev/null +++ b/official/4.2/Source/frxIBO6.bpk @@ -0,0 +1,136 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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)\Projects;$(BCB)\include;$(BCB)\include\vcl + +[HistoryLists\hlLibraryPath] +Count=1 +Item0=$(BCB)\Projects;$(BCB)\lib\obj;$(BCB)\lib + +[HistoryLists\hlDebugSourcePath] +Count=1 +Item0=$(BCB)\source\vcl + +[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/4.2/Source/frxIBO6.cpp b/official/4.2/Source/frxIBO6.cpp new file mode 100644 index 0000000..48ce892 --- /dev/null +++ b/official/4.2/Source/frxIBO6.cpp @@ -0,0 +1,18 @@ +//--------------------------------------------------------------------------- + +#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/4.2/Source/frxIBO6.dpk b/official/4.2/Source/frxIBO6.dpk new file mode 100644 index 0000000..fe3a07f --- /dev/null +++ b/official/4.2/Source/frxIBO6.dpk @@ -0,0 +1,44 @@ +// Package file for Delphi 6 + +package frxIBO6; + +{$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, + IBO40CRT_D6, + IBO40FRT_D6, + IBO40TRT_D6, + IBO40VRT_D6, + IBO40XRT_D6, + frx6, + fs6; + +contains + frxIBOSet in 'frxIBOSet.pas'; + +end. diff --git a/official/4.2/Source/frxIBO7.dpk b/official/4.2/Source/frxIBO7.dpk new file mode 100644 index 0000000..aa9d09e --- /dev/null +++ b/official/4.2/Source/frxIBO7.dpk @@ -0,0 +1,44 @@ +// Package file for Delphi 7 + +package frxIBO7; + +{$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, + IBO40CRT_D7, + IBO40FRT_D7, + IBO40TRT_D7, + IBO40VRT_D7, + IBO40XRT_D7, + frx7, + fs7; + +contains + frxIBOSet in 'frxIBOSet.pas'; + +end. diff --git a/official/4.2/Source/frxIBOSet.pas b/official/4.2/Source/frxIBOSet.pas new file mode 100644 index 0000000..1370bd6 --- /dev/null +++ b/official/4.2/Source/frxIBOSet.pas @@ -0,0 +1,398 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ IBO DB dataset } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxIBOSet; + +interface + +{$I frx.inc} + +uses + SysUtils, Windows, Messages, Classes, frxClass, IB_Components, IB_Header +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TfrxIBODataset = class(TfrxCustomDBDataset) + private + FBookmark: String; + FDataSet: TIB_DataSet; + FDataSource: TIB_DataSource; + FEof: Boolean; + procedure SetDataSet(Value: TIB_DataSet); + procedure SetDataSource(Value: TIB_DataSource); + function DataSetActive: Boolean; + function IsDataSetStored: Boolean; + protected + FDS: TIB_DataSet; + function GetDisplayText(Index: String): WideString; override; + function GetDisplayWidth(Index: String): Integer; override; + function GetFieldType(Index: String): TfrxFieldType; override; + function GetValue(Index: String): Variant; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + procedure Initialize; override; + procedure Finalize; override; + procedure First; override; + procedure Next; override; + procedure Prior; override; + procedure Open; override; + procedure Close; override; + function Eof: Boolean; override; + + function GetDataSet: TIB_DataSet; + function IsBlobField(const fName: String): Boolean; override; + procedure AssignBlobTo(const fName: String; Obj: TObject); override; + procedure GetFieldList(List: TStrings); override; + published + property DataSet: TIB_DataSet read FDataSet write SetDataSet stored IsDataSetStored; + property DataSource: TIB_DataSource read FDataSource write SetDataSource stored IsDataSetStored; + end; + + +implementation + +uses frxUtils, frxRes, frxUnicodeUtils; + +type + EDSError = class(Exception); + + +{ TfrxIBODataset } + +procedure TfrxIBODataset.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited; + if Operation = opRemove then + if AComponent = FDataSource then + DataSource := nil + else if AComponent = FDataSet then + DataSet := nil +end; + +procedure TfrxIBODataset.SetDataSet(Value: TIB_DataSet); +begin + FDataSet := Value; + if Value <> nil then + FDataSource := nil; + FDS := GetDataSet; +end; + +procedure TfrxIBODataset.SetDataSource(Value: TIB_DataSource); +begin + FDataSource := Value; + if Value <> nil then + FDataSet := nil; + FDS := GetDataSet; +end; + +function TfrxIBODataset.DataSetActive: Boolean; +begin + Result := (FDS <> nil) and FDS.Active; +end; + +function TfrxIBODataset.GetDataset: TIB_DataSet; +begin + if FDataSet <> nil then + Result := FDataSet + else if (FDataSource <> nil) and (FDataSource.DataSet <> nil) then + Result := FDataSource.DataSet + else + Result := nil; +end; + +function TfrxIBODataset.IsDataSetStored: Boolean; +begin + Result := Report = nil; +end; + +procedure TfrxIBODataset.Initialize; +begin + if FDS = nil then + raise Exception.Create(Format(frxResources.Get('dbNotConn'), [Name])); + + FEof := False; + FInitialized := False; +end; + +procedure TfrxIBODataset.Finalize; +begin + if FDS = nil then Exit; + if FBookMark <> '' then + FDS.Bookmark := FBookmark; + FBookMark := ''; + + if CloseDataSource then + Close; + FInitialized := False; +end; + +procedure TfrxIBODataset.Open; +var + i: Integer; +begin + if FInitialized then + Exit; + + FInitialized := True; + FDS.Open; + if (RangeBegin = rbCurrent) or (RangeEnd = reCurrent) then + FBookmark := FDS.Bookmark else + FBookmark := ''; + + GetFieldList(Fields); + for i := 0 to Fields.Count - 1 do + Fields.Objects[i] := FDS.FindField(ConvertAlias(Fields[i])); + + inherited; +end; + +procedure TfrxIBODataset.Close; +begin + inherited; + + if FBookMark <> '' then + FDS.Bookmark := FBookmark; + FBookMark := ''; + + FInitialized := False; + FDS.Close; +end; + +procedure TfrxIBODataset.First; +begin + if not FInitialized then + Open; + + if RangeBegin = rbFirst then + FDS.First else + FDS.Bookmark := FBookmark; + FEof := False; + inherited First; +end; + +procedure TfrxIBODataset.Next; +begin + if not FInitialized then + Open; + + FEof := False; + if RangeEnd = reCurrent then + begin + if FDS.Bookmark = FBookmark then + FEof := True; + Exit; + end; + if not Eof then FDS.Next; + inherited Next; +end; + +procedure TfrxIBODataset.Prior; +begin + if not FInitialized then + Open; + + FDS.Prior; + inherited Prior; +end; + +function TfrxIBODataset.Eof: Boolean; +begin + if not FInitialized then + Open; + + Result := inherited Eof or FDS.Eof or FEof; + if FDS.Eof then + begin + if not FDS.Bof then + try + FDS.Prior; + except + end; + FEof := True; + end; +end; + +function TfrxIBODataset.GetDisplayText(Index: String): WideString; +var + i: Integer; +begin + if not FInitialized then + Open; + + if DataSetActive then + if Fields.Count = 0 then + Result := FDS.FieldByName(Index).DisplayText + else + begin + i := Fields.IndexOf(Index); + if i <> -1 then + Result := TIB_Column(Fields.Objects[i]).DisplayText + else + begin + Result := frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' + + Index + '"'; + ReportRef.Errors.Add(ReportRef.CurObject + ': ' + Result); + end; + end + else + Result := UserName + '."' + Index + '"'; +end; + +function TfrxIBODataset.GetValue(Index: String): Variant; +var + i: Integer; + f: TIB_Column; +begin + if not FInitialized then + Open; + + i := Fields.IndexOf(Index); + if i <> -1 then + begin + f := TIB_Column(Fields.Objects[i]); + if f.IsCurrencyDataType then + Result := f.AsCurrency + else + Result := f.Value + end + else + begin + Result := Null; + ReportRef.Errors.Add(ReportRef.CurObject + ': ' + + frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' + Index + '"'); + end; +end; + +function TfrxIBODataset.GetDisplayWidth(Index: String): Integer; +var + f: TIB_Column; +// fDef: TFieldDef; +begin + Result := 10; + Index := ConvertAlias(Index); + f := FDS.FindField(Index); + if f <> nil then + Result := f.DisplayWidth div 7 +{ else + begin + try + if not FDS.FieldDefs.Updated then + FDS.FieldDefs.Update; + except + end; + fDef := FDS.FieldDefs.Find(Index); + if fDef <> nil then + case fDef.DataType of + ftString: Result := fDef.Size; + ftLargeInt: Result := 15; + ftDateTime: Result := 20; + end; + end;} +end; + +function TfrxIBODataset.GetFieldType(Index: String): TfrxFieldType; +var + f: TIB_Column; +begin + Result := fftNumeric; + f := FDS.FindField(ConvertAlias(Index)); + if f <> nil then + if (f.SqlType = SQL_TEXT) or (f.SqlType = SQL_TEXT_) or + (f.SqlType = SQL_VARYING) or (f.SqlType = SQL_VARYING_) then + Result := fftString + else if f.IsBoolean then + Result := fftBoolean; +end; + +procedure TfrxIBODataset.AssignBlobTo(const fName: String; Obj: TObject); +var + Field: TIB_Column; + BlobStream: TStream; + sl: TStringList; +begin + if not FInitialized then + Open; + Field := TIB_Column(Fields.Objects[Fields.IndexOf(fName)]); + + if Obj is TWideStrings then + begin + BlobStream := TMemoryStream.Create; + sl := TStringList.Create; + try + Field.AssignTo(BlobStream); + BlobStream.Position := 0; + sl.LoadFromStream(BlobStream); + TWideStrings(Obj).Assign(sl); + finally + BlobStream.Free; + sl.Free; + end; + end + else if Obj is TStream then + begin + Field.AssignTo(Obj); + TStream(Obj).Position := 0; + end; +end; + +procedure TfrxIBODataset.GetFieldList(List: TStrings); +var + i: Integer; + tempList: TStringList; +begin + List.Clear; + tempList := TStringList.Create; + + if FieldAliases.Count = 0 then + begin + if FDS <> nil then + try + FDS.Prepare; + FDS.GetFieldNamesList(tempList); + for i := 0 to tempList.Count - 1 do + List.Add(Copy(tempList[i], Pos('.', tempList[i]) + 1, 255)); + except + end; + end + else + begin + for i := 0 to FieldAliases.Count - 1 do + List.Add(FieldAliases.Values[FieldAliases.Names[i]]); + end; + + tempList.Free; +end; + +function TfrxIBODataset.IsBlobField(const fName: String): Boolean; +var + Field: TIB_Column; + i: Integer; +begin + if not FInitialized then + Open; + + Result := False; + i := Fields.IndexOf(fName); + if i <> -1 then + begin + Field := TIB_Column(Fields.Objects[i]); + Result := (Field <> nil) and (Field.SQLType >= 520) and (Field.SQLType <= 541); + end; +end; + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxInheritError.dfm b/official/4.2/Source/frxInheritError.dfm new file mode 100644 index 0000000..4748d12 Binary files /dev/null and b/official/4.2/Source/frxInheritError.dfm differ diff --git a/official/4.2/Source/frxInheritError.pas b/official/4.2/Source/frxInheritError.pas new file mode 100644 index 0000000..7f8f35b --- /dev/null +++ b/official/4.2/Source/frxInheritError.pas @@ -0,0 +1,76 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Inherit error dialog } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxInheritError; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ImgList, ExtCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TfrxInheritErrorForm = class(TForm) + OkB: TButton; + CancelB: TButton; + MessageL: TLabel; + DeleteRB: TRadioButton; + RenameRB: TRadioButton; + PaintBox1: TPaintBox; + ImageList1: TImageList; + procedure FormCreate(Sender: TObject); + procedure PaintBox1Paint(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + + +implementation + +{$R *.dfm} + +uses frxRes; + +procedure TfrxInheritErrorForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(6000); + OkB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + MessageL.Caption := frxGet(6001); + DeleteRB.Caption := frxGet(6002); + RenameRB.Caption := frxGet(6003); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxInheritErrorForm.PaintBox1Paint(Sender: TObject); +begin + with PaintBox1 do + begin + Canvas.Brush.Color := Color; + Canvas.FillRect(Rect(0, 0, 32, 32)); + ImageList1.Draw(Canvas, 0, 0, 0); + end; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxInsp.dfm b/official/4.2/Source/frxInsp.dfm new file mode 100644 index 0000000..f0264f4 Binary files /dev/null and b/official/4.2/Source/frxInsp.dfm differ diff --git a/official/4.2/Source/frxInsp.pas b/official/4.2/Source/frxInsp.pas new file mode 100644 index 0000000..248281f --- /dev/null +++ b/official/4.2/Source/frxInsp.pas @@ -0,0 +1,1141 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Object Inspector } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxInsp; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ExtCtrls, StdCtrls, Buttons, frxDsgnIntf, frxPopupForm, + frxClass, Menus, ComCtrls +{$IFDEF UseTabset} +, Tabs +{$ENDIF} +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxObjectInspector = class(TForm) + ObjectsCB: TComboBox; + PopupMenu1: TPopupMenu; + N11: TMenuItem; + N21: TMenuItem; + N31: TMenuItem; + BackPanel: TPanel; + Box: TScrollBox; + PB: TPaintBox; + Edit1: TEdit; + EditPanel: TPanel; + EditBtn: TSpeedButton; + ComboPanel: TPanel; + ComboBtn: TSpeedButton; + HintPanel: TScrollBox; + Splitter1: TSplitter; + PropL: TLabel; + DescrL: TLabel; + N41: TMenuItem; + N51: TMenuItem; + N61: TMenuItem; + procedure PBPaint(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure PBMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure PBMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure PBMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure Edit1KeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure Edit1KeyPress(Sender: TObject; var Key: Char); + procedure EditBtnClick(Sender: TObject); + procedure ComboBtnClick(Sender: TObject); + procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure ObjectsCBClick(Sender: TObject); + procedure ObjectsCBDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure PBDblClick(Sender: TObject); + procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure FormEndDock(Sender, Target: TObject; X, Y: Integer); + procedure ComboBtnMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure FormShow(Sender: TObject); + procedure TabChange(Sender: TObject); + procedure N11Click(Sender: TObject); + procedure N21Click(Sender: TObject); + procedure N31Click(Sender: TObject); + procedure FormDeactivate(Sender: TObject); + private + { Private declarations } + FDesigner: TfrxCustomDesigner; + FDisableDblClick: Boolean; + FDisableUpdate: Boolean; + FDown: Boolean; + FEventList: TfrxPropertyList; + FHintWindow: THintWindow; + FItemIndex: Integer; + FLastPosition: String; + FList: TfrxPropertyList; + FPopupForm: TfrxPopupForm; + FPopupLB: TListBox; + FPopupLBVisible: Boolean; + FPropertyList: TfrxPropertyList; + FPanel: TPanel; + FRowHeight: Integer; + FSelectedObjects: TList; + FSplitterPos: Integer; +{$IFDEF UseTabset} + FTabs: TTabSet; +{$ELSE} + FTabs: TTabControl; +{$ENDIF} + FTempBMP: TBitmap; + FTempList: TList; + FTickCount: UInt; + FUpdatingObjectsCB: Boolean; + FUpdatingPB: Boolean; + FOnSelectionChanged: TNotifyEvent; + FOnModify: TNotifyEvent; + + function Count: Integer; + function GetItem(Index: Integer): TfrxPropertyItem; + function GetName(Index: Integer): String; + function GetOffset(Index: Integer): Integer; + function GetType(Index: Integer): TfrxPropertyAttributes; + function GetValue(Index: Integer): String; + procedure AdjustControls; + procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave; + procedure DrawOneLine(i: Integer; Selected: Boolean); + procedure DoModify; + procedure SetObjects(Value: TList); + procedure SetItemIndex(Value: Integer); + procedure SetSelectedObjects(Value: TList); + procedure SetValue(Index: Integer; Value: String); + procedure LBClick(Sender: TObject); + function GetSplitter1Pos: Integer; + procedure SetSplitter1Pos(const Value: Integer); + public + { Public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure DisableUpdate; + procedure EnableUpdate; + procedure Inspect(AObjects: array of TPersistent); + procedure SetColor(Color: TColor); + procedure UpdateProperties; + property Objects: TList write SetObjects; + property ItemIndex: Integer read FItemIndex write SetItemIndex; + property SelectedObjects: TList read FSelectedObjects write SetSelectedObjects; + property SplitterPos: Integer read FSplitterPos write FSplitterPos; + property Splitter1Pos: Integer read GetSplitter1Pos write SetSplitter1Pos; + property OnModify: TNotifyEvent read FOnModify write FOnModify; + property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; + end; + + +implementation + +{$R *.DFM} + +uses frxUtils, frxRes, frxrcInsp; + + +type + TInspPanel = class(TPanel) + protected + procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND; + procedure Paint; override; + end; + + THackWinControl = class(TWinControl); + + +{ TInspPanel } + +procedure TInspPanel.WMEraseBackground(var Message: TMessage); +begin +// empty method +end; + +procedure TInspPanel.Paint; +begin +// empty method +end; + + +{ TfrxObjectInspector } + +constructor TfrxObjectInspector.Create(AOwner: TComponent); +begin + if not (AOwner is TfrxCustomDesigner) then + raise Exception.Create('The Owner of the object inspector should be TfrxCustomDesigner'); + inherited Create(AOwner); + FItemIndex := -1; + FTempBMP := TBitmap.Create; + FTempList := TList.Create; + FDesigner := TfrxCustomDesigner(AOwner); + FHintWindow := THintWindow.Create(Self); + FHintWindow.Color := clInfoBk; + + FPanel := TInspPanel.Create(Self); + with FPanel do + begin + Parent := Box; + BevelInner := bvNone; + BevelOuter := bvNone; + end; + PB.Parent := FPanel; + ComboPanel.Parent := FPanel; + EditPanel.Parent := FPanel; + Edit1.Parent := FPanel; +{$IFDEF UseTabset} + Box.BevelKind := bkFlat; + HintPanel.BevelKind := bkFlat; +{$ELSE} + Box.BorderStyle := bsSingle; + HintPanel.BorderStyle := bsSingle; +{$IFDEF Delphi7} + Box.ControlStyle := Box.ControlStyle + [csNeedsBorderPaint]; + HintPanel.ControlStyle := HintPanel.ControlStyle + [csNeedsBorderPaint]; +{$ENDIF} +{$ENDIF} + + FRowHeight := Canvas.TextHeight('Wg') + 3; + with Box.VertScrollBar do + begin + Increment := FRowHeight; + Tracking := True; + end; + +{$IFDEF UseTabset} + FTabs := TTabSet.Create(Self); + FTabs.OnClick := TabChange; + FTabs.ShrinkToFit := True; + FTabs.Style := tsSoftTabs; + FTabs.TabPosition := tpTop; +{$ELSE} + FTabs := TTabControl.Create(Self); + FTabs.OnChange := TabChange; +{$ENDIF} + FTabs.Parent := Self; + FTabs.SendToBack; + FTabs.Tabs.Add(frxResources.Get('oiProp')); + FTabs.Tabs.Add(frxResources.Get('oiEvent')); + FTabs.TabIndex := 0; + + if Screen.PixelsPerInch > 96 then + ObjectsCB.ItemHeight := 19; + FSplitterPos := PB.Width div 2; + AutoScroll := False; + + FormResize(nil); + + Caption := frxGet(2000); +end; + +destructor TfrxObjectInspector.Destroy; +begin + FTempBMP.Free; + FTempList.Free; + if FPropertyList <> nil then + FPropertyList.Free; + if FEventList <> nil then + FEventList.Free; + inherited; +end; + +procedure TfrxObjectInspector.UpdateProperties; +begin + SetSelectedObjects(FSelectedObjects); +end; + +procedure TfrxObjectInspector.Inspect(AObjects: array of TPersistent); +var + i: Integer; +begin + FTempList.Clear; + for i := Low(AObjects) to High(AObjects) do + FTempList.Add(AObjects[i]); + Objects := FTempList; + SelectedObjects := FTempList; +end; + +function TfrxObjectInspector.GetSplitter1Pos: Integer; +begin + Result := HintPanel.Height; +end; + +procedure TfrxObjectInspector.SetSplitter1Pos(const Value: Integer); +begin + HintPanel.Height := Value; +end; + +procedure TfrxObjectInspector.DisableUpdate; +begin + FDisableUpdate := True; +end; + +procedure TfrxObjectInspector.EnableUpdate; +begin + FDisableUpdate := False; +end; + +procedure TfrxObjectInspector.SetColor(Color: TColor); +begin + ObjectsCB.Color := Color; + Box.Color := Color; + PB.Repaint; +end; + +procedure TfrxObjectInspector.SetObjects(Value: TList); +var + i: Integer; + s: String; +begin + ObjectsCB.Items.Clear; + for i := 0 to Value.Count - 1 do + begin + if TObject(Value[i]) is TComponent then + s := TComponent(Value[i]).Name + ': ' + TComponent(Value[i]).ClassName else + s := ''; + ObjectsCB.Items.AddObject(s, Value[i]); + end; +end; + +procedure TfrxObjectInspector.SetSelectedObjects(Value: TList); +var + i: Integer; + s: String; + + procedure CreateLists; + var + i: Integer; + p: TfrxPropertyItem; + s: String; + begin + if FPropertyList <> nil then + FPropertyList.Free; + if FEventList <> nil then + FEventList.Free; + FEventList := nil; + + FPropertyList := frxCreatePropertyList(Value, FDesigner); + if FPropertyList <> nil then + begin + FEventList := TfrxPropertyList.Create(FDesigner); + + i := 0; + while i < FPropertyList.Count do + begin + p := FPropertyList[i]; + s := p.Editor.PropInfo.PropType^.Name; + if (Pos('Tfrx', s) = 1) and (Pos('Event', s) = Length(s) - 4) then + p.Collection := FEventList else + Inc(i); + end; + end; + + if FTabs.TabIndex = 0 then + FList := FPropertyList else + FList := FEventList; + end; + +begin + FSelectedObjects := Value; + CreateLists; + + FUpdatingObjectsCB := True; + if FSelectedObjects.Count = 1 then + begin + ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]); + if ObjectsCB.ItemIndex = -1 then + begin + s := TComponent(FSelectedObjects[0]).Name + ': ' + + TComponent(FSelectedObjects[0]).ClassName; + ObjectsCB.Items.AddObject(s, FSelectedObjects[0]); + ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]); + end; + end + else + ObjectsCB.ItemIndex := -1; + FUpdatingObjectsCB := False; + + FItemIndex := -1; + FormResize(nil); + if Count > 0 then + begin + for i := 0 to Count - 1 do + if GetName(i) = FLastPosition then + begin + ItemIndex := i; + Exit; + end; + s := FLastPosition; + ItemIndex := 0; + FLastPosition := s; + end; +end; + +function TfrxObjectInspector.Count: Integer; + + function EnumProperties(p: TfrxPropertyList): Integer; + var + i: Integer; + begin + Result := 0; + for i := 0 to p.Count - 1 do + begin + Inc(Result); + if (p[i].SubProperty <> nil) and p[i].Expanded then + Inc(Result, EnumProperties(p[i].SubProperty)); + end; + end; + +begin + if FList <> nil then + Result := EnumProperties(FList) else + Result := 0; +end; + +function TfrxObjectInspector.GetItem(Index: Integer): TfrxPropertyItem; + + function EnumProperties(p: TfrxPropertyList; var Index: Integer): TfrxPropertyItem; + var + i: Integer; + begin + Result := nil; + for i := 0 to p.Count - 1 do + begin + Dec(Index); + if Index < 0 then + begin + Result := p[i]; + break; + end; + if (p[i].SubProperty <> nil) and p[i].Expanded then + Result := EnumProperties(p[i].SubProperty, Index); + if Index < 0 then + break; + end; + end; + +begin + if (Index >= 0) and (Index < Count) then + Result := EnumProperties(FList, Index) else + Result := nil; +end; + +function TfrxObjectInspector.GetOffset(Index: Integer): Integer; +var + p: TfrxPropertyList; +begin + Result := 0; + p := TfrxPropertyList(GetItem(Index).Collection); + while p.Parent <> nil do + begin + Inc(Result); + p := p.Parent; + end; +end; + +function TfrxObjectInspector.GetName(Index: Integer): String; +begin + Result := GetItem(Index).Editor.GetName; +end; + +function TfrxObjectInspector.GetType(Index: Integer): TfrxPropertyAttributes; +begin + Result := GetItem(Index).Editor.GetAttributes; +end; + +function TfrxObjectInspector.GetValue(Index: Integer): String; +begin + Result := GetItem(Index).Editor.Value; +end; + +procedure TfrxObjectInspector.DoModify; +var + i: Integer; +begin + if FSelectedObjects.Count = 1 then + begin + i := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]); + if TObject(FSelectedObjects[0]) is TComponent then + ObjectsCB.Items.Strings[i] := TComponent(FSelectedObjects[0]).Name + ': ' + + TComponent(FSelectedObjects[0]).ClassName; + ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]); + end; + + if Assigned(FOnModify) then + FOnModify(Self); +end; + +procedure TfrxObjectInspector.SetItemIndex(Value: Integer); +var + p: TfrxPropertyItem; + s: String; +begin + PropL.Caption := ''; + DescrL.Caption := ''; + if Value > Count - 1 then + Value := Count - 1; + if Value < 0 then + Value := -1; + + Edit1.Visible := Count > 0; + if Count = 0 then Exit; + + if FItemIndex <> -1 then + if Edit1.Modified then + SetValue(FItemIndex, Edit1.Text); + FItemIndex := Value; + + if FItemIndex <> -1 then + begin + FLastPosition := GetName(FItemIndex); + p := GetItem(FItemIndex); + s := GetName(FItemIndex); + PropL.Caption := s; + if TfrxPropertyList(p.Collection).Component <> nil then + begin + s := 'prop' + s + '.' + TfrxPropertyList(p.Collection).Component.ClassName; + if frxResources.Get(s) = s then + s := frxResources.Get('prop' + GetName(FItemIndex)) else + s := frxResources.Get(s); + DescrL.Caption := s; + end; + end; + + AdjustControls; +end; + +procedure TfrxObjectInspector.SetValue(Index: Integer; Value: String); +begin + try + GetItem(Index).Editor.Value := Value; + DoModify; + PBPaint(nil); + except + on E: Exception do + begin + frxErrorMsg(E.Message); + Edit1.Text := GetItem(Index).Editor.Value; + end; + end; +end; + +procedure TfrxObjectInspector.AdjustControls; +var + PropType: TfrxPropertyAttributes; + y, ww: Integer; +begin + if (csDocking in ControlState) or FDisableUpdate then Exit; + if FItemIndex = -1 then + begin + EditPanel.Visible := False; + ComboPanel.Visible := False; + Edit1.Visible := False; + FUpdatingPB := False; + PBPaint(nil); + Exit; + end; + + FUpdatingPB := True; + PropType := GetType(FItemIndex); + + EditPanel.Visible := paDialog in PropType; + ComboPanel.Visible := paValueList in PropType; + Edit1.ReadOnly := paReadOnly in PropType; + + ww := PB.Width - FSplitterPos - 2; + y := FItemIndex * FRowHeight + 1; + if EditPanel.Visible then + begin + EditPanel.SetBounds(PB.Width - 15, y - 1, 15, FRowHeight - 1); + EditBtn.SetBounds(0, 0, EditPanel.Width, EditPanel.Height); + Dec(ww, 15); + end; + if ComboPanel.Visible then + begin + ComboPanel.SetBounds(PB.Width - 15, y - 1, 15, FRowHeight - 1); + ComboBtn.SetBounds(0, 0, ComboPanel.Width, ComboPanel.Height); + Dec(ww, 15); + end; + + Edit1.Text := GetValue(FItemIndex); + Edit1.Modified := False; + Edit1.SetBounds(FSplitterPos + 2, y, ww, FRowHeight - 2); + Edit1.SelectAll; + + if y + FRowHeight > Box.VertScrollBar.Position + Box.ClientHeight then + Box.VertScrollBar.Position := y - Box.ClientHeight + FRowHeight; + if y < Box.VertScrollBar.Position then + Box.VertScrollBar.Position := y - 1; + + FUpdatingPB := False; + PBPaint(nil); +end; + +procedure TfrxObjectInspector.DrawOneLine(i: Integer; Selected: Boolean); +var + R: TRect; + s: String; + p: TfrxPropertyItem; + offs, add: Integer; + + procedure Line(x, y, dx, dy: Integer); + begin + FTempBMP.Canvas.MoveTo(x, y); + FTempBMP.Canvas.LineTo(x + dx, y + dy); + end; + + procedure DrawProperty; + var + x, y: Integer; + begin + x := offs + GetOffset(i) * (12 + add); + y := 1 + i * FRowHeight; + + with FTempBMP.Canvas do + begin + Pen.Color := clGray; + Brush.Color := clWhite; + + if offs < 12 then + begin + Rectangle(x + 1, y + 2 + add, x + 10, y + 11 + add); + Line(x + 3, y + 6 + add, 5, 0); + if s[1] = '+' then + Line(x + 5, y + 4 + add, 0, 5); + + s := Copy(s, 2, 255); + Inc(x, 12 + add); + end; + + Brush.Style := bsClear; + if ((s = 'Name') or (s = 'Width') or (s = 'Height') or (s = 'Left') or (s = 'Top')) + and (GetOffset(i) = 0) then + Font.Style := [fsBold]; + TextRect(R, x, y, s); + end; + end; + +begin + if Count > 0 then + with FTempBMP.Canvas do + begin + Pen.Color := clBtnShadow; + Font.Assign(Self.Font); + R := Rect(0, i * FRowHeight, FSplitterPos, i * FRowHeight + FRowHeight - 1); + + if Screen.PixelsPerInch > 96 then + add := 2 + else + add := 0; + p := GetItem(i); + s := GetName(i); + if p.SubProperty <> nil then + begin + offs := 1 + add; + if p.Expanded then + s := '-' + s else + s := '+' + s; + end + else + offs := 13 + add; + + p.Editor.ItemHeight := FRowHeight; + + if Selected then + begin + Pen.Color := clBtnFace; + Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0); + Brush.Color := clBtnFace; + FillRect(R); + DrawProperty; + end + else + begin + Pen.Color := clBtnFace; + Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0); + Pen.Color := clBtnFace; + Line(FSplitterPos - 1, 0 + i * FRowHeight, 0, FRowHeight); + DrawProperty; + Font.Color := clNavy; + if paOwnerDraw in p.Editor.GetAttributes then + p.Editor.OnDrawItem(FTempBMP.Canvas, + Rect(FSplitterPos + 2, 1 + i * FRowHeight, Width, 1 + (i + 1) * FRowHeight)) + else + TextOut(FSplitterPos + 2, 1 + i * FRowHeight, GetValue(i)); + end; + end; +end; + + +{ Form events } + +procedure TfrxObjectInspector.FormShow(Sender: TObject); +begin + AdjustControls; +end; + +procedure TfrxObjectInspector.FormResize(Sender: TObject); +var + h: Integer; +begin + if Screen.PixelsPerInch > 96 then + h := 26 + else + h := 22; + FTabs.SetBounds(0, ObjectsCB.Top + ObjectsCB.Height + 4, ClientWidth, h); +{$IFDEF UseTabset} + BackPanel.Top := FTabs.Top + FTabs.Height - 1; +{$ELSE} + BackPanel.Top := FTabs.Top + FTabs.Height - 2; +{$ENDIF} + BackPanel.Width := ClientWidth; + BackPanel.Height := ClientHeight - BackPanel.Top; + ObjectsCB.Width := ClientWidth; + + FPanel.Height := Count * FRowHeight; + FPanel.Width := Box.ClientWidth; + AdjustControls; +end; + +procedure TfrxObjectInspector.FormEndDock(Sender, Target: TObject; X, Y: Integer); +begin + FormResize(nil); +end; + +procedure TfrxObjectInspector.TabChange(Sender: TObject); +begin + if FDesigner.IsPreviewDesigner then + begin + FTabs.TabIndex := 0; + Exit; + end; + if FTabs.TabIndex = 0 then + FList := FPropertyList else +{$IFNDEF FR_VER_BASIC} + FList := FEventList; +{$ELSE} + FTabs.TabIndex := 0; +{$ENDIF} + FItemIndex := -1; + FormResize(nil); +end; + +procedure TfrxObjectInspector.N11Click(Sender: TObject); +begin + if Edit1.Visible then + Edit1.CutToClipboard; +end; + +procedure TfrxObjectInspector.N21Click(Sender: TObject); +begin + if Edit1.Visible then + Edit1.PasteFromClipboard; +end; + +procedure TfrxObjectInspector.N31Click(Sender: TObject); +begin + if Edit1.Visible then + Edit1.CopyToClipboard; +end; + +procedure TfrxObjectInspector.FormDeactivate(Sender: TObject); +begin + if FDisableUpdate then Exit; + SetItemIndex(FItemIndex); +end; + + +{ PB events } + +procedure TfrxObjectInspector.PBPaint(Sender: TObject); +var + i: Integer; + r: TRect; +begin + if FUpdatingPB then Exit; + + r := PB.BoundsRect; + FTempBMP.Width := PB.Width; + FTempBMP.Height := PB.Height; + with FTempBMP.Canvas do + begin + Brush.Color := Box.Color; + FillRect(r); + end; + + if not FDisableUpdate then + begin + for i := 0 to Count - 1 do + if i <> ItemIndex then + DrawOneLine(i, False); + if FItemIndex <> -1 then + DrawOneLine(ItemIndex, True); + end; + + PB.Canvas.Draw(0, 0, FTempBMP); +end; + +procedure TfrxObjectInspector.PBMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + p: TfrxPropertyItem; + n, x1: Integer; +begin + FDisableDblClick := False; + if Count = 0 then Exit; + if PB.Cursor = crHSplit then + FDown := True + else + begin + n := Y div FRowHeight; + + if (X > FSplitterPos) and (X < FSplitterPos + 15) and + (n >= 0) and (n < Count) then + begin + p := GetItem(n); + if p.Editor.ClassName = 'TfrxBooleanProperty' then + begin + p.Editor.Edit; + DoModify; + PBPaint(nil); + Exit; + end; + end; + + ItemIndex := n; + Edit1.SetFocus; + FTickCount := GetTickCount; + + p := GetItem(ItemIndex); + x1 := GetOffset(ItemIndex) * 12; + if (X > x1) and (X < x1 + 13) and (p.SubProperty <> nil) then + begin + p.Expanded := not p.Expanded; + FormResize(nil); + FDisableDblClick := True; + end; + end; +end; + +procedure TfrxObjectInspector.PBMouseUp(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + FDown := False; +end; + +procedure TfrxObjectInspector.PBMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + n, OffsetX, MaxWidth: Integer; + s: String; + HideHint: Boolean; + + procedure ShowHint(const s: String; x, y: Integer); + var + HintRect: TRect; + p: TPoint; + begin + p := PB.ClientToScreen(Point(x - 2, y - 2)); + HintRect := FHintWindow.CalcHintRect(1000, s, nil); + OffsetRect(HintRect, p.X, p.Y); + FHintWindow.ActivateHint(HintRect, s); + HideHint := False; + end; + +begin + HideHint := True; + + if not FDown then + begin + if (X > FSplitterPos - 4) and (X < FSplitterPos + 2) then + PB.Cursor := crHSplit + else + begin + PB.Cursor := crDefault; + + { hint window } + n := Y div FRowHeight; + if (X > 12) and (n >= 0) and (n < Count) then + begin + if X <= FSplitterPos - 4 then + begin + OffsetX := (GetOffset(n) + 1) * 12; + s := GetName(n); + MaxWidth := FSplitterPos - OffsetX; + end + else + begin + OffsetX := FSplitterPos + 1; + s := GetValue(n); + MaxWidth := PB.ClientWidth - FSplitterPos; + if n = ItemIndex then + MaxWidth := 1000; + end; + + if PB.Canvas.TextWidth(s) > MaxWidth then + ShowHint(s, OffsetX, n * FRowHeight); + end; + end; + end + else + begin + if (x > 30) and (x < PB.ClientWidth - 30) then + FSplitterPos := X; + AdjustControls; + end; + + if HideHint then + FHintWindow.ReleaseHandle; +end; + +procedure TfrxObjectInspector.PBDblClick(Sender: TObject); +var + p: TfrxPropertyItem; +begin + if (Count = 0) or FDisableDblClick then Exit; + + p := GetItem(ItemIndex); + if p.SubProperty <> nil then + begin + p.Expanded := not p.Expanded; + FormResize(nil); + end; +end; + + +{ Edit1 events } + +procedure TfrxObjectInspector.Edit1MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if GetTickCount - FTickCount < GetDoubleClickTime then + EditBtnClick(nil); +end; + +procedure TfrxObjectInspector.Edit1KeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + i: Integer; +begin + if Count = 0 then Exit; + if Key = vk_Escape then + begin + Edit1.Perform(EM_UNDO, 0, 0); + Edit1.Modified := False; + end; + if Key = vk_Up then + begin + if ItemIndex > 0 then + ItemIndex := ItemIndex - 1; + Key := 0; + end + else if Key = vk_Down then + begin + if ItemIndex < Count - 1 then + ItemIndex := ItemIndex + 1; + Key := 0; + end + else if Key = vk_Prior then + begin + i := Box.Height div FRowHeight; + i := ItemIndex - i; + if i < 0 then + i := 0; + ItemIndex := i; + Key := 0; + end + else if Key = vk_Next then + begin + i := Box.Height div FRowHeight; + i := ItemIndex + i; + ItemIndex := i; + Key := 0; + end; +end; + +procedure TfrxObjectInspector.Edit1KeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + begin + if paDialog in GetType(ItemIndex) then + EditBtnClick(nil) + else + begin + if Edit1.Modified then + SetValue(ItemIndex, Edit1.Text); + Edit1.Modified := False; + end; + Edit1.SelectAll; + Key := #0; + end; +end; + + +{ EditBtn and ComboBtn events } + +procedure TfrxObjectInspector.EditBtnClick(Sender: TObject); +begin + if GetItem(ItemIndex).Editor.Edit then + begin + ItemIndex := FItemIndex; + DoModify; + end; +end; + +procedure TfrxObjectInspector.ComboBtnMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + FPopupLBVisible := GetTickCount - frxPopupFormCloseTime < 100; +end; + +procedure TfrxObjectInspector.ComboBtnClick(Sender: TObject); +var + i, wItems, nItems: Integer; + p: TPoint; +begin + if FPopupLBVisible then + Edit1.SetFocus + else + begin + FPopupForm := TfrxPopupForm.Create(Self); + FPopupLB := TListBox.Create(FPopupForm); + with FPopupLB do + begin + Parent := FPopupForm; + Ctl3D := False; + Align := alClient; + if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then + Style := lbOwnerDrawFixed; + ItemHeight := FRowHeight; + OnClick := LBClick; + OnDrawItem := GetItem(FItemIndex).Editor.OnDrawLBItem; + GetItem(FItemIndex).Editor.GetValues; + Items.Assign(GetItem(FItemIndex).Editor.Values); + + if Items.Count > 0 then + begin + ItemIndex := Items.IndexOf(GetValue(FItemIndex)); + wItems := 0; + for i := 0 to Items.Count - 1 do + begin + if Canvas.TextWidth(Items[i]) > wItems then + wItems := Canvas.TextWidth(Items[i]); + end; + + Inc(wItems, 8); + if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then + Inc(wItems, GetItem(FItemIndex).Editor.GetExtraLBSize); + nItems := Items.Count; + if nItems > 8 then + begin + nItems := 8; + Inc(wItems, GetSystemMetrics(SM_CXVSCROLL)); + end; + + p := Edit1.ClientToScreen(Point(0, Edit1.Height)); + + if wItems < PB.Width - FSplitterPos then + FPopupForm.SetBounds(p.X - 3, p.Y, + PB.Width - FSplitterPos + 1, nItems * ItemHeight + 2) + else + FPopupForm.SetBounds(p.X + (PB.Width - FSplitterPos - wItems) - 2, p.Y, + wItems, nItems * ItemHeight + 2); + if FPopupForm.Left < 0 then + FPopupForm.Left := 0; + if FPopupForm.Top + FPopupForm.Height > Screen.Height then + FPopupForm.Top := Screen.Height - FPopupForm.Height; + FDisableUpdate := True; + FPopupForm.Show; + FDisableUpdate := False; + end; + end; + end; +end; + +procedure TfrxObjectInspector.LBClick(Sender: TObject); +begin + Edit1.Text := FPopupLB.Items[FPopupLB.ItemIndex]; + FPopupForm.Hide; + Edit1.SetFocus; + Edit1.SelectAll; + SetValue(ItemIndex, Edit1.Text); +end; + + +{ ObjectsCB events } + +procedure TfrxObjectInspector.ObjectsCBClick(Sender: TObject); +begin + if FUpdatingObjectsCB then Exit; + + FSelectedObjects.Clear; + if ObjectsCB.ItemIndex <> -1 then + FSelectedObjects.Add(ObjectsCB.Items.Objects[ObjectsCB.ItemIndex]); + SetSelectedObjects(FSelectedObjects); + Edit1.SetFocus; + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self); +end; + +procedure TfrxObjectInspector.ObjectsCBDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + if FDisableUpdate then exit; + with ObjectsCB.Canvas do + begin + FillRect(Rect); + if Index <> -1 then + TextOut(Rect.Left + 2, Rect.Top + 1, ObjectsCB.Items[Index]); + end; +end; + + +{ Mouse wheel } + +procedure TfrxObjectInspector.FormMouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + with Box.VertScrollBar do + Position := Position + FRowHeight; +end; + +procedure TfrxObjectInspector.FormMouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + with Box.VertScrollBar do + Position := Position - FRowHeight; +end; + +procedure TfrxObjectInspector.CMMouseLeave(var Msg: TMessage); +begin + FHintWindow.ReleaseHandle; + inherited; +end; + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxNewItem.dfm b/official/4.2/Source/frxNewItem.dfm new file mode 100644 index 0000000..8fdb63e Binary files /dev/null and b/official/4.2/Source/frxNewItem.dfm differ diff --git a/official/4.2/Source/frxNewItem.pas b/official/4.2/Source/frxNewItem.pas new file mode 100644 index 0000000..f0d1261 --- /dev/null +++ b/official/4.2/Source/frxNewItem.pas @@ -0,0 +1,176 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ New item dialog } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxNewItem; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, StdCtrls, ImgList; + +type + TfrxNewItemForm = class(TForm) + Pages: TPageControl; + ItemsTab: TTabSheet; + OkB: TButton; + CancelB: TButton; + TemplateTab: TTabSheet; + InheritCB: TCheckBox; + TemplateLV: TListView; + ItemsLV: TListView; + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ItemsLVDblClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + { Private declarations } + FTemplates: TStringList; + public + { Public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + +implementation + +{$R *.DFM} + +uses frxClass, frxDesgn, frxDsgnIntf, frxUtils, frxRes; + + +constructor TfrxNewItemForm.Create(AOwner: TComponent); +begin + inherited; + FTemplates := TStringList.Create; + FTemplates.Sorted := True; +end; + +destructor TfrxNewItemForm.Destroy; +begin + FTemplates.Free; + inherited; +end; + +procedure TfrxNewItemForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(5300); + ItemsTab.Caption := frxGet(5301); + TemplateTab.Caption := frxGet(5302); + InheritCB.Caption := frxGet(5303); + OkB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + ItemsLV.LargeImages := frxResources.WizardImages; + TemplateLV.LargeImages := frxResources.WizardImages; + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxNewItemForm.FormShow(Sender: TObject); +var + i: Integer; + Item: TfrxWizardItem; + lvItem: TListItem; +begin + for i := 0 to frxWizards.Count - 1 do + begin + Item := frxWizards[i]; + if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then + begin + frxResources.SetWizardImages(Item.ButtonBmp); + Item.ButtonImageIndex := frxResources.WizardImages.Count - 1; + end; + + lvItem := ItemsLV.Items.Add; + lvItem.Caption := Item.ClassRef.GetDescription; + lvItem.Data := Item; + lvItem.ImageIndex := Item.ButtonImageIndex; + end; + + if frxDesignerComp <> nil then + begin + frxDesignerComp.GetTemplateList(FTemplates); + for i := 0 to FTemplates.Count - 1 do + begin + lvItem := TemplateLV.Items.Add; + lvItem.Caption := ExtractFileName(FTemplates[i]); + lvItem.Data := Pointer(i); + lvItem.ImageIndex := 5; + end; + end; +end; + +procedure TfrxNewItemForm.ItemsLVDblClick(Sender: TObject); +begin + ModalResult := mrOk; +end; + +procedure TfrxNewItemForm.FormDestroy(Sender: TObject); +var + w: TfrxCustomWizard; + Designer: TfrxDesignerForm; + Report: TfrxReport; + templ: String; +begin + if ModalResult = mrOk then + begin + if (Pages.ActivePage = ItemsTab) and (ItemsLV.Selected <> nil) then + begin + w := TfrxCustomWizard(TfrxWizardItem(ItemsLV.Selected.Data).ClassRef.NewInstance); + w.Create(Owner); + if w.Execute then + w.Designer.Modified := True; + w.Free; + end + else if (Pages.ActivePage = TemplateTab) and (TemplateLV.Selected <> nil) then + begin + Designer := TfrxDesignerForm(Owner); + Report := Designer.Report; + templ := FTemplates[Integer(TemplateLV.Selected.Data)]; + Designer.Lock; + try + Report.Clear; + if InheritCB.Checked then + Report.ParentReport := ExtractRelativePath( + Report.GetApplicationFolder, templ) + else + begin + if Assigned(Report.OnLoadTemplate) then + Report.OnLoadTemplate(Report, templ) + else + Report.LoadFromFile(templ); + end; + finally + Report.FileName := ''; + Designer.ReloadReport; + end; + end; + end; +end; + +procedure TfrxNewItemForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxOLE.pas b/official/4.2/Source/frxOLE.pas new file mode 100644 index 0000000..faee066 --- /dev/null +++ b/official/4.2/Source/frxOLE.pas @@ -0,0 +1,287 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ OLE object } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxOLE; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + OleCtnrs, StdCtrls, ExtCtrls, frxClass, ActiveX +{$IFDEF Delphi6} +, Variants +{$ENDIF} +{$IFDEF FR_COM} +, FastReport_TLB +{$ENDIF}; + + +type + TfrxSizeMode = (fsmClip, fsmScale); + + TfrxOLEObject = class(TComponent) // fake component + end; + +{$IFDEF FR_COM} + TfrxOLEView = class(TfrxView, IfrxOLEView) +{$ELSE} + TfrxOLEView = class(TfrxView) +{$ENDIF} + private + FOleContainer: TOleContainer; + FSizeMode: TfrxSizeMode; + FStretched: Boolean; + procedure ReadData(Stream: TStream); + procedure SetStretched(const Value: Boolean); + procedure WriteData(Stream: TStream); + protected + procedure DefineProperties(Filer: TFiler); override; +{$IFDEF FR_COM} + function Get_OleContainer(out Value: IUnknown): HResult; stdcall; + function Get_SizeMode(out Value: Integer): HResult; stdcall; + function Set_SizeMode(Value: Integer): HResult; stdcall; + function Get_Stretched(out Value: WordBool): HResult; stdcall; + function Set_Stretched(Value: WordBool): HResult; stdcall; +{$ENDIF} + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; + procedure GetData; override; + class function GetDescription: String; override; + property OleContainer: TOleContainer read FOleContainer; + published + property BrushStyle; + property Color; + property Cursor; + property DataField; + property DataSet; + property DataSetName; + property Frame; + property SizeMode: TfrxSizeMode read FSizeMode write FSizeMode default fsmClip; + property Stretched: Boolean read FStretched write SetStretched default False; + property TagStr; + property URL; + end; + +procedure frxAssignOle(ContFrom, ContTo: TOleContainer); + + +implementation + +uses + frxOLERTTI, +{$IFNDEF NO_EDITORS} + frxOLEEditor, +{$ENDIF} + frxDsgnIntf, frxRes; + + +procedure frxAssignOle(ContFrom, ContTo: TOleContainer); +var + st: TMemoryStream; +begin + if (ContFrom = nil) or (ContFrom.OleObjectInterface = nil) then + begin + ContTo.DestroyObject; + Exit; + end; + st := TMemoryStream.Create; + ContFrom.SaveToStream(st); + st.Position := 0; + ContTo.LoadFromStream(st); + st.Free; +end; + +function HimetricToPixels(const P: TPoint): TPoint; +begin + Result.X := MulDiv(P.X, Screen.PixelsPerInch, 2540); + Result.Y := MulDiv(P.Y, Screen.PixelsPerInch, 2540); +end; + + +{ TfrxOLEView } + +constructor TfrxOLEView.Create(AOwner: TComponent); +begin + inherited; + Font.Name := 'Tahoma'; + Font.Size := 8; + + FOleContainer := TOleContainer.Create(nil); + with FOleContainer do + begin + Parent := frxParentForm; + SendMessage(frxParentForm.Handle, WM_CREATEHANDLE, Integer(FOleContainer), 0); + AllowInPlace := False; + AutoVerbMenu := False; + BorderStyle := bsNone; + SizeMode := smClip; + end; +end; + +destructor TfrxOLEView.Destroy; +begin + SendMessage(frxParentForm.Handle, WM_DESTROYHANDLE, Integer(FOleContainer), 0); + FOleContainer.Free; + inherited; +end; + +class function TfrxOLEView.GetDescription: String; +begin + Result := frxResources.Get('obOLE'); +end; + +procedure TfrxOLEView.DefineProperties(Filer: TFiler); +begin + inherited; + Filer.DefineBinaryProperty('OLE', ReadData, WriteData, + OleContainer.OleObjectInterface <> nil); +end; + +procedure TfrxOLEView.ReadData(Stream: TStream); +begin + FOleContainer.LoadFromStream(Stream); +end; + +procedure TfrxOLEView.WriteData(Stream: TStream); +begin + FOleContainer.SaveToStream(Stream); +end; + +procedure TfrxOLEView.SetStretched(const Value: Boolean); +var + VS: TPoint; +begin + FStretched := Value; + if not Stretched then + with FOleContainer do + if OleObjectInterface <> nil then + begin + Run; + VS.X := MulDiv(Width, 2540, Screen.PixelsPerInch); + VS.Y := MulDiv(Height, 2540, Screen.PixelsPerInch); + OleObjectInterface.SetExtent(DVASPECT_CONTENT, VS); + end; +end; + +procedure TfrxOLEView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); +var + DRect, R: TRect; + W, H: Integer; + ViewObject2: IViewObject2; + S, ViewSize: TPoint; +begin + BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); + DRect := Rect(FX, FY, FX1, FY1); + OleContainer.Width := FDX; + OleContainer.Height := FDY; + DrawBackground; + + if (FDX > 0) and (FDY > 0) then + with OleContainer do + if OleObjectInterface <> nil then + if Self.SizeMode = fsmClip then + OleDraw(OleObjectInterface, DVASPECT_CONTENT, Canvas.Handle, DRect) + else + begin + if Succeeded(OleObjectInterface.QueryInterface(IViewObject2, + ViewObject2)) then + begin + ViewObject2.GetExtent(DVASPECT_CONTENT, -1, nil, ViewSize); + W := DRect.Right - DRect.Left; + H := DRect.Bottom - DRect.Top; + S := HimetricToPixels(ViewSize); + if W * S.Y > H * S.X then + begin + S.X := S.X * H div S.Y; + S.Y := H; + end + else + begin + S.Y := S.Y * W div S.X; + S.X := W; + end; + + R.Left := DRect.Left + (W - S.X) div 2; + R.Top := DRect.Top + (H - S.Y) div 2; + R.Right := R.Left + S.X; + R.Bottom := R.Top + S.Y; + OleDraw(OleObjectInterface, DVASPECT_CONTENT, Canvas.Handle, R); + end + end + else + frxResources.ObjectImages.Draw(Canvas, FX + 1, FY + 2, 22); + + DrawFrame; +end; + +procedure TfrxOLEView.GetData; +var + s: TMemoryStream; +begin + inherited; + if IsDataField then + begin + s := TMemoryStream.Create; + try + DataSet.AssignBlobTo(DataField, s); + FOleContainer.LoadFromStream(s); + finally + s.Free; + end; + end; +end; + +{$IFDEF FR_COM} +function TfrxOLEView.Get_OleContainer(out Value: IUnknown): HResult; stdcall; +begin + Value := OleContainer; + Result := S_OK; +end; + +function TfrxOLEView.Get_SizeMode(out Value: Integer): HResult; stdcall; +begin + Value := Integer(SizeMode); + Result := S_OK; +end; + +function TfrxOLEView.Set_SizeMode(Value: Integer): HResult; stdcall; +begin + SizeMode := TfrxSizeMode(Value); + Result := S_OK; +end; + +function TfrxOLEView.Get_Stretched(out Value: WordBool): HResult; stdcall; +begin + Value := Stretched; + Result := S_OK; +end; + +function TfrxOLEView.Set_Stretched(Value: WordBool): HResult; stdcall; +begin + Stretched := Value; + Result := S_OK; +end; +{$ENDIF} + + +initialization + frxObjects.RegisterObject1(TfrxOLEView, nil, '', '', 0, 22); + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxOLEEditor.dfm b/official/4.2/Source/frxOLEEditor.dfm new file mode 100644 index 0000000..1ee2da4 Binary files /dev/null and b/official/4.2/Source/frxOLEEditor.dfm differ diff --git a/official/4.2/Source/frxOLEEditor.pas b/official/4.2/Source/frxOLEEditor.pas new file mode 100644 index 0000000..ec59ae9 --- /dev/null +++ b/official/4.2/Source/frxOLEEditor.pas @@ -0,0 +1,148 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ OLE design editor } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxOLEEditor; + +interface + +{$I frx.inc} + +uses + Windows, Classes, SysUtils, Graphics, Controls, StdCtrls, Forms, Menus, + Dialogs, frxClass, frxCustomEditors, frxDsgnIntf, frxOLE, OleCtnrs +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxOLEEditor = class(TfrxViewEditor) + public + function Edit: Boolean; override; + function HasEditor: Boolean; override; + procedure GetMenuItems; override; + function Execute(Tag: Integer; Checked: Boolean): Boolean; override; + end; + + TfrxOleEditorForm = class(TForm) + InsertB: TButton; + EditB: TButton; + CloseB: TButton; + OleContainer: TOleContainer; + procedure InsertBClick(Sender: TObject); + procedure EditBClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + { Private declarations } + public + { Public declarations } + end; + + +implementation + +{$R *.DFM} + +uses frxRes; + + +{ TfrxOLEEditor } + +function TfrxOLEEditor.HasEditor: Boolean; +begin + Result := True; +end; + +function TfrxOLEEditor.Edit: Boolean; +begin + with TfrxOleEditorForm.Create(Designer) do + begin + frxAssignOLE(TfrxOLEView(Component).OleContainer, OleContainer); + Result := ShowModal = mrOk; + if Result then + frxAssignOLE(OleContainer, TfrxOLEView(Component).OleContainer); + Free; + end; +end; + +function TfrxOLEEditor.Execute(Tag: Integer; Checked: Boolean): Boolean; +var + i: Integer; + c: TfrxComponent; + v: TfrxOLEView; +begin + Result := inherited Execute(Tag, Checked); + for i := 0 to Designer.SelectedObjects.Count - 1 do + begin + c := Designer.SelectedObjects[i]; + if (c is TfrxOLEView) and not (rfDontModify in c.Restrictions) then + begin + v := TfrxOLEView(c); + if Tag = 1 then + v.Stretched := Checked; + Result := True; + end; + end; +end; + +procedure TfrxOLEEditor.GetMenuItems; +var + v: TfrxOLEView; +begin + v := TfrxOLEView(Component); + AddItem(frxResources.Get('olStretched'), 1, v.Stretched); + inherited; +end; + + +{ TfrxOLEEditorForm } + +procedure TfrxOleEditorForm.InsertBClick(Sender: TObject); +begin + OleContainer.InsertObjectDialog; +end; + +procedure TfrxOleEditorForm.EditBClick(Sender: TObject); +begin + if OleContainer.OleObjectInterface <> nil then + OleContainer.DoVerb(ovPrimary); +end; + +procedure TfrxOleEditorForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(3400); + InsertB.Caption := frxGet(3401); + EditB.Caption := frxGet(3402); + CloseB.Caption := frxGet(3403); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + + +procedure TfrxOleEditorForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +initialization + frxComponentEditors.Register(TfrxOLEView, TfrxOLEEditor); + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxOLERTTI.pas b/official/4.2/Source/frxOLERTTI.pas new file mode 100644 index 0000000..50866d2 --- /dev/null +++ b/official/4.2/Source/frxOLERTTI.pas @@ -0,0 +1,70 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ OLE RTTI } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxOLERTTI; + +interface + +{$I frx.inc} + +implementation + +uses + Windows, Classes, SysUtils, Forms, fs_iinterpreter, frxOLE, frxClassRTTI +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TFunctions = class(TfsRTTIModule) + private + 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('TfrxSizeMode', 'fsmClip, fsmScale'); + with AddClass(TfrxOLEView, 'TfrxView') do + AddProperty('OleContainer', 'TOleContainer', GetProp, nil); + end; +end; + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TfrxOLEView then + begin + if PropName = 'OLECONTAINER' then + Result := Integer(TfrxOLEView(Instance).OleContainer) + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPBarcode.pas b/official/4.2/Source/frxPBarcode.pas new file mode 100644 index 0000000..f8808ce --- /dev/null +++ b/official/4.2/Source/frxPBarcode.pas @@ -0,0 +1,206 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ PSOFT Barcode Add-in object } +{ http://www.psoft.sk } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPBarcode; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Menus, EanKod, EanSpecs, frxClass, ExtCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPBarCodeObject = class(TComponent); // fake component + + TfrxPBarCodeView = class(TfrxView) + private + FBarCode: TEan; + FExpression: String; + FText: String; + FLinesColor: TColor; + FBarType: TTypBarCode; + FRotation: Integer; + FFontAutoSize: Boolean; + FCalcCheckSum: Boolean; + FShowText: Boolean; + function GetPDF417: TpsPDF417; + function GetSecurity: Boolean; + function GetHorzLines: TBarcodeHorzLines; + function GetStartStopLine: Boolean; + function GetTrasparent: Boolean; + procedure SetPDF417(const Value: TpsPDF417); + procedure SetSecurity(const Value: Boolean); + procedure SetHorzLines(const Value: TBarcodeHorzLines); + procedure SetStartStopLines(const Value: Boolean); + procedure SetTrasparent(const Value: Boolean); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; + procedure GetData; override; + class function GetDescription: String; override; + property BarCode: TEan read FBarCode; + published + property HorzLines: TBarcodeHorzLines read GetHorzLines write SetHorzLines; + property Security: Boolean read GetSecurity write SetSecurity; + property PDF417: TpsPDF417 read GetPDF417 write SetPDF417; + property StartStopLines: Boolean read GetStartStopLine write SetStartStopLines; + property Trasparent: Boolean read GetTrasparent write SetTrasparent; + property LinesColor: TColor read FLinesColor write FLinesColor default clBlack; + property BarType: TTypBarCode read FBarType write FBarType; + property Rotation: Integer read FRotation write FRotation; + property Font; + property FontAutoSize: Boolean read FFontAutoSize write FFontAutoSize default True; + property CalcCheckSum: Boolean read FCalcCheckSum write FCalcCheckSum default False; + property ShowText: Boolean read FShowText write FShowText default True; + property Color; + property DataField; + property DataSet; + property DataSetName; + property Expression: String read FExpression write FExpression; + property Frame; + property Text: String read FText write FText; + end; + + +implementation + +uses +{$IFNDEF NO_EDITORS} + frxPBarcodeEditor, +{$ENDIF} + frxPBarcodeRTTI, frxDsgnIntf, frxRes; + + + +{ TfrxPBarCodeView } + +constructor TfrxPBarCodeView.Create(AOwner: TComponent); +begin + inherited; + FBarCode := TEan.Create(nil); + FLinesColor := clBlack; + FFontAutoSize := True; + FShowText := True; +end; + +destructor TfrxPBarCodeView.Destroy; +begin + FBarCode.Free; + inherited Destroy; +end; + +class function TfrxPBarCodeView.GetDescription: String; +begin + Result := 'PSOFT Barcode object'; +end; + +procedure TfrxPBarCodeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, + OffsetY: Extended); +begin + FBarCode.LinesColor := FLinesColor; + FBarCode.BackgroundColor := Color; + FBarCode.Transparent := Color = clNone; + + FBarCode.Angle := FRotation; + FBarCode.Font.Assign(Font); + FBarCode.FontAutoSize := FFontAutoSize; + + FBarCode.AutoCheckDigit := FCalcCheckSum; + FBarCode.TypBarCode := FBarType; + if FText <> '' then + FBarCode.BarCode := FText; + FBarcode.ShowLabels := FShowText; + + BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); + PaintBarCode(Canvas, Rect(FX, FY, FX1, FY1), FBarCode); + DrawFrame; +end; + +procedure TfrxPBarCodeView.GetData; +begin + inherited; + if IsDataField then + FText := DataSet.Value[DataField] + else if FExpression <> '' then + FText := Report.Calc(FExpression); +end; + + +function TfrxPBarCodeView.GetPDF417: TpsPDF417; +begin + Result := FBarCode.PDF417; +end; + +procedure TfrxPBarCodeView.SetPDF417(const Value: TpsPDF417); +begin + FBarCode.PDF417 := Value; +end; + +function TfrxPBarCodeView.GetSecurity: Boolean; +begin + Result := FBarCode.Security; +end; + +procedure TfrxPBarCodeView.SetSecurity(const Value: Boolean); +begin + FBarCode.Security := Value; +end; + +function TfrxPBarCodeView.GetHorzLines: TBarcodeHorzLines; +begin + Result := FBarCode.HorzLines; +end; + +procedure TfrxPBarCodeView.SetHorzLines(const Value: TBarcodeHorzLines); +begin + FBarCode.HorzLines := Value; +end; + +function TfrxPBarCodeView.GetStartStopLine: Boolean; +begin + Result := FBarCode.StartStopLines; +end; + +procedure TfrxPBarCodeView.SetStartStopLines(const Value: Boolean); +begin + FBarCode.StartStopLines := Value; +end; + +function TfrxPBarCodeView.GetTrasparent: Boolean; +begin + Result := FBarCode.Transparent; +end; + +procedure TfrxPBarCodeView.SetTrasparent(const Value: Boolean); +begin + FBarCode.Transparent := Value; +end; + +initialization + frxObjects.RegisterObject1(TfrxPBarCodeView, nil, '', 'Other', 0, 23); + + + +end. + + +//a925ad72a1da9d8873ffb721772811b5 + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPBarcodeEditor.dfm b/official/4.2/Source/frxPBarcodeEditor.dfm new file mode 100644 index 0000000..d0ccdc8 Binary files /dev/null and b/official/4.2/Source/frxPBarcodeEditor.dfm differ diff --git a/official/4.2/Source/frxPBarcodeEditor.pas b/official/4.2/Source/frxPBarcodeEditor.pas new file mode 100644 index 0000000..386d4a3 --- /dev/null +++ b/official/4.2/Source/frxPBarcodeEditor.pas @@ -0,0 +1,241 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ PSOFT Barcode design editor } +{ http://www.psoft.sk } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPBarcodeEditor; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Menus, ExtCtrls, Buttons, frxClass, frxPBarcode, frxCustomEditors, + EanKod, EanSpecs, frxCtrls, ComCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPBarcodeEditor = class(TfrxViewEditor) + public + function Edit: Boolean; override; + function HasEditor: Boolean; override; + procedure GetMenuItems; override; + function Execute(Tag: Integer; Checked: Boolean): Boolean; override; + end; + + TfrxPBarcodeEditorForm = class(TForm) + CancelB: TButton; + OkB: TButton; + CodeE: TfrxComboEdit; + CodeLbl: TLabel; + TypeCB: TComboBox; + TypeLbl: TLabel; + ExampleBvl: TBevel; + ExamplePB: TPaintBox; + OptionsLbl: TGroupBox; + CalcCheckSumCB: TCheckBox; + ViewTextCB: TCheckBox; + RotationLbl: TGroupBox; + Rotation0RB: TRadioButton; + Rotation90RB: TRadioButton; + Rotation180RB: TRadioButton; + Rotation270RB: TRadioButton; + procedure ExprBtnClick(Sender: TObject); + procedure ExamplePBPaint(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + { Private declarations } + FBarcode: TfrxPBarcodeView; + public + { Public declarations } + property Barcode: TfrxPBarcodeView read FBarcode write FBarcode; + end; + + +implementation + +uses frxDsgnIntf, frxRes, frxUtils; + +{$R *.DFM} + + +{ TfrxPBarcodeEditor } + +function TfrxPBarcodeEditor.HasEditor: Boolean; +begin + Result := True; +end; + +function TfrxPBarcodeEditor.Edit: Boolean; +begin + with TfrxPBarcodeEditorForm.Create(Designer) do + begin + Barcode := TfrxPBarcodeView(Component); + Result := ShowModal = mrOk; + Free; + end; +end; + +function TfrxPBarcodeEditor.Execute(Tag: Integer; Checked: Boolean): Boolean; +var + i: Integer; + c: TfrxComponent; + v: TfrxPBarcodeView; +begin + Result := inherited Execute(Tag, Checked); + for i := 0 to Designer.SelectedObjects.Count - 1 do + begin + c := Designer.SelectedObjects[i]; + if (c is TfrxPBarcodeView) and not (rfDontModify in c.Restrictions) then + begin + v := TfrxPBarcodeView(c); + if Tag = 1 then + v.CalcCheckSum := Checked + else if Tag = 2 then + v.ShowText := Checked; + Result := True; + end; + end; +end; + +procedure TfrxPBarcodeEditor.GetMenuItems; +var + v: TfrxPBarcodeView; +begin + v := TfrxPBarcodeView(Component); + AddItem(frxResources.Get('bcCalcChecksum'), 1, v.CalcCheckSum); + AddItem(frxResources.Get('bcShowText'), 2, v.ShowText); + inherited; +end; + + +{ TfrxPBarcodeEditorForm } + +procedure TfrxPBarcodeEditorForm.FormShow(Sender: TObject); +begin + FBarcode.BarCode.AddTypesToList(TypeCB.Items, btText); + + CodeE.Text := FBarcode.Text; + TypeCB.ItemIndex := Integer(FBarcode.BarType); + CalcCheckSumCB.Checked := FBarcode.CalcCheckSum; + ViewTextCB.Checked := FBarcode.ShowText; + + case FBarcode.Rotation of + 90: Rotation90RB.Checked := True; + 180: Rotation180RB.Checked := True; + 270: Rotation270RB.Checked := True; + else Rotation0RB.Checked := True; + end; + + ExamplePBPaint(nil); +end; + +procedure TfrxPBarcodeEditorForm.FormHide(Sender: TObject); +begin + if ModalResult = mrOk then + begin + FBarcode.Text := CodeE.Text; + FBarcode.BarType := TTypBarcode(TypeCB.ItemIndex); + FBarcode.CalcCheckSum := CalcCheckSumCB.Checked; + FBarcode.ShowText := ViewTextCB.Checked; + + if Rotation90RB.Checked then + FBarcode.Rotation := 90 + else if Rotation180RB.Checked then + FBarcode.Rotation := 180 + else if Rotation270RB.Checked then + FBarcode.Rotation := 270 + else + FBarcode.Rotation := 0; + end; +end; + +procedure TfrxPBarcodeEditorForm.ExprBtnClick(Sender: TObject); +var + s: String; +begin + s := TfrxCustomDesigner(Owner).InsertExpression(CodeE.Text); + if s <> '' then + CodeE.Text := s; +end; + +procedure TfrxPBarcodeEditorForm.ExamplePBPaint(Sender: TObject); +var + Barcode: TfrxPBarcodeView; +begin + Barcode := TfrxPBarcodeView.Create(nil); + Barcode.BarType := TTypBarcode(TypeCB.ItemIndex); + if Rotation0RB.Checked then + Barcode.Rotation := 0 + else if Rotation90RB.Checked then + Barcode.Rotation := 90 + else if Rotation180RB.Checked then + Barcode.Rotation := 180 + else + Barcode.Rotation := 270; + Barcode.CalcCheckSum := CalcCheckSumCB.Checked; + Barcode.ShowText := ViewTextCB.Checked; + Barcode.SetBounds(20, 20, ExamplePB.Width - 40, 200); + + with ExamplePB.Canvas do + begin + Brush.Color := clWhite; + FillRect(Rect(0, 0, ExamplePB.Width, ExamplePB.Height)); + end; + + Barcode.Draw(ExamplePB.Canvas, 1, 1, 0, 0); + Barcode.Free; +end; + +procedure TfrxPBarcodeEditorForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(3500); + CodeLbl.Caption := frxGet(3501); + TypeLbl.Caption := frxGet(3502); + OptionsLbl.Caption := frxGet(3504); + RotationLbl.Caption := frxGet(3505); + CancelB.Caption := frxGet(2); + OkB.Caption := frxGet(1); + CalcCheckSumCB.Caption := frxGet(3506); + ViewTextCB.Caption := frxGet(3507); + Rotation0RB.Caption := frxGet(3508); + Rotation90RB.Caption := frxGet(3509); + Rotation180RB.Caption := frxGet(3510); + Rotation270RB.Caption := frxGet(3511); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + + +procedure TfrxPBarcodeEditorForm.FormKeyDown(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +initialization + frxComponentEditors.Register(TfrxPBarcodeView, TfrxPBarcodeEditor); + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPBarcodeRTTI.pas b/official/4.2/Source/frxPBarcodeRTTI.pas new file mode 100644 index 0000000..bdd3a5e --- /dev/null +++ b/official/4.2/Source/frxPBarcodeRTTI.pas @@ -0,0 +1,61 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ PSOFT Barcode RTTI } +{ http://www.psoft.sk } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPBarcodeRTTI; + +interface + +{$I frx.inc} + +implementation + +uses + Windows, Classes, SysUtils, Forms, fs_iinterpreter, frxPBarcode, frxClassRTTI +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + + +type + TFunctions = class(TfsRTTIModule) + public + constructor Create(AScript: TfsScript); override; + end; + + +{ TFunctions } + +constructor TFunctions.Create(AScript: TfsScript); +begin + inherited Create(AScript); + with AScript do + begin + AddEnum('TTypBarCode', + 'bcEan8, bcEan13, bcCodabar, bcCode39Standard, bcCode39Full, bcCode93Standard, ' + + 'bcCode93Full, bcCode128, bcABCCodabar, bc25Datalogic, bc25Interleaved, ' + + 'bc25Matrix, bc25Industrial, bc25IATA, bc25Invert, bc25Coop, bcITF, bcISBN, ' + + 'bcISSN, bcISMN, bcUPCA, bcUPCE0, bcUPCE1, bcUPCShipping, bcJAN8, bcJAN13, ' + + 'bcMSIPlessey, bcPostNet, bcOPC, bcEan128, bcCode11, bcPZN, bcPDF417'); + AddClass(TfrxPBarcodeView, 'TfrxView'); + end; +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPassw.dfm b/official/4.2/Source/frxPassw.dfm new file mode 100644 index 0000000..c91be69 Binary files /dev/null and b/official/4.2/Source/frxPassw.dfm differ diff --git a/official/4.2/Source/frxPassw.pas b/official/4.2/Source/frxPassw.pas new file mode 100644 index 0000000..099a46f --- /dev/null +++ b/official/4.2/Source/frxPassw.pas @@ -0,0 +1,61 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Password form } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPassw; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPasswordForm = class(TForm) + OkB: TButton; + CancelB: TButton; + PasswordE: TEdit; + PasswordL: TLabel; + Image1: TImage; + procedure FormCreate(Sender: TObject); + private + public + end; + + +implementation + +{$R *.dfm} + +uses frxRes; + + +procedure TfrxPasswordForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(5000); + PasswordL.Caption := frxGet(5001); + OkB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPictureCache.pas b/official/4.2/Source/frxPictureCache.pas new file mode 100644 index 0000000..4e35012 --- /dev/null +++ b/official/4.2/Source/frxPictureCache.pas @@ -0,0 +1,136 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Picture Cache } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPictureCache; + +interface + +{$I frx.inc} + +uses + Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, frxXML +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPictureCache = class(TObject) + private + FIndex: TStringList; + function Add: TStream; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + procedure AddPicture(Picture: TfrxPictureView); + procedure GetPicture(Picture: TfrxPictureView); + procedure SaveToXML(Item: TfrxXMLItem); + procedure LoadFromXML(Item: TfrxXMLItem); + end; + + +implementation + +uses + frxUtils; + + +{ TfrxPictureCache } + +constructor TfrxPictureCache.Create; +begin + FIndex := TStringList.Create; +end; + +destructor TfrxPictureCache.Destroy; +begin + Clear; + FIndex.Free; + inherited; +end; + +procedure TfrxPictureCache.Clear; +begin + while FIndex.Count > 0 do + begin + TStream(FIndex.Objects[0]).Free; + FIndex.Delete(0); + end; +end; + +function TfrxPictureCache.Add: TStream; +begin + Result := TMemoryStream.Create; + FIndex.AddObject('', Result); +end; + +procedure TfrxPictureCache.AddPicture(Picture: TfrxPictureView); +begin + if Picture.Picture.Graphic = nil then + Picture.ImageIndex := 0 + else + begin + Picture.ImageIndex := FIndex.Count + 1; + Picture.Picture.Graphic.SaveToStream(Add); + end; +end; + +procedure TfrxPictureCache.GetPicture(Picture: TfrxPictureView); +var + s: TStream; +begin + if (Picture.ImageIndex <= 0) or (Picture.ImageIndex > FIndex.Count) then + Picture.Picture.Assign(nil) + else + begin + s := TStream(FIndex.Objects[Picture.ImageIndex - 1]); + s.Position := 0; + Picture.LoadPictureFromStream(s); + end; +end; + +procedure TfrxPictureCache.LoadFromXML(Item: TfrxXMLItem); +var + i: Integer; + xi: TfrxXMLItem; +begin + Clear; + for i := 0 to Item.Count - 1 do + begin + xi := Item[i]; + frxStringToStream(xi.Prop['stream'], Add); + end; +end; + +procedure TfrxPictureCache.SaveToXML(Item: TfrxXMLItem); +var + i: Integer; + s: TStream; + xi: TfrxXMLItem; +begin + Item.Clear; + for i := 0 to FIndex.Count - 1 do + begin + xi := Item.Add; + s := TStream(FIndex.Objects[i]); + s.Position := 0; + xi.Name := 'item'; + xi.Text := 'stream="' + frxStreamToString(s) + '"'; + end; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPopupForm.dfm b/official/4.2/Source/frxPopupForm.dfm new file mode 100644 index 0000000..9e8f0ac Binary files /dev/null and b/official/4.2/Source/frxPopupForm.dfm differ diff --git a/official/4.2/Source/frxPopupForm.pas b/official/4.2/Source/frxPopupForm.pas new file mode 100644 index 0000000..6e07f59 --- /dev/null +++ b/official/4.2/Source/frxPopupForm.pas @@ -0,0 +1,61 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Parent form for pop-up controls } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPopupForm; + +interface + +{$I frx.inc} + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPopupForm = class(TForm) + procedure FormDeactivate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + private + { Private declarations } + public + { Public declarations } + end; + +var + frxPopupFormCloseTime: UInt = 0; + + +implementation + +{$R *.DFM} + + +procedure TfrxPopupForm.FormDeactivate(Sender: TObject); +begin + frxPopupFormCloseTime := GetTickCount; + Close; +end; + +procedure TfrxPopupForm.FormClose(Sender: TObject; + var Action: TCloseAction); +begin + Action := caFree; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPreview.dfm b/official/4.2/Source/frxPreview.dfm new file mode 100644 index 0000000..2ee9dbf Binary files /dev/null and b/official/4.2/Source/frxPreview.dfm differ diff --git a/official/4.2/Source/frxPreview.pas b/official/4.2/Source/frxPreview.pas new file mode 100644 index 0000000..996ba0f --- /dev/null +++ b/official/4.2/Source/frxPreview.pas @@ -0,0 +1,2885 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Report preview } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPreview; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, Buttons, StdCtrls, Menus, ComCtrls, ImgList, frxCtrls, frxDock, +{$IFDEF FR_COM} + FastReport_TLB, +{$ENDIF} + ToolWin, frxPreviewPages, frxClass +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +const + WM_UPDATEZOOM = WM_USER + 1; + +type + TfrxPreview = class; + TfrxPreviewWorkspace = class; + TfrxPageList = class; + + TfrxPreviewTool = (ptHand, ptZoom); // not implemented, backw compatibility only + TfrxPageChangedEvent = procedure(Sender: TfrxPreview; PageNo: Integer) of object; + +{$IFDEF FR_COM} + TfrxPreview = class(TfrxCustomPreview, IfrxPreview) +{$ELSE} + TfrxPreview = class(TfrxCustomPreview) +{$ENDIF} + private + FAllowF3: Boolean; + FBorderStyle: TBorderStyle; + FCancelButton: TButton; + FLocked: Boolean; + FMessageLabel: TLabel; + FMessagePanel: TPanel; + FOnPageChanged: TfrxPageChangedEvent; + FOutline: TTreeView; + FOutlineColor: TColor; + FOutlinePopup: TPopupMenu; + FPageNo: Integer; + FRefreshing: Boolean; + FRunning: Boolean; + FScrollBars: TScrollStyle; + FSplitter: TSplitter; + FThumbnail: TfrxPreviewWorkspace; + FTick: Cardinal; + FTool: TfrxPreviewTool; + FWorkspace: TfrxPreviewWorkspace; + FZoom: Extended; + FZoomMode: TfrxZoomMode; + function GetActiveFrameColor: TColor; + function GetBackColor: TColor; + function GetFrameColor: TColor; + function GetOutlineVisible: Boolean; + function GetOutlineWidth: Integer; + function GetPageCount: Integer; + function GetThumbnailVisible: Boolean; + procedure EditTemplate; + procedure OnCancel(Sender: TObject); + procedure OnCollapseClick(Sender: TObject); + procedure OnExpandClick(Sender: TObject); + procedure OnMoveSplitter(Sender: TObject); + procedure OnOutlineClick(Sender: TObject); + procedure SetActiveFrameColor(const Value: TColor); + procedure SetBackColor(const Value: TColor); + procedure SetBorderStyle(Value: TBorderStyle); + procedure SetFrameColor(const Value: TColor); + procedure SetOutlineColor(const Value: TColor); + procedure SetOutlineWidth(const Value: Integer); + procedure SetOutlineVisible(const Value: Boolean); + procedure SetPageNo(Value: Integer); + procedure SetThumbnailVisible(const Value: Boolean); + procedure SetZoom(const Value: Extended); + procedure SetZoomMode(const Value: TfrxZoomMode); + procedure UpdateOutline; + procedure UpdatePages; + procedure UpdatePageNumbers; + procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND; + procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; + protected + procedure CreateParams(var Params: TCreateParams); override; + procedure Resize; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Init; override; + procedure Lock; override; + procedure Unlock; override; + procedure RefreshReport; override; + procedure InternalOnProgressStart(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); override; + procedure InternalOnProgress(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); override; + procedure InternalOnProgressStop(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); override; + +{$IFDEF FR_COM} + function AddPage: HResult; stdcall; + function DeletePage: HResult; stdcall; + function Print: HResult; stdcall; + function Edit: HResult; stdcall; + function First: HResult; stdcall; + function Next: HResult; stdcall; + function Prior: HResult; stdcall; + function Last: HResult; stdcall; + function PageSetupDlg: HResult; stdcall; + function Find: HResult; stdcall; + function FindNext: HResult; stdcall; + function Cancel: HResult; stdcall; + function Clear: HResult; stdcall; + function SetPosition(PageN, Top: Integer): HResult; stdcall; + function ShowMessage(const s: WideString): HResult; stdcall; + function HideMessage: HResult; stdcall; + function MouseWheelScroll(Delta: Integer; Horz: WordBool; Zoom: WordBool): HResult; stdcall; + function Get_PageCount(out Value: Integer): HResult; stdcall; + function Get_PageNo(out Value: Integer): HResult; stdcall; + function Set_PageNo(Value: Integer): HResult; stdcall; + function Get_Tool(out Value: frxPreviewTool): HResult; stdcall; + function Set_Tool(Value: frxPreviewTool): HResult; stdcall; + function Get_Zoom(out Value: Double): HResult; stdcall; + function Set_Zoom(Value: Double): HResult; stdcall; + function Get_ZoomMode(out Value: frxZoomMode): HResult; stdcall; + function Set_ZoomMode(Value: frxZoomMode): HResult; stdcall; + function Get_OutlineVisible(out Value: WordBool): HResult; stdcall; + function Set_OutlineVisible(Value: WordBool): HResult; stdcall; + function Get_OutlineWidth(out Value: Integer): HResult; stdcall; + function Set_OutlineWidth(Value: Integer): HResult; stdcall; + function Get_Enabled(out Value: WordBool): HResult; stdcall; + function Set_Enabled(Value: WordBool): HResult; stdcall; + function LoadPreparedReportFromFile(const FileName: WideString): HResult; stdcall; + function SavePreparedReportToFile(const FileName: WideString): HResult; stdcall; + function Get_FullScreen(out Value: WordBool): HResult; stdcall; + function Set_FullScreen(Value: WordBool): HResult; stdcall; + function Get_ToolBarVisible(out Value: WordBool): HResult; stdcall; + function Set_ToolBarVisible(Value: WordBool): HResult; stdcall; + function Get_StatusBarVisible(out Value: WordBool): HResult; stdcall; + function Set_StatusBarVisible(Value: WordBool): HResult; stdcall; +{$ELSE} + procedure AddPage; + procedure DeletePage; + procedure Print; + procedure Edit; + procedure First; + procedure Next; + procedure Prior; + procedure Last; + procedure PageSetupDlg; + procedure Find; + procedure FindNext; + procedure Cancel; + procedure Clear; + procedure SetPosition(PageN, Top: Integer); + procedure ShowMessage(const s: String); + procedure HideMessage; + procedure MouseWheelScroll(Delta: Integer; Horz: Boolean = False; + Zoom: Boolean = False); +{$ENDIF} + procedure LoadFromFile; overload; + procedure LoadFromFile(FileName: String); overload; + procedure SaveToFile; overload; + procedure SaveToFile(FileName: String); overload; + procedure Export(Filter: TfrxCustomExportFilter); + function FindText(SearchString: String; FromTop, IsCaseSensitive: Boolean): Boolean; + function FindTextFound: Boolean; + procedure FindTextClear; + + property PageCount: Integer read GetPageCount; + property PageNo: Integer read FPageNo write SetPageNo; + // not implemented, backw compatibility only + property Tool: TfrxPreviewTool read FTool write FTool; + property Zoom: Extended read FZoom write SetZoom; + property ZoomMode: TfrxZoomMode read FZoomMode write SetZoomMode; + published + property Align; + property ActiveFrameColor: TColor read GetActiveFrameColor write SetActiveFrameColor default $804020; + property BackColor: TColor read GetBackColor write SetBackColor default clGray; + property BevelEdges; + property BevelInner; + property BevelKind; + property BevelOuter; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property BorderWidth; + property FrameColor: TColor read GetFrameColor write SetFrameColor default clBlack; + property OutlineColor: TColor read FOutlineColor write SetOutlineColor default clWindow; + property OutlineVisible: Boolean read GetOutlineVisible write SetOutlineVisible; + property OutlineWidth: Integer read GetOutlineWidth write SetOutlineWidth; + property PopupMenu; + property ThumbnailVisible: Boolean read GetThumbnailVisible write SetThumbnailVisible; + property OnClick; + property OnPageChanged: TfrxPageChangedEvent read FOnPageChanged write FOnPageChanged; + end; + + TfrxPreviewForm = class(TForm) + ToolBar: TToolBar; + OpenB: TToolButton; + SaveB: TToolButton; + PrintB: TToolButton; + ExportB: TToolButton; + FindB: TToolButton; + PageSettingsB: TToolButton; + Sep3: TfrxTBPanel; + ZoomCB: TfrxComboBox; + Sep1: TToolButton; + Sep2: TToolButton; + FirstB: TToolButton; + PriorB: TToolButton; + Sep4: TfrxTBPanel; + PageE: TEdit; + NextB: TToolButton; + LastB: TToolButton; + StatusBar: TStatusBar; + ZoomMinusB: TToolButton; + Sep5: TToolButton; + ZoomPlusB: TToolButton; + DesignerB: TToolButton; + frTBPanel1: TfrxTBPanel; + CancelB: TSpeedButton; + ExportPopup: TPopupMenu; + HiddenMenu: TPopupMenu; + Showtemplate1: TMenuItem; + RightMenu: TPopupMenu; + FullScreenBtn: TToolButton; + EmailB: TToolButton; + PdfB: TToolButton; + OutlineB: TToolButton; + ThumbB: TToolButton; + N1: TMenuItem; + ExpandMI: TMenuItem; + CollapseMI: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure ZoomMinusBClick(Sender: TObject); + procedure ZoomCBClick(Sender: TObject); + procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure FirstBClick(Sender: TObject); + procedure PriorBClick(Sender: TObject); + procedure NextBClick(Sender: TObject); + procedure LastBClick(Sender: TObject); + procedure PageEClick(Sender: TObject); + procedure PrintBClick(Sender: TObject); + procedure OpenBClick(Sender: TObject); + procedure SaveBClick(Sender: TObject); + procedure FindBClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure DesignerBClick(Sender: TObject); + procedure NewPageBClick(Sender: TObject); + procedure DelPageBClick(Sender: TObject); + procedure CancelBClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure PageSettingsBClick(Sender: TObject); + procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure DesignerBMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Showtemplate1Click(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FullScreenBtnClick(Sender: TObject); + procedure PdfBClick(Sender: TObject); + procedure EmailBClick(Sender: TObject); + procedure ZoomPlusBClick(Sender: TObject); + procedure OutlineBClick(Sender: TObject); + procedure ThumbBClick(Sender: TObject); + procedure CollapseAllClick(Sender: TObject); + procedure ExpandAllClick(Sender: TObject); + private + FFreeOnClose: Boolean; + FPreview: TfrxPreview; + FOldBS: TFormBorderStyle; + FOldState: TWindowState; + FFullScreen: Boolean; + FPDFExport: TfrxCustomExportFilter; + FEmailExport: TfrxCustomExportFilter; + procedure ExportMIClick(Sender: TObject); + procedure OnPageChanged(Sender: TfrxPreview; PageNo: Integer); + procedure OnPreviewDblClick(Sender: TObject); + procedure UpdateControls; + procedure UpdateZoom; + procedure WMUpdateZoom(var Message: TMessage); message WM_UPDATEZOOM; + procedure WMActivateApp(var Msg: TWMActivateApp); message WM_ACTIVATEAPP; + procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; + function GetReport: TfrxReport; + public + procedure Init; + procedure SetMessageText(const Value: String); + procedure SwitchToFullScreen; + property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose; + property Preview: TfrxPreview read FPreview; + property Report: TfrxReport read GetReport; + end; + + TfrxPreviewWorkspace = class(TfrxScrollWin) + private + FActiveFrameColor: TColor; + FBackColor: TColor; + FDefaultCursor: TCursor; + FDisableUpdate: Boolean; + FDown: Boolean; + FEMFImage: TMetafile; + FEMFImagePage: Integer; + FFrameColor: TColor; + FIsThumbnail: Boolean; + FLastFoundPage: Integer; + FLastPoint: TPoint; + FLocked: Boolean; + FOffset: TPoint; + FPageList: TfrxPageList; + FPageNo: Integer; + FPreview: TfrxPreview; + FPreviewPages: TfrxCustomPreviewPages; + FZoom: Extended; + procedure DrawPages(BorderOnly: Boolean); + procedure FindText; + procedure SetToPageNo(PageNo: Integer); + procedure UpdateScrollBars; + protected + 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 OnHScrollChange(Sender: TObject); override; + procedure Resize; override; + procedure OnVScrollChange(Sender: TObject); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + procedure SetPosition(PageN, Top: Integer); + { page list } + procedure AddPage(AWidth, AHeight: Integer); + procedure ClearPageList; + procedure CalcPageBounds(ClientWidth: Integer); + + property ActiveFrameColor: TColor read FActiveFrameColor write FActiveFrameColor default $804020; + property BackColor: TColor read FBackColor write FBackColor default clGray; + property FrameColor: TColor read FFrameColor write FFrameColor default clBlack; + property IsThumbnail: Boolean read FIsThumbnail write FIsThumbnail; + property Locked: Boolean read FLocked write FLocked; + property PageNo: Integer read FPageNo write FPageNo; + property Preview: TfrxPreview read FPreview write FPreview; + property PreviewPages: TfrxCustomPreviewPages read FPreviewPages + write FPreviewPages; + property Zoom: Extended read FZoom write FZoom; + end; + + TfrxPageItem = class(TCollectionItem) + public + Height: Word; + Width: Word; + OffsetX: Integer; + OffsetY: Integer; + end; + + TfrxPageList = class(TCollection) + private + FMaxWidth: Integer; + function GetItems(Index: Integer): TfrxPageItem; + public + constructor Create; + property Items[Index: Integer]: TfrxPageItem read GetItems; default; + procedure AddPage(AWidth, AHeight: Integer; Zoom: Extended); + procedure CalcBounds(ClientWidth: Integer); + function FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer; + function GetPageBounds(Index, ClientWidth: Integer; Scale: Extended): TRect; + function GetMaxBounds: TPoint; + end; + + +implementation + +{$R *.DFM} +{$R *.RES} + +uses + Printers, frxPrinter, frxSearchDialog, frxUtils, frxRes, frxDsgnIntf, + frxPreviewPageSettings, frxDMPClass; + + +type + THackControl = class(TWinControl); + +{ search given string in a metafile } + +var + TextToFind: String; + TextFound: Boolean; + TextBounds: TRect; + RecordNo: Integer; + LastFoundRecord: Integer; + CaseSensitive: Boolean; + +function EnumEMFRecordsProc(DC: HDC; HandleTable: PHandleTable; + EMFRecord: PEnhMetaRecord; nObj: Integer; OptData: Pointer): Bool; stdcall; +var + Typ: Byte; + s: String; + t: TEMRExtTextOut; + Found: Boolean; +begin + Result := True; + Typ := EMFRecord^.iType; + if Typ in [83, 84] then + begin + t := PEMRExtTextOut(EMFRecord)^; + s := WideCharLenToString(PWideChar(PChar(EMFRecord) + t.EMRText.offString), + t.EMRText.nChars); + if CaseSensitive then + Found := Pos(TextToFind, s) <> 0 else + Found := Pos(AnsiUpperCase(TextToFind), AnsiUpperCase(s)) <> 0; + if Found and (RecordNo > LastFoundRecord) then + begin + TextFound := True; + TextBounds := t.rclBounds; + LastFoundRecord := RecordNo; + Result := False; + end; + end; + Inc(RecordNo); +end; + + +{ TfrxPageList } + +constructor TfrxPageList.Create; +begin + inherited Create(TfrxPageItem); +end; + +function TfrxPageList.GetItems(Index: Integer): TfrxPageItem; +begin + Result := TfrxPageItem(inherited Items[Index]); +end; + +procedure TfrxPageList.AddPage(AWidth, AHeight: Integer; Zoom: Extended); +begin + with TfrxPageItem(Add) do + begin + Width := Round(AWidth * Zoom); + Height := Round(AHeight * Zoom); + end; +end; + +procedure TfrxPageList.CalcBounds(ClientWidth: Integer); +var + i, j, CurX, CurY, MaxY, offs: Integer; + Item: TfrxPageItem; +begin + FMaxWidth := 0; + CurY := 10; + i := 0; + while i < Count do + begin + j := i; + CurX := 0; + MaxY := 0; + { find series of pages that will fit in the clientwidth } + { also calculate max height of series } + while j < Count do + begin + Item := Items[j]; + { check the width, allow at least one iteration } + if (CurX > 0) and (CurX + Item.Width > ClientWidth) then break; + Item.OffsetX := CurX; + Item.OffsetY := CurY; + Inc(CurX, Item.Width + 10); + if Item.Height > MaxY then + MaxY := Item.Height; + Inc(j); + end; + + if CurX > FMaxWidth then + FMaxWidth := CurX; + + { center series horizontally } + offs := (ClientWidth - CurX + 10) div 2; + if offs < 0 then + offs := 0; + Inc(offs, 10); + while (i < j) do + begin + Inc(Items[i].OffsetX, offs); + Inc(i); + end; + + Inc(CurY, MaxY + 10); + end; +end; + +function TfrxPageList.FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer; +var + i, i0, i1, c, add: Integer; + Item: TfrxPageItem; +begin + i0 := 0; + i1 := Count - 1; + + while i0 <= i1 do + begin + i := (i0 + i1) div 2; + if OffsetX <> 0 then + add := 0 else + add := Round(Items[i].Height / 5); + if Items[i].OffsetY <= OffsetY + add then + c := -1 else + c := 1; + + if c < 0 then + i0 := i + 1 else + i1 := i - 1; + end; + + { find exact page } + if OffsetX <> 0 then + begin + for i := i1 - 20 to i1 + 20 do + begin + if (i < 0) or (i >= Count) then continue; + Item := Items[i]; + if PtInRect(Rect(Item.OffsetX, Item.OffsetY, + Item.OffsetX + Item.Width, Item.OffsetY + Item.Height), + Point(OffsetX, OffsetY)) then + begin + i1 := i; + break; + end; + end; + end; + + Result := i1; +end; + +function TfrxPageList.GetPageBounds(Index, ClientWidth: Integer; + Scale: Extended): TRect; +var + ColumnOffs: Integer; + Item: TfrxPageItem; +begin + if (Index >= Count) or (Index < 0) then + begin + if 794 * Scale > ClientWidth then + ColumnOffs := 10 else + ColumnOffs := Round((ClientWidth - 794 * Scale) / 2); + Result.Left := ColumnOffs; + Result.Top := Round(10 * Scale); + Result.Right := Result.Left + Round(794 * Scale); + Result.Bottom := Result.Top + Round(1123 * Scale); + end + else + begin + Item := Items[Index]; + Result.Left := Item.OffsetX; + Result.Top := Item.OffsetY; + Result.Right := Result.Left + Item.Width; + Result.Bottom := Result.Top + Item.Height; + end; +end; + +function TfrxPageList.GetMaxBounds: TPoint; +begin + if Count = 0 then + Result := Point(0, 0) + else + begin + Result.X := FMaxWidth; + Result.Y := Items[Count - 1].OffsetY + Items[Count - 1].Height; + end; +end; + + +{ TfrxPreviewWorkspace } + +constructor TfrxPreviewWorkspace.Create(AOwner: TComponent); +begin + inherited; + FPageList := TfrxPageList.Create; + + FBackColor := clGray; + FFrameColor := clBlack; + FActiveFrameColor := $804020; + FZoom := 1; + FDefaultCursor := crHand; + + LargeChange := 300; + SmallChange := 8; +end; + +destructor TfrxPreviewWorkspace.Destroy; +begin + if FEMFImage <> nil then + FEMFImage.Free; + FPageList.Free; + inherited; +end; + +procedure TfrxPreviewWorkspace.OnHScrollChange(Sender: TObject); +var + pp: Integer; + r: TRect; +begin + pp := FOffset.X - HorzPosition; + FOffset.X := HorzPosition; + r := Rect(0, 0, ClientWidth, ClientHeight); + ScrollWindowEx(Handle, pp, 0, @r, @r, 0, nil, SW_ERASE + SW_INVALIDATE); +end; + +procedure TfrxPreviewWorkspace.OnVScrollChange(Sender: TObject); +var + i, pp: Integer; + r: TRect; +begin + pp := FOffset.Y - VertPosition; + FOffset.Y := VertPosition; + r := Rect(0, 0, ClientWidth, ClientHeight); + ScrollWindowEx(Handle, 0, pp, @r, @r, 0, nil, SW_ERASE + SW_INVALIDATE); + + if not FIsThumbnail then + begin + i := FPageList.FindPage(FOffset.Y); + FDisableUpdate := True; + Preview.PageNo := i + 1; + FDisableUpdate := False; + end; +end; + +procedure TfrxPreviewWorkspace.DrawPages(BorderOnly: Boolean); +var + i, n: Integer; + PageBounds: TRect; + h: HRGN; + + function PageVisible: Boolean; + begin + if (PageBounds.Top > ClientHeight) or (PageBounds.Bottom < 0) then + Result := False + else + Result := RectVisible(Canvas.Handle, PageBounds); + end; + + procedure DrawPage(Index: Integer); + var + i: Integer; + TxtBounds: TRect; + begin + with Canvas, PageBounds do + begin + Pen.Color := FrameColor; + Pen.Width := 1; + Pen.Mode := pmCopy; + Pen.Style := psSolid; + Brush.Color := clWhite; + Brush.Style := bsSolid; + Dec(Bottom); + Rectangle(Left, Top, Right, Bottom); + end; + + PreviewPages.DrawPage(Index, Canvas, Zoom, Zoom, PageBounds.Left, PageBounds.Top); + + if FIsThumbnail then + with Canvas do + begin + Font.Name := 'Arial'; + Font.Size := 8; + Font.Style := []; + Font.Color := clWhite; + Brush.Style := bsSolid; + Brush.Color := BackColor; + TextOut(PageBounds.Left + 1, PageBounds.Top + 1, ' ' + IntToStr(Index + 1) + ' '); + end; + + { highlight text found } + TxtBounds := Rect(Round(TextBounds.Left * Zoom), + Round(TextBounds.Top * Zoom), + Round(TextBounds.Right * Zoom), + Round(TextBounds.Bottom * Zoom)); + if TextFound and (Index = FLastFoundPage) then + with Canvas, TxtBounds do + begin + Pen.Width := 1; + Pen.Style := psSolid; + Pen.Mode := pmXor; + Pen.Color := clWhite; + for i := 0 to Bottom - Top do + begin + MoveTo(PageBounds.Left + Left - 1, PageBounds.Top + Top + i); + LineTo(PageBounds.Left + Right + 1, PageBounds.Top + Top + i); + end; + Pen.Mode := pmCopy; + end; + end; + +begin + if not Visible then Exit; + + if Locked or (FPageList.Count = 0) then + begin + Canvas.Brush.Color := BackColor; + Canvas.FillRect(Rect(0, 0, ClientWidth, ClientHeight)); + Exit; + end; + + if PreviewPages = nil then Exit; + + h := CreateRectRgn(0, 0, ClientWidth, ClientHeight); + GetClipRgn(Canvas.Handle, h); + + { index of first visible page } + n := FPageList.FindPage(FOffset.Y); + + { exclude page areas to prevent flickering } + for i := n - 40 to n + 40 do + begin + if i < 0 then continue; + if i >= FPageList.Count then break; + + PageBounds := FPageList.GetPageBounds(i, ClientWidth, Zoom); + OffsetRect(PageBounds, -FOffset.X, -FOffset.Y); + if PageVisible then + with PageBounds do + ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom); + end; + + { now draw background on the non-clipped area} + with Canvas do + begin + Brush.Color := BackColor; + Brush.Style := bsSolid; + FillRect(Rect(0, 0, ClientWidth, ClientHeight)); + end; + + { restore clipregion } + SelectClipRgn(Canvas.Handle, h); + + { draw border around the active page } + PageBounds := FPageList.GetPageBounds(PageNo - 1, ClientWidth, Zoom); + OffsetRect(PageBounds, -FOffset.X, -FOffset.Y); + with Canvas, PageBounds do + begin + Pen.Color := ActiveFrameColor; + Pen.Width := 2; + Pen.Mode := pmCopy; + Pen.Style := psSolid; + Polyline([Point(Left - 1, Top - 1), + Point(Right + 1, Top - 1), + Point(Right + 1, Bottom + 1), + Point(Left - 1, Bottom + 1), + Point(Left - 1, Top - 2)]); + end; + if not BorderOnly then + begin + { draw visible pages } + for i := n - 40 to n + 40 do + begin + if i < 0 then continue; + if i >= FPageList.Count then break; + + PageBounds := FPageList.GetPageBounds(i, ClientWidth, Zoom); + OffsetRect(PageBounds, -FOffset.X, -FOffset.Y); + Inc(PageBounds.Bottom); + if PageVisible then + DrawPage(i); + end; + end; + + DeleteObject(h); +end; + +procedure TfrxPreviewWorkspace.Paint; +begin + DrawPages(False); +end; + +procedure TfrxPreviewWorkspace.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if (FPageList.Count = 0) or Locked then Exit; + + if Button = mbLeft then + begin + FDown := True; + FLastPoint.X := X; + FLastPoint.Y := Y; + end; +end; + +procedure TfrxPreviewWorkspace.MouseMove(Shift: TShiftState; X, Y: Integer); +var + PageNo: Integer; + PageBounds: TRect; + Cur: TCursor; +begin + if (FPageList.Count = 0) or Locked or FIsThumbnail then Exit; + + if FDown then + begin + HorzPosition := HorzPosition - (X - FLastPoint.X); + VertPosition := VertPosition - (Y - FLastPoint.Y); + FLastPoint.X := X; + FLastPoint.Y := Y; + end + else + begin + PageNo := FPageList.FindPage(FOffset.Y + Y, FOffset.X + X); + PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, Zoom); + Cur := FDefaultCursor; + PreviewPages.ObjectOver(PageNo, X, Y, mbLeft, [], Zoom, + PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, False, Cur); + Cursor := Cur; + end; +end; + +procedure TfrxPreviewWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + PageNo: Integer; + PageBounds: TRect; + Cur: TCursor; +begin + if not FIsThumbnail and Assigned(Preview.OnClick) then + Preview.OnClick(Preview); + if (FPageList.Count = 0) or Locked then Exit; + + FDown := False; + PageNo := FPageList.FindPage(FOffset.Y + Y, FOffset.X + X); + FDisableUpdate := True; + Preview.PageNo := PageNo + 1; + FDisableUpdate := False; + if not FIsThumbnail and (Button <> mbRight) then + begin + PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, Zoom); + PreviewPages.ObjectOver(PageNo, X, Y, Button, Shift, Zoom, + PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur); + end; +end; + +procedure TfrxPreviewWorkspace.FindText; +var + EMFCanvas: TMetafileCanvas; + PageBounds, TxtBounds: TRect; +begin + TextFound := False; + + while FLastFoundPage < FPageList.Count do + begin + if (FEMFImage = nil) or (FEMFImagePage <> FLastFoundPage) then + begin + if FEMFImage <> nil then + FEMFImage.Free; + FEMFImage := TMetafile.Create; + EMFCanvas := TMetafileCanvas.Create(FEMFImage, 0); + PreviewPages.DrawPage(FLastFoundPage, EMFCanvas, 1, 1, 0, 0); + EMFCanvas.Free; + end; + + FEMFImagePage := FLastFoundPage; + RecordNo := 0; + EnumEnhMetafile(0, FEMFImage.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0)); + + if TextFound then + begin + PageBounds := FPageList.GetPageBounds(FLastFoundPage, ClientWidth, Zoom); + TxtBounds := Rect(Round(TextBounds.Left * Zoom), + Round(TextBounds.Top * Zoom), + Round(TextBounds.Right * Zoom), + Round(TextBounds.Bottom * Zoom)); + + if (PageBounds.Top + TxtBounds.Top < FOffset.Y) or + (PageBounds.Top + TxtBounds.Bottom > FOffset.Y + ClientHeight) then + VertPosition := PageBounds.Top + TxtBounds.Bottom - ClientHeight + 20; + if (PageBounds.Left + TxtBounds.Left < FOffset.X) or + (PageBounds.Left + TxtBounds.Right > FOffset.X + ClientWidth) then + HorzPosition := PageBounds.Left + TxtBounds.Right - ClientWidth + 20; + Repaint; + break; + end; + + LastFoundRecord := -1; + Inc(FLastFoundPage); + end; +end; + +procedure TfrxPreviewWorkspace.Resize; +begin + inherited; + HorzPage := ClientWidth; + VertPage := ClientHeight; +end; + +procedure TfrxPreviewWorkspace.SetToPageNo(PageNo: Integer); +begin + if FDisableUpdate then Exit; + VertPosition := + FPageList.GetPageBounds(PageNo - 1, ClientWidth, Zoom).Top - 10; +end; + +procedure TfrxPreviewWorkspace.UpdateScrollBars; +var + MaxSize: TPoint; +begin + MaxSize := FPageList.GetMaxBounds; + HorzRange := MaxSize.X + 10; + VertRange := MaxSize.Y + 10; +end; + +procedure TfrxPreviewWorkspace.SetPosition(PageN, Top: Integer); +var + Pos: Integer; + Page: TfrxReportPage; +begin + Page := PreviewPages.Page[PageN - 1]; + if Top = 0 then + Pos := 0 + else + Pos := Round((Top + Page.TopMargin * fr01cm) * Zoom); + + VertPosition := FPageList.GetPageBounds(PageN - 1, ClientWidth, Zoom).Top - 10 + Pos; +end; + +procedure TfrxPreviewWorkspace.AddPage(AWidth, AHeight: Integer); +begin + FPageList.AddPage(AWidth, AHeight, Zoom); +end; + +procedure TfrxPreviewWorkspace.CalcPageBounds(ClientWidth: Integer); +begin + FPageList.CalcBounds(ClientWidth); +end; + +procedure TfrxPreviewWorkspace.ClearPageList; +begin + FPageList.Clear; +end; + + +{ TfrxPreview } + +constructor TfrxPreview.Create(AOwner: TComponent); +var + m: TMenuItem; +begin + inherited; + + FOutlinePopup := TPopupMenu.Create(Self); + FOutlinePopup.Images := frxResources.PreviewButtonImages; + m := TMenuItem.Create(FOutlinePopup); + FOutlinePopup.Items.Add(m); + m.Caption := frxGet(601); + m.ImageIndex := 13; + m.OnClick := OnCollapseClick; + m := TMenuItem.Create(FOutlinePopup); + FOutlinePopup.Items.Add(m); + m.Caption := frxGet(600); + m.ImageIndex := 14; + m.OnClick := OnExpandClick; + + FOutline := TTreeView.Create(Self); + with FOutline do + begin + Parent := Self; + Align := alLeft; + HideSelection := False; +{$IFDEF UseTabset} + BorderStyle := bsNone; + BevelKind := bkFlat; +{$ELSE} + BorderStyle := bsSingle; +{$ENDIF} + OnClick := OnOutlineClick; + PopupMenu := FOutlinePopup; + end; + + FThumbnail := TfrxPreviewWorkspace.Create(Self); + FThumbnail.Parent := Self; + FThumbnail.Align := alLeft; + FThumbnail.Visible := False; + FThumbnail.Zoom := 0.1; + FThumbnail.IsThumbnail := True; + FThumbnail.Preview := Self; + + FSplitter := TSplitter.Create(Self); + FSplitter.Parent := Self; + FSplitter.Align := alLeft; + FSplitter.Width := 4; + FSplitter.Left := FOutline.Width + 1; + FSplitter.OnMoved := OnMoveSplitter; + + FWorkspace := TfrxPreviewWorkspace.Create(Self); + FWorkspace.Parent := Self; + FWorkspace.Align := alClient; + FWorkspace.Preview := Self; + + FMessagePanel := TPanel.Create(Self); + FMessagePanel.Parent := Self; + FMessagePanel.Visible := False; + FMessagePanel.SetBounds(0, 0, 0, 0); + + FMessageLabel := TLabel.Create(FMessagePanel); + FMessageLabel.Parent := FMessagePanel; + FMessageLabel.AutoSize := False; + FMessageLabel.Alignment := taCenter; + FMessageLabel.SetBounds(4, 20, 255, 20); + + FCancelButton := TButton.Create(FMessagePanel); + FCancelButton.Parent := FMessagePanel; + FCancelButton.SetBounds(92, 44, 75, 25); + FCancelButton.Caption := frxResources.Get('clCancel'); + FCancelButton.Visible := False; + FCancelButton.OnClick := OnCancel; + + FBorderStyle := bsSingle; + FPageNo := 1; + FScrollBars := ssBoth; + FZoom := 1; + FZoomMode := zmDefault; + FOutlineColor := clWindow; + + Width := 100; + Height := 100; +end; + +destructor TfrxPreview.Destroy; +begin + if Report <> nil then + Report.Preview := nil; + inherited; +end; + +procedure TfrxPreview.CreateParams(var Params: TCreateParams); +const + BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER); +begin + inherited CreateParams(Params); + with Params do + begin + Style := Style or BorderStyles[FBorderStyle]; + if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then + begin + Style := Style and not WS_BORDER; + ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; + end; + end; +end; + +procedure TfrxPreview.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + + if Operation = opRemove then + if AComponent = Report then + begin + Clear; + Report := nil; + PreviewPages := nil; + end; +end; + +procedure TfrxPreview.Init; +begin + FWorkspace.PreviewPages := PreviewPages; + FThumbnail.PreviewPages := PreviewPages; + + TextFound := False; + FWorkspace.FLastFoundPage := 0; + LastFoundRecord := -1; + FAllowF3 := False; + + FWorkspace.DoubleBuffered := True; + OutlineWidth := Report.PreviewOptions.OutlineWidth; + OutlineVisible := Report.PreviewOptions.OutlineVisible; + ThumbnailVisible := Report.PreviewOptions.ThumbnailVisible; + UpdatePages; + UpdateOutline; + First; +end; + +procedure TfrxPreview.WMEraseBackground(var Message: TMessage); +begin +end; + +procedure TfrxPreview.WMGetDlgCode(var Message: TWMGetDlgCode); +begin + Message.Result := DLGC_WANTARROWS; +end; + +procedure TfrxPreview.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if Key = vk_Up then + FWorkspace.VertPosition := FWorkspace.VertPosition - 8 + else if Key = vk_Down then + FWorkspace.VertPosition := FWorkspace.VertPosition + 8 + else if Key = vk_Left then + FWorkspace.HorzPosition := FWorkspace.HorzPosition - 8 + else if Key = vk_Right then + FWorkspace.HorzPosition := FWorkspace.HorzPosition + 8 + else if Key = vk_Prior then + if ssCtrl in Shift then + PageNo := PageNo - 1 + else + FWorkspace.VertPosition := FWorkspace.VertPosition - 300 + else if Key = vk_Next then + if ssCtrl in Shift then + PageNo := PageNo + 1 + else + FWorkspace.VertPosition := FWorkspace.VertPosition + 300 + else if Key = vk_Home then + PageNo := 1 + else if Key = vk_End then + PageNo := PageCount + else if (Key = vk_F3) and (pbFind in Report.PreviewOptions.Buttons) then + FindNext + else if ssCtrl in Shift then + begin + if (Key = Ord('P')) and (pbPrint in Report.PreviewOptions.Buttons) then + Print + else if (Key = Ord('S')) and (pbSave in Report.PreviewOptions.Buttons) then + SaveToFile + else if (Key = Ord('F')) and (pbFind in Report.PreviewOptions.Buttons) then + Find + else if (Key = Ord('O')) and (pbLoad in Report.PreviewOptions.Buttons) then + LoadFromFile + end; +end; + +procedure TfrxPreview.Resize; +begin + inherited; + if PreviewPages <> nil then + UpdatePages; +end; + +procedure TfrxPreview.OnMoveSplitter(Sender: TObject); +begin + UpdatePages; +end; + +procedure TfrxPreview.OnCollapseClick(Sender: TObject); +begin + FOutline.FullCollapse; +end; + +procedure TfrxPreview.OnExpandClick(Sender: TObject); +begin + FOutline.FullExpand; + if FOutline.Items.Count > 0 then + FOutline.TopItem := FOutline.Items[0]; +end; + +procedure TfrxPreview.SetZoom(const Value: Extended); +begin + FZoom := Value; + if FZoom < 0.25 then + FZoom := 0.25; + + FZoomMode := zmDefault; + UpdatePages; +end; + +procedure TfrxPreview.SetZoomMode(const Value: TfrxZoomMode); +begin + FZoomMode := Value; + UpdatePages; +end; + +function TfrxPreview.GetOutlineVisible: Boolean; +begin + Result := FOutline.Visible; +end; + +procedure TfrxPreview.SetOutlineVisible(const Value: Boolean); +var + NeedChange: Boolean; +begin + NeedChange := Value <> FOutline.Visible; + + FSplitter.Visible := Value or ThumbnailVisible; + FOutline.Visible := Value; + if Value then + FThumbnail.Visible := False; + + if Owner is TfrxPreviewForm then + TfrxPreviewForm(Owner).OutlineB.Down := Value; + if NeedChange then + UpdatePages; +end; + +function TfrxPreview.GetThumbnailVisible: Boolean; +begin + Result := FThumbnail.Visible; +end; + +procedure TfrxPreview.SetThumbnailVisible(const Value: Boolean); +var + NeedChange: Boolean; +begin + NeedChange := Value <> FThumbnail.Visible; + + FSplitter.Visible := Value or OutlineVisible; + FThumbnail.Visible := Value; + if Value then + FOutline.Visible := False; + + if Value then + begin + FThumbnail.HorzPosition := FThumbnail.HorzPosition; + FThumbnail.VertPosition := FThumbnail.VertPosition; + end; + if Owner is TfrxPreviewForm then + TfrxPreviewForm(Owner).ThumbB.Down := Value; + if NeedChange then + UpdatePages; +end; + +function TfrxPreview.GetOutlineWidth: Integer; +begin + Result := FOutline.Width; +end; + +procedure TfrxPreview.SetOutlineWidth(const Value: Integer); +begin + FOutline.Width := Value; + if not (csDesigning in ComponentState) then + FThumbnail.Width := Value; +end; + +procedure TfrxPreview.SetOutlineColor(const Value: TColor); +begin + FOutlineColor := Value; + FOutline.Color := Value; +end; + +procedure TfrxPreview.SetPageNo(Value: Integer); +var + ActivePageChanged: Boolean; +begin + if Value < 1 then + Value := 1; + if Value > PageCount then + Value := PageCount; + ActivePageChanged := FPageNo <> Value; + FPageNo := Value; + FWorkspace.PageNo := Value; + FThumbnail.PageNo := Value; + + if ActivePageChanged then + begin + FWorkspace.DrawPages(True); + FThumbnail.DrawPages(True); + end; + FWorkspace.SetToPageNo(FPageNo); + FThumbnail.SetToPageNo(FPageNo); + UpdatePageNumbers; +end; + +function TfrxPreview.GetActiveFrameColor: TColor; +begin + Result := FWorkspace.ActiveFrameColor; +end; + +function TfrxPreview.GetBackColor: TColor; +begin + Result := FWorkspace.BackColor; +end; + +function TfrxPreview.GetFrameColor: TColor; +begin + Result := FWorkspace.FrameColor; +end; + +procedure TfrxPreview.SetActiveFrameColor(const Value: TColor); +begin + FWorkspace.ActiveFrameColor := Value; +end; + +procedure TfrxPreview.SetBackColor(const Value: TColor); +begin + FWorkspace.BackColor := Value; +end; + +procedure TfrxPreview.SetFrameColor(const Value: TColor); +begin + FWorkspace.FrameColor := Value; +end; + +procedure TfrxPreview.SetBorderStyle(Value: TBorderStyle); +begin + if BorderStyle <> Value then + begin + FBorderStyle := Value; + RecreateWnd; + end; +end; + +procedure TfrxPreview.UpdatePageNumbers; +begin + if Assigned(FOnPageChanged) then + FOnPageChanged(Self, FPageNo); +end; + +function TfrxPreview.GetPageCount: Integer; +begin + if PreviewPages <> nil then + Result := PreviewPages.Count + else + Result := 0; +end; + +{$IFDEF FR_COM} +function TfrxPreview.ShowMessage(const s: WideString): HResult; +{$ELSE} +procedure TfrxPreview.ShowMessage(const s: String); +{$ENDIF} +begin + FMessagePanel.SetBounds((Width - 260) div 2, (Height - 75) div 3, 260, 75); + FMessageLabel.Caption := s; + FMessagePanel.Show; + FMessagePanel.Update; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.HideMessage: HResult; +{$ELSE} +procedure TfrxPreview.HideMessage; +{$ENDIF} +begin + FMessagePanel.Hide; + FCancelButton.Hide; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.First: HResult; +{$ELSE} +procedure TfrxPreview.First; +{$ENDIF} +begin + PageNo := 1; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Next: HResult; +{$ELSE} +procedure TfrxPreview.Next; +{$ENDIF} +begin + PageNo := PageNo + 1; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Prior: HResult; +{$ELSE} +procedure TfrxPreview.Prior; +{$ENDIF} +begin + PageNo := PageNo - 1; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Last: HResult; +{$ELSE} +procedure TfrxPreview.Last; +{$ENDIF} +begin + PageNo := PageCount; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Print: HResult; +begin + if not FRunning then + begin + try + PreviewPages.CurPreviewPage := PageNo; + PreviewPages.Print; + Result := S_OK; + except + Result := E_FAIL; + end; + Unlock; + end else + Result := RPC_E_SERVERCALL_RETRYLATER; +end; +{$ELSE} +procedure TfrxPreview.Print; +begin + if FRunning then Exit; + try + PreviewPages.CurPreviewPage := PageNo; + PreviewPages.Print; + finally + Unlock; + end; +end; +{$ENDIF} + +procedure TfrxPreview.SaveToFile; +var + SaveDlg: TSaveDialog; +begin + if FRunning then Exit; + SaveDlg := TSaveDialog.Create(Application); + try + SaveDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3'; + if SaveDlg.Execute then + begin + FWorkspace.Repaint; + SaveToFile(ChangeFileExt(SaveDlg.FileName, '.fp3')); + end; + finally + SaveDlg.Free; + end; +end; + +procedure TfrxPreview.SaveToFile(FileName: String); +begin + if FRunning then Exit; + try + Lock; + ShowMessage(frxResources.Get('clSaving')); + PreviewPages.SaveToFile(FileName); + finally + Unlock; + end; +end; + +procedure TfrxPreview.LoadFromFile; +var + OpenDlg: TOpenDialog; +begin + if FRunning then Exit; + OpenDlg := TOpenDialog.Create(nil); + try + OpenDlg.Options := [ofHideReadOnly]; + OpenDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3'; + if OpenDlg.Execute then + begin + FWorkspace.Repaint; + LoadFromFile(OpenDlg.FileName); + end; + finally + OpenDlg.Free; + end; +end; + +procedure TfrxPreview.LoadFromFile(FileName: String); +begin + if FRunning then Exit; + try + Lock; + ShowMessage(frxResources.Get('clLoading')); + PreviewPages.LoadFromFile(FileName); + finally + UpdateOutline; + Unlock; + PageNo := 1; + end; +end; + +procedure TfrxPreview.Export(Filter: TfrxCustomExportFilter); +begin + if FRunning then Exit; + try + PreviewPages.CurPreviewPage := PageNo; + if Report.DotMatrixReport and (frxDotMatrixExport <> nil) and + (Filter.ClassName = 'TfrxTextExport') then + Filter := frxDotMatrixExport; + PreviewPages.Export(Filter); + finally + Unlock; + end; +end; + +function TfrxPreview.FindText(SearchString: String; FromTop, IsCaseSensitive: Boolean): Boolean; +begin + TextToFind := SearchString; + CaseSensitive := IsCaseSensitive; + if FromTop then + FWorkspace.FLastFoundPage := 0 + else + FWorkspace.FLastFoundPage := PageNo - 1; + LastFoundRecord := -1; + + FWorkspace.FindText; + + FAllowF3 := True; + Result := TextFound; +end; + +function TfrxPreview.FindTextFound: Boolean; +begin + Result := TextFound; +end; + +procedure TfrxPreview.FindTextClear; +begin + LastFoundRecord := -1; + FWorkspace.FLastFoundPage := 0; + TextFound := False; + Invalidate; +end; + +{$IFDEF FR_COM} +function TfrxPreview.PageSetupDlg: HResult; +{$ELSE} +procedure TfrxPreview.PageSetupDlg; +{$ENDIF} +var + APage: TfrxReportPage; + + procedure UpdateReport; + var + i: Integer; + begin + for i := 0 to Report.PagesCount - 1 do + if Report.Pages[i] is TfrxReportPage then + with TfrxReportPage(Report.Pages[i]) do + begin + Orientation := APage.Orientation; + PaperWidth := APage.PaperWidth; + PaperHeight := APage.PaperHeight; + PaperSize := APage.PaperSize; + + LeftMargin := APage.LeftMargin; + RightMargin := APage.RightMargin; + TopMargin := APage.TopMargin; + BottomMargin := APage.BottomMargin; + end; + end; + +begin +{$IFDEF FR_COM} + if FRunning then Result := RPC_E_SERVERCALL_RETRYLATER else + begin +{$ELSE} + if FRunning then Exit; +{$ENDIF} + APage := PreviewPages.Page[PageNo - 1]; + + if Assigned(APage) then with TfrxPageSettingsForm.Create(Application) do + begin + Page := APage; + Report := Self.Report; + if ShowModal = mrOk then + begin + if NeedRebuild then + begin + UpdateReport; + Self.Report.PrepareReport; + end + else + begin + try + Lock; + PreviewPages.ModifyPage(PageNo - 1, Page); + finally + Unlock; + end; + end; + end; + Free; + end; +{$IFDEF FR_COM} + Result := S_OK; + end; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Find: HResult; +{$ELSE} +procedure TfrxPreview.Find; +{$ENDIF} +begin + with TfrxSearchDialog.Create(Application) do + begin + if ShowModal = mrOk then + begin + TextToFind := TextE.Text; + CaseSensitive := CaseCB.Checked; + if TopCB.Checked then + FWorkspace.FLastFoundPage := 0 + else + FWorkspace.FLastFoundPage := PageNo - 1; + LastFoundRecord := -1; + FWorkspace.FindText; + end; + Free; + end; + + FAllowF3 := True; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.FindNext: HResult; +{$ELSE} +procedure TfrxPreview.FindNext; +{$ENDIF} +begin + if FAllowF3 then + FWorkspace.FindText; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.Edit: HResult; +{$ELSE} +procedure TfrxPreview.Edit; +{$ENDIF} +var + r: TfrxReport; + p: TfrxReportPage; + SourcePage: TfrxPage; + + procedure RemoveBands; + var + i: Integer; + l: TList; + c: TfrxComponent; + begin + l := p.AllObjects; + + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if c is TfrxView then + begin + TfrxView(c).DataField := ''; + TfrxView(c).DataSet := nil; + TfrxView(c).Restrictions := []; + end; + + if c.Parent <> p then + begin + c.Left := c.AbsLeft; + c.Top := c.AbsTop; + c.ParentFont := False; + c.Parent := p; + if (c is TfrxView) and (TfrxView(c).Align in [baBottom, baClient]) then + TfrxView(c).Align := baNone; + end; + end; + + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if c is TfrxBand then + c.Free; + end; + end; + +begin + SourcePage := PreviewPages.Page[PageNo - 1]; + r := nil; + if Assigned(SourcePage) then + try + if SourcePage is TfrxDMPPage then + p := TfrxDMPPage.Create(nil) else + p := TfrxReportPage.Create(nil); + p.AssignAll(SourcePage); + RemoveBands; + r := TfrxReport.Create(nil); + p.Parent := r; + if r.DesignPreviewPage then + try + Lock; + PreviewPages.ModifyPage(PageNo - 1, TfrxReportPage(r.Pages[0])); + finally + Unlock; + end; + except + if Assigned(r) then r.Free; + end; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +procedure TfrxPreview.EditTemplate; +var + r: TfrxReport; + i: Integer; +begin + r := TfrxReport.Create(nil); + try + for i := 0 to TfrxPreviewPages(PreviewPages).SourcePages.Count - 1 do + r.Objects.Add(TfrxPreviewPages(PreviewPages).SourcePages[i]); + r.DesignReport; + finally + r.Objects.Clear; + r.Free; + end; +end; + +{$IFDEF FR_COM} +function TfrxPreview.Clear: HResult; +begin + if FRunning then Result := RPC_E_SERVERCALL_RETRYLATER else + begin +{$ELSE} +procedure TfrxPreview.Clear; +begin + if FRunning then Exit; +{$ENDIF} + Lock; + try + PreviewPages.Clear; + finally + Unlock; + end; + + UpdateOutline; + PageNo := 0; + with FWorkspace do + begin + HorzRange := 0; + VertRange := 0; + end; +{$IFDEF FR_COM} + Result := S_OK; + end; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.AddPage: HResult; +begin + if FRunning then Result := RPC_E_SERVERCALL_RETRYLATER else + begin +{$ELSE} +procedure TfrxPreview.AddPage; +begin + if FRunning then Exit; +{$ENDIF} + PreviewPages.AddEmptyPage(PageNo - 1); + UpdatePages; + PageNo := PageNo; +{$IFDEF FR_COM} + Result := S_OK; + end; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.DeletePage: HResult; +begin + if FRunning then Result := RPC_E_SERVERCALL_RETRYLATER else + begin +{$ELSE} +procedure TfrxPreview.DeletePage; +begin + if FRunning then Exit; +{$ENDIF} + PreviewPages.DeletePage(PageNo - 1); + if PageNo >= PageCount then + PageNo := PageNo - 1; + UpdatePages; + UpdatePageNumbers; +{$IFDEF FR_COM} + Result := S_OK; + end; +{$ENDIF} +end; + +procedure TfrxPreview.Lock; +begin + FLocked := True; + FWorkspace.Locked := True; + FThumbnail.Locked := True; +end; + +procedure TfrxPreview.Unlock; +begin + HideMessage; + FLocked := False; + FWorkspace.Locked := False; + FThumbnail.Locked := False; + //FPageNo := 1; + UpdatePages; + FWorkspace.Repaint; + FThumbnail.Repaint; +end; + +{$IFDEF FR_COM} +function TfrxPreview.SetPosition(PageN, Top: Integer): HResult; +{$ELSE} +procedure TfrxPreview.SetPosition(PageN, Top: Integer); +{$ENDIF} +begin + if PageN > PageCount then + PageN := PageCount; + if PageN <= 0 then + PageN := 1; + FWorkspace.SetPosition(PageN, Top); +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +procedure TfrxPreview.RefreshReport; +var + hpos, vpos, pno: Integer; +begin + hpos := FWorkspace.FOffset.X; + vpos := FWorkspace.FOffset.Y; + pno := FPageNo; + + Lock; + FRefreshing := True; + try + Report.PrepareReport; + FLocked := False; + FThumbnail.Locked := False; + if pno <= PageCount then + FPageNo := pno + else + FPageNo := 1; + UpdatePages; + UpdateOutline; + finally + FRefreshing := False; + end; + + FWorkspace.DoubleBuffered := True; + FWorkspace.FOffset.X := hpos; + FWorkspace.FOffset.Y := vpos; + FWorkspace.Locked := False; + FWorkspace.Repaint; + FThumbnail.Repaint; + FWorkspace.DoubleBuffered := False; + if pno > PageCount then + PageNo := 1; +end; + +procedure TfrxPreview.UpdatePages; +var + PageSize: TPoint; + i: Integer; +begin + if FLocked or (PageCount = 0) then Exit; + + { clear find settings } + FAllowF3 := False; + FWorkspace.FEMFImagePage := -1; + + { calc zoom if not zmDefault} + PageSize := PreviewPages.PageSize[PageNo - 1]; + if PageSize.Y = 0 then Exit; + case FZoomMode of + zmWholePage: + begin + FZoom := (FWorkspace.Height - 26) / PageSize.Y; + SetPosition(PageNo, 0); + end; + zmPageWidth: + FZoom := (FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26) / PageSize.X; + end; + + FWorkspace.DoubleBuffered := True; + FThumbnail.DoubleBuffered := True; + { fill page list and calc bounds } + FWorkspace.Zoom := FZoom; + FThumbnail.Zoom := 0.1; + FWorkspace.ClearPageList; + FThumbnail.ClearPageList; + for i := 0 to PageCount - 1 do + begin + PageSize := PreviewPages.PageSize[i]; + FWorkspace.AddPage(PageSize.X, PageSize.Y); + if not FRunning then + FThumbnail.AddPage(PageSize.X, PageSize.Y); + end; + + FWorkspace.CalcPageBounds(FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26); + if not FRunning then + FThumbnail.CalcPageBounds(FThumbnail.Width - GetSystemMetrics(SM_CXVSCROLL) - 26); + + FWorkspace.UpdateScrollBars; + FThumbnail.UpdateScrollBars; + { avoid positioning errors when resizing } + FWorkspace.HorzPosition := FWorkspace.HorzPosition; + FWorkspace.VertPosition := FWorkspace.VertPosition; + + if not FRefreshing then + begin + FWorkspace.Repaint; + FThumbnail.Repaint; + end; + + if Owner is TfrxPreviewForm then + TfrxPreviewForm(Owner).UpdateZoom; + FWorkspace.DoubleBuffered := False; + FThumbnail.DoubleBuffered := False; +end; + +procedure TfrxPreview.UpdateOutline; +var + Outline: TfrxCustomOutline; + + procedure DoUpdate(RootNode: TTreeNode); + var + i, n: Integer; + Node: TTreeNode; + Page, Top: Integer; + Text: String; + begin + n := Outline.Count; + for i := 0 to n - 1 do + begin + Outline.GetItem(i, Text, Page, Top); + Node := FOutline.Items.AddChild(RootNode, Text); + Node.ImageIndex := Page + 1; + Node.StateIndex := Top; + + Outline.LevelDown(i); + DoUpdate(Node); + Outline.LevelUp; + end; + end; + +begin + FOutline.Items.BeginUpdate; + FOutline.Items.Clear; + Outline := Report.PreviewPages.Outline; + Outline.LevelRoot; + DoUpdate(nil); + if Report.PreviewOptions.OutlineExpand then + FOutline.FullExpand; + if FOutline.Items.Count > 0 then + FOutline.TopItem := FOutline.Items[0]; + FOutline.Items.EndUpdate; +end; + +procedure TfrxPreview.OnOutlineClick(Sender: TObject); +var + Node: TTreeNode; + PageN, Top: Integer; +begin + Node := FOutline.Selected; + if Node = nil then Exit; + + PageN := Node.ImageIndex; + Top := Node.StateIndex; + + SetPosition(PageN, Top); + SetFocus; +end; + +procedure TfrxPreview.InternalOnProgressStart(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); +begin + if FRefreshing then Exit; + + Clear; + Report.DrillState.Clear; + FRunning := True; + if Owner is TfrxPreviewForm then + TfrxPreviewForm(Owner).UpdateControls; +end; + +procedure TfrxPreview.InternalOnProgress(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); +var + PageSize: TPoint; +begin + if FRefreshing then + begin + UpdatePageNumbers; + Exit; + end; + + if Report.Engine.FinalPass then + begin + PageSize := Report.PreviewPages.PageSize[Progress]; + if Progress < 50 then + begin + FWorkspace.AddPage(PageSize.X, PageSize.Y); + FWorkspace.CalcPageBounds(FWorkspace.Width - GetSystemMetrics(SM_CXVSCROLL) - 26); + end; + end; + + if Progress = 0 then + begin + PageNo := 1; + if Report.Engine.FinalPass then + UpdatePages; + if Owner is TfrxPreviewForm then + TfrxPreviewForm(Owner).CancelB.Caption := frxResources.Get('clCancel'); + FTick := GetTickCount; + end + else if Progress = 1 then + begin + FTick := GetTickCount - FTick; + if FTick < 5 then + FTick := 50 + else if FTick < 10 then + FTick := 20 + else + FTick := 5; + PageNo := 1; + if Report.Engine.FinalPass then + UpdatePages; + end + else if Progress mod Integer(FTick) = 0 then + begin + UpdatePageNumbers; + if Report.Engine.FinalPass then + FWorkspace.UpdateScrollBars; + end; + + Application.ProcessMessages; +end; + +procedure TfrxPreview.InternalOnProgressStop(Sender: TfrxReport; + ProgressType: TfrxProgressType; Progress: Integer); +begin + if FRefreshing then Exit; + + FRunning := False; + UpdatePageNumbers; + FWorkspace.UpdateScrollBars; + FThumbnail.UpdateScrollBars; + UpdatePages; + UpdateOutline; + if Owner is TfrxPreviewForm then + begin + TfrxPreviewForm(Owner).CancelB.Caption := frxResources.Get('clClose'); + TfrxPreviewForm(Owner).StatusBar.Panels[1].Text := ''; + TfrxPreviewForm(Owner).UpdateControls; + end; +end; + +procedure TfrxPreview.OnCancel(Sender: TObject); +begin + Report.Terminated := True; +end; + +{$IFDEF FR_COM} +function TfrxPreview.Cancel: HResult; +{$ELSE} +procedure TfrxPreview.Cancel; +{$ENDIF} +begin + if FRunning then + OnCancel(Self); +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.MouseWheelScroll(Delta: Integer; Horz: WordBool; Zoom: WordBool): HResult; stdcall; +{$ELSE} +procedure TfrxPreview.MouseWheelScroll(Delta: Integer; Horz: Boolean = False; + Zoom: Boolean = False); +{$ENDIF} +begin + if Delta <> 0 then + if Zoom then + begin + FZoom := FZoom + Round(Delta / Abs(Delta)) / 10; + if FZoom < 0.3 then + FZoom := 0.3; + SetZoom(FZoom); + end + else + begin + with FWorkspace do + begin + if Horz then + HorzPosition := HorzPosition + Round(-Delta / Abs(Delta)) * 20 + else + VertPosition := VertPosition + Round(-Delta / Abs(Delta)) * 20; + end; + end; +{$IFDEF FR_COM} + Result := S_OK; +{$ENDIF} +end; + +{$IFDEF FR_COM} +function TfrxPreview.LoadPreparedReportFromFile(const FileName: WideString): HResult; stdcall; +begin + Result := S_OK; + try + LoadFromFile(FileName); + except + Result := E_INVALIDARG; + end; +end; + +function TfrxPreview.SavePreparedReportToFile(const FileName: WideString): HResult; stdcall; +begin + Result := S_OK; + try + SaveToFile(FileName); + except + Result := E_INVALIDARG; + end; +end; + +function TfrxPreview.Get_FullScreen(out Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + Value := TfrxPreviewForm(Owner).FFullScreen; + Result := S_OK; + end else Result := E_FAIL; +end; + +function TfrxPreview.Set_FullScreen(Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + if TfrxPreviewForm(Owner).FFullScreen <> Value then + TfrxPreviewForm(Owner).SwitchToFullScreen; + Result := S_OK; + end + else + Result := E_FAIL; +end; + +function TfrxPreview.Get_ToolBarVisible(out Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + Value := TfrxPreviewForm(Owner).ToolBar.Visible; + Result := S_OK; + end + else + Result := E_FAIL; +end; + +function TfrxPreview.Set_ToolBarVisible(Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + TfrxPreviewForm(Owner).ToolBar.Visible := Value; + Result := S_OK; + end + else + Result := E_FAIL; +end; + +function TfrxPreview.Get_StatusBarVisible(out Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + Value := TfrxPreviewForm(Owner).StatusBar.Visible; + Result := S_OK; + end + else + Result := E_FAIL; +end; + +function TfrxPreview.Set_StatusBarVisible(Value: WordBool): HResult; stdcall; +begin + if Owner is TfrxPreviewForm then + begin + TfrxPreviewForm(Owner).StatusBar.Visible := Value; + Result := S_OK; + end + else + Result := E_FAIL; +end; + + +function TfrxPreview.Get_PageCount(out Value: Integer): HResult; stdcall; +begin + Value := PageCount; + Result := S_OK; +end; + +function TfrxPreview.Get_PageNo(out Value: Integer): HResult; stdcall; +begin + Value := PageNo; + Result := S_OK; +end; + +function TfrxPreview.Set_PageNo(Value: Integer): HResult; stdcall; +begin + PageNo := Value; + Result := S_OK; +end; + +function TfrxPreview.Get_Tool(out Value: frxPreviewTool): HResult; stdcall; +begin + Value := frxPreviewTool(Tool); + Result := S_OK; +end; + +function TfrxPreview.Set_Tool(Value: frxPreviewTool): HResult; stdcall; +begin + Tool := TfrxPreviewTool(Value); + Result := S_OK; +end; + +function TfrxPreview.Get_Zoom(out Value: Double): HResult; stdcall; +begin + Value := Zoom; + Result := S_OK; +end; + +function TfrxPreview.Set_Zoom(Value: Double): HResult; stdcall; +begin + Zoom := Value; + Result := S_OK; +end; + +function TfrxPreview.Get_ZoomMode(out Value: frxZoomMode): HResult; stdcall; +begin + Value := frxZoomMode(ZoomMode); + Result := S_OK; +end; + +function TfrxPreview.Set_ZoomMode(Value: frxZoomMode): HResult; stdcall; +begin + ZoomMode := TfrxZoomMode(Value); + Result := S_OK; +end; + +function TfrxPreview.Get_OutlineVisible(out Value: WordBool): HResult; stdcall; +begin + Value := OutlineVisible; + Result := S_OK; +end; + +function TfrxPreview.Set_OutlineVisible(Value: WordBool): HResult; stdcall; +begin + OutlineVisible := Value; + Result := S_OK; +end; + +function TfrxPreview.Get_OutlineWidth(out Value: Integer): HResult; stdcall; +begin + Value := OutlineWidth; + Result := S_OK; +end; + +function TfrxPreview.Set_OutlineWidth(Value: Integer): HResult; stdcall; +begin + OutlineWidth := Value; + Result := S_OK; +end; + +function TfrxPreview.Get_Enabled(out Value: WordBool): HResult; stdcall; +begin + Value := Enabled; + Result := S_OK; +end; + +function TfrxPreview.Set_Enabled(Value: WordBool): HResult; stdcall; +begin + Enabled := Value; + Result := S_OK; +end; +{$ENDIF} + + +{ TfrxPreviewForm } + +procedure TfrxPreviewForm.FormCreate(Sender: TObject); +begin +{$IFDEF FR_COM} + Icon.Handle := LoadIcon(hInstance, 'SDESGNICON'); +{$ENDIF} + Caption := frxGet(100); + PrintB.Caption := frxGet(101); + PrintB.Hint := frxGet(102); + OpenB.Caption := frxGet(103); + OpenB.Hint := frxGet(104); + SaveB.Caption := frxGet(105); + SaveB.Hint := frxGet(106); + ExportB.Caption := frxGet(107); + ExportB.Hint := frxGet(108); + FindB.Caption := frxGet(109); + FindB.Hint := frxGet(110); + ZoomCB.Hint := frxGet(119); + PageSettingsB.Caption := frxGet(120); + PageSettingsB.Hint := frxGet(121); + DesignerB.Caption := frxGet(132); + DesignerB.Hint := frxGet(133); + {$IFDEF FR_LITE} + DesignerB.Hint := DesignerB.Hint + #13#10 + 'This feature is not available in FreeReport'; + {$ENDIF} + FirstB.Caption := frxGet(134); + FirstB.Hint := frxGet(135); + PriorB.Caption := frxGet(136); + PriorB.Hint := frxGet(137); + NextB.Caption := frxGet(138); + NextB.Hint := frxGet(139); + LastB.Caption := frxGet(140); + LastB.Hint := frxGet(141); + CancelB.Caption := frxResources.Get('clClose'); + PageE.Hint := frxGet(142); + FullScreenBtn.Hint := frxGet(150); + PdfB.Hint := frxGet(151); + EmailB.Hint := frxGet(152); + ZoomPlusB.Caption := frxGet(124); + ZoomPlusB.Hint := frxGet(125); + ZoomMinusB.Caption := frxGet(126); + ZoomMinusB.Hint := frxGet(127); + OutlineB.Caption := frxGet(128); + OutlineB.Hint := frxGet(129); + ThumbB.Caption := frxGet(130); + ThumbB.Hint := frxGet(131); + ZoomCB.Items.Clear; + ZoomCB.Items.Add('25%'); + ZoomCB.Items.Add('50%'); + ZoomCB.Items.Add('75%'); + ZoomCB.Items.Add('100%'); + ZoomCB.Items.Add('150%'); + ZoomCB.Items.Add('200%'); + ZoomCB.Items.Add(frxResources.Get('zmPageWidth')); + ZoomCB.Items.Add(frxResources.Get('zmWholePage')); + Toolbar.Images := frxResources.PreviewButtonImages; + ExpandMI.Caption := frxGet(600); + CollapseMI.Caption := frxGet(601); + + FPreview := TfrxPreview.Create(Self); + FPreview.Parent := Self; + FPreview.Align := alClient; + FPreview.BorderStyle := bsNone; + FPreview.BevelKind := bkNone; + FPreview.OnPageChanged := OnPageChanged; + FPreview.FWorkspace.OnDblClick := OnPreviewDblClick; + ActiveControl := FPreview; + SetWindowLong(PageE.Handle, GWL_STYLE, GetWindowLong(PageE.Handle, GWL_STYLE) or ES_NUMBER); + + if Screen.PixelsPerInch > 96 then + StatusBar.Height := 24; + + FFullScreen := False; + FPDFExport := nil; + FEmailExport := nil; + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxPreviewForm.Init; +var + i, j, k: Integer; + m, e: TMenuItem; +begin + FPreview.Init; + with Report.PreviewOptions do + begin + if Maximized then + WindowState := wsMaximized; + if MDIChild then + FormStyle := fsMDIChild; + FPreview.Zoom := Zoom; + FPreview.ZoomMode := ZoomMode; + + {$IFDEF FR_LITE} + DesignerB.Enabled := False; + {$ELSE} + DesignerB.Enabled := AllowEdit; + {$ENDIF} + + PrintB.Visible := pbPrint in Buttons; + OpenB.Visible := pbLoad in Buttons; + SaveB.Visible := pbSave in Buttons; + ExportB.Visible := pbExport in Buttons; + FindB.Visible := pbFind in Buttons; + PdfB.Visible := False; + EmailB.Visible := False; + + ZoomPlusB.Visible := pbZoom in Buttons; + ZoomMinusB.Visible := pbZoom in Buttons; + Sep3.Visible := pbZoom in Buttons; + FullScreenBtn.Visible := (pbZoom in Buttons) and not (pbNoFullScreen in Buttons); + if not (pbZoom in Buttons) then + Sep1.Free; + + OutlineB.Visible := pbOutline in Buttons; + ThumbB.Visible := pbOutline in Buttons; + PageSettingsB.Visible := pbPageSetup in Buttons; + DesignerB.Visible := pbEdit in Buttons; + if not (PageSettingsB.Visible or DesignerB.Visible) then + Sep2.Free; + + FirstB.Visible := pbNavigator in Buttons; + PriorB.Visible := pbNavigator in Buttons; + NextB.Visible := pbNavigator in Buttons; + LastB.Visible := pbNavigator in Buttons; + Sep4.Visible := pbNavigator in Buttons; + if not (pbNavigator in Buttons) then + Sep5.Free; + + CancelB.Visible := not (pbNoClose in Buttons); + + Toolbar.ShowCaptions := ShowCaptions; + end; + + if (frxExportFilters.Count = 0) or + ((frxExportFilters.Count = 1) and (frxExportFilters[0].Filter = frxDotMatrixExport)) then + ExportB.Visible := False; + + for i := 0 to frxExportFilters.Count - 1 do + begin + if frxExportFilters[i].Filter = frxDotMatrixExport then + continue; + m := TMenuItem.Create(ExportPopup); + ExportPopup.Items.Add(m); + m.Caption := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...'; + m.Tag := i; + m.OnClick := ExportMIClick; + if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxPDFExport' then + begin + FPDFExport := TfrxCustomExportFilter(frxExportFilters[i].Filter); + PdfB.Visible := pbExportQuick in Report.PreviewOptions.Buttons; + end; + if not (pbNoEmail in Report.PreviewOptions.Buttons) then + if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxMailExport' then + begin + FEmailExport := TfrxCustomExportFilter(frxExportFilters[i].Filter); + EmailB.Visible := pbExportQuick in Report.PreviewOptions.Buttons; + end; + end; + + if Report.ReportOptions.Name <> '' then + Caption := Report.ReportOptions.Name; + + k := 0; + + RightMenu.Images := ToolBar.Images; + for i := 0 to ToolBar.ButtonCount - 1 do + begin + if (ToolBar.Buttons[i].Style <> tbsCheck) and + (ToolBar.Buttons[i].Visible) and + (ToolBar.Buttons[i].Hint <> '') then + begin + m := TMenuItem.Create(RightMenu); + RightMenu.Items.Add(m); + ToolBar.Buttons[i].Tag := Integer(m); + m.Caption := ToolBar.Buttons[i].Hint; + m.OnClick := ToolBar.Buttons[i].OnClick; + m.ImageIndex := ToolBar.Buttons[i].ImageIndex; + if Assigned(ToolBar.Buttons[i].DropdownMenu) then + for j := 0 to ToolBar.Buttons[i].DropdownMenu.Items.Count - 1 do + begin + e := TMenuItem.Create(m); + e.Caption := ToolBar.Buttons[i].DropdownMenu.Items[j].Caption; + e.Tag := ToolBar.Buttons[i].DropdownMenu.Items[j].Tag; + e.OnClick := ToolBar.Buttons[i].DropdownMenu.Items[j].OnClick; + m.Add(e); + end; + end; + if ToolBar.Buttons[i].Style = tbsSeparator then + begin + if k = 1 then + break; + m := TMenuItem.Create(RightMenu); + RightMenu.Items.Add(m); + m.Caption := '-'; + Inc(k); + end; + end; + + PopupMenu := RightMenu; +end; + +procedure TfrxPreviewForm.UpdateControls; + + function HasDrillDown: Boolean; + var + l: TList; + i: Integer; + c: TfrxComponent; + begin + Result := False; + l := Report.AllObjects; + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then + begin + Result := True; + break; + end; + end; + end; + + procedure EnableControls(cAr: array of TObject; Enabled: Boolean); + var + i: Integer; + begin + for i := 0 to High(cAr) do + begin + if cAr[i] is TMenuItem then + TMenuItem(cAr[i]).Visible := Enabled + else if cAr[i] is TToolButton then + begin + TToolButton(cAr[i]).Enabled := Enabled; + TToolButton(cAr[i]).Down := False; + if TToolButton(cAr[i]).Tag <> 0 then + TMenuItem(TToolButton(cAr[i]).Tag).Enabled := Enabled; + end; + end; + end; + +begin + EnableControls([PrintB, OpenB, SaveB, ExportB, PdfB, EmailB, FindB, PageSettingsB], + (not FPreview.FRunning) and (FPreview.PageCount > 0)); + EnableControls([DesignerB], + not FPreview.FRunning and Report.PreviewOptions.AllowEdit); + EnableControls([ExpandMI, CollapseMI, N1], + not FPreview.FRunning and HasDrillDown); +end; + +procedure TfrxPreviewForm.PrintBClick(Sender: TObject); +begin + FPreview.Print; + Enabled := True; +end; + +procedure TfrxPreviewForm.OpenBClick(Sender: TObject); +begin + FPreview.LoadFromFile; + if Report.ReportOptions.Name <> '' then + Caption := Report.ReportOptions.Name + else + Caption := frxGet(100); +end; + +procedure TfrxPreviewForm.SaveBClick(Sender: TObject); +begin + FPreview.SaveToFile; +end; + +procedure TfrxPreviewForm.FindBClick(Sender: TObject); +begin + FPreview.Find; +end; + +procedure TfrxPreviewForm.ZoomPlusBClick(Sender: TObject); +begin + FPreview.Zoom := FPreview.Zoom + 0.25; +end; + +procedure TfrxPreviewForm.ZoomMinusBClick(Sender: TObject); +begin + FPreview.Zoom := FPreview.Zoom - 0.25; +end; + +function TfrxPreviewForm.GetReport: TfrxReport; +begin + Result := Preview.Report; +end; + +procedure TfrxPreviewForm.UpdateZoom; +begin + ZoomCB.Text := IntToStr(Round(FPreview.Zoom * 100)) + '%'; +end; + +procedure TfrxPreviewForm.ZoomCBClick(Sender: TObject); +var + s: String; +begin + FPreview.SetFocus; + + if ZoomCB.ItemIndex = 6 then + FPreview.ZoomMode := zmPageWidth + else if ZoomCB.ItemIndex = 7 then + FPreview.ZoomMode := zmWholePage + else + begin + s := ZoomCB.Text; + + if Pos('%', s) <> 0 then + s[Pos('%', s)] := ' '; + while Pos(' ', s) <> 0 do + Delete(s, Pos(' ', s), 1); + + if s <> '' then + FPreview.Zoom := frxStrToFloat(s) / 100; + end; + + PostMessage(Handle, WM_UPDATEZOOM, 0, 0); +end; + +procedure TfrxPreviewForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + CancelBClick(Self); + if Key = VK_F11 then + SwitchToFullScreen; + if Key = VK_F1 then + frxResources.Help(Self); +end; + +procedure TfrxPreviewForm.FormKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + begin + if ActiveControl = ZoomCB then + ZoomCBClick(nil); + if ActiveControl = PageE then + PageEClick(nil); + end; +end; + +procedure TfrxPreviewForm.WMUpdateZoom(var Message: TMessage); +begin + UpdateZoom; +end; + +procedure TfrxPreviewForm.PageSettingsBClick(Sender: TObject); +begin + FPreview.PageSetupDlg; +end; + +procedure TfrxPreviewForm.OnPageChanged(Sender: TfrxPreview; PageNo: Integer); +var + FirstPass: Boolean; +begin + FirstPass := False; + if FPreview.PreviewPages <> nil then + FirstPass := not FPreview.PreviewPages.Engine.FinalPass; + + if FirstPass and FPreview.FRunning then + StatusBar.Panels[0].Text := frxResources.Get('clFirstPass') + ' ' + + IntToStr(FPreview.PageCount) + else + StatusBar.Panels[0].Text := Format(frxResources.Get('clPageOf'), + [PageNo, FPreview.PageCount]); + PageE.Text := IntToStr(PageNo); +end; + +procedure TfrxPreviewForm.PageEClick(Sender: TObject); +begin + FPreview.PageNo := StrToInt(PageE.Text); + FPreview.SetFocus; +end; + +procedure TfrxPreviewForm.FirstBClick(Sender: TObject); +begin + FPreview.First; +end; + +procedure TfrxPreviewForm.PriorBClick(Sender: TObject); +begin + FPreview.Prior; +end; + +procedure TfrxPreviewForm.NextBClick(Sender: TObject); +begin + FPreview.Next; +end; + +procedure TfrxPreviewForm.LastBClick(Sender: TObject); +begin + FPreview.Last; +end; + +procedure TfrxPreviewForm.FormMouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +begin + FPreview.MouseWheelScroll(WheelDelta, False, ssCtrl in Shift); +end; + +procedure TfrxPreviewForm.DesignerBClick(Sender: TObject); +begin + FPreview.Edit; +end; + +procedure TfrxPreviewForm.FormCloseQuery(Sender: TObject; + var CanClose: Boolean); +begin + CanClose := not FPreview.FRunning; +end; + +procedure TfrxPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if FFreeOnClose then + Action := caFree; + if Assigned(Report.OnClosePreview) then + Report.OnClosePreview(Self); +end; + +procedure TfrxPreviewForm.NewPageBClick(Sender: TObject); +begin + FPreview.AddPage; +end; + +procedure TfrxPreviewForm.DelPageBClick(Sender: TObject); +begin + FPreview.DeletePage; +end; + +procedure TfrxPreviewForm.CancelBClick(Sender: TObject); +begin + if FPreview.FRunning then + FPreview.Cancel else + Close; +end; + +procedure TfrxPreviewForm.ExportMIClick(Sender: TObject); +begin + FPreview.Export(TfrxCustomExportFilter(frxExportFilters[TMenuItem(Sender).Tag].Filter)); + Enabled := True; +end; + +procedure TfrxPreviewForm.DesignerBMouseUp(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + pt: TPoint; +begin + pt := DesignerB.ClientToScreen(Point(0, 0)); + if Button = mbRight then + HiddenMenu.Popup(pt.X, pt.Y); +end; + +procedure TfrxPreviewForm.Showtemplate1Click(Sender: TObject); +begin + FPreview.EditTemplate; +end; + +procedure TfrxPreviewForm.SetMessageText(const Value: String); +begin + StatusBar.Panels[1].Text := Value; + Application.ProcessMessages; +end; + +procedure TfrxPreviewForm.SwitchToFullScreen; +begin + if not FFullScreen then + begin + StatusBar.Visible := False; + ToolBar.Visible := False; + FOldBS := BorderStyle; + FOldState := WindowState; + BorderStyle := bsNone; + WindowState := wsMaximized; + FFullScreen := True; + end + else + begin + WindowState := FOldState; + BorderStyle := FOldBS; + FFullScreen := False; + StatusBar.Visible := True; + ToolBar.Visible := True; + end; +end; + +procedure TfrxPreviewForm.FullScreenBtnClick(Sender: TObject); +begin + SwitchToFullScreen; +end; + +procedure TfrxPreviewForm.PdfBClick(Sender: TObject); +begin + if Assigned(FPDFExport) then + FPreview.Export(FPDFExport); +end; + +procedure TfrxPreviewForm.EmailBClick(Sender: TObject); +begin + if Assigned(FEmailExport) then + FPreview.Export(FEmailExport); +end; + +procedure TfrxPreviewForm.WMActivateApp(var Msg: TWMActivateApp); +begin + if IsIconic(Application.Handle) then + begin + ShowWindow(Application.Handle, SW_RESTORE); + SetActiveWindow(Handle); + end; + inherited; +end; + +procedure TfrxPreviewForm.WMSysCommand(var Msg: TWMSysCommand); +begin + if Msg.CmdType = SC_MINIMIZE then + if not Report.PreviewOptions.MDIChild then + ShowWindow(Application.Handle, SW_MINIMIZE) + else + inherited + else + inherited; +end; + +procedure TfrxPreviewForm.OutlineBClick(Sender: TObject); +begin + FPreview.OutlineVisible := OutlineB.Down; +end; + +procedure TfrxPreviewForm.ThumbBClick(Sender: TObject); +begin + FPreview.ThumbnailVisible := ThumbB.Down; +end; + +procedure TfrxPreviewForm.OnPreviewDblClick(Sender: TObject); +begin + if FFullScreen then + SwitchToFullScreen; +end; + +procedure TfrxPreviewForm.CollapseAllClick(Sender: TObject); +var + l: TList; + i: Integer; + c: TfrxComponent; +begin + FPreview.Lock; + l := Report.AllObjects; + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then + TfrxGroupHeader(c).ExpandDrillDown := False; + end; + Report.DrillState.Clear; + Preview.RefreshReport; +end; + +procedure TfrxPreviewForm.ExpandAllClick(Sender: TObject); +var + l: TList; + i: Integer; + c: TfrxComponent; +begin + FPreview.Lock; + l := Report.AllObjects; + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then + TfrxGroupHeader(c).ExpandDrillDown := True; + end; + Report.DrillState.Clear; + Preview.RefreshReport; +end; + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPreview.res b/official/4.2/Source/frxPreview.res new file mode 100644 index 0000000..358bacf Binary files /dev/null and b/official/4.2/Source/frxPreview.res differ diff --git a/official/4.2/Source/frxPreviewPageSettings.dfm b/official/4.2/Source/frxPreviewPageSettings.dfm new file mode 100644 index 0000000..a88bcab Binary files /dev/null and b/official/4.2/Source/frxPreviewPageSettings.dfm differ diff --git a/official/4.2/Source/frxPreviewPageSettings.pas b/official/4.2/Source/frxPreviewPageSettings.pas new file mode 100644 index 0000000..d21a881 --- /dev/null +++ b/official/4.2/Source/frxPreviewPageSettings.pas @@ -0,0 +1,257 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Preview Page settings } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPreviewPageSettings; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, StdCtrls, frxClass +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TfrxDesignerUnits = (duCM, duInches, duPixels, duChars); + + TfrxPageSettingsForm = class(TForm) + OKB: TButton; + CancelB: TButton; + SizeL: TGroupBox; + WidthL: TLabel; + HeightL: TLabel; + UnitL1: TLabel; + UnitL2: TLabel; + WidthE: TEdit; + HeightE: TEdit; + SizeCB: TComboBox; + OrientationL: TGroupBox; + PortraitImg: TImage; + LandscapeImg: TImage; + PortraitRB: TRadioButton; + LandscapeRB: TRadioButton; + MarginsL: TGroupBox; + LeftL: TLabel; + TopL: TLabel; + RightL: TLabel; + BottomL: TLabel; + UnitL3: TLabel; + UnitL4: TLabel; + UnitL5: TLabel; + UnitL6: TLabel; + MarginLeftE: TEdit; + MarginTopE: TEdit; + MarginRightE: TEdit; + MarginBottomE: TEdit; + OtherL: TGroupBox; + ApplyToCurRB: TRadioButton; + ApplyToAllRB: TRadioButton; + procedure FormShow(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure PortraitRBClick(Sender: TObject); + procedure SizeCBClick(Sender: TObject); + procedure WidthEChange(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + { Private declarations } + FPage: TfrxReportPage; + FReport: TfrxReport; + FUnits: TfrxDesignerUnits; + FUpdating: Boolean; + function GetNeedRebuild: Boolean; + function mmToUnits(mm: Extended): Extended; + function UnitsTomm(mm: Extended): Extended; + public + { Public declarations } + property NeedRebuild: Boolean read GetNeedRebuild; + property Page: TfrxReportPage read FPage write FPage; + property Report: TfrxReport read FReport write FReport; + end; + + +implementation + +{$R *.DFM} + +uses Printers, frxPrinter, frxUtils, frxRes, IniFiles; + + +function TfrxPageSettingsForm.mmToUnits(mm: Extended): Extended; +begin + Result := 0; + case FUnits of + duCM, duPixels, duChars: + Result := mm / 10; + duInches: + Result := mm / 25.4; + end; +end; + +function TfrxPageSettingsForm.UnitsTomm(mm: Extended): Extended; +begin + Result := 0; + case FUnits of + duCM, duPixels, duChars: + Result := mm * 10; + duInches: + Result := mm * 25.4; + end; +end; + +function TfrxPageSettingsForm.GetNeedRebuild: Boolean; +begin + Result := ApplyToAllRB.Checked; +end; + +procedure TfrxPageSettingsForm.FormShow(Sender: TObject); +var + i: Integer; + Ini: TCustomIniFile; + uStr: String; +begin + FUpdating := True; + + Caption := frxGet(400); + WidthL.Caption := frxGet(401); + HeightL.Caption := frxGet(402); + SizeL.Caption := frxGet(403); + OrientationL.Caption := frxGet(404); + LeftL.Caption := frxGet(405); + TopL.Caption := frxGet(406); + RightL.Caption := frxGet(407); + BottomL.Caption := frxGet(408); + MarginsL.Caption := frxGet(409); + PortraitRB.Caption := frxGet(410); + LandscapeRB.Caption := frxGet(411); + OKB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + OtherL.Caption := frxGet(412); + ApplyToCurRB.Caption := frxGet(413); + ApplyToAllRB.Caption := frxGet(414); + + Ini := Report.GetIniFile; + FUnits := TfrxDesignerUnits(Ini.ReadInteger('Form.TfrxDesignerForm', 'Units', 0)); + Ini.Free; + + uStr := ''; + case FUnits of + duCM, duPixels, duChars: + uStr := frxResources.Get('uCm'); + duInches: + uStr := frxResources.Get('uInch'); + end; + + UnitL1.Caption := uStr; + UnitL2.Caption := uStr; + UnitL3.Caption := uStr; + UnitL4.Caption := uStr; + UnitL5.Caption := uStr; + UnitL6.Caption := uStr; + + SizeCB.Items := frxPrinters.Printer.Papers; + i := frxPrinters.Printer.PaperIndex(Page.PaperSize); + if i = -1 then + i := frxPrinters.Printer.PaperIndex(256); + SizeCB.ItemIndex := i; + + WidthE.Text := frxFloatToStr(mmToUnits(Page.PaperWidth)); + HeightE.Text := frxFloatToStr(mmToUnits(Page.PaperHeight)); + PortraitRB.Checked := Page.Orientation = poPortrait; + LandscapeRB.Checked := Page.Orientation = poLandscape; + + MarginLeftE.Text := frxFloatToStr(mmToUnits(Page.LeftMargin)); + MarginRightE.Text := frxFloatToStr(mmToUnits(Page.RightMargin)); + MarginTopE.Text := frxFloatToStr(mmToUnits(Page.TopMargin)); + MarginBottomE.Text := frxFloatToStr(mmToUnits(Page.BottomMargin)); + + PortraitRBClick(nil); + FUpdating := False; +end; + +procedure TfrxPageSettingsForm.FormHide(Sender: TObject); +begin + if ModalResult = mrOk then + begin + if PortraitRB.Checked then + Page.Orientation := poPortrait else + Page.Orientation := poLandscape; + + Page.PaperWidth := UnitsTomm(frxStrToFloat(WidthE.Text)); + Page.PaperHeight := UnitsTomm(frxStrToFloat(HeightE.Text)); + Page.PaperSize := frxPrinters.Printer.PaperNameToNumber(SizeCB.Text); + + Page.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text)); + Page.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text)); + Page.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text)); + Page.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text)); + + Page.AlignChildren; + end; +end; + +procedure TfrxPageSettingsForm.PortraitRBClick(Sender: TObject); +begin + PortraitImg.Visible := PortraitRB.Checked; + LandscapeImg.Visible := LandscapeRB.Checked; + SizeCBClick(nil); +end; + +procedure TfrxPageSettingsForm.SizeCBClick(Sender: TObject); +var + pOr: TPrinterOrientation; + pNumber: Integer; + pWidth, pHeight: Extended; +begin + if FUpdating then Exit; + FUpdating := True; + + with frxPrinters.Printer do + begin + pNumber := PaperNameToNumber(SizeCB.Text); + pWidth := UnitsTomm(frxStrToFloat(WidthE.Text)); + pHeight := UnitsTomm(frxStrToFloat(HeightE.Text)); + if PortraitRB.Checked then + pOr := poPortrait else + pOr := poLandscape; + + if pNumber = 256 then + SetViewParams(pNumber, pHeight, pWidth, pOr) else + SetViewParams(pNumber, pWidth, pHeight, pOr); + + WidthE.Text := frxFloatToStr(mmToUnits(PaperWidth)); + HeightE.Text := frxFloatToStr(mmToUnits(PaperHeight)); + end; + + FUpdating := False; +end; + +procedure TfrxPageSettingsForm.WidthEChange(Sender: TObject); +begin + if not FUpdating then + SizeCB.ItemIndex := 0; +end; + +procedure TfrxPageSettingsForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPreviewPages.pas b/official/4.2/Source/frxPreviewPages.pas new file mode 100644 index 0000000..5149a31 --- /dev/null +++ b/official/4.2/Source/frxPreviewPages.pas @@ -0,0 +1,2326 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Preview Pages } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPreviewPages; + +interface + +{$I frx.inc} + +uses + Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, + frxClass, frxXML, frxPictureCache +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxOutline = class(TfrxCustomOutline) + private + protected + function GetCount: Integer; override; + public + function Root: TfrxXMLItem; + procedure AddItem(const Text: String; Top: Integer); override; + procedure LevelDown(Index: Integer); override; + procedure LevelRoot; override; + procedure LevelUp; override; + procedure GetItem(Index: Integer; var Text: String; + var Page, Top: Integer); override; + procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); override; + function GetCurPosition: TfrxXMLItem; override; + end; + + TfrxDictionary = class(TObject) + private + FNames: TStringList; + FSourceNames: TStringList; + public + constructor Create; + destructor Destroy; override; + procedure Add(const Name, SourceName: String; Obj: TObject); + procedure Clear; + function AddUnique(const Base, SourceName: String; Obj: TObject): String; + function CreateUniqueName(const Base: String): String; + function GetSourceName(const Name: String): String; + function GetObject(const Name: String): TObject; + property Names: TStringList read FNames; + property SourceNames: TStringList read FSourceNames; + end; + + TfrxPreviewPages = class(TfrxCustomPreviewPages) + private + FAllowPartialLoading: Boolean; + FCopyNo: Integer; + FDictionary: TfrxDictionary; { list of all objects } + FFirstObjectIndex: Integer; { used in the ClearFirstPassPages } + FFirstPageIndex: Integer; { used in the ClearFirstPassPages } + FLogicalPageN: Integer; + FPageCache: TStringList; { last 20 TfrxPreviewPage } + FPagesItem: TfrxXMLItem; { shortcut to XMLDoc.Root.FindName('previewpages') } + FPictureCache: TfrxPictureCache; + FPrintScale: Extended; + FSourcePages: TList; { list of source pages } + FTempStream: TStream; + FXMLDoc: TfrxXMLDocument; { parsed FP3 document } + FXMLSize: Integer; + procedure AfterLoad; + procedure BeforeSave; + procedure ClearPageCache; + procedure ClearSourcePages; + function CurXMLPage: TfrxXMLItem; + function GetObject(const Name: String): TfrxComponent; + procedure DoLoadFromStream; + procedure DoSaveToStream; + protected + function GetCount: Integer; override; + function GetPage(Index: Integer): TfrxReportPage; override; + function GetPageSize(Index: Integer): TPoint; override; + public + constructor Create(AReport: TfrxReport); override; + destructor Destroy; override; + procedure Clear; override; + procedure Initialize; override; + + { engine commands } + procedure AddAnchor(const Text: String); + procedure AddObject(Obj: TfrxComponent); override; + procedure AddPage(Page: TfrxReportPage); override; + procedure AddPicture(Picture: TfrxPictureView); override; + procedure AddSourcePage(Page: TfrxReportPage); override; + procedure AddToSourcePage(Obj: TfrxComponent); override; + procedure BeginPass; override; + procedure ClearFirstPassPages; override; + procedure CutObjects(APosition: Integer); override; + procedure Finish; override; + procedure IncLogicalPageNumber; override; + procedure ResetLogicalPageNumber; override; + procedure PasteObjects(X, Y: Extended); override; + procedure ShiftAnchors(From, NewTop: Integer); override; + procedure UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended); + function BandExists(Band: TfrxBand): Boolean; override; + function FindAnchor(const Text: String): TfrxXMLItem; + function GetAnchorPage(const Text: String): Integer; + function GetAnchorCurPosition: Integer; override; + function GetCurPosition: Integer; override; + function GetLastY: Extended; override; + function GetLogicalPageNo: Integer; override; + function GetLogicalTotalPages: Integer; override; + + { preview commands } + procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY, + OffsetX, OffsetY: Extended); override; + procedure AddEmptyPage(Index: Integer); override; + procedure DeletePage(Index: Integer); override; + procedure ModifyPage(Index: Integer; Page: TfrxReportPage); override; + procedure AddFrom(Report: TfrxReport); override; + procedure LoadFromStream(Stream: TStream; + AllowPartialLoading: Boolean = False); override; + procedure SaveToStream(Stream: TStream); override; + function LoadFromFile(const FileName: String; + ExceptionIfNotFound: Boolean = False): Boolean; override; + procedure SaveToFile(const FileName: String); override; + function Print: Boolean; override; + function Export(Filter: TfrxCustomExportFilter): Boolean; override; + procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton; + Shift: TShiftState; Scale, OffsetX, OffsetY: Extended; + Click: Boolean; var Cursor: TCursor); override; + property SourcePages: TList read FSourcePages; + end; + + +implementation + +uses + frxPreview, Printers, frxPrinter, frxPrintDialog, frxXMLSerializer, frxUtils, + ShellApi, frxDMPClass, frxRes; + +type + THackComponent = class(TfrxComponent); + THackMemoView = class(TfrxCustomMemoView); + THackThread = class(TThread); + +{$IFDEF TRIAL} +const + FR_UNREG = ')segap 5 ylno( noisrev deretsigernU - tropeRtsaF'; +{$ENDIF} + +{ TfrxOutline } + +procedure TfrxOutline.AddItem(const Text: String; Top: Integer); +begin + CurItem := CurItem.Add; + CurItem.Name := 'item'; + CurItem.Text := 'text="' + frxStrToXML(Text) + + '" page="' + IntToStr(PreviewPages.CurPage) + + '" top="' + IntToStr(Top) + '"'; +end; + +procedure TfrxOutline.GetItem(Index: Integer; var Text: String; var Page, + Top: Integer); +var + Item: TfrxXMLItem; + s: String; +begin + Item := CurItem[Index]; + Text := Item.Prop['text']; + + s := Item.Prop['page']; + if s <> '' then + Page := StrToInt(s); + + s := Item.Prop['top']; + if s <> '' then + Top := StrToInt(s); +end; + +procedure TfrxOutline.LevelDown(Index: Integer); +begin + CurItem := CurItem[Index]; +end; + +procedure TfrxOutline.LevelRoot; +begin + CurItem := Root; +end; + +procedure TfrxOutline.LevelUp; +begin + if CurItem <> Root then + CurItem := CurItem.Parent; +end; + +function TfrxOutline.Root: TfrxXMLItem; +begin + Result := TfrxPreviewPages(PreviewPages).FXMLDoc.Root.FindItem('outline'); +end; + +function TfrxOutline.GetCount: Integer; +begin + if CurItem = nil then + Result := 0 + else + Result := CurItem.Count; +end; + +procedure TfrxOutline.ShiftItems(From: TfrxXMLItem; NewTop: Integer); +var + i, TopY, CorrY: Integer; + + procedure EnumItems(Item: TfrxXMLItem); + var + i: Integer; + begin + Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1); + Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY); + for i := 0 to Item.Count - 1 do + EnumItems(Item[i]); + end; + +begin + if From = nil then Exit; + i := From.Parent.IndexOf(From); + if i + 1 >= From.Parent.Count then Exit; + From := From.Parent[i + 1]; + + TopY := StrToInt(From.Prop['top']); + CorrY := NewTop - TopY; + EnumItems(From); +end; + +function TfrxOutline.GetCurPosition: TfrxXMLItem; +begin + if Count = 0 then + Result := nil else + Result := CurItem[Count - 1]; +end; + + +{ TfrxDictionary } + +constructor TfrxDictionary.Create; +begin + FNames := TStringList.Create; + FNames.Sorted := True; + FSourceNames := TStringList.Create; +end; + +destructor TfrxDictionary.Destroy; +begin + FNames.Free; + FSourceNames.Free; + inherited; +end; + +procedure TfrxDictionary.Clear; +begin + FNames.Clear; + FSourceNames.Clear; +end; + +procedure TfrxDictionary.Add(const Name, SourceName: String; Obj: TObject); +var + i: Integer; +begin + i := FSourceNames.AddObject(SourceName, Obj); + FNames.AddObject(Name, TObject(i)); +end; + +function TfrxDictionary.AddUnique(const Base, SourceName: String; Obj: TObject): String; +begin + Result := CreateUniqueName(Base); + Add(Result, SourceName, Obj); +end; + +function TfrxDictionary.CreateUniqueName(const Base: String): String; +var + i: Integer; +begin + i := 10000; + while (i > 1) and (FNames.IndexOf(Base + IntToStr(i)) = -1) do + i := i div 2; + while FNames.IndexOf(Base + IntToStr(i)) <> -1 do + Inc(i); + Result := Base + IntToStr(i); +end; + +function TfrxDictionary.GetObject(const Name: String): TObject; +var + i: Integer; +begin + Result := nil; + i := FNames.IndexOf(Name); + if i <> -1 then + Result := FSourceNames.Objects[Integer(FNames.Objects[i])]; +end; + +function TfrxDictionary.GetSourceName(const Name: String): String; +var + i: Integer; +begin + Result := ''; + i := FNames.IndexOf(Name); + if i <> -1 then + Result := FSourceNames[Integer(FNames.Objects[i])]; +end; + + +{ TfrxPreviewPages } + +constructor TfrxPreviewPages.Create(AReport: TfrxReport); +begin + inherited; + FDictionary := TfrxDictionary.Create; + FSourcePages := TList.Create; + FXMLDoc := TfrxXMLDocument.Create; + FXMLDoc.Root.Name := 'preparedreport'; +// FXMLDoc.AutoIndent := True; + FPageCache := TStringList.Create; + FPictureCache := TfrxPictureCache.Create; +end; + +destructor TfrxPreviewPages.Destroy; +begin + ClearPageCache; + FPageCache.Free; + FDictionary.Free; + ClearSourcePages; + FPictureCache.Free; + FSourcePages.Free; + FXMLDoc.Free; + inherited; +end; + +procedure TfrxPreviewPages.Clear; +begin + ClearPageCache; + ClearSourcePages; + FXMLDoc.Clear; + FDictionary.Clear; + FPictureCache.Clear; + CurPage := -1; + FXMLSize := 0; +end; + +procedure TfrxPreviewPages.Initialize; +begin + FXMLDoc.TempDir := Report.EngineOptions.TempDir; + Report.InternalOnProgressStart(ptRunning); +end; + +procedure TfrxPreviewPages.ClearPageCache; +begin + while FPageCache.Count > 0 do + begin + TfrxReportPage(FPageCache.Objects[0]).Free; + FPageCache.Delete(0); + end; +end; + +procedure TfrxPreviewPages.ClearSourcePages; +begin + while FSourcePages.Count > 0 do + begin + TfrxReportPage(FSourcePages[0]).Free; + FSourcePages.Delete(0); + end; +end; + +procedure TfrxPreviewPages.BeginPass; +begin + FFirstPageIndex := Count - 1; + if FFirstPageIndex <> -1 then + FFirstObjectIndex := FXMLDoc.Root.FindItem('previewpages')[FFirstPageIndex].Count; + ResetLogicalPageNumber; +end; + +procedure TfrxPreviewPages.ClearFirstPassPages; +var + PagesRoot: TfrxXMLItem; + p: TfrxXMLItem; + i: Integer; +begin + if FFirstPageIndex = -1 then + begin + for i := 0 to FXMLDoc.Root.Count - 1 do + if (CompareText(FXMLDoc.Root[i].Name, 'anchors') <> 0) and + (CompareText(FXMLDoc.Root[i].Name, 'logicalpagenumbers') <> 0) then + FXMLDoc.Root[i].Clear; + end + else + begin + PagesRoot := FXMLDoc.Root.FindItem('previewpages'); + p := PagesRoot[FFirstPageIndex]; + { clear some objects on first page } + while p.Count > FFirstObjectIndex do + p[FFirstObjectIndex].Free; + { clear remained pages } + while Count > FFirstPageIndex + 1 do + PagesRoot[FFirstPageIndex + 1].Free; + end; + + ResetLogicalPageNumber; + CurPage := FFirstPageIndex; + FXMLSize := 0; +end; + +function TfrxPreviewPages.CurXMLPage: TfrxXMLItem; +begin + Result := FXMLDoc.Root.FindItem('previewpages'); + Result := Result[CurPage]; +end; + +function TfrxPreviewPages.GetCount: Integer; +begin + Result := FXMLDoc.Root.FindItem('previewpages').Count; +end; + +function TfrxPreviewPages.GetCurPosition: Integer; +begin + Result := CurXMLPage.Count; +end; + +procedure TfrxPreviewPages.AddAnchor(const Text: String); +var + AnchorRoot, Item: TfrxXMLItem; +begin + AnchorRoot := FXMLDoc.Root.FindItem('anchors'); + Item := AnchorRoot.Add; + Item.Name := 'item'; + Item.Text := 'text="' + frxStrToXML(Text) + + '" page="' + IntToStr(CurPage) + + '" top="' + IntToStr(Round(Engine.CurY)) + '"'; +end; + +function TfrxPreviewPages.FindAnchor(const Text: String): TfrxXMLItem; +var + AnchorRoot, Item: TfrxXMLItem; + i: Integer; +begin + Result := nil; + AnchorRoot := FXMLDoc.Root.FindItem('anchors'); + for i := AnchorRoot.Count - 1 downto 0 do + begin + Item := AnchorRoot[i]; + if AnsiCompareText(Item.Prop['text'], Text) = 0 then + begin + Result := Item; + Exit; + end; + end; +end; + +function TfrxPreviewPages.GetAnchorPage(const Text: String): Integer; +var + Item: TfrxXMLItem; +begin + Item := FindAnchor(Text); + if Item <> nil then + Result := StrToInt(Item.Prop['page']) + 1 else + Result := 1; +end; + +function TfrxPreviewPages.GetAnchorCurPosition: Integer; +begin + Result := FXMLDoc.Root.FindItem('anchors').Count - 1; +end; + +procedure TfrxPreviewPages.ShiftAnchors(From, NewTop: Integer); +var + i, CorrY: Integer; + AnchorRoot, Item: TfrxXMLItem; +begin + AnchorRoot := FXMLDoc.Root.FindItem('anchors'); + if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit; + + Item := AnchorRoot[From + 1]; + CorrY := NewTop - StrToInt(Item.Prop['top']); + + for i := From + 1 to AnchorRoot.Count - 1 do + begin + Item := AnchorRoot[i]; + Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1); + Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY); + end; +end; + +procedure TfrxPreviewPages.IncLogicalPageNumber; +var + xi: TfrxXMLItem; +begin + if Engine.FinalPass and Engine.DoublePass then Exit; + + Inc(FLogicalPageN); + xi := FXMLDoc.Root.FindItem('logicalpagenumbers').Add; + xi.Name := 'page'; + xi.Prop['n'] := IntToStr(FLogicalPageN); +end; + +procedure TfrxPreviewPages.ResetLogicalPageNumber; +var + i: Integer; + xi, pageItem: TfrxXMLItem; +begin + if Engine.FinalPass and Engine.DoublePass then Exit; + + pageItem := FXMLDoc.Root.FindItem('logicalpagenumbers'); + for i := CurPage downto FFirstPageIndex + 1 do + begin + if (i < 0) or (i >= pageItem.Count) then continue; + xi := pageItem[i]; + xi.Prop['t'] := IntToStr(FLogicalPageN); + if xi.Prop['n'] = '1' then + break; + end; + FLogicalPageN := 0; +end; + +function TfrxPreviewPages.GetLogicalPageNo: Integer; +var + xi: TfrxXMLItem; +begin + xi := FXMLDoc.Root.FindItem('logicalpagenumbers'); + if (CurPage < 0) or (CurPage >= xi.Count) then + Result := CurPage - FirstPage + 1 + else + begin + xi := xi[CurPage]; + Result := StrToInt(xi.Prop['n']); + end; +end; + +function TfrxPreviewPages.GetLogicalTotalPages: Integer; +var + xi: TfrxXMLItem; +begin + xi := FXMLDoc.Root.FindItem('logicalpagenumbers'); + if (CurPage < 0) or (CurPage >= xi.Count) then + Result := Engine.TotalPages - FirstPage + else + begin + xi := xi[CurPage]; + if xi.Prop['t'] <> '' then + Result := StrToInt(xi.Prop['t']) + else + Result := 0; + end; +end; + +procedure TfrxPreviewPages.AddObject(Obj: TfrxComponent); + + procedure DoAdd(c: TfrxComponent; Item: TfrxXMLItem); + var + i: Integer; + begin + if (not c.Visible) or not (csPreviewVisible in c.frComponentStyle) then Exit; + + with THackComponent(c) do + begin + Item := Item.Add; + { the component that was created after report has been started } + if FOriginalComponent = nil then + begin + Item.Name := ClassName; + Item.Text := AllDiff(nil); + end + else + begin + { the component that exists in the report template } + Item.Name := FAliasName; + if Engine.FinalPass then + begin + if csDefaultDiff in frComponentStyle then + Item.Text := AllDiff(FOriginalComponent) else + Item.Text := Diff(FOriginalComponent); + end + else + { we don't need to output all info on the first pass, only coordinates } + Item.Text := InternalDiff(FOriginalComponent); + end; + Inc(FXMLSize, Length(Item.Name) + Length(Item.Text) + Item.InstanceSize + 16); + end; + + for i := 0 to c.Objects.Count - 1 do + DoAdd(c.Objects[i], Item); + end; + +begin + DoAdd(Obj, CurXMLPage); +end; + +procedure TfrxPreviewPages.AddPage(Page: TfrxReportPage); +var + xi: TfrxXMLItem; + + procedure UnloadPages; + var + i: Integer; + begin + if Report.EngineOptions.UseFileCache then + if FXMLSize > Report.EngineOptions.MaxMemSize * 1024 * 1024 then + begin + for i := xi.Count - 2 downto 0 do + if xi[i].Loaded then + FXMLDoc.UnloadItem(xi[i]) else + break; + FXMLSize := 0; + end; + end; + + function GetSourceNo(Page: TfrxReportPage): Integer; + var + i: Integer; + begin + Result := -1; + for i := 0 to FSourcePages.Count - 1 do + if THackComponent(FSourcePages[i]).FOriginalComponent = Page then + begin + Result := i; + break; + end; + end; + +begin + FPagesItem := FXMLDoc.Root.FindItem('previewpages'); + xi := FPagesItem; + UnloadPages; + + CurPage := CurPage + 1; + if (CurPage >= Count) or (AddPageAction = apAdd) then + begin + xi := xi.Add; + xi.Name := 'page' + IntToStr(GetSourceNo(Page)); + if Count > 2 then + xi.Unloadable := True; + Report.InternalOnProgress(ptRunning, CurPage + 1); + AddPageAction := apWriteOver; + CurPage := Count - 1; + IncLogicalPageNumber; + end; +end; + +procedure TfrxPreviewPages.AddSourcePage(Page: TfrxReportPage); +var + p: TfrxReportPage; + xs: TfrxXMLSerializer; + xi: TfrxXMLItem; + i: Integer; + originals, copies: TList; + c1, c2: TfrxComponent; + s, s1: String; + + function EnumObjects(Parent, Parent1: TfrxComponent): TfrxComponent; + var + i: Integer; + c: TfrxComponent; + begin + Result := nil; + if not (csPreviewVisible in Parent.frComponentStyle) then Exit; + + c := TfrxComponent(Parent.NewInstance); + c.Create(Parent1); + if Parent is TfrxPictureView then + TfrxPictureView(Parent).IsPictureStored := False; + c.Assign(Parent); + if Parent is TfrxPictureView then + TfrxPictureView(Parent).IsPictureStored := True; + c.Name := Parent.Name; + originals.Add(Parent); + copies.Add(c); + + for i := 0 to Parent.Objects.Count - 1 do + EnumObjects(Parent.Objects[i], c); + Result := c; + end; + +begin + xs := TfrxXMLSerializer.Create(nil); + xi := TfrxXMLItem.Create; + originals := TList.Create; + copies := TList.Create; + + try + p := TfrxReportPage(EnumObjects(Page, nil)); + THackComponent(p).FOriginalComponent := Page; + FSourcePages.Add(p); + + for i := 1 to copies.Count - 1 do + begin + c1 := copies[i]; + c2 := originals[i]; + + THackComponent(c2).FOriginalComponent := c1; + THackComponent(c1).FOriginalComponent := c2; + + if c1 is TfrxBand then + s := 'b' else + s := LowerCase(c1.BaseName[1]); + s := FDictionary.AddUnique(s, 'Page' + IntToStr(FSourcePages.Count - 1) + + '.' + c1.Name, c1); + // speed optimization + if c1 is TfrxCustomMemoView then + begin + TfrxCustomMemoView(c1).DataSet := nil; + TfrxCustomMemoView(c1).DataField := ''; + end; + if csDefaultDiff in c1.frComponentStyle then + s1 := c1.ClassName + else + s1 := xs.WriteComponentStr(c1); + THackComponent(c1).FBaseName := s1; + THackComponent(c1).FAliasName := s; + THackComponent(c2).FAliasName := s; + end; + + finally + originals.Free; + copies.Free; + xs.Free; + xi.Free; + end; +end; + +procedure TfrxPreviewPages.AddPicture(Picture: TfrxPictureView); +begin + FPictureCache.AddPicture(Picture); +end; + +procedure TfrxPreviewPages.AddToSourcePage(Obj: TfrxComponent); +var + NewObj: TfrxComponent; + Page: TfrxReportPage; + s: String; + xs: TfrxXMLSerializer; +begin + xs := TfrxXMLSerializer.Create(nil); + Page := FSourcePages[FSourcePages.Count - 1]; + NewObj := TfrxComponent(Obj.NewInstance); + NewObj.Create(Page); + NewObj.Assign(Obj); + NewObj.CreateUniqueName; + + s := FDictionary.AddUnique(LowerCase(NewObj.BaseName[1]), + 'Page' + IntToStr(FSourcePages.Count - 1) + '.' + NewObj.Name, NewObj); + if csDefaultDiff in NewObj.frComponentStyle then + THackComponent(NewObj).FBaseName := NewObj.ClassName else + THackComponent(NewObj).FBaseName := xs.WriteComponentStr(NewObj); + + THackComponent(Obj).FOriginalComponent := NewObj; + THackComponent(Obj).FAliasName := s; + THackComponent(NewObj).FAliasName := s; + xs.Free; +end; + +procedure TfrxPreviewPages.UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended); +var + SourcePage: TfrxReportPage; + xi: TfrxXMLItem; + i: Integer; +begin + SourcePage := nil; + for i := 0 to FSourcePages.Count - 1 do + begin + SourcePage := FSourcePages[i]; + if THackComponent(SourcePage).FOriginalComponent = Page then + break; + end; + + SourcePage.PaperSize := 256; + SourcePage.PaperWidth := Width / fr01cm; + SourcePage.PaperHeight := Height / fr01cm; + xi := TfrxXMLItem.Create; + xi.Text := THackComponent(SourcePage).FBaseName; + xi.Prop['PaperSize'] := '256'; + xi.Prop['PaperWidth'] := frxFloatToStr(SourcePage.PaperWidth); + xi.Prop['PaperHeight'] := frxFloatToStr(SourcePage.PaperHeight); + THackComponent(SourcePage).FBaseName := xi.Text; + xi.Free; +end; + +procedure TfrxPreviewPages.Finish; +var + i: Integer; +begin + ClearPageCache; + { avoid bug with multiple PrepareReport(False) } + for i := 0 to FSourcePages.Count - 1 do + THackComponent(FSourcePages[i]).FOriginalComponent := nil; + Report.InternalOnProgressStop(ptRunning); +end; + +function TfrxPreviewPages.BandExists(Band: TfrxBand): Boolean; +var + i: Integer; + c: TfrxComponent; +begin + Result := False; + for i := 0 to CurXMLPage.Count - 1 do + begin + c := GetObject(CurXMLPage[i].Name); + if c <> nil then + if (THackComponent(c).FOriginalComponent = Band) or + ((Band is TfrxPageFooter) and (c is TfrxPageFooter)) or + ((Band is TfrxColumnFooter) and (c is TfrxColumnFooter)) then + begin + Result := True; + break; + end; + end; +end; + +function TfrxPreviewPages.GetLastY: Extended; +var + i: Integer; + c: TfrxComponent; + s: String; + y: Extended; +begin + Result := 0; + for i := 0 to CurXMLPage.Count - 1 do + begin + c := GetObject(CurXMLPage[i].Name); + if c is TfrxBand then + if not (c is TfrxPageFooter) and not (c is TfrxOverlay) then + begin + s := CurXMLPage[i].Prop['t']; + if s <> '' then + y := frxStrToFloat(s) else + y := c.Top; + s := CurXMLPage[i].Prop['h']; + if s <> '' then + y := y + frxStrToFloat(s) else + y := y + c.Height; + if y > Result then + Result := y; + end; + end; +end; + +procedure TfrxPreviewPages.CutObjects(APosition: Integer); +var + xi: TfrxXMLItem; +begin + xi := FXMLDoc.Root.FindItem('cutted'); + while APosition < CurXMLPage.Count do + xi.AddItem(CurXMLPage[APosition]); +end; + +procedure TfrxPreviewPages.PasteObjects(X, Y: Extended); +var + xi: TfrxXMLItem; + LeftX, TopY, CorrX, CorrY: Extended; + + procedure CorrectX(xi: TfrxXMLItem); + var + X: Extended; + begin + if xi.Prop['l'] <> '' then + X := frxStrToFloat(xi.Prop['l']) else + X := 0; + X := X + CorrX; + xi.Prop['l'] := FloatToStr(X); + end; + + procedure CorrectY(xi: TfrxXMLItem); + var + Y: Extended; + begin + if xi.Prop['t'] <> '' then + Y := frxStrToFloat(xi.Prop['t']) else + Y := 0; + Y := Y + CorrY; + xi.Prop['t'] := FloatToStr(Y); + end; + +begin + xi := FXMLDoc.Root.FindItem('cutted'); + + if xi.Count > 0 then + begin + if xi[0].Prop['l'] <> '' then + LeftX := frxStrToFloat(xi[0].Prop['l']) else + LeftX := 0; + CorrX := X - LeftX; + + if xi[0].Prop['t'] <> '' then + TopY := frxStrToFloat(xi[0].Prop['t']) else + TopY := 0; + CorrY := Y - TopY; + + while xi.Count > 0 do + begin + CorrectX(xi[0]); + CorrectY(xi[0]); + CurXMLPage.AddItem(xi[0]); + end; + end; + + xi.Free; +end; + +procedure TfrxPreviewPages.DoLoadFromStream; +var + Compressor: TfrxCustomCompressor; +begin + Compressor := nil; + if frxCompressorClass <> nil then + begin + FAllowPartialLoading := False; + Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance); + Compressor.Create(nil); + Compressor.Report := Report; + Compressor.IsFR3File := False; + try + Compressor.CreateStream; + if Compressor.Decompress(FTempStream) then + FTempStream := Compressor.Stream; + except + Compressor.Free; + Report.Errors.Add(frxResources.Get('clDecompressError')); + frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text); + Exit; + end; + end; + FXMLDoc.LoadFromStream(FTempStream, FAllowPartialLoading); + AfterLoad; + if Compressor <> nil then + Compressor.Free; +end; + +procedure TfrxPreviewPages.DoSaveToStream; +var + Compressor: TfrxCustomCompressor; + StreamTo: TStream; +begin + StreamTo := FTempStream; + Compressor := nil; + if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then + begin + Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance); + Compressor.Create(nil); + Compressor.Report := Report; + Compressor.IsFR3File := False; + Compressor.CreateStream; + StreamTo := Compressor.Stream; + end; + try + BeforeSave; + FXMLDoc.SaveToStream(StreamTo); + finally + if Compressor <> nil then + begin + try + Compressor.Compress(FTempStream); + finally + Compressor.Free; + end; + end; + end; +end; + +procedure TfrxPreviewPages.LoadFromStream(Stream: TStream; + AllowPartialLoading: Boolean = False); +begin + Clear; + FTempStream := Stream; + FAllowPartialLoading := AllowPartialLoading; +{$IFNDEF FR_COM} +// if Report.EngineOptions.ReportThread <> nil then +// THackThread(Report.EngineOptions.ReportThread).Synchronize(DoLoadFromStream) +// else +{$ENDIF} + DoLoadFromStream; +end; + +procedure TfrxPreviewPages.SaveToStream(Stream: TStream); +begin + FTempStream := Stream; +{$IFNDEF FR_COM} +// if Report.EngineOptions.ReportThread <> nil then +// THackThread(Report.EngineOptions.ReportThread).Synchronize(DoSaveToStream) +// else +{$ENDIF} + DoSaveToStream; +end; + +function TfrxPreviewPages.LoadFromFile(const FileName: String; + ExceptionIfNotFound: Boolean): Boolean; +var + Stream: TFileStream; +begin + Result := FileExists(FileName); + if Result or ExceptionIfNotFound then + begin + Stream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +{ Clear; + FXMLDoc.LoadFromFile(FileName); + AfterLoad;} + end; +end; + +procedure TfrxPreviewPages.SaveToFile(const FileName: String); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +{ BeforeSave; + FXMLDoc.SaveToFile(FileName); + ClearPageCache; + AfterLoad;} +end; + +procedure TfrxPreviewPages.AfterLoad; +var + i: Integer; + xs: TfrxXMLSerializer; + xi: TfrxXMLItem; + p: TfrxReportPage; + +{ store source objects' properties in the FBaseName to get it later in the GetPage } + procedure DoProps(p: TfrxReportPage); + var + i: Integer; + l: TList; + c: THackComponent; + begin + l := p.AllObjects; + for i := 0 to l.Count - 1 do + begin + c := l[i]; + c.FBaseName := xs.WriteComponentStr(c); + end; + end; + +{ fill FDictionary.Objects } + procedure FillDictionary; + var + i: Integer; + Name, PageName, ObjName: String; + PageN: Integer; + begin + xi := FXMLDoc.Root.FindItem('dictionary'); + FDictionary.Clear; + for i := 0 to xi.Count - 1 do + begin + Name := Copy(xi[i].Text, 7, Length(xi[i].Text) - 7); + PageName := Copy(Name, 1, Pos('.', Name) - 1); + ObjName := Copy(Name, Pos('.', Name) + 1, 255); + + PageN := StrToInt(Copy(PageName, 5, 255)); + FDictionary.Add(xi[i].Name, Name, + TfrxReportPage(FSourcePages[PageN]).FindObject(ObjName)); + end; + end; + +begin + FPagesItem := FXMLDoc.Root.FindItem('previewpages'); + xs := TfrxXMLSerializer.Create(nil); + +{ load the report settings } + xi := FXMLDoc.Root.FindItem('report'); + if xi.Count > 0 then + xs.ReadRootComponent(Report, xi[0]); + +{ build sourcepages } + try + xi := FXMLDoc.Root.FindItem('sourcepages'); + ClearSourcePages; + + for i := 0 to xi.Count - 1 do + begin + if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then + p := TfrxDMPPage.Create(nil) else + p := TfrxReportPage.Create(nil); + xs.Owner := p; + xs.ReadRootComponent(p, xi[i]); + DoProps(p); + FSourcePages.Add(p); + end; + xi.Clear; + + finally + xs.Free; + end; + +{ build the dictionary } + FillDictionary; + +{ load the picturecache } + FPictureCache.LoadFromXML(FXMLDoc.Root.FindItem('picturecache')); +end; + +procedure TfrxPreviewPages.BeforeSave; +var + i: Integer; + xs: TfrxXMLSerializer; + xi: TfrxXMLItem; +begin + FPagesItem := FXMLDoc.Root.FindItem('previewpages'); + xs := TfrxXMLSerializer.Create(nil); + +{ upload the report settings } + xi := FXMLDoc.Root.FindItem('report'); + xi.Clear; + xi := xi.Add; + xi.Name := Report.ClassName; + xi.Text := 'DotMatrixReport="' + frxValueToXML(Report.DotMatrixReport) + + '" PreviewOptions.OutlineVisible="' + frxValueToXML(Report.PreviewOptions.OutlineVisible) + + '" PreviewOptions.OutlineWidth="' + frxValueToXML(Report.PreviewOptions.OutlineWidth) + + '" ReportOptions.Name="' + frxStrToXML(Report.ReportOptions.Name) + '"'; + +{ upload the sourcepages } + try + xi := FXMLDoc.Root.FindItem('sourcepages'); + xi.Clear; + for i := 0 to FSourcePages.Count - 1 do + xs.WriteRootComponent(FSourcePages[i], True, xi.Add); + + finally + xs.Free; + end; + +{ upload the dictionary } + xi := FXMLDoc.Root.FindItem('dictionary'); + xi.Clear; + for i := 0 to FDictionary.Names.Count - 1 do + with xi.Add do + begin + Name := FDictionary.Names[i]; + Text := 'name="' + FDictionary.GetSourceName(Name) + '"'; + end; + +{ upload the picturecache } + xi := FXMLDoc.Root.FindItem('picturecache'); + FPictureCache.SaveToXML(xi); +end; + +function TfrxPreviewPages.GetObject(const Name: String): TfrxComponent; +begin + Result := TfrxComponent(FDictionary.GetObject(Name)); +end; + +function TfrxPreviewPages.GetPage(Index: Integer): TfrxReportPage; +var + xi: TfrxXMLItem; + xs: TfrxXMLSerializer; + i: Integer; + Source: TfrxReportPage; + + procedure DoObjects(Item: TfrxXMLItem; Owner: TfrxComponent); + var + i: Integer; + c, c0: TfrxComponent; + begin + for i := 0 to Item.Count - 1 do + begin + c0 := GetObject(Item[i].Name); + { object not found in the dictionary } + if c0 = nil then + c := xs.ReadComponentStr(Owner, Item[i].Name + ' ' + Item[i].Text, True) + else + begin + c := xs.ReadComponentStr(Owner, + THackComponent(c0).FBaseName + ' ' + Item[i].Text, True); + c.Name := c0.Name; + if (c is TfrxPictureView) and (TfrxPictureView(c).Picture.Graphic = nil) then + FPictureCache.GetPicture(TfrxPictureView(c)); + end; + c.Parent := Owner; + + DoObjects(Item[i], c); + end; + end; + +begin + Result := nil; + if Count = 0 then Exit; + + { check pagecache first } + if not Engine.Running then + begin + i := FPageCache.IndexOf(IntToStr(Index)); + if i <> -1 then + begin + Result := TfrxReportPage(FPageCache.Objects[i]); + FPageCache.Exchange(i, 0); + Exit; + end; + end; + + xs := TfrxXMLSerializer.Create(nil); + try + { load the page item } + xi := FPagesItem[Index]; + FXMLDoc.LoadItem(xi); + + if CompareText(xi.Name, 'TfrxReportPage') = 0 then + begin + { page item do not refer to the originalpages } + Result := TfrxReportPage.Create(nil); + xs.ReadRootComponent(Result, xi); + end + else if CompareText(xi.Name, 'TfrxDMPPage') = 0 then + begin + { page item do not refer to the originalpages } + Result := TfrxDMPPage.Create(nil); + xs.ReadRootComponent(Result, xi); + end + else + begin + Source := FSourcePages[StrToInt(Copy(xi.Name, 5, 5))]; + { create reportpage and assign properties from original page } + if Source is TfrxDMPPage then + Result := TfrxDMPPage.Create(nil) else + Result := TfrxReportPage.Create(nil); + Result.Assign(Source); + + { create objects } + DoObjects(xi, Result); + end; + finally + xs.Free; + end; + + { update aligned objects } + Result.AlignChildren; + + { add this page to the pagecache } + FPageCache.InsertObject(0, IntToStr(Index), Result); + i := FPageCache.Count; + + { remove the least used item from the pagecache } + if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then + begin + xi := FPagesItem[StrToInt(FPageCache[i - 1])]; + if Report.EngineOptions.UseFileCache and xi.Unloadable then + begin + FXMLDoc.UnloadItem(xi); + xi.Clear; + end; + + TfrxReportPage(FPageCache.Objects[i - 1]).Free; + FPageCache.Delete(i - 1); + end; +end; + +function TfrxPreviewPages.GetPageSize(Index: Integer): TPoint; +var + xi: TfrxXMLItem; + p: TfrxReportPage; +begin + if (Count = 0) or (Index < 0) or (Index >= Count) then + begin + Result := Point(0, 0); + Exit; + end; + + xi := FPagesItem[Index]; + if (CompareText(xi.Name, 'TfrxReportPage') = 0) or + (CompareText(xi.Name, 'TfrxDMPPage') = 0) then + p := GetPage(Index) else + p := FSourcePages[StrToInt(Copy(xi.Name, 5, 256))]; + Result.X := Round(p.Width); + Result.Y := Round(p.Height); +end; + +procedure TfrxPreviewPages.AddEmptyPage(Index: Integer); +var + xi: TfrxXMLItem; +begin + if Count = 0 then Exit; + + xi := TfrxXMLItem.Create; + xi.Name := FPagesItem[Index].Name; + FPagesItem.InsertItem(Index, xi); + ClearPageCache; +end; + +procedure TfrxPreviewPages.DeletePage(Index: Integer); +begin + if Count < 2 then Exit; + + FPagesItem[Index].Free; + ClearPageCache; +end; + +procedure TfrxPreviewPages.ModifyPage(Index: Integer; Page: TfrxReportPage); +var + xs: TfrxXMLSerializer; +begin + xs := TfrxXMLSerializer.Create(nil); + try + FPagesItem[Index].Clear; + xs.WriteRootComponent(Page, True, FPagesItem[Index]); + FPagesItem[Index].Unloadable := False; + ClearPageCache; + finally + xs.Free; + end; +end; + +procedure TfrxPreviewPages.AddFrom(Report: TfrxReport); +var + i: Integer; + Page: TfrxReportPage; + xi: TfrxXMLItem; + xs: TfrxXMLSerializer; +begin + xs := TfrxXMLSerializer.Create(nil); + + for i := 0 to Report.PreviewPages.Count - 1 do + begin + Page := Report.PreviewPages.Page[i]; + xi := TfrxXMLItem.Create; + xi.Name := FPagesItem[Count - 1].Name; + xs.WriteRootComponent(Page, True, xi); + xi.Unloadable := False; + FPagesItem.AddItem(xi); + end; + + xs.Free; + ClearPageCache; +end; + +procedure TfrxPreviewPages.DrawPage(Index: Integer; Canvas: TCanvas; + ScaleX, ScaleY, OffsetX, OffsetY: Extended); +var + i: Integer; + Page: TfrxReportPage; + l: TList; + c: TfrxComponent; + IsPrinting: Boolean; + SaveLeftMargin, SaveRightMargin: Extended; + rgn: HRGN; + + function ViewVisible(c: TfrxComponent): Boolean; + var + r: TRect; + begin + with c do + r := Rect(Round(AbsLeft * ScaleX) - 20, Round(AbsTop * ScaleY) - 20, + Round((AbsLeft + Width) * ScaleX + 20), + Round((AbsTop + Height) * ScaleY + 20)); + OffsetRect(r, Round(OffsetX), Round(OffsetY)); + Result := RectVisible(Canvas.Handle, r) or (Canvas is TMetafileCanvas); + end; + +begin + Page := GetPage(Index); + if Page = nil then Exit; + + SaveLeftMargin := Page.LeftMargin; + SaveRightMargin := Page.RightMargin; + if Page.MirrorMargins and (Index mod 2 = 1) then + begin + Page.LeftMargin := SaveRightMargin; + Page.RightMargin := SaveLeftMargin; + end; + + IsPrinting := Canvas is TfrxPrinterCanvas; + rgn := 0; + if not IsPrinting then + begin + rgn := CreateRectRgn(0, 0, 10000, 10000); + GetClipRgn(Canvas.Handle, rgn); + IntersectClipRect(Canvas.Handle, + Round(OffsetX), + Round(OffsetY), + Round(OffsetX + Page.PaperWidth * fr01cm * ScaleX) - 1, + Round(OffsetY + Page.PaperHeight * fr01cm * ScaleY) - 1); + end; + + Page.Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); + OffsetX := OffsetX + Page.LeftMargin * fr01cm * ScaleX; + OffsetY := OffsetY + Page.TopMargin * fr01cm * ScaleY; + + l := Page.AllObjects; + + for i := 0 to l.Count - 1 do + begin + c := l[i]; + if (c is TfrxView) and ViewVisible(c) then + if not IsPrinting or TfrxView(c).Printable then + begin + c.IsPrinting := IsPrinting; + { needed for TOTALPAGES macro } + if c is TfrxCustomMemoView then + begin + THackMemoView(c).FTotalPages := Count; + THackMemoView(c).FCopyNo := FCopyNo; + THackMemoView(c).FPrintScale := FPrintScale; + end; + { draw the object } + TfrxView(c).Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); + c.IsPrinting := False; + end; + end; + + Page.LeftMargin := SaveLeftMargin; + Page.RightMargin := SaveRightMargin; + if not IsPrinting then + begin + SelectClipRgn(Canvas.Handle, rgn); + DeleteObject(rgn); + end; +end; + +function TfrxPreviewPages.Print: Boolean; +var + MaxCount: Integer; + PagesPrinted, ACopyNo: Integer; + pgList: TStringList; + LastDuplexMode: TfrxDuplexMode; + LastPaperSize, LastPaperWidth, LastPaperHeight, LastBin: Integer; + LastOrientation: TPrinterOrientation; + SplitAddX, SplitAddY: Extended; + DuplexMode: TfrxDuplexMode; + SavePrintOptions: TfrxPrintOptions; + SheetWidth, SheetHeight: Extended; + + + function GetNextPage(var Index: Integer): TfrxReportPage; + begin + Result := nil; + while Index < Count - 1 do + begin + Inc(Index); + if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then + continue + else + begin + Result := GetPage(Index); + break; + end; + end; + end; + + procedure SplitPage(a, b, c, d: Extended; var x, y: Integer; var NeedRotate: Boolean); + var + tempX, tempY: Integer; + tempC: Extended; + + procedure TrySplit; + begin + if Abs(Trunc(a / c) * c - a) < 11 then + x := Round(a / c) + else + x := Trunc(a / c) + 1; + + if Abs(Trunc(b / d) * d - b) < 11 then + y := Round(b / d) + else + y := Trunc(b / d) + 1; + end; + + begin + NeedRotate := False; + + TrySplit; + + tempX := x; + tempY := y; + + tempC := c; + c := d; + d := tempC; + + TrySplit; + + if x * y >= tempX * tempY then + begin + x := tempX; + y := tempY; + end + else + NeedRotate := True; + end; + + procedure DoPrint; + var + i: Integer; + Printer: TfrxCustomPrinter; + PagePrinted: Boolean; + Page: TfrxReportPage; + + function PrintSplittedPage(Index: Integer): Boolean; + var + Bin, ACopies, x, y, countX, countY: Integer; + pieceX, pieceY, offsX, offsY, marginX, marginY, printedX, printedY: Extended; + orient: TPrinterOrientation; + NeedChangeOrientation: Boolean; + dup: TfrxDuplexMode; + begin + Result := True; + if Index >= Count then Exit; + + if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit; + if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or + ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit; + if Report.Terminated then + begin + Printer.Abort; + Result := False; + Exit; + end; + + Page := GetPage(Index); + + if Report.PrintOptions.Collate then + begin + ACopies := 1; + FCopyNo := ACopyNo; + end + else + begin + ACopies := Report.PrintOptions.Copies; + FCopyNo := 1; + end; + + if Assigned(Report.OnPrintPage) then + Report.OnPrintPage(Page, FCopyNo); + + if Index = 0 then + Bin := Page.Bin else + Bin := Page.BinOtherPages; + + SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth, SheetHeight, + countX, countY, NeedChangeOrientation); + + orient := poPortrait; + if NeedChangeOrientation then + orient := poLandscape; + + dup := Page.Duplex; + if DuplexMode <> dmNone then + dup := DuplexMode; + + if not PagePrinted or (orient <> LastOrientation) then + Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet, + SheetWidth, SheetHeight, orient, Bin, Integer(dup) + 1, ACopies); + if not PagePrinted then + Printer.BeginDoc; + + if orient = poPortrait then + begin + pieceX := SheetWidth * (Printer.DPI.X / 25.4); + pieceY := SheetHeight * (Printer.DPI.Y / 25.4); + end + else + begin + pieceX := SheetHeight * (Printer.DPI.X / 25.4); + pieceY := SheetWidth * (Printer.DPI.Y / 25.4); + end; + + marginY := 0; + printedY := 0; + offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4; + + for y := 1 to countY do + begin + marginX := 0; + printedX := 0; + offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4; + + for x := 1 to countX do + begin + Printer.BeginPage; + DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96, + offsX, offsY); + +{$IFDEF TRIAL} + with Printer.Canvas do + begin + Font.Size := 12; + Font.Color := clBlack; + TextOut(0, 0, frxReverseString(FR_UNREG)); + end; +{$ENDIF} + Printer.EndPage; + + printedX := printedX + (pieceX - marginX - Printer.RightMargin * Printer.DPI.X / 25.4) - + SplitAddX * Printer.DPI.X / 25.4; + offsX := -printedX; + marginX := Printer.LeftMargin * Printer.DPI.X / 25.4; + end; + + printedY := printedY + (pieceY - marginY - Printer.BottomMargin * Printer.DPI.Y / 25.4) - + SplitAddY * Printer.DPI.Y / 25.4; + offsY := -printedY; + marginY := Printer.TopMargin * Printer.DPI.Y / 25.4; + end; + + Report.InternalOnProgress(ptPrinting, Index + 1); + Application.ProcessMessages; + + PagePrinted := True; + Inc(PagesPrinted); + + LastOrientation := Page.Orientation; + ClearPageCache; + end; + + + function PrintPage(Index: Integer): Boolean; + var + Bin, ACopies: Integer; + dup: TfrxDuplexMode; + ZoomX, ZoomY: Extended; + begin + Result := True; + if Index >= Count then Exit; + + if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit; + if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or + ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit; + if Report.Terminated then + begin + Printer.Abort; + Result := False; + Exit; + end; + + Page := GetPage(Index); + + if Report.PrintOptions.Collate then + begin + ACopies := 1; + FCopyNo := ACopyNo; + end + else + begin + ACopies := Report.PrintOptions.Copies; + FCopyNo := 1; + end; + + if Assigned(Report.OnPrintPage) then + Report.OnPrintPage(Page, FCopyNo); + + if Index = 0 then + Bin := Page.Bin else + Bin := Page.BinOtherPages; + + dup := Page.Duplex; + if DuplexMode <> dmNone then + dup := DuplexMode; + + if Report.PrintOptions.PrintMode = pmDefault then + begin + if (not PagePrinted) or + (LastPaperSize <> Page.PaperSize) or + (LastPaperWidth <> Round(Page.PaperWidth)) or + (LastPaperHeight <> Round(Page.PaperHeight)) or + (LastBin <> Bin) or + (LastOrientation <> Page.Orientation) or + (LastDuplexMode <> dup) then + Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight, + Page.Orientation, Bin, Integer(dup) + 1, ACopies); + end + else + if (not PagePrinted) or + (LastBin <> Bin) or + (LastOrientation <> Page.Orientation) or + (LastDuplexMode <> dup) then + begin + Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet, + SheetWidth, SheetHeight, Page.Orientation, Bin, Integer(dup) + 1, ACopies); + SheetWidth := frxPrinters.Printer.PaperWidth; + SheetHeight := frxPrinters.Printer.PaperHeight; + end; + if not PagePrinted then + Printer.BeginDoc; + + Printer.BeginPage; + + if Report.PrintOptions.PrintMode = pmDefault then + begin + ZoomX := 1; + ZoomY := 1; + end + else + begin + ZoomX := SheetWidth / Page.PaperWidth; + ZoomY := SheetHeight / Page.PaperHeight; + if ZoomY < ZoomX then + FPrintScale := ZoomY + else + FPrintScale := ZoomX; + end; + + DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96 * ZoomX, Printer.DPI.Y / 96 * ZoomY, + -Printer.LeftMargin * Printer.DPI.X / 25.4, + -Printer.TopMargin * Printer.DPI.Y / 25.4); + + Report.InternalOnProgress(ptPrinting, Index + 1); + +{$IFDEF TRIAL} + with Printer.Canvas do + begin + Font.Size := 12; + Font.Color := clBlack; + TextOut(0, 0, frxReverseString(FR_UNREG)); + end; +{$ENDIF} + Printer.EndPage; + Application.ProcessMessages; + + PagePrinted := True; + Inc(PagesPrinted); + + LastPaperSize := Page.PaperSize; + LastPaperWidth := Round(Page.PaperWidth); + LastPaperHeight := Round(Page.PaperHeight); + LastBin := Bin; + LastOrientation := Page.Orientation; + LastDuplexMode := dup; + ClearPageCache; + end; + + procedure PrintPages; + var + i: Integer; + begin + PagesPrinted := 0; + + if Report.PrintOptions.Reverse then + begin + for i := MaxCount - 1 downto 0 do + if not PrintPage(i) then + break; + end + else + for i := 0 to MaxCount - 1 do + if not PrintPage(i) then + break; + end; + + procedure PrintSplittedPages; + var + i: Integer; + begin + PagesPrinted := 0; + + if Report.PrintOptions.Reverse then + begin + for i := MaxCount - 1 downto 0 do + if not PrintSplittedPage(i) then + break; + end + else + for i := 0 to MaxCount - 1 do + if not PrintSplittedPage(i) then + break; + end; + + procedure PrintJoinedPages; + var + Index, cp, x, y, countX, countY: Integer; + pieceX, pieceY, offsX, offsY: Extended; + orient: TPrinterOrientation; + NeedChangeOrientation: Boolean; + dup: TfrxDuplexMode; + begin + PagesPrinted := 0; + if Count = 0 then Exit; + + { get the first page and calculate the join options } + Index := -1; + Page := GetNextPage(Index); + + SplitPage(SheetWidth, SheetHeight, Page.PaperWidth, Page.PaperHeight, + countX, countY, NeedChangeOrientation); + orient := poPortrait; + if NeedChangeOrientation then + begin + orient := poLandscape; + x := countX; + countX := countY; + countY := x; + end; + + { setup the printer } + dup := Page.Duplex; + if DuplexMode <> dmNone then + dup := DuplexMode; + Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet, + SheetWidth, SheetHeight, orient, Page.Bin, Integer(dup) + 1, 1); + PagePrinted := True; + Printer.BeginDoc; + + { start the cycle } + pieceX := Page.PaperWidth * (Printer.DPI.X / 25.4); + pieceY := Page.PaperHeight * (Printer.DPI.Y / 25.4); + + Index := -1; + while Index < MaxCount - 1 do + begin + cp := 1; + offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4; + Printer.BeginPage; + + for y := 1 to countY do + begin + offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4; + + for x := 1 to countX do + begin + { get the next page } + FCopyNo := cp; + if cp = 1 then + Page := GetNextPage(Index); + Inc(cp); + if cp > Report.PrintOptions.Copies then + cp := 1; + + if Page = nil then break; + + DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96, + offsX, offsY); + + offsX := offsX + pieceX; + end; + + if Page = nil then break; + offsY := offsY + pieceY; + end; + +{$IFDEF TRIAL} + with Printer.Canvas do + begin + Font.Size := 12; + Font.Color := clBlack; + TextOut(0, 0, frxReverseString(FR_UNREG)); + end; +{$ENDIF} + Printer.EndPage; + + Report.InternalOnProgress(ptPrinting, Index); + Application.ProcessMessages; + if Report.Terminated then + begin + Printer.Abort; + Exit; + end; + + Inc(PagesPrinted); + ClearPageCache; + end; + end; + + begin + Printer := frxPrinters.Printer; + Report.Terminated := False; + Report.InternalOnProgressStart(ptPrinting); + + if Report.ReportOptions.Name <> '' then + Printer.Title := Report.ReportOptions.Name else + Printer.Title := Report.FileName; + if Report.PrintOptions.Copies <= 0 then + Report.PrintOptions.Copies := 1; +{$IFNDEF TRIAL} + MaxCount := Count; +{$ELSE} + MaxCount := 5; +{$ENDIF} + + PagePrinted := False; + LastDuplexMode := dmNone; + + if Report.PrintOptions.Collate then + for i := 0 to Report.PrintOptions.Copies - 1 do + begin + ACopyNo := i + 1; + case Report.PrintOptions.PrintMode of + pmDefault, pmScale: + PrintPages; + pmSplit: + PrintSplittedPages; + pmJoin: + PrintJoinedPages; + end; + if (LastDuplexMode in [dmVertical, dmHorizontal]) and (PagesPrinted mod 2 <> 0) then + begin + Printer.BeginPage; + Printer.EndPage; + end; + + if Report.Terminated then break; + end + else + begin + case Report.PrintOptions.PrintMode of + pmDefault, pmScale: + PrintPages; + pmSplit: + PrintSplittedPages; + pmJoin: + PrintJoinedPages; + end; + end; + + if PagePrinted then + Printer.EndDoc; + Report.InternalOnProgressStop(ptPrinting); + end; + +begin + Result := True; + if not frxPrinters.HasPhysicalPrinters then + begin + frxErrorMsg(frxResources.Get('clNoPrinters')); + Result := False; + Exit; + end; + + FPrintScale := 1; + + if Report.DotMatrixReport and (frxDotMatrixExport <> nil) then + begin + Report.SelectPrinter; + frxDotMatrixExport.ShowDialog := Report.PrintOptions.ShowDialog; + Result := Export(frxDotMatrixExport); + Exit; + end; + + SavePrintOptions := TfrxPrintOptions.Create; + SavePrintOptions.Assign(Report.PrintOptions); + DuplexMode := dmNone; + Report.SelectPrinter; + + if Report.PrintOptions.ShowDialog then + with TfrxPrintDialog.Create(Application) do + begin + AReport := Report; + ADuplexMode := DuplexMode; + ShowModal; + if ModalResult = mrOk then + begin + DuplexMode := ADuplexMode; + Free; + end + else + begin + Free; + FCopyNo := 0; + Result := False; + SavePrintOptions.Free; + Exit; + end; + end; + + if Report.PrintOptions.PrintMode <> pmDefault then + begin + frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, 0, 0, poPortrait); + SheetWidth := frxPrinters.Printer.PaperWidth; + SheetHeight := frxPrinters.Printer.PaperHeight; + SplitAddX := 3; + SplitAddY := 3; + end; + + if Assigned(Report.OnPrintReport) then + Report.OnPrintReport(Report); + + if Report.Preview <> nil then + Report.Preview.Lock; + pgList := TStringList.Create; + try + frxParsePageNumbers(Report.PrintOptions.PageNumbers, pgList, Count); + ClearPageCache; + DoPrint; + finally + if Assigned(Report.OnAfterPrintReport) then + Report.OnAfterPrintReport(Report); + FCopyNo := 0; + Report.PrintOptions.Assign(SavePrintOptions); + SavePrintOptions.Free; + pgList.Free; + end; +end; + +function TfrxPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean; +var + pgList: TStringList; + tempBMP: TBitmap; + + procedure ExportPage(Index: Integer); + var + i, j: Integer; + Page: TfrxReportPage; + c: TfrxComponent; + p: TfrxPictureView; +{$IFDEF TRIAL} + m: TfrxCustomMemoView; +{$ENDIF} + + procedure ExportObject(c: TfrxComponent); + begin + if c is TfrxCustomMemoView then + begin + { set up font if Highlight is active } + if TfrxCustomMemoView(c).Highlight.Active then + TfrxCustomMemoView(c).Font.Assign(TfrxCustomMemoView(c).Highlight.Font); + { needed for TOTALPAGES, COPYNAME macros } + THackMemoView(c).FTotalPages := Count; + THackMemoView(c).FCopyNo := 1; + THackMemoView(c).ExtractMacros; + { needed if memo has AutoWidth and Align properties } + if THackMemoView(c).AutoWidth then + THackMemoView(c).Draw(tempBMP.Canvas, 1, 1, 0, 0); + end; + Filter.ExportObject(c); + end; + + begin + if Index >= Count then Exit; + if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit; + Page := GetPage(Index); + if Page = nil then Exit; + + if Filter.ShowProgress then + Report.InternalOnProgress(ptExporting, Index + 1); + + Filter.StartPage(Page, Index); + try + { set the offset of the page objects } + if Page.MirrorMargins and (Index mod 2 = 1) then + Page.Left := Page.RightMargin * fr01cm else + Page.Left := Page.LeftMargin * fr01cm; + Page.Top := Page.TopMargin * fr01cm; + + { export the page background picture and frame } + p := TfrxPictureView.Create(nil); + p.Name := '_pagebackground'; + p.Color := Page.Color; + p.Frame.Assign(Page.Frame); + p.Picture.Assign(Page.BackPicture); + p.Stretched := True; + p.KeepAspectRatio := False; + try + p.SetBounds(Page.Left, Page.Top, + Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm, + Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm); + Filter.ExportObject(p); + finally + p.Free; + end; +{$IFDEF TRIAL} + m := TfrxCustomMemoView.Create(nil); + try + m.SetBounds(Page.Left, Page.Top - 10, + Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm, 10); + m.Text := frxReverseString(FR_UNREG); + m.HAlign := haRight; + m.Font.Size := 7; + m.Font.Color := clGray; + Filter.ExportObject(m); + finally + m.Free; + end; +{$ENDIF} + + for i := 0 to Page.Objects.Count - 1 do + begin + c := Page.Objects[i]; + if c is TfrxBand then + begin + if c is TfrxPageHeader then + begin + { suppress a header } + if Filter.SuppressPageHeadersFooters and (Index <> 0) then continue; + end; + if c is TfrxPageFooter then + begin + { suppress a footer } + if Filter.SuppressPageHeadersFooters and (Index <> Count - 1) then continue; + end; + end; + + ExportObject(c); + if c.Objects.Count <> 0 then + for j := 0 to c.Objects.Count - 1 do + ExportObject(c.Objects[j]); + end; + + finally + Filter.FinishPage(Page, Index); + end; + + if Report.Preview = nil then + ClearPageCache + else + begin + Page.Left := 0; + Page.Top := 0; + end; + end; + + procedure DoExport; + var + i: Integer; + begin + if Filter.Start then + try + if Report.Preview <> nil then + begin + Report.Preview.Refresh; + Report.Preview.Lock; + end; + + if Filter.ShowProgress then + Report.InternalOnProgressStart(ptExporting); + +{$IFNDEF TRIAL} + for i := 0 to Count - 1 do +{$ELSE} + for i := 0 to 4 do +{$ENDIF} + begin + ExportPage(i); + if Report.Terminated then break; + Application.ProcessMessages; + end; + + finally + if Report.Preview <> nil then + begin + TfrxPreview(Report.Preview).HideMessage; + Report.Preview.Refresh; + end; + + if Filter.ShowProgress then + Report.InternalOnProgressStop(ptExporting); + + Filter.Finish; + end; + end; + +begin + Result := False; + FCopyNo := 0; + if Filter = nil then Exit; + + Filter.Report := Report; + if (Filter.ShowDialog and (Filter.ShowModal <> mrOk)) then + Exit; + if Filter.CurPage then + if Report.Preview <> nil then + Filter.PageNumbers := IntToStr(CurPreviewPage) else + Filter.PageNumbers := '1'; + + Result := True; + Report.Terminated := False; + + pgList := TStringList.Create; + tempBMP := TBitmap.Create; + try + frxParsePageNumbers(Filter.PageNumbers, pgList, Count); + + if Filter = frxDotMatrixExport then + if Assigned(Report.OnPrintReport) then + Report.OnPrintReport(Report); + + try + DoExport; + except + on e: Exception do + begin + Result := False; + Report.Errors.Text := e.Message; + frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text); + end; + end; + + if Filter = frxDotMatrixExport then + if Assigned(Report.OnAfterPrintReport) then + Report.OnAfterPrintReport(Report); + finally + pgList.Free; + tempBMP.Free; + end; +end; + +procedure TfrxPreviewPages.ObjectOver(Index: Integer; X, Y: Integer; + Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended; + Click: Boolean; var Cursor: TCursor); +var + Page: TfrxReportPage; + c: TfrxComponent; + l: TList; + i: Integer; + Flag: Boolean; + v: TfrxView; + drill: TfrxGroupHeader; + drillName: String; + + function MouseInView(c: TfrxComponent): Boolean; + var + r: TRect; + begin + with c do + r := Rect(Round(AbsLeft * Scale), Round(AbsTop * Scale), + Round((AbsLeft + Width) * Scale), + Round((AbsTop + Height) * Scale)); + OffsetRect(r, Round(OffsetX), Round(OffsetY)); + Result := PtInRect(r, Point(X, Y)); + end; + + procedure SetToAnchor(const Text: String); + var + Item: TfrxXMLItem; + PageN, Top: Integer; + begin + Item := FindAnchor(Text); + if Item <> nil then + begin + PageN := StrToInt(Item.Prop['page']); + Top := StrToInt(Item.Prop['top']); + TfrxPreview(Report.Preview).SetPosition(PageN + 1, Top); + end; + end; + +begin + if (Index < 0) or (Index >= Count) or Engine.Running then Exit; + Page := GetPage(Index); + if Page = nil then Exit; + + if Page.MirrorMargins and (Index mod 2 = 1) then + OffsetX := OffsetX + Page.RightMargin * fr01cm * Scale else + OffsetX := OffsetX + Page.LeftMargin * fr01cm * Scale; + OffsetY := OffsetY + Page.TopMargin * fr01cm * Scale; + + Report.SetProgressMessage(''); + Page := GetPage(Index); // get page again to ensure it was not cleared during export + if Page = nil then Exit; + + drill := nil; + l := Page.AllObjects; + + for i := l.Count - 1 downto 0 do + begin + c := l[i]; + if (c is TfrxGroupHeader) and MouseInView(c) then + if TfrxGroupHeader(c).DrillDown then + begin + drill := TfrxGroupHeader(c); + break; + end; + + if (c is TfrxView) and MouseInView(c) then + begin + v := TfrxView(c); + if (v.Parent is TfrxGroupHeader) and TfrxGroupHeader(v.Parent).DrillDown then + begin + drill := TfrxGroupHeader(v.Parent); + break; + end; + if v.Cursor <> crDefault then + Cursor := v.Cursor; + if v.URL <> '' then + begin + Report.SetProgressMessage(v.URL); + if v.Cursor = crDefault then + Cursor := crHandPoint; + end; + + if Click then + begin + if v.URL <> '' then + if Pos('@', v.URL) = 1 then + TfrxPreview(Report.Preview).PageNo := StrToInt(Copy(v.URL, 2, 255)) + else if Pos('#', v.URL) = 1 then + SetToAnchor(Copy(v.URL, 2, 255)) + else + ShellExecute(GetDesktopWindow, nil, PChar(v.URL), nil, nil, sw_ShowNormal); + + Flag := False; + Report.DoPreviewClick(v, Button, Shift, Flag); + if Flag then + begin + ModifyPage(Index, Page); + Report.Preview.Invalidate; + end; + end + else if Assigned(Report.OnMouseOverObject) then + Report.OnMouseOverObject(v); + break; + end; + end; + + if drill <> nil then + begin + Cursor := crHandPoint; + if Click and (Button = mbLeft) then + begin + drillName := drill.Name + '.' + IntToStr(drill.Tag); + if Report.DrillState.IndexOf(drillName) = -1 then + Report.DrillState.Add(drillName) + else + Report.DrillState.Delete(Report.DrillState.IndexOf(drillName)); + Report.Preview.RefreshReport; + end; + end; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPrintDialog.dfm b/official/4.2/Source/frxPrintDialog.dfm new file mode 100644 index 0000000..6d4310f Binary files /dev/null and b/official/4.2/Source/frxPrintDialog.dfm differ diff --git a/official/4.2/Source/frxPrintDialog.pas b/official/4.2/Source/frxPrintDialog.pas new file mode 100644 index 0000000..b75d553 --- /dev/null +++ b/official/4.2/Source/frxPrintDialog.pas @@ -0,0 +1,324 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Print dialog } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPrintDialog; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, frxCtrls, ExtCtrls, Buttons, ComCtrls, frxClass +{$IFDEF Delphi6} +, Variants, ImgList +{$ENDIF}; + + +type + TfrxPrintDialog = class(TForm) + OkB: TButton; + CancelB: TButton; + FileDlg: TSaveDialog; + Label12: TGroupBox; + WhereL: TLabel; + WhereL1: TLabel; + PrintersCB: TComboBox; + PropButton: TButton; + FileCB: TCheckBox; + Label1: TGroupBox; + DescrL: TLabel; + AllRB: TRadioButton; + CurPageRB: TRadioButton; + PageNumbersRB: TRadioButton; + PageNumbersE: TEdit; + Label2: TGroupBox; + CopiesL: TLabel; + CollateImg: TImage; + NonCollateImg: TImage; + CopiesPB: TPaintBox; + CopiesE: TEdit; + CollateCB: TCheckBox; + UpDown1: TUpDown; + ScaleGB: TGroupBox; + PagPageSizeCB: TComboBox; + NameL: TLabel; + PagSizeL: TLabel; + PrintModeCB: TComboBox; + PrintModeIL: TImageList; + OtherGB: TGroupBox; + PrintL: TLabel; + DuplexL: TLabel; + PrintPagesCB: TComboBox; + DuplexCB: TComboBox; + OrderL: TLabel; + OrderCB: TComboBox; + procedure PrintersCBDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); + procedure FormCreate(Sender: TObject); + procedure PropButtonClick(Sender: TObject); + procedure PrintersCBClick(Sender: TObject); + procedure PageNumbersRBClick(Sender: TObject); + procedure CollateLClick(Sender: TObject); + procedure CollateCBClick(Sender: TObject); + procedure CopiesPBPaint(Sender: TObject); + procedure PageNumbersEEnter(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure PrintModeCBDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); + procedure FormShow(Sender: TObject); + procedure PrintModeCBClick(Sender: TObject); + private + { Private declarations } + OldIndex: Integer; + public + { Public declarations } + AReport: TfrxReport; + ADuplexMode: TfrxDuplexMode; + end; + + +implementation + +{$R *.DFM} + +uses frxPrinter, Printers, frxUtils, frxRes; + + +procedure TfrxPrintDialog.FormCreate(Sender: TObject); +begin + Caption := frxGet(200); + Label12.Caption := frxGet(201); + DescrL.Caption := frxGet(9); + Label1.Caption := frxGet(202); + CopiesL.Caption := frxGet(203); + CollateCB.Caption := frxGet(204); + Label2.Caption := frxGet(205); + PrintL.Caption := frxGet(206); + WhereL.Caption := frxGet(208); + OkB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + PropButton.Caption := frxGet(209); + AllRB.Caption := frxGet(3); + CurPageRB.Caption := frxGet(4); + PageNumbersRB.Caption := frxGet(5); + FileCB.Caption := frxGet(210); + NameL.Caption := frxGet(212); + ScaleGB.Caption := frxGet(213); + PagSizeL.Caption := frxGet(214); + DuplexL.Caption := frxGet(216); + OtherGB.Caption := frxGet(207); + OrderL.Caption := frxGet(211); + + OrderCB.Items.Clear; + OrderCB.Items.Add(frxResources.Get('poDirect')); + OrderCB.Items.Add(frxResources.Get('poReverse')); + + PrintPagesCB.Items.Clear; + PrintPagesCB.Items.Add(frxResources.Get('ppAll')); + PrintPagesCB.Items.Add(frxResources.Get('ppOdd')); + PrintPagesCB.Items.Add(frxResources.Get('ppEven')); + PrintPagesCB.ItemIndex := 0; + + DuplexCB.Items.Clear; + DuplexCB.Items.Add(frxResources.Get('dupDefault')); + DuplexCB.Items.Add(frxResources.Get('dupVert')); + DuplexCB.Items.Add(frxResources.Get('dupHorz')); + DuplexCB.Items.Add(frxResources.Get('dupSimpl')); + DuplexCB.ItemIndex := 0; + + PrintModeCB.Items.Clear; + PrintModeCB.Items.Add(frxResources.Get('pmDefault')); + PrintModeCB.Items.Add(frxResources.Get('pmSplit')); + PrintModeCB.Items.Add(frxResources.Get('pmJoin')); + PrintModeCB.Items.Add(frxResources.Get('pmScale')); + + SetWindowLong(CopiesE.Handle, GWL_STYLE, GetWindowLong(CopiesE.Handle, GWL_STYLE) or ES_NUMBER); + + if Screen.PixelsPerInch > 96 then + PrintersCB.ItemHeight := 19; + PrintersCB.Items.Assign(frxPrinters.Printers); + PrintersCB.ItemIndex := frxPrinters.PrinterIndex; + PrintersCBClick(nil); + + OldIndex := frxPrinters.PrinterIndex; + CollateCBClick(nil); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxPrintDialog.FormShow(Sender: TObject); +begin + UpDown1.Position := AReport.PrintOptions.Copies; + CollateCB.Checked := AReport.PrintOptions.Collate; + PageNumbersE.Text := AReport.PrintOptions.PageNumbers; + if AReport.PrintOptions.PageNumbers <> '' then + PageNumbersRB.Checked := True; + PrintPagesCB.ItemIndex := Integer(AReport.PrintOptions.PrintPages); + if AReport.PrintOptions.Reverse then + OrderCB.ItemIndex := 1 + else + OrderCB.ItemIndex := 0; + + PrintModeCB.ItemIndex := Integer(AReport.PrintOptions.PrintMode); + PrintModeCBClick(nil); + if AReport.PrintOptions.PrintMode <> pmDefault then + begin + PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(AReport.PrintOptions.PrintOnSheet) + 1; + if frxPrinters.Printer.PaperIndex(256) < frxPrinters.Printer.PaperIndex(AReport.PrintOptions.PrintOnSheet) then + PagPageSizeCB.ItemIndex := PagPageSizeCB.ItemIndex - 1; + end; +end; + +procedure TfrxPrintDialog.FormHide(Sender: TObject); +begin + if ModalResult <> mrOk then + frxPrinters.PrinterIndex := OldIndex + else + begin + frxPrinters.Printer.FileName := ''; + if FileCB.Checked then + if FileDlg.Execute then + frxPrinters.Printer.FileName := ChangeFileExt(FileDlg.FileName, '.prn') else + ModalResult := mrCancel; + end; + + if ModalResult = mrOk then + begin + AReport.PrintOptions.Copies := StrToInt(CopiesE.Text); + AReport.PrintOptions.Collate := CollateCB.Checked; + if AllRB.Checked then + AReport.PrintOptions.PageNumbers := '' + else if CurPageRB.Checked then + AReport.PrintOptions.PageNumbers := IntToStr(AReport.PreviewPages.CurPreviewPage) + else + AReport.PrintOptions.PageNumbers := PageNumbersE.Text; + AReport.PrintOptions.PrintPages := TfrxPrintPages(PrintPagesCB.ItemIndex); + ADuplexMode := TfrxDuplexMode(DuplexCB.ItemIndex); + AReport.PrintOptions.Reverse := OrderCB.ItemIndex = 1; + + AReport.PrintOptions.PrintMode := TfrxPrintMode(PrintModeCB.ItemIndex); + AReport.PrintOptions.PrintOnSheet := frxPrinters.Printer.PaperNameToNumber(PagPageSizeCB.Text); + end; +end; + +procedure TfrxPrintDialog.PrintersCBDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +begin + with PrintersCB.Canvas do + begin + FillRect(ARect); + frxResources.PreviewButtonImages.Draw(PrintersCB.Canvas, ARect.Left + 2, ARect.Top, 2); + TextOut(ARect.Left + 24, ARect.Top + 1, PrintersCB.Items[Index]); + end; +end; + +procedure TfrxPrintDialog.PropButtonClick(Sender: TObject); +begin + frxPrinters.Printer.PropertiesDlg; +end; + +procedure TfrxPrintDialog.PrintersCBClick(Sender: TObject); +var + SaveSheet: Integer; +begin + if PagPageSizeCB.ItemIndex <= 0 then + SaveSheet := -1 + else + SaveSheet := frxPrinters.Printer.PaperNameToNumber(PagPageSizeCB.Text); + + frxPrinters.PrinterIndex := PrintersCB.ItemIndex; + WhereL1.Caption := frxPrinters.Printer.Port; + PagPageSizeCB.Items := frxPrinters.Printer.Papers; + PagPageSizeCB.Items.Delete(frxPrinters.Printer.PaperIndex(256)); + PagPageSizeCB.Items.Insert(0, frxResources.Get('pgDefault')); + + if (SaveSheet <> -1) and (frxPrinters.Printer.PaperIndex(SaveSheet) <> -1) then + begin + PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(SaveSheet) + 1; + if frxPrinters.Printer.PaperIndex(256) < frxPrinters.Printer.PaperIndex(SaveSheet) then + PagPageSizeCB.ItemIndex := PagPageSizeCB.ItemIndex - 1 + end + else + PagPageSizeCB.ItemIndex := 0 +end; + +procedure TfrxPrintDialog.PageNumbersEEnter(Sender: TObject); +begin + PageNumbersRB.Checked := True; +end; + +procedure TfrxPrintDialog.PageNumbersRBClick(Sender: TObject); +begin + if Visible then + PageNumbersE.SetFocus; +end; + +procedure TfrxPrintDialog.CollateLClick(Sender: TObject); +begin + CollateCB.Checked := not CollateCB.Checked; +end; + +procedure TfrxPrintDialog.CollateCBClick(Sender: TObject); +begin + CopiesPBPaint(nil); +end; + +procedure TfrxPrintDialog.CopiesPBPaint(Sender: TObject); +begin + with CopiesPB.Canvas do + begin + Brush.Color := Color; + FillRect(Rect(0, 0, CopiesPB.Width, CopiesPB.Height)); + if CollateCB.Checked then + frxDrawTransparent(CopiesPB.Canvas, 0, 0, CollateImg.Picture.Bitmap) else + frxDrawTransparent(CopiesPB.Canvas, 0, 0, NonCollateImg.Picture.Bitmap); + end; +end; + +procedure TfrxPrintDialog.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +procedure TfrxPrintDialog.PrintModeCBDrawItem(Control: TWinControl; + Index: Integer; ARect: TRect; State: TOwnerDrawState); +begin + with PrintModeCB do + begin + Canvas.FillRect(ARect); + PrintModeIL.Draw(Canvas, ARect.Left + 2, ARect.Top + 1, Index); + Canvas.TextOut(ARect.Left + 74, ARect.Top + 10, Items[Index]); + end; +end; + +procedure TfrxPrintDialog.PrintModeCBClick(Sender: TObject); +var + DefaultMode: Boolean; +begin + DefaultMode := PrintModeCB.ItemIndex = 0; + if DefaultMode then + PagPageSizeCB.ItemIndex := 0; + PagPageSizeCB.Enabled := not DefaultMode; + if not DefaultMode and (PagPageSizeCB.ItemIndex = 0) then + PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(DMPAPER_A4); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxPrinter.pas b/official/4.2/Source/frxPrinter.pas new file mode 100644 index 0000000..72dda45 --- /dev/null +++ b/official/4.2/Source/frxPrinter.pas @@ -0,0 +1,964 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Printer } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxPrinter; + +interface + +{$I frx.inc} + +uses + Windows, SysUtils, Classes, Graphics, Forms, Printers +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxPrinterCanvas = class; + + TfrxCustomPrinter = class(TObject) + private + FBin: Integer; + FBins: TStrings; + FCanvas: TfrxPrinterCanvas; + FDefOrientation: TPrinterOrientation; + FDefPaper: Integer; + FDefPaperHeight: Extended; + FDefPaperWidth: Extended; + FDPI: TPoint; + FFileName: String; + FHandle: THandle; + FInitialized: Boolean; + FName: String; + FPaper: Integer; + FPapers: TStrings; + FPaperHeight: Extended; + FPaperWidth: Extended; + FLeftMargin: Extended; + FTopMargin: Extended; + FRightMargin: Extended; + FBottomMargin: Extended; + FOrientation: TPrinterOrientation; + FPort: String; + FPrinting: Boolean; + FTitle: String; + public + constructor Create(const AName, APort: String); virtual; + destructor Destroy; override; + procedure Init; virtual; abstract; + procedure Abort; virtual; abstract; + procedure BeginDoc; virtual; abstract; + procedure BeginPage; virtual; abstract; + procedure BeginRAWDoc; virtual; abstract; + procedure EndDoc; virtual; abstract; + procedure EndPage; virtual; abstract; + procedure EndRAWDoc; virtual; abstract; + procedure WriteRAWDoc(const buf: String); virtual; abstract; + + function BinIndex(ABin: Integer): Integer; + function PaperIndex(APaper: Integer): Integer; + function BinNameToNumber(const ABin: String): Integer; + function PaperNameToNumber(const APaper: String): Integer; + procedure SetViewParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; + AOrientation: TPrinterOrientation); virtual; abstract; + procedure SetPrintParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation; + ABin, ADuplex, ACopies: Integer); virtual; abstract; + procedure PropertiesDlg; virtual; abstract; + + property Bin: Integer read FBin; + property Bins: TStrings read FBins; + property Canvas: TfrxPrinterCanvas read FCanvas; + property DefOrientation: TPrinterOrientation read FDefOrientation; + property DefPaper: Integer read FDefPaper; + property DefPaperHeight: Extended read FDefPaperHeight; + property DefPaperWidth: Extended read FDefPaperWidth; + property DPI: TPoint read FDPI; + property FileName: String read FFileName write FFileName; + property Handle: THandle read FHandle; + property Name: String read FName; + property Paper: Integer read FPaper; + property Papers: TStrings read FPapers; + property PaperHeight: Extended read FPaperHeight; + property PaperWidth: Extended read FPaperWidth; + property LeftMargin: Extended read FLeftMargin; + property TopMargin: Extended read FTopMargin; + property RightMargin: Extended read FRightMargin; + property BottomMargin: Extended read FBottomMargin; + property Orientation: TPrinterOrientation read FOrientation; + property Port: String read FPort; + property Title: String read FTitle write FTitle; + end; + + TfrxVirtualPrinter = class(TfrxCustomPrinter) + public + procedure Init; override; + procedure Abort; override; + procedure BeginDoc; override; + procedure BeginPage; override; + procedure BeginRAWDoc; override; + procedure EndDoc; override; + procedure EndPage; override; + procedure EndRAWDoc; override; + procedure WriteRAWDoc(const buf: String); override; + procedure SetViewParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; + AOrientation: TPrinterOrientation); override; + procedure SetPrintParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation; + ABin, ADuplex, ACopies: Integer); override; + procedure PropertiesDlg; override; + end; + + TfrxPrinter = class(TfrxCustomPrinter) + private + FDeviceMode: THandle; + FDC: HDC; + FDriver: String; + FMode: PDeviceMode; + procedure CreateDevMode; + procedure FreeDevMode; + procedure GetDC; + procedure RecreateDC; + public + destructor Destroy; override; + procedure Init; override; + procedure Abort; override; + procedure BeginDoc; override; + procedure BeginPage; override; + procedure BeginRAWDoc; override; + procedure EndDoc; override; + procedure EndPage; override; + procedure EndRAWDoc; override; + procedure WriteRAWDoc(const buf: String); override; + procedure SetViewParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; + AOrientation: TPrinterOrientation); override; + procedure SetPrintParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation; + ABin, ADuplex, ACopies: Integer); override; + procedure PropertiesDlg; override; + procedure UpdateDeviceCaps; + property DeviceMode: PDeviceMode read FMode; + end; + + + TfrxPrinters = class(TObject) + private + FHasPhysicalPrinters: Boolean; + FPrinters: TStrings; + FPrinterIndex: Integer; + FPrinterList: TList; + function GetDefaultPrinter: String; + function GetItem(Index: Integer): TfrxCustomPrinter; + function GetCurrentPrinter: TfrxCustomPrinter; + procedure SetPrinterIndex(Value: Integer); + public + constructor Create; + destructor Destroy; override; + function IndexOf(AName: String): Integer; + procedure Clear; + procedure FillPrinters; + property Items[Index: Integer]: TfrxCustomPrinter read GetItem; default; + property HasPhysicalPrinters: Boolean read FHasPhysicalPrinters; + property Printer: TfrxCustomPrinter read GetCurrentPrinter; + property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex; + property Printers: TStrings read FPrinters; + end; + + TfrxPrinterCanvas = class(TCanvas) + private + FPrinter: TfrxCustomPrinter; + procedure UpdateFont; + public + procedure Changing; override; + end; + + +function frxPrinters: TfrxPrinters; +function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean; + + +implementation + +uses frxUtils, WinSpool, Dialogs, frxRes; + + +type + TPaperInfo = packed record + Typ: Integer; + Name: String; + X, Y: Integer; + end; + + +const + PAPERCOUNT = 66; + PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = ( + (Typ:1; Name: ''; X:2159; Y:2794), + (Typ:2; Name: ''; X:2159; Y:2794), + (Typ:3; Name: ''; X:2794; Y:4318), + (Typ:4; Name: ''; X:4318; Y:2794), + (Typ:5; Name: ''; X:2159; Y:3556), + (Typ:6; Name: ''; X:1397; Y:2159), + (Typ:7; Name: ''; X:1842; Y:2667), + (Typ:8; Name: ''; X:2970; Y:4200), + (Typ:9; Name: ''; X:2100; Y:2970), + (Typ:10; Name: ''; X:2100; Y:2970), + (Typ:11; Name: ''; X:1480; Y:2100), + (Typ:12; Name: ''; X:2500; Y:3540), + (Typ:13; Name: ''; X:1820; Y:2570), + (Typ:14; Name: ''; X:2159; Y:3302), + (Typ:15; Name: ''; X:2150; Y:2750), + (Typ:16; Name: ''; X:2540; Y:3556), + (Typ:17; Name: ''; X:2794; Y:4318), + (Typ:18; Name: ''; X:2159; Y:2794), + (Typ:19; Name: ''; X:984; Y:2254), + (Typ:20; Name: ''; X:1048; Y:2413), + (Typ:21; Name: ''; X:1143; Y:2635), + (Typ:22; Name: ''; X:1207; Y:2794), + (Typ:23; Name: ''; X:1270; Y:2921), + (Typ:24; Name: ''; X:4318; Y:5588), + (Typ:25; Name: ''; X:5588; Y:8636), + (Typ:26; Name: ''; X:8636; Y:11176), + (Typ:27; Name: ''; X:1100; Y:2200), + (Typ:28; Name: ''; X:1620; Y:2290), + (Typ:29; Name: ''; X:3240; Y:4580), + (Typ:30; Name: ''; X:2290; Y:3240), + (Typ:31; Name: ''; X:1140; Y:1620), + (Typ:32; Name: ''; X:1140; Y:2290), + (Typ:33; Name: ''; X:2500; Y:3530), + (Typ:34; Name: ''; X:1760; Y:2500), + (Typ:35; Name: ''; X:1760; Y:1250), + (Typ:36; Name: ''; X:1100; Y:2300), + (Typ:37; Name: ''; X:984; Y:1905), + (Typ:38; Name: ''; X:920; Y:1651), + (Typ:39; Name: ''; X:3778; Y:2794), + (Typ:40; Name: ''; X:2159; Y:3048), + (Typ:41; Name: ''; X:2159; Y:3302), + (Typ:42; Name: ''; X:2500; Y:3530), + (Typ:43; Name: ''; X:1000; Y:1480), + (Typ:44; Name: ''; X:2286; Y:2794), + (Typ:45; Name: ''; X:2540; Y:2794), + (Typ:46; Name: ''; X:3810; Y:2794), + (Typ:47; Name: ''; X:2200; Y:2200), + (Typ:50; Name: ''; X:2355; Y:3048), + (Typ:51; Name: ''; X:2355; Y:3810), + (Typ:52; Name: ''; X:2969; Y:4572), + (Typ:53; Name: ''; X:2354; Y:3223), + (Typ:54; Name: ''; X:2101; Y:2794), + (Typ:55; Name: ''; X:2100; Y:2970), + (Typ:56; Name: ''; X:2355; Y:3048), + (Typ:57; Name: ''; X:2270; Y:3560), + (Typ:58; Name: ''; X:3050; Y:4870), + (Typ:59; Name: ''; X:2159; Y:3223), + (Typ:60; Name: ''; X:2100; Y:3300), + (Typ:61; Name: ''; X:1480; Y:2100), + (Typ:62; Name: ''; X:1820; Y:2570), + (Typ:63; Name: ''; X:3220; Y:4450), + (Typ:64; Name: ''; X:1740; Y:2350), + (Typ:65; Name: ''; X:2010; Y:2760), + (Typ:66; Name: ''; X:4200; Y:5940), + (Typ:67; Name: ''; X:2970; Y:4200), + (Typ:68; Name: ''; X:3220; Y:4450)); + + +var + FPrinters: TfrxPrinters = nil; + + +function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean; +var + i: Integer; +begin + Result := False; + for i := 0 to PAPERCOUNT - 1 do + if PaperInfo[i].Typ = PaperSize then + begin + Width := PaperInfo[i].X / 10; + Height := PaperInfo[i].Y / 10; + Result := True; + break; + end; +end; + + +{ TfrxPrinterCanvas } + +procedure TfrxPrinterCanvas.Changing; +begin + inherited; + UpdateFont; +end; + +procedure TfrxPrinterCanvas.UpdateFont; +var + FontSize: Integer; +begin + if FPrinter.DPI.Y <> Font.PixelsPerInch then + begin + FontSize := Font.Size; + Font.PixelsPerInch := FPrinter.DPI.Y; + Font.Size := FontSize; + end; +end; + + +{ TfrxCustomPrinter } + +constructor TfrxCustomPrinter.Create(const AName, APort: String); +begin + FName := AName; + FPort := APort; + + FBins := TStringList.Create; + FBins.AddObject(frxResources.Get('prDefault'), Pointer(DMBIN_AUTO)); + + FPapers := TStringList.Create; + FPapers.AddObject(frxResources.Get('prCustom'), Pointer(256)); + + FCanvas := TfrxPrinterCanvas.Create; + FCanvas.FPrinter := Self; +end; + +destructor TfrxCustomPrinter.Destroy; +begin + FBins.Free; + FPapers.Free; + FCanvas.Free; + inherited; +end; + +function TfrxCustomPrinter.BinIndex(ABin: Integer): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to FBins.Count - 1 do + if Integer(FBins.Objects[i]) = ABin then + begin + Result := i; + break; + end; +end; + +function TfrxCustomPrinter.PaperIndex(APaper: Integer): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to FPapers.Count - 1 do + if Integer(FPapers.Objects[i]) = APaper then + begin + Result := i; + break; + end; +end; + +function TfrxCustomPrinter.BinNameToNumber(const ABin: String): Integer; +var + i: Integer; +begin + i := FBins.IndexOf(ABin); + if i = -1 then + i := 0; + Result := Integer(FBins.Objects[i]); +end; + +function TfrxCustomPrinter.PaperNameToNumber(const APaper: String): Integer; +var + i: Integer; +begin + i := FPapers.IndexOf(APaper); + if i = -1 then + i := 0; + Result := Integer(FPapers.Objects[i]); +end; + + +{ TfrxVirtualPrinter } + +procedure TfrxVirtualPrinter.Init; +var + i: Integer; +begin + if FInitialized then Exit; + + FDPI := Point(600, 600); + FDefPaper := DMPAPER_A4; + FDefOrientation := poPortrait; + FDefPaperWidth := 210; + FDefPaperHeight := 297; + + for i := 0 to PAPERCOUNT - 1 do + FPapers.AddObject(PaperInfo[i].Name, Pointer(PaperInfo[i].Typ)); + + FBin := -1; + FInitialized := True; +end; + +procedure TfrxVirtualPrinter.Abort; +begin +end; + +procedure TfrxVirtualPrinter.BeginDoc; +begin +end; + +procedure TfrxVirtualPrinter.BeginPage; +begin +end; + +procedure TfrxVirtualPrinter.EndDoc; +begin +end; + +procedure TfrxVirtualPrinter.EndPage; +begin +end; + +procedure TfrxVirtualPrinter.BeginRAWDoc; +begin +end; + +procedure TfrxVirtualPrinter.EndRAWDoc; +begin +end; + +procedure TfrxVirtualPrinter.WriteRAWDoc(const buf: String); +begin +end; + +procedure TfrxVirtualPrinter.SetViewParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation); +var + i: Integer; + Found: Boolean; +begin + Found := False; + if APaperSize <> 256 then + for i := 0 to PAPERCOUNT - 1 do + if PaperInfo[i].Typ = APaperSize then + begin + if AOrientation = poPortrait then + begin + APaperWidth := PaperInfo[i].X / 10; + APaperHeight := PaperInfo[i].Y / 10; + end + else + begin + APaperWidth := PaperInfo[i].Y / 10; + APaperHeight := PaperInfo[i].X / 10; + end; + Found := True; + break; + end; + + if not Found then + APaperSize := 256; + + FOrientation := AOrientation; + FPaper := APaperSize; + FPaperWidth := APaperWidth; + FPaperHeight := APaperHeight; + FLeftMargin := 5; + FTopMargin := 5; + FRightMargin := 5; + FBottomMargin := 5; +end; + +procedure TfrxVirtualPrinter.SetPrintParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation; + ABin, ADuplex, ACopies: Integer); +begin + SetViewParams(APaperSize, APaperWidth, APaperHeight, AOrientation); + FBin := ABin; +end; + +procedure TfrxVirtualPrinter.PropertiesDlg; +begin +end; + + +{ TfrxPrinter } + +destructor TfrxPrinter.Destroy; +begin + FreeDevMode; + inherited; +end; + +procedure TfrxPrinter.Init; + + procedure FillPapers; + var + i, PaperSizesCount: Integer; + PaperSizes: array[0..255] of Word; + PaperNames: PChar; + begin + FillChar(PaperSizes, SizeOf(PaperSizes), 0); + PaperSizesCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERS, @PaperSizes, FMode); + GetMem(PaperNames, PaperSizesCount * 64); + DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERNAMES, PaperNames, FMode); + + for i := 0 to PaperSizesCount - 1 do + if PaperSizes[i] <> 256 then + FPapers.AddObject(StrPas(PaperNames + i * 64), Pointer(PaperSizes[i])); + + FreeMem(PaperNames, PaperSizesCount * 64); + end; + + procedure FillBins; + var + i, BinsCount: Integer; + BinNumbers: array[0..255] of Word; + BinNames: PChar; + begin + FillChar(BinNumbers, SizeOf(BinNumbers), 0); + BinsCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINS, @BinNumbers[0], FMode); + GetMem(BinNames, BinsCount * 64); + DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINNAMES, BinNames, FMode); + + for i := 0 to BinsCount - 1 do + if BinNumbers[i] <> DMBIN_AUTO then + FBins.AddObject(StrPas(BinNames + i * 24), Pointer(BinNumbers[i])); + + FreeMem(BinNames, BinsCount * 64); + end; + +begin + if FInitialized then Exit; + + CreateDevMode; + if FDeviceMode = 0 then Exit; + RecreateDC; + + UpdateDeviceCaps; + FDefPaper := FMode.dmPaperSize; + FPaper := FDefPaper; + FDefPaperWidth := FPaperWidth; + FDefPaperHeight := FPaperHeight; + if FMode.dmOrientation = DMORIENT_PORTRAIT then + FDefOrientation := poPortrait else + FDefOrientation := poLandscape; + FOrientation := FDefOrientation; + + FillPapers; + FillBins; + FBin := -1; + + FInitialized := True; +end; + +procedure TfrxPrinter.Abort; +begin + AbortDoc(FDC); + EndDoc; +end; + +procedure TfrxPrinter.BeginDoc; +var + DocInfo: TDocInfo; +begin + FPrinting := True; + + FillChar(DocInfo, SizeOf(DocInfo), 0); + DocInfo.cbSize := SizeOf(DocInfo); + DocInfo.lpszDocName := PChar(FTitle); + if FFileName <> '' then + DocInfo.lpszOutput := PChar(FFileName); + + RecreateDC; + StartDoc(FDC, DocInfo); +end; + +procedure TfrxPrinter.BeginPage; +begin + StartPage(FDC); +end; + +procedure TfrxPrinter.EndDoc; +var + Saved8087CW: Word; +begin + Saved8087CW := Default8087CW; + Set8087CW($133F); + try + Windows.EndDoc(FDC); + except + end; + Set8087CW(Saved8087CW); + + FPrinting := False; + RecreateDC; + FBin := -1; +end; + +procedure TfrxPrinter.EndPage; +begin + Windows.EndPage(FDC); +end; + +procedure TfrxPrinter.BeginRAWDoc; +var + DocInfo1: TDocInfo1; +begin + RecreateDC; + DocInfo1.pDocName := PChar(FTitle); + DocInfo1.pOutputFile := nil; + DocInfo1.pDataType := 'RAW'; + StartDocPrinter(FHandle, 1, @DocInfo1); + StartPagePrinter(FHandle); +end; + +procedure TfrxPrinter.EndRAWDoc; +begin + EndPagePrinter(FHandle); + EndDocPrinter(FHandle); +end; + +procedure TfrxPrinter.WriteRAWDoc(const buf: String); +var + N: DWORD; +begin + WritePrinter(FHandle, PChar(buf), Length(buf), N); +end; + +procedure TfrxPrinter.CreateDevMode; +var + bufSize: Integer; + dm: TDeviceMode; +begin + if OpenPrinter(PChar(FName), FHandle, nil) then + begin + bufSize := DocumentProperties(0, FHandle, PChar(FName), dm, dm, 0); + if bufSize > 0 then + begin + FDeviceMode := GlobalAlloc(GHND, bufSize); + if FDeviceMode <> 0 then + begin + FMode := GlobalLock(FDeviceMode); + if DocumentProperties(0, FHandle, PChar(FName), FMode^, FMode^, + DM_OUT_BUFFER) < 0 then + begin + GlobalUnlock(FDeviceMode); + GlobalFree(FDeviceMode); + FDeviceMode := 0; + FMode := nil; + end + end; + end; + end; +end; + +procedure TfrxPrinter.FreeDevMode; +begin + FCanvas.Handle := 0; + if FDC <> 0 then + DeleteDC(FDC); + if FHandle <> 0 then + ClosePrinter(FHandle); + if FDeviceMode <> 0 then + begin + GlobalUnlock(FDeviceMode); + GlobalFree(FDeviceMode); + end; +end; + +procedure TfrxPrinter.RecreateDC; +begin + if FDC <> 0 then + try + DeleteDC(FDC); + except + end; + FDC := 0; + GetDC; +end; + +procedure TfrxPrinter.GetDC; +begin + if FDC = 0 then + begin + if FPrinting then + FDC := CreateDC(PChar(FDriver), PChar(FName), nil, FMode) else + FDC := CreateIC(PChar(FDriver), PChar(FName), nil, FMode); + FCanvas.Handle := FDC; + FCanvas.Refresh; + FCanvas.UpdateFont; + end; +end; + +procedure TfrxPrinter.SetViewParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation); +begin + if APaperSize <> 256 then + begin + FMode.dmFields := DM_PAPERSIZE or DM_ORIENTATION; + FMode.dmPaperSize := APaperSize; + if AOrientation = poPortrait then + FMode.dmOrientation := DMORIENT_PORTRAIT else + FMode.dmOrientation := DMORIENT_LANDSCAPE; + RecreateDC; + UpdateDeviceCaps; + end + else + begin + // copy the margins from A4 paper + SetViewParams(DMPAPER_A4, 0, 0, AOrientation); + FPaperHeight := APaperHeight; + FPaperWidth := APaperWidth; + end; + + FPaper := APaperSize; + FOrientation := AOrientation; +end; + +procedure TfrxPrinter.SetPrintParams(APaperSize: Integer; + APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation; + ABin, ADuplex, ACopies: Integer); +begin + FMode.dmFields := FMode.dmFields or DM_PAPERSIZE or DM_ORIENTATION or DM_COPIES or + DM_DEFAULTSOURCE; + if ADuplex <> 1 then + FMode.dmFields := FMode.dmFields or DM_DUPLEX; + + if APaperSize = 256 then + begin + FMode.dmFields := FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH; + FMode.dmPaperLength := Round(APaperHeight * 10); + FMode.dmPaperWidth := Round(APaperWidth * 10); + end + else + begin + FMode.dmPaperLength := 0; + FMode.dmPaperWidth := 0; + end; + + FMode.dmPaperSize := APaperSize; + + if AOrientation = poPortrait then + FMode.dmOrientation := DMORIENT_PORTRAIT else + FMode.dmOrientation := DMORIENT_LANDSCAPE; + + FMode.dmCopies := ACopies; + if FBin <> -1 then + ABin := FBin; + if ABin <> DMBIN_AUTO then + FMode.dmDefaultSource := ABin; + if ADuplex = 4 then + FMode.dmDuplex := DMDUP_SIMPLEX + else if ADuplex <> 1 then + FMode.dmDuplex := ADuplex; + + FDC := ResetDC(FDC, FMode^); + FDC := ResetDC(FDC, FMode^); // needed for some printers + FCanvas.Refresh; + UpdateDeviceCaps; + FPaper := APaperSize; + FOrientation := AOrientation; +end; + +procedure TfrxPrinter.UpdateDeviceCaps; +begin + FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY)); + if (FDPI.X = 0) or (FDPI.Y = 0) then + raise Exception.Create('Printer selected is not valid'); + FPaperHeight := Round(GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4); + FPaperWidth := Round(GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4); + FLeftMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4); + FTopMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4); + FRightMargin := FPaperWidth - Round(GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4) - FLeftMargin; + FBottomMargin := FPaperHeight - Round(GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4) - FTopMargin; +end; + +procedure TfrxPrinter.PropertiesDlg; +var + h: THandle; +begin + if Screen.ActiveForm <> nil then + h := Screen.ActiveForm.Handle else + h := 0; + if DocumentProperties(h, FHandle, PChar(FName), FMode^, + FMode^, DM_IN_BUFFER or DM_OUT_BUFFER or DM_IN_PROMPT) > 0 then + begin + FBin := FMode.dmDefaultSource; + RecreateDC; + end; +end; + + +{ TfrxPrinters } + +constructor TfrxPrinters.Create; +begin + FPrinterList := TList.Create; + FPrinters := TStringList.Create; + + FillPrinters; + if FPrinterList.Count = 0 then + begin + FPrinterList.Add(TfrxVirtualPrinter.Create(frxResources.Get('prVirtual'), '')); + FHasPhysicalPrinters := False; + PrinterIndex := 0; + end + else + begin + FHasPhysicalPrinters := True; + PrinterIndex := IndexOf(GetDefaultPrinter); + end; +end; + +destructor TfrxPrinters.Destroy; +begin + Clear; + FPrinterList.Free; + FPrinters.Free; + inherited; +end; + +procedure TfrxPrinters.Clear; +begin + while FPrinterList.Count > 0 do + begin + TObject(FPrinterList[0]).Free; + FPrinterList.Delete(0); + end; + FPrinters.Clear; +end; + +function TfrxPrinters.GetItem(Index: Integer): TfrxCustomPrinter; +begin + Result := FPrinterList[Index]; +end; + +function TfrxPrinters.IndexOf(AName: String): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to FPrinterList.Count - 1 do + if AnsiCompareText(Items[i].Name, AName) = 0 then + begin + Result := i; + break; + end; +end; + +procedure TfrxPrinters.SetPrinterIndex(Value: Integer); +begin + if Value <> -1 then + FPrinterIndex := Value + else + FPrinterIndex := IndexOf(GetDefaultPrinter); + Items[FPrinterIndex].Init; +end; + +function TfrxPrinters.GetCurrentPrinter: TfrxCustomPrinter; +begin + Result := Items[PrinterIndex]; +end; + +function TfrxPrinters.GetDefaultPrinter: String; +var + prnName: array[0..255] of Char; +begin + GetProfileString('windows', 'device', '', prnName, 255); + Result := Copy(prnName, 1, Pos(',', prnName) - 1); +end; + +procedure TfrxPrinters.FillPrinters; +var + i, j: Integer; + Buf, prnInfo: PChar; + Flags, bufSize, prnCount: DWORD; + Level: Byte; + sl: TStringList; + + procedure AddPrinter(ADevice, APort: String); + begin + FPrinterList.Add(TfrxPrinter.Create(ADevice, APort)); + FPrinters.Add(ADevice); + end; + +begin + Clear; + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL; + Level := 4; + end + else + begin + Flags := PRINTER_ENUM_LOCAL; + Level := 5; + end; + + bufSize := 0; + EnumPrinters(Flags, nil, Level, nil, 0, bufSize, prnCount); + if bufSize = 0 then Exit; + + GetMem(Buf, bufSize); + try + if not EnumPrinters(Flags, nil, Level, PByte(Buf), bufSize, bufSize, prnCount) then + Exit; + prnInfo := Buf; + + for i := 0 to prnCount - 1 do + if Level = 4 then + with PPrinterInfo4(prnInfo)^ do + begin + AddPrinter(pPrinterName, ''); + Inc(prnInfo, SizeOf(TPrinterInfo4)); + end + else + with PPrinterInfo5(prnInfo)^ do + begin + sl := TStringList.Create; + frxSetCommaText(pPortName, sl, ','); + + for j := 0 to sl.Count - 1 do + AddPrinter(pPrinterName, sl[j]); + + sl.Free; + Inc(prnInfo, SizeOf(TPrinterInfo5)); + end; + + finally + FreeMem(Buf, bufSize); + end; +end; + + + +function frxPrinters: TfrxPrinters; +begin + if FPrinters = nil then + FPrinters := TfrxPrinters.Create; + Result := FPrinters; +end; + + +initialization + FPrinters := nil; + +finalization + if FPrinters <> nil then + FPrinters.Free; + FPrinters := nil; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxProgress.dfm b/official/4.2/Source/frxProgress.dfm new file mode 100644 index 0000000..eeb58fa Binary files /dev/null and b/official/4.2/Source/frxProgress.dfm differ diff --git a/official/4.2/Source/frxProgress.pas b/official/4.2/Source/frxProgress.pas new file mode 100644 index 0000000..7827399 --- /dev/null +++ b/official/4.2/Source/frxProgress.pas @@ -0,0 +1,161 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Progress } +{ } +{ Copyright (c) 2004-2007 } +{ by Alexander Fediachov, } +{ Fast Reports, Inc. } +{ } +{******************************************} + +unit frxProgress; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, StdCtrls, ExtCtrls; + +type + TfrxProgress = class(TForm) + Panel1: TPanel; + LMessage: TLabel; + Bar: TProgressBar; + CancelB: TButton; + procedure WMNCHitTest(var Message :TWMNCHitTest); message WM_NCHITTEST; + procedure FormCreate(Sender: TObject); + procedure CancelBClick(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + FActiveForm: TForm; + FTerminated: Boolean; + FPosition: Integer; + FMessage: String; + FProgress: Boolean; + procedure SetPosition(Value: Integer); + procedure SetMessage(const Value: String); + procedure SetTerminated(Value: Boolean); + procedure SetProgress(Value: Boolean); + public + procedure Reset; + procedure Execute(MaxValue: Integer; const Msg: String; + Canceled: Boolean; Progress: Boolean); + procedure Tick; + property Terminated: Boolean read FTerminated write SetTerminated; + property Position: Integer read FPosition write SetPosition; + property ShowProgress: Boolean read FProgress write SetProgress; + property Message: String read FMessage write SetMessage; + end; + + +implementation + +{$R *.DFM} + +uses frxRes; + +{ TfrxProgress } + +procedure TfrxProgress.WMNCHitTest(var Message: TWMNCHitTest); +begin + inherited; + if Message.Result = htClient then + Message.Result := htCaption; +end; + +procedure TfrxProgress.FormCreate(Sender: TObject); +begin + CancelB.Caption := frxGet(2); + FActiveForm := Screen.ActiveForm; + if FActiveForm <> nil then + FActiveForm.Enabled := False; + Bar.Min := 0; + Bar.Max := 100; + Position := 0; + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxProgress.FormDestroy(Sender: TObject); +begin + if FActiveForm <> nil then + FActiveForm.Enabled := True; +end; + +procedure TfrxProgress.FormHide(Sender: TObject); +begin + if FActiveForm <> nil then + FActiveForm.Enabled := True; +end; + +procedure TfrxProgress.Reset; +begin + Position := 0; +end; + +procedure TfrxProgress.SetPosition(Value: Integer); +begin + FPosition := Value; + Bar.Position := Value; + BringToFront; + Application.ProcessMessages; +end; + +procedure TfrxProgress.Execute(MaxValue: Integer; const Msg: String; + Canceled: Boolean; Progress: Boolean); +begin + Terminated := False; + CancelB.Visible := Canceled; + ShowProgress := Progress; + Bar.Min := 0; + Reset; + Bar.Max := MaxValue; + Message := Msg; + Show; + Application.ProcessMessages; +end; + +procedure TfrxProgress.Tick; +begin + if (Position < Bar.Max) and (Position >= Bar.Min) then + Position := Position + 1; +end; + +procedure TfrxProgress.SetMessage(const Value: String); +begin + FMessage := Value; + LMessage.Caption := Value; + LMessage.Refresh; +end; + +procedure TfrxProgress.CancelBClick(Sender: TObject); +begin + Terminated := True; +end; + +procedure TfrxProgress.SetTerminated(Value: boolean); +begin + FTerminated := Value; + if Value then Close; +end; + +procedure TfrxProgress.SetProgress(Value: boolean); +begin + Bar.Visible := Value; + FProgress := Value; + if Value then + LMessage.Top := 15 + else + LMessage.Top := 35; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxReg.dcr b/official/4.2/Source/frxReg.dcr new file mode 100644 index 0000000..c2daa6e Binary files /dev/null and b/official/4.2/Source/frxReg.dcr differ diff --git a/official/4.2/Source/frxReg.pas b/official/4.2/Source/frxReg.pas new file mode 100644 index 0000000..63015a4 --- /dev/null +++ b/official/4.2/Source/frxReg.pas @@ -0,0 +1,138 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Registration unit } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxReg; + +{$I frx.inc} +//{$I frxReg.inc} + +interface + + +procedure Register; + +implementation + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, +{$IFNDEF Delphi6} + DsgnIntf, +{$ELSE} + DesignIntf, DesignEditors, +{$ENDIF} + Dialogs, frxClass, + frxDock, frxCtrls, frxDesgnCtrls, + frxDesgn, frxPreview, frxRich, frxOLE, frxBarCode, + frxChBox, frxDMPExport, +{$IFNDEF FR_VER_BASIC} + frxDCtrl, +{$ENDIF} + frxCross, frxRichEdit, frxGradient, + frxGZip, frxEditAliases, frxCrypt; + +{-----------------------------------------------------------------------} +type + TfrxReportEditor = class(TComponentEditor) + procedure ExecuteVerb(Index: Integer); override; + function GetVerb(Index: Integer): String; override; + function GetVerbCount: Integer; override; + end; + + TfrxDataSetEditor = class(TComponentEditor) + procedure ExecuteVerb(Index: Integer); override; + function GetVerb(Index: Integer): String; override; + function GetVerbCount: Integer; override; + end; + + +{ TfrxReportEditor } + +procedure TfrxReportEditor.ExecuteVerb(Index: Integer); +var + Report: TfrxReport; +begin + Report := TfrxReport(Component); + if Report.Designer <> nil then + Report.Designer.BringToFront + else + begin + Report.DesignReport(Designer, Self); + if Report.StoreInDFM then + Designer.Modified; + end; +end; + +function TfrxReportEditor.GetVerb(Index: Integer): String; +begin + Result := 'Edit Report...'; +end; + +function TfrxReportEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + + +{ TfrxDataSetEditor } + +procedure TfrxDataSetEditor.ExecuteVerb(Index: Integer); +begin + with TfrxAliasesEditorForm.Create(Application) do + begin + DataSet := TfrxCustomDBDataSet(Component); + if ShowModal = mrOk then + Self.Designer.Modified; + Free; + end; +end; + +function TfrxDataSetEditor.GetVerb(Index: Integer): String; +begin + Result := 'Edit Fields Aliases...'; +end; + +function TfrxDataSetEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + + +{-----------------------------------------------------------------------} +procedure Register; +begin + RegisterComponents('FastReport 4.0', + [TfrxReport, TfrxUserDataset, +{$IFNDEF FR_VER_BASIC} + TfrxDesigner, +{$ENDIF} + TfrxPreview, + TfrxBarcodeObject, TfrxOLEObject, TfrxRichObject, + TfrxCrossObject, TfrxCheckBoxObject, TfrxGradientObject, + TfrxDotMatrixExport +{$IFNDEF FR_VER_BASIC} + , TfrxDialogControls +{$ENDIF} + , TfrxGZipCompressor, TfrxCrypt + ]); + + RegisterComponents('FR4 tools', + [TfrxDockSite, TfrxTBPanel, TfrxComboEdit, + TfrxComboBox, TfrxFontComboBox, TfrxRuler, TfrxScrollBox]); + + RegisterComponentEditor(TfrxReport, TfrxReportEditor); + RegisterComponentEditor(TfrxCustomDBDataSet, TfrxDataSetEditor); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRegDB.pas b/official/4.2/Source/frxRegDB.pas new file mode 100644 index 0000000..3b8c871 --- /dev/null +++ b/official/4.2/Source/frxRegDB.pas @@ -0,0 +1,48 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Registration unit } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRegDB; + +{$I frx.inc} + +interface + + +procedure Register; + +implementation + +uses + Windows, Messages, SysUtils, Classes, Forms, Controls, +{$IFNDEF Delphi6} + DsgnIntf, +{$ELSE} + DesignIntf, DesignEditors, +{$ENDIF} + frxDBSet, + frxCustomDB, + frxCustomDBEditor, + frxCustomDBRTTI, + frxEditMD, + frxEditQueryParams; + + +{-----------------------------------------------------------------------} +procedure Register; +begin + RegisterComponents('FastReport 4.0', [TfrxDBDataset]); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRegIBO.pas b/official/4.2/Source/frxRegIBO.pas new file mode 100644 index 0000000..3c47217 --- /dev/null +++ b/official/4.2/Source/frxRegIBO.pas @@ -0,0 +1,42 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Registration unit } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRegIBO; + +{$I frx.inc} + +interface + + +procedure Register; + +implementation + +uses + Windows, Messages, SysUtils, Classes, Forms, Controls, +{$IFNDEF Delphi6} + DsgnIntf, +{$ELSE} + DesignIntf, DesignEditors, +{$ENDIF} + frxIBOSet; + +{-----------------------------------------------------------------------} +procedure Register; +begin + RegisterComponents('FastReport 4.0', [TfrxIBODataset]); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRegTee.pas b/official/4.2/Source/frxRegTee.pas new file mode 100644 index 0000000..49109c5 --- /dev/null +++ b/official/4.2/Source/frxRegTee.pas @@ -0,0 +1,43 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Registration unit } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRegTee; + +{$I frx.inc} + +interface + + +procedure Register; + +implementation + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, +{$IFNDEF Delphi6} + DsgnIntf, +{$ELSE} + DesignIntf, DesignEditors, +{$ENDIF} + frxChart; + + +procedure Register; +begin + RegisterComponents('FastReport 4.0', + [TfrxChartObject]); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxReportTree.dfm b/official/4.2/Source/frxReportTree.dfm new file mode 100644 index 0000000..d27ad2a Binary files /dev/null and b/official/4.2/Source/frxReportTree.dfm differ diff --git a/official/4.2/Source/frxReportTree.pas b/official/4.2/Source/frxReportTree.pas new file mode 100644 index 0000000..a5cc894 --- /dev/null +++ b/official/4.2/Source/frxReportTree.pas @@ -0,0 +1,214 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Report Tree } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxReportTree; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, frxClass +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxReportTreeForm = class(TForm) + Tree: TTreeView; + procedure FormShow(Sender: TObject); + procedure TreeChange(Sender: TObject; Node: TTreeNode); + procedure FormCreate(Sender: TObject); + procedure TreeKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + FComponents: TList; + FDesigner: TfrxCustomDesigner; + FNodes: TList; + FReport: TfrxReport; + FUpdating: Boolean; + FOnSelectionChanged: TNotifyEvent; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetColor(Value: TColor); + procedure UpdateItems; + procedure UpdateSelection; + property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged + write FOnSelectionChanged; + end; + + +implementation + +{$R *.DFM} + +uses frxRes, frxDesgn, frxDsgnIntf; + +type + THackWinControl = class(TWinControl); + + +{ TfrxReportTreeForm } + +constructor TfrxReportTreeForm.Create(AOwner: TComponent); +begin + inherited; + FComponents := TList.Create; + FNodes := TList.Create; +{$IFDEF UseTabset} + Tree.BevelKind := bkFlat; +{$ELSE} + Tree.BorderStyle := bsSingle; +{$ENDIF} +end; + +destructor TfrxReportTreeForm.Destroy; +begin + FComponents.Free; + FNodes.Free; + inherited; +end; + +procedure TfrxReportTreeForm.FormShow(Sender: TObject); +begin + UpdateItems; +end; + +procedure TfrxReportTreeForm.UpdateItems; + + procedure SetImageIndex(Node: TTreeNode; Index: Integer); + begin + Node.ImageIndex := Index; + Node.StateIndex := Index; + Node.SelectedIndex := Index; + end; + + procedure EnumItems(c: TfrxComponent; RootNode: TTreeNode); + var + i: Integer; + Node: TTreeNode; + Item: TfrxObjectItem; + begin + Node := Tree.Items.AddChild(RootNode, c.Name); + FComponents.Add(c); + FNodes.Add(Node); + Node.Data := c; + if c is TfrxReport then + begin + Node.Text := 'Report'; + SetImageIndex(Node, 34); + end + else if c is TfrxReportPage then + SetImageIndex(Node, 35) + else if c is TfrxDialogPage then + SetImageIndex(Node, 36) + else if c is TfrxDataPage then + SetImageIndex(Node, 37) + else if c is TfrxBand then + SetImageIndex(Node, 40) + else + begin + for i := 0 to frxObjects.Count - 1 do + begin + Item := frxObjects[i]; + if Item.ClassRef = c.ClassType then + begin + SetImageIndex(Node, Item.ButtonImageIndex); + break; + end; + end; + end; + + if c is TfrxDataPage then + begin + for i := 0 to c.Objects.Count - 1 do + if TObject(c.Objects[i]) is TfrxDialogComponent then + EnumItems(c.Objects[i], Node) + end + else + for i := 0 to c.Objects.Count - 1 do + EnumItems(c.Objects[i], Node); + end; + +begin + Tree.Items.BeginUpdate; + Tree.Items.Clear; + FComponents.Clear; + FNodes.Clear; + EnumItems(FReport, nil); + + Tree.FullExpand; + UpdateSelection; + Tree.Items.EndUpdate; +end; + +procedure TfrxReportTreeForm.TreeChange(Sender: TObject; Node: TTreeNode); +begin + if FUpdating then Exit; + FDesigner.SelectedObjects.Clear; + FDesigner.SelectedObjects.Add(Tree.Selected.Data); + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self); +end; + +procedure TfrxReportTreeForm.SetColor(Value: TColor); +begin + Tree.Color := Value; + UpdateItems; +end; + +procedure TfrxReportTreeForm.FormCreate(Sender: TObject); +begin + FDesigner := TfrxCustomDesigner(Owner); + FReport := FDesigner.Report; + Tree.Images := frxResources.ObjectImages; + Caption := frxGet(2200); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxReportTreeForm.UpdateSelection; +var + c: TComponent; + i: Integer; +begin + if FDesigner.SelectedObjects.Count = 0 then Exit; + c := FDesigner.SelectedObjects[0]; + FUpdating := True; + + i := FComponents.IndexOf(c); + if i <> -1 then + begin + TTreeNode(FNodes[i]).Selected := True; + Tree.TopItem := TTreeNode(FNodes[i]); + end; + + FUpdating := False; +end; + +procedure TfrxReportTreeForm.TreeKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = vk_Delete then + begin + THackWinControl(TfrxDesignerForm(FDesigner).Workspace).KeyDown(Key, Shift); + end; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRes.pas b/official/4.2/Source/frxRes.pas new file mode 100644 index 0000000..8249c38 --- /dev/null +++ b/official/4.2/Source/frxRes.pas @@ -0,0 +1,515 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Language resources management } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRes; + +interface + +{$I frx.inc} + +uses + Windows, SysUtils, Classes, Controls, Graphics, Forms, ImgList, TypInfo +{$IFDEF Delphi6} +, Variants +{$ENDIF} +{$IFDEF FR_COM} +, ComObj +, FastReport_TLB +, DispatchablePersistent +{$ENDIF}; + + +type +{$IFDEF FR_COM} + TfrxResources = class(TDispatchablePersistent, IfrxResources) +{$ELSE} + TfrxResources = class(TObject) +{$ENDIF} + private + FDisabledButtonImages: TImageList; + FMainButtonImages: TImageList; + FNames: TStringList; + FObjectImages: TImageList; + FPreviewButtonImages: TImageList; + FValues: TStringList; + FWizardImages: TImageList; + FLanguages: TStringList; + FHelpFile: String; + procedure BuildLanguagesList; + function GetMainButtonImages: TImageList; + function GetObjectImages: TImageList; + function GetPreviewButtonImages: TImageList; + function GetWizardImages: TImageList; + 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); + procedure SetButtonImages(Images: TBitmap; Clear: Boolean = False); + procedure SetObjectImages(Images: TBitmap; Clear: Boolean = False); + procedure SetPreviewButtonImages(Images: TBitmap; Clear: Boolean = False); + procedure SetWizardImages(Images: TBitmap; Clear: Boolean = False); + procedure UpdateFSResources; + procedure Help(Sender: TObject); overload; + property DisabledButtonImages: TImageList read FDisabledButtonImages; + property MainButtonImages: TImageList read GetMainButtonImages; + property PreviewButtonImages: TImageList read GetPreviewButtonImages; + property ObjectImages: TImageList read GetObjectImages; + property WizardImages: TImageList read GetWizardImages; + property Languages: TStringList read FLanguages; + property HelpFile: String read FHelpFile write FHelpFile; +{$IFDEF FR_COM} + function Get_HelpFile(out Value: WideString): HResult; stdcall; + function Set_HelpFile(const Value: WideString): HResult; stdcall; + function Help: HResult; overload; stdcall; + function GetResourceString(const ID: WideString; out Value: WideString): HResult; stdcall; + function LoadLanguageResourcesFromFile(const FileName: WideString): HResult; stdcall; +{$ENDIF} + end; + +function frxResources: TfrxResources; +function frxGet(ID: Integer): String; + + +implementation + +uses frxUtils, frxChm, fs_iconst, frxGZip; + +var + FResources: TfrxResources = nil; + + +{ TfrxResources } + +constructor TfrxResources.Create; +begin +{$IFDEF FR_COM} + inherited Create(IfrxResources); +{$ELSE} + inherited; +{$ENDIF} + FDisabledButtonImages := TImageList.Create(nil); + FDisabledButtonImages.Width := 16; + FDisabledButtonImages.Height := 16; + FMainButtonImages := TImageList.Create(nil); + FMainButtonImages.Width := 16; + FMainButtonImages.Height := 16; + FObjectImages := TImageList.Create(nil); + FObjectImages.Width := 16; + FObjectImages.Height := 16; + FPreviewButtonImages := TImageList.Create(nil); + FPreviewButtonImages.Width := 16; + FPreviewButtonImages.Height := 16; + FWizardImages := TImageList.Create(nil); + FWizardImages.Width := 32; + FWizardImages.Height := 32; + FNames := TStringList.Create; + FValues := TStringList.Create; + FNames.Sorted := True; + FLanguages := TStringList.Create; + HelpFile := 'FRUser.chm'; + BuildLanguagesList; +end; + +destructor TfrxResources.Destroy; +begin + FLanguages.Free; + FDisabledButtonImages.Free; + FMainButtonImages.Free; + FObjectImages.Free; + FPreviewButtonImages.Free; + FWizardImages.Free; + FNames.Free; + FValues.Free; + inherited; +end; + +procedure TfrxResources.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 TfrxResources.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]; + vl := Copy(nm, Pos('=', nm) + 1, MaxInt); + nm := Copy(nm, 1, Pos('=', nm) - 1); + if (nm <> '') and (vl <> '') then + Add(nm, vl); + end; + sl.Free; +end; + +procedure TfrxResources.Clear; +begin + FNames.Clear; + FValues.Clear; +end; + +function TfrxResources.Get(const StrName: String): String; +var + i: Integer; +begin + i := FNames.IndexOf(StrName); + if i <> -1 then + Result := FValues[Integer(FNames.Objects[i])] else + Result := StrName; + if (Result <> '') and (Result[1] = '!') then + Delete(Result, 1, 1); +end; + +function TfrxResources.GetMainButtonImages: TImageList; +var + Images: TBitmap; + stm: TMemoryStream; + res: TResourceStream; +begin + if FMainButtonImages.Count = 0 then + begin + Images := TBitmap.Create; + stm := TMemoryStream.Create; + res := TResourceStream.Create(hInstance, 'DesgnButtons', RT_RCDATA); + try + frxDecompressStream(res, stm); + stm.Position := 0; + Images.LoadFromStream(stm); + SetButtonImages(Images); + finally + stm.Free; + res.Free; + Images.Free; + end; + end; + + Result := FMainButtonImages; +end; + +function TfrxResources.GetPreviewButtonImages: TImageList; +var + Images: TBitmap; + stm: TMemoryStream; + res: TResourceStream; +begin + if FPreviewButtonImages.Count = 0 then + begin + Images := TBitmap.Create; + stm := TMemoryStream.Create; + res := TResourceStream.Create(hInstance, 'PreviewButtons', RT_RCDATA); + try + frxDecompressStream(res, stm); + stm.Position := 0; + Images.LoadFromStream(stm); + SetPreviewButtonImages(Images); + finally + stm.Free; + res.Free; + Images.Free; + end; + end; + + Result := FPreviewButtonImages; +end; + +function TfrxResources.GetObjectImages: TImageList; +var + Images: TBitmap; + stm: TMemoryStream; + res: TResourceStream; +begin + if FObjectImages.Count = 0 then + begin + Images := TBitmap.Create; + stm := TMemoryStream.Create; + res := TResourceStream.Create(hInstance, 'ObjectButtons', RT_RCDATA); + try + frxDecompressStream(res, stm); + stm.Position := 0; + Images.LoadFromStream(stm); + SetObjectImages(Images); + finally + stm.Free; + res.Free; + Images.Free; + end; + end; + + Result := FObjectImages; +end; + +function TfrxResources.GetWizardImages: TImageList; +var + Images: TBitmap; + stm: TMemoryStream; + res: TResourceStream; +begin + if FWizardImages.Count = 0 then + begin + Images := TBitmap.Create; + stm := TMemoryStream.Create; + res := TResourceStream.Create(hInstance, 'WizardButtons', RT_RCDATA); + try + frxDecompressStream(res, stm); + stm.Position := 0; + Images.LoadFromStream(stm); + SetWizardImages(Images); + finally + stm.Free; + res.Free; + Images.Free; + end; + end; + + Result := FWizardImages; +end; + +procedure TfrxResources.SetButtonImages(Images: TBitmap; Clear: Boolean = False); +begin + if Clear then + begin + FMainButtonImages.Clear; + FDisabledButtonImages.Clear; + end; + frxAssignImages(Images, 16, 16, FMainButtonImages, FDisabledButtonImages); +end; + +procedure TfrxResources.SetObjectImages(Images: TBitmap; Clear: Boolean = False); +begin + if Clear then + FObjectImages.Clear; + frxAssignImages(Images, 16, 16, FObjectImages); +end; + +procedure TfrxResources.SetPreviewButtonImages(Images: TBitmap; Clear: Boolean = False); +begin + if Clear then + FPreviewButtonImages.Clear; + frxAssignImages(Images, 16, 16, FPreviewButtonImages); +end; + +procedure TfrxResources.SetWizardImages(Images: TBitmap; Clear: Boolean = False); +begin + if Clear then + FWizardImages.Clear; + frxAssignImages(Images, 32, 32, FWizardImages); +end; + +procedure TfrxResources.LoadFromFile(const FileName: String); +var + f: TFileStream; +begin + if FileExists(FileName) then + begin + f := TFileStream.Create(FileName, fmOpenRead); + try + LoadFromStream(f); + finally + f.Free; + end; + end; +end; + +procedure TfrxResources.LoadFromStream(Stream: TStream); +var + 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; + UpdateFSResources; +end; + +procedure TfrxResources.UpdateFSResources; +begin + SLangNotFound := Get('SLangNotFound'); + SInvalidLanguage := Get('SInvalidLanguage'); + SIdRedeclared := Get('SIdRedeclared'); + SUnknownType := Get('SUnknownType'); + SIncompatibleTypes := Get('SIncompatibleTypes'); + SIdUndeclared := Get('SIdUndeclared'); + SClassRequired := Get('SClassRequired'); + SIndexRequired := Get('SIndexRequired'); + SStringError := Get('SStringError'); + SClassError := Get('SClassError'); + SArrayRequired := Get('SArrayRequired'); + SVarRequired := Get('SVarRequired'); + SNotEnoughParams := Get('SNotEnoughParams'); + STooManyParams := Get('STooManyParams'); + SLeftCantAssigned := Get('SLeftCantAssigned'); + SForError := Get('SForError'); + SEventError := Get('SEventError'); +end; + +type + THelpTopic = record + Sender: String; + Topic: String; + end; + +const + helpTopicsCount = 17; + helpTopics: array[0..helpTopicsCount - 1] of THelpTopic = + ((Sender: 'TfrxDesignerForm'; Topic: 'Designer.htm'), + (Sender: 'TfrxOptionsEditor'; Topic: 'Designer_options.htm'), + (Sender: 'TfrxReportEditorForm'; Topic: 'Report_options.htm'), + (Sender: 'TfrxPageEditorForm'; Topic: 'Page_options.htm'), + (Sender: 'TfrxCrossEditorForm'; Topic: 'Cross_tab_reports.htm'), + (Sender: 'TfrxChartEditorForm'; Topic: 'Diagrams.htm'), + (Sender: 'TfrxSyntaxMemo'; Topic: 'Script.htm'), + (Sender: 'TfrxDialogPage'; Topic: 'Dialogue_forms.htm'), + (Sender: 'TfrxDialogComponent'; Topic: 'Data_access_components.htm'), + (Sender: 'TfrxVarEditorForm'; Topic: 'Variables.htm'), + (Sender: 'TfrxHighlightEditorForm'; Topic: 'Conditional_highlighting.htm'), + (Sender: 'TfrxSysMemoEditorForm'; Topic: 'Inserting_aggregate_function.htm'), + (Sender: 'TfrxFormatEditorForm'; Topic: 'Values_formatting.htm'), + (Sender: 'TfrxGroupEditorForm'; Topic: 'Report_with_groups.htm'), + (Sender: 'TfrxPictureEditorForm'; Topic: 'Picture_object.htm'), + (Sender: 'TfrxMemoEditorForm'; Topic: 'Text_object.htm'), + (Sender: 'TfrxSQLEditorForm'; Topic: 'TfrxADOQuery.htm') + ); + + + + +procedure TfrxResources.Help(Sender: TObject); +var + i: Integer; + topic: String; +begin + topic := ''; + if Sender <> nil then + for i := 0 to helpTopicsCount - 1 do + if CompareText(helpTopics[i].Sender, Sender.ClassName) = 0 then + topic := '::/' + helpTopics[i].Topic; + frxDisplayHHTopic(Application.Handle, ExtractFilePath(Application.ExeName) + FHelpFile + topic); +end; + +procedure TfrxResources.BuildLanguagesList; +var + i: Integer; + SRec: TSearchRec; + Dir: String; + s: String; +begin + Dir := GetAppPath; + FLanguages.Clear; + i := FindFirst(Dir + '*.frc', faAnyFile, SRec); + try + while i = 0 do + begin + s := LowerCase(SRec.Name); + s := UpperCase(Copy(s, 1, 1)) + Copy(s, 2, Length(s) - 1); + s := StringReplace(s, '.frc', '', []); + FLanguages.Add(s); + i := FindNext(SRec); + end; + FLanguages.Sort; + finally + FindClose(Srec); + end; +end; + + +function frxResources: TfrxResources; +begin + if FResources = nil then + FResources := TfrxResources.Create; + Result := FResources; +end; + +function frxGet(ID: Integer): String; +begin + Result := frxResources.Get(IntToStr(ID)); +end; + +{$IFDEF FR_COM} +function TfrxResources.Get_HelpFile(out Value: WideString): HResult; stdcall; +begin + Value := HelpFile; + Result := S_OK; +end; + +function TfrxResources.Set_HelpFile(const Value: WideString): HResult; stdcall; +begin + HelpFile := Value; + Result := S_OK; +end; + +function TfrxResources.Help: HResult; stdcall; +begin + Help(nil); + Result := S_OK; +end; + +function TfrxResources.GetResourceString(const ID: WideString; out Value: WideString): HResult; stdcall; +begin + Value := Get(ID); + Result := S_OK; +end; + +function TfrxResources.LoadLanguageResourcesFromFile(const FileName: WideString): HResult; stdcall; +begin + try + LoadFromFile(FileName); + Result := S_OK; + except + Result := E_FAIL; + end; +end; +{$ENDIF} + + +initialization + +finalization + if FResources <> nil then + FResources.Free; + FResources := nil; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRich.pas b/official/4.2/Source/frxRich.pas new file mode 100644 index 0000000..d64adb7 --- /dev/null +++ b/official/4.2/Source/frxRich.pas @@ -0,0 +1,625 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ RichEdit Add-In Object } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRich; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Forms, Menus, frxClass, + RichEdit, frxRichEdit, frxPrinter +{$IFDEF Delphi6} +, Variants +{$ENDIF} +{$IFDEF FR_COM} +, ActiveX, AxCtrls +, ClrStream +, FastReport_TLB +{$ENDIF}; + + +type + TfrxRichObject = class(TComponent) // fake component + end; + +{$IFDEF FR_COM} + TfrxRichView = class(TfrxStretcheable, IfrxRichView) +{$ELSE} + TfrxRichView = class(TfrxStretcheable) +{$ENDIF} + private + FAllowExpressions: Boolean; + FExpressionDelimiters: String; + FFlowTo: TfrxRichView; + FGapX: Extended; + FGapY: Extended; + FParaBreak: Boolean; + FRichEdit: TrxRichEdit; + FTempStream: TMemoryStream; + FTempStream1: TMemoryStream; + FWysiwyg: Boolean; + function CreateMetafile: TMetafile; + function IsExprDelimitersStored: Boolean; + function UsePrinterCanvas: Boolean; + procedure ReadData(Stream: TStream); + procedure WriteData(Stream: TStream); +{$IFDEF FR_COM} + function LoadViewFromStream(const Stream: IUnknown): HResult; stdcall; + function SaveViewToStream(const Stream: IUnknown): HResult; stdcall; + function Get_RichAlign(out Value: frxHAlign): HResult; stdcall; + function Set_RichAlign(Value: frxHAlign): HResult; stdcall; + function Get_WYSIWIG(out Value: WordBool): HResult; stdcall; + function Set_WYSIWIG(Value: WordBool): HResult; stdcall; + function Get_AllowExpressions(out Value: WordBool): HResult; stdcall; + function Set_AllowExpressions(Value: WordBool): HResult; stdcall; +{$ENDIF} + protected + procedure DefineProperties(Filer: TFiler); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; + procedure AfterPrint; override; + procedure BeforePrint; override; + procedure GetData; override; + procedure InitPart; override; + function CalcHeight: Extended; override; + function DrawPart: Extended; override; + class function GetDescription: String; override; + function GetComponentText: String; override; + property RichEdit: TrxRichEdit read FRichEdit; + published + property AllowExpressions: Boolean read FAllowExpressions + write FAllowExpressions default True; + property BrushStyle; + property Color; + property Cursor; + property DataField; + property DataSet; + property DataSetName; + property ExpressionDelimiters: String read FExpressionDelimiters + write FExpressionDelimiters stored IsExprDelimitersStored; + property FlowTo: TfrxRichView read FFlowTo write FFlowTo; + property Frame; + property GapX: Extended read FGapX write FGapX; + property GapY: Extended read FGapY write FGapY; + property TagStr; + property URL; + property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True; + end; + + +procedure frxAssignRich(RichFrom, RichTo: TrxRichEdit); + + +implementation + +uses + frxRichRTTI, +{$IFNDEF NO_EDITORS} + frxRichEditor, +{$ENDIF} + frxUtils, frxDsgnIntf, frxRes; + + +procedure frxAssignRich(RichFrom, RichTo: TrxRichEdit); +var + st: TMemoryStream; +begin + st := TMemoryStream.Create; + try + RichFrom.Lines.SaveToStream(st); + st.Position := 0; + RichTo.Lines.LoadFromStream(st); + finally + st.Free; + end; +end; + + +{ TfrxRichView } + +constructor TfrxRichView.Create(AOwner: TComponent); +begin + inherited; + FRichEdit := TrxRichEdit.Create(nil); + FRichEdit.Parent := frxParentForm; + SendMessage(frxParentForm.Handle, WM_CREATEHANDLE, Integer(FRichEdit), 0); + FRichEdit.AutoURLDetect := False; + { make rich transparent } + SetWindowLong(FRichEdit.Handle, GWL_EXSTYLE, + GetWindowLong(FRichEdit.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT); + + FTempStream := TMemoryStream.Create; + FTempStream1 := TMemoryStream.Create; + + FAllowExpressions := True; + FExpressionDelimiters := '[,]'; + FGapX := 2; + FGapY := 1; + FWysiwyg := True; +end; + +destructor TfrxRichView.Destroy; +begin + SendMessage(frxParentForm.Handle, WM_DESTROYHANDLE, Integer(FRichEdit), 0); + FRichEdit.Free; + FTempStream.Free; + FTempStream1.Free; + inherited; +end; + +class function TfrxRichView.GetDescription: String; +begin + Result := frxResources.Get('obRich'); +end; + +function TfrxRichView.IsExprDelimitersStored: Boolean; +begin + Result := FExpressionDelimiters <> '[,]'; +end; + +procedure TfrxRichView.DefineProperties(Filer: TFiler); +begin + inherited; + Filer.DefineBinaryProperty('RichEdit', ReadData, WriteData, True); +end; + +procedure TfrxRichView.ReadData(Stream: TStream); +begin + FRichEdit.Lines.LoadFromStream(Stream); +end; + +procedure TfrxRichView.WriteData(Stream: TStream); +begin + FRichEdit.Lines.SaveToStream(Stream); +end; + +procedure TfrxRichView.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) and (AComponent = FFlowTo) then + FFlowTo := nil; +end; + +function TfrxRichView.UsePrinterCanvas: Boolean; +begin + Result := frxPrinters.HasPhysicalPrinters and FWysiwyg; +end; + +function TfrxRichView.CreateMetafile: TMetafile; +var + Range: TFormatRange; + EMFCanvas: TMetafileCanvas; + PrinterHandle: THandle; +begin + if UsePrinterCanvas then + PrinterHandle := frxPrinters.Printer.Canvas.Handle + else + PrinterHandle := GetDC(0); + FillChar(Range, SizeOf(TFormatRange), 0); + + with Range do + begin + rc := Rect(Round(GapX * 1440 / 96), Round(GapY * 1440 / 96), + Round((Width - GapX) * 1440 / 96), + Round((Height - GapY) * 1440 / 96)); + rcPage := rc; + + Result := TMetafile.Create; + Result.Width := Round(Width * GetDeviceCaps(PrinterHandle, LOGPIXELSX) / 96); + Result.Height := Round(Height * GetDeviceCaps(PrinterHandle, LOGPIXELSY) / 96); + + EMFCanvas := TMetafileCanvas.Create(Result, PrinterHandle); + hdc := EMFCanvas.Handle; + hdcTarget := hdc; + + chrg.cpMin := 0; + chrg.cpMax := -1; + FRichEdit.Perform(EM_FORMATRANGE, 1, Integer(@Range)); + end; + + if not UsePrinterCanvas then + ReleaseDC(0, PrinterHandle); + + FRichEdit.Perform(EM_FORMATRANGE, 0, 0); + EMFCanvas.Free; +end; + +procedure TfrxRichView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, + OffsetY: Extended); +var + EMF: TMetafile; +begin + BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); + DrawBackground; + + EMF := CreateMetafile; + try + Canvas.StretchDraw(Rect(FX, FY, FX1, FY1), EMF); + finally + EMF.Free; + end; + + DrawFrame; +end; + +procedure TfrxRichView.BeforePrint; +begin + inherited; + FTempStream.Position := 0; + FRichEdit.Lines.SaveToStream(FTempStream); +end; + +procedure TfrxRichView.AfterPrint; +begin + FTempStream.Position := 0; + FRichEdit.Lines.LoadFromStream(FTempStream); + inherited; +end; + +procedure TfrxRichView.GetData; +var + ss: TStringStream; + i, j, TextLen: Integer; + s1, s2, dc1, dc2: String; + + function GetSpecial(const s: String; Pos: Integer): Integer; + var + i: Integer; + begin + Result := 0; + for i := 1 to Pos do + if s[i] in [#10, #13] then + Inc(Result); + end; + + function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer; + var + I,X: Integer; + Len, LenSubStr: Integer; + begin + if Offset = 1 then + Result := Pos(SubStr, S) + else + begin + I := Offset; + LenSubStr := Length(SubStr); + Len := Length(S) - LenSubStr + 1; + while I <= Len do + begin + if S[I] = SubStr[1] then + begin + X := 1; + while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do + Inc(X); + if (X = LenSubStr) then + begin + Result := I; + exit; + end; + end; + Inc(I); + end; + Result := 0; + end; + end; + +begin + inherited; + if IsDataField then + begin + ss := TStringStream.Create(VarToStr(DataSet.Value[DataField])); + try + FRichEdit.Lines.LoadFromStream(ss); + finally + ss.Free; + end; + end; + + if FAllowExpressions then + begin + dc1 := FExpressionDelimiters; + dc2 := Copy(dc1, Pos(',', dc1) + 1, 255); + dc1 := Copy(dc1, 1, Pos(',', dc1) - 1); + + with FRichEdit do + try + Lines.BeginUpdate; + + i := Pos(dc1, Text); + while i > 0 do + begin + SelStart := i - 1 - GetSpecial(Text, i) div 2; + s1 := frxGetBrackedVariable(Text, dc1, dc2, i, j); + s2 := VarToStr(Report.Calc(s1)); + + SelLength := j - i + 1; + TextLen := Length(Text) - SelLength; + SelText := s2; + + i := PosEx(dc1, Text, i + Length(Text) - TextLen); + end; + finally + Lines.EndUpdate; + end; + end; + + if FFlowTo <> nil then + begin + InitPart; + DrawPart; + FTempStream1.Position := 0; + FlowTo.RichEdit.Lines.LoadFromStream(FTempStream1); + FFlowTo.AllowExpressions := False; + end; +end; + +function TfrxRichView.CalcHeight: Extended; +var + Range: TFormatRange; +begin + FillChar(Range, SizeOf(TFormatRange), 0); + with Range do + begin + rc := Rect(0, 0, Round((Width - GapX * 2) * 1440 / 96), Round(1000000 * 1440.0 / 96)); + rcPage := rc; + if UsePrinterCanvas then + hdc := frxPrinters.Printer.Canvas.Handle + else + hdc := GetDC(0); + hdcTarget := hdc; + + chrg.cpMin := 0; + chrg.cpMax := -1; + FRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range)); + + if not UsePrinterCanvas then + ReleaseDC(0, hdc); + if RichEdit.GetTextLen = 0 then + Result := 0 + else + Result := Round(rc.Bottom / (1440.0 / 96)) + 2 * GapY + 2; + end; + + FRichEdit.Perform(EM_FORMATRANGE, 0, 0); +end; + +function TfrxRichView.DrawPart: Extended; +var + Range: TFormatRange; + LastChar: Integer; +begin + { get remained part of text } + FTempStream1.Position := 0; + FRichEdit.Lines.LoadFromStream(FTempStream1); + if FParaBreak then + begin +// FRichEdit.SelStart := 1; +// FRichEdit.SelLength := 1; + FRichEdit.Paragraph.FirstIndent := 0; + FRichEdit.Paragraph.LeftIndent := 0; + end; + + { calculate the last visible char } + FillChar(Range, SizeOf(TFormatRange), 0); + with Range do + begin + rc := Rect(0, 0, Round((Width - GapX * 2) * 1440 / 96), + Round((Height - GapY * 2) * 1440 / 96)); + rcPage := rc; + if UsePrinterCanvas then + hdc := frxPrinters.Printer.Canvas.Handle + else + hdc := GetDC(0); + hdcTarget := hdc; + + chrg.cpMin := 0; + chrg.cpMax := -1; + LastChar := FRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range)); + Result := Round((rcPage.Bottom - rc.Bottom) / (1440.0 / 96)) + 2 * GapY + 0.1; + + if not UsePrinterCanvas then + ReleaseDC(0, hdc); + end; + FRichEdit.Perform(EM_FORMATRANGE, 0, 0); + + { text can't fit } + if Result < 0 then + begin + Result := Height; + Exit; + end; + + { copy the outbounds text to the temp stream } + try + if LastChar > 1 then + begin + FRichEdit.SelStart := LastChar - 1; + FRichEdit.SelLength := 1; + FParaBreak := FRichEdit.SelText <> #13; + end; + + FRichEdit.SelStart := LastChar; + FRichEdit.SelLength := FRichEdit.GetTextLen - LastChar + 1; + if FRichEdit.SelLength = 1 then + Result := 0; + FTempStream1.Clear; + FRichEdit.StreamMode := [smSelection]; + FRichEdit.Lines.SaveToStream(FTempStream1); + FRichEdit.SelText := ''; + finally + FRichEdit.StreamMode := []; + end; +end; + +procedure TfrxRichView.InitPart; +begin + FTempStream1.Clear; + FRichEdit.Lines.SaveToStream(FTempStream1); + FParaBreak := False; +end; + +function TfrxRichView.GetComponentText: String; +var + FTStream: TMemoryStream; +begin + if PlainText then + begin + FTStream := TMemoryStream.Create; + try + FTempStream.Clear; + FRichEdit.Lines.SaveToStream(FTStream); + FRichEdit.PlainText := True; + FRichEdit.Lines.SaveToStream(FTempStream); + SetLength(Result, FTempStream.Size); + FTempStream.Position := 0; + FTempStream.Read(Result[1], FTempStream.Size); + FRichEdit.PlainText := False; + FTStream.Position := 0; + FRichEdit.Lines.LoadFromStream(FTStream); + finally + FTStream.Free; + end; + end + else + begin + FTempStream.Clear; + FRichEdit.Lines.SaveToStream(FTempStream); + SetLength(Result, FTempStream.Size); + FTempStream.Position := 0; + FTempStream.Read(Result[1], FTempStream.Size); + end; +end; + +{$IFDEF FR_COM} +function TfrxRichView.LoadViewFromStream(const Stream: IUnknown): HResult; stdcall; +var + ComStream: IStream; + OleStream: TOleStream; + + NetStream: _Stream; + ClrStream: TClrStream; +begin + try + Result := Stream.QueryInterface(IStream, ComStream); + if Result = S_OK then + begin + OleStream := TOleStream.Create(ComStream); + ReadData(OleStream); + OleStream.Free; + ComStream := nil; + end + else + begin + Result := Stream.QueryInterface(_Stream, NetStream); + if Result = S_OK then + begin + ClrStream := TClrStream.Create(NetStream); + ReadData(ClrStream); + ClrStream.Free; + NetStream._Release(); + end; + end; + except + Result := E_FAIL; + end; +end; + +function TfrxRichView.SaveViewToStream(const Stream: IUnknown): HResult; stdcall; +var + ComStream: IStream; + OleStream: TOleStream; + + NetStream: _Stream; + ClrStream: TClrStream; +begin + try + Result := Stream.QueryInterface(IStream, ComStream); + if Result = S_OK then + begin + OleStream := TOleStream.Create(ComStream); + WriteData(OleStream); + OleStream.Free; + ComStream := nil; + end + else + begin + Result := Stream.QueryInterface(_Stream, NetStream); + if Result = S_OK then + begin + ClrStream := TClrStream.Create(NetStream); + WriteData(ClrStream); + ClrStream.Free; + NetStream._Release(); + end; + end; + except + Result := E_FAIL; + end; +end; + +function TfrxRichView.Get_RichAlign(out Value: frxHAlign): HResult; stdcall; +begin + Result := S_OK; + Value := frxHAlign(FRichEdit.Paragraph.Alignment); +end; + +function TfrxRichView.Set_RichAlign(Value: frxHAlign): HResult; stdcall; +begin + Result := S_OK; + FRichEdit.SelectAll; + case Value of + hAlignLeft: FRichEdit.Paragraph.Alignment := paLeftJustify; + hAlignRight: FRichEdit.Paragraph.Alignment := paRightJustify; + hAlignCenter: FRichEdit.Paragraph.Alignment := paCenter; + hAlignBlock: FRichEdit.Paragraph.Alignment := paJustify; + else Result := E_FAIL; + end; +end; + +function TfrxRichView.Get_WYSIWIG(out Value: WordBool): HResult; stdcall; +begin + Value := FWysiwyg; + Result := S_OK; +end; + +function TfrxRichView.Set_WYSIWIG(Value: WordBool): HResult; stdcall; +begin + FWysiwyg := Value; + Result := S_OK; +end; + +function TfrxRichView.Get_AllowExpressions(out Value: WordBool): HResult; stdcall; +begin + Value := FAllowExpressions; + Result := S_OK; +end; + +function TfrxRichView.Set_AllowExpressions(Value: WordBool): HResult; stdcall; +begin + FAllowExpressions := Value; + Result := S_OK; +end; +{$ENDIF} + +initialization + frxObjects.RegisterObject1(TfrxRichView, nil, '', '', 0, 26); + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRichEdit.pas b/official/4.2/Source/frxRichEdit.pas new file mode 100644 index 0000000..6d74e28 --- /dev/null +++ b/official/4.2/Source/frxRichEdit.pas @@ -0,0 +1,4362 @@ +{*******************************************************} +{ } +{ Delphi VCL Extensions (RX) } +{ } +{ Copyright (c) 1998 Master-Bank } +{ } +{ Changes made by Alexander Tzyganenko: } +{ - removed ifdefs to match Delphi4 and above } +{ - removed maxmin unit from uses list } +{ } +{*******************************************************} + +unit frxRichEdit; + +{$I frx.inc} + +interface + +uses + Windows, ActiveX, ComObj, CommCtrl, Messages, SysUtils, Classes, Controls, + Forms, Graphics, StdCtrls, Dialogs, RichEdit, Menus, ComCtrls; + +type + TRichEditVersion = 1..3; + +{$IFDEF RICHBCB} + TCharFormat2A = record + cbSize: UINT; + dwMask: DWORD; + dwEffects: DWORD; + yHeight: Longint; + yOffset: Longint; + crTextColor: TColorRef; + bCharSet: Byte; + bPitchAndFamily: Byte; + szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar; + { new fields in version 2.0 } + wWeight: Word; { Font weight (LOGFONT value) } + sSpacing: Smallint; { Amount to space between letters } + crBackColor: TColorRef; { Background color } + lid: LCID; { Locale ID } + dwReserved: DWORD; { Reserved. Must be 0 } + sStyle: Smallint; { Style handle } + wKerning: Word; { Twip size above which to kern char pair } + bUnderlineType: Byte; { Underline type } + bAnimation: Byte; { Animated text like marching ants } + bRevAuthor: Byte; { Revision author index } + bReserved1: Byte; + end; + TCharFormat2 = TCharFormat2A; + + TParaFormat2 = record + cbSize: UINT; + dwMask: DWORD; + wNumbering: Word; + wReserved: Word; + dxStartIndent: Longint; + dxRightIndent: Longint; + dxOffset: Longint; + wAlignment: Word; + cTabCount: Smallint; + rgxTabs: array [0..MAX_TAB_STOPS - 1] of Longint; + { new fields in version 2.0 } + dySpaceBefore: Longint; { Vertical spacing before paragraph } + dySpaceAfter: Longint; { Vertical spacing after paragraph } + dyLineSpacing: Longint; { Line spacing depending on Rule } + sStyle: Smallint; { Style handle } + bLineSpacingRule: Byte; { Rule for line spacing (see tom.doc) } + bCRC: Byte; { Reserved for CRC for rapid searching } + wShadingWeight: Word; { Shading in hundredths of a per cent } + wShadingStyle: Word; { Nibble 0: style, 1: cfpat, 2: cbpat } + wNumberingStart: Word; { Starting value for numbering } + wNumberingStyle: Word; { Alignment, roman/arabic, (), ), ., etc.} + wNumberingTab: Word; { Space bet 1st indent and 1st-line text } + wBorderSpace: Word; { Space between border and text (twips) } + wBorderWidth: Word; { Border pen width (twips) } + wBorders: Word; { Byte 0: bits specify which borders } + { Nibble 2: border style, 3: color index } + end; +{$ENDIF} + +type + TRxCustomRichEdit = class; + +{ TRxTextAttributes } + + TRxAttributeType = (atDefaultText, atSelected, atWord); + TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize, + caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink, + caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor); + TRxConsistentAttributes = set of TRxConsistentAttribute; + TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript); + TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave); + + TRxTextAttributes = class(TPersistent) + private + RichEdit: TRxCustomRichEdit; + FType: TRxAttributeType; + procedure AssignFont(Font: TFont); + procedure GetAttributes(var Format: TCharFormat2); + function GetCharset: TFontCharset; + procedure SetCharset(Value: TFontCharset); + function GetSubscriptStyle: TSubscriptStyle; + procedure SetSubscriptStyle(Value: TSubscriptStyle); + function GetBackColor: TColor; + function GetColor: TColor; + function GetConsistentAttributes: TRxConsistentAttributes; + function GetHeight: Integer; + function GetHidden: Boolean; + function GetDisabled: Boolean; + function GetLink: Boolean; + function GetName: TFontName; + function GetOffset: Integer; + function GetPitch: TFontPitch; + function GetProtected: Boolean; + function GetRevAuthorIndex: Byte; + function GetSize: Integer; + function GetStyle: TFontStyles; + function GetUnderlineType: TUnderlineType; + procedure SetAttributes(var Format: TCharFormat2); + procedure SetBackColor(Value: TColor); + procedure SetColor(Value: TColor); + procedure SetDisabled(Value: Boolean); + procedure SetHeight(Value: Integer); + procedure SetHidden(Value: Boolean); + procedure SetLink(Value: Boolean); + procedure SetName(Value: TFontName); + procedure SetOffset(Value: Integer); + procedure SetPitch(Value: TFontPitch); + procedure SetProtected(Value: Boolean); + procedure SetRevAuthorIndex(Value: Byte); + procedure SetSize(Value: Integer); + procedure SetStyle(Value: TFontStyles); + procedure SetUnderlineType(Value: TUnderlineType); + protected + procedure InitFormat(var Format: TCharFormat2); + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TRxCustomRichEdit; AttributeType: TRxAttributeType); + procedure Assign(Source: TPersistent); override; + property Charset: TFontCharset read GetCharset write SetCharset; + property BackColor: TColor read GetBackColor write SetBackColor; + property Color: TColor read GetColor write SetColor; + property ConsistentAttributes: TRxConsistentAttributes read GetConsistentAttributes; + property Disabled: Boolean read GetDisabled write SetDisabled; + property Hidden: Boolean read GetHidden write SetHidden; + property Link: Boolean read GetLink write SetLink; + property Name: TFontName read GetName write SetName; + property Offset: Integer read GetOffset write SetOffset; + property Pitch: TFontPitch read GetPitch write SetPitch; + property Protected: Boolean read GetProtected write SetProtected; + property RevAuthorIndex: Byte read GetRevAuthorIndex write SetRevAuthorIndex; + property SubscriptStyle: TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle; + property Size: Integer read GetSize write SetSize; + property Style: TFontStyles read GetStyle write SetStyle; + property Height: Integer read GetHeight write SetHeight; + property UnderlineType: TUnderlineType read GetUnderlineType write SetUnderlineType; + end; + +{ TRxParaAttributes } + + TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter, + nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman); + TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple); + TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify); + TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore, + lsSpecified, lsMultiple); + THeadingStyle = 0..9; + TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell); + + TRxParaAttributes = class(TPersistent) + private + RichEdit: TRxCustomRichEdit; + procedure GetAttributes(var Paragraph: TParaFormat2); + function GetAlignment: TParaAlignment; + function GetFirstIndent: Longint; + function GetHeadingStyle: THeadingStyle; + function GetLeftIndent: Longint; + function GetRightIndent: Longint; + function GetSpaceAfter: Longint; + function GetSpaceBefore: Longint; + function GetLineSpacing: Longint; + function GetLineSpacingRule: TLineSpacingRule; + function GetNumbering: TRxNumbering; + function GetNumberingStyle: TRxNumberingStyle; + function GetNumberingTab: Word; + function GetTab(Index: Byte): Longint; + function GetTabCount: Integer; + function GetTableStyle: TParaTableStyle; + procedure SetAlignment(Value: TParaAlignment); + procedure SetAttributes(var Paragraph: TParaFormat2); + procedure SetFirstIndent(Value: Longint); + procedure SetHeadingStyle(Value: THeadingStyle); + procedure SetLeftIndent(Value: Longint); + procedure SetRightIndent(Value: Longint); + procedure SetSpaceAfter(Value: Longint); + procedure SetSpaceBefore(Value: Longint); + procedure SetLineSpacing(Value: Longint); + procedure SetLineSpacingRule(Value: TLineSpacingRule); + procedure SetNumbering(Value: TRxNumbering); + procedure SetNumberingStyle(Value: TRxNumberingStyle); + procedure SetNumberingTab(Value: Word); + procedure SetTab(Index: Byte; Value: Longint); + procedure SetTabCount(Value: Integer); + procedure SetTableStyle(Value: TParaTableStyle); + protected + procedure InitPara(var Paragraph: TParaFormat2); + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TRxCustomRichEdit); + procedure Assign(Source: TPersistent); override; + property Alignment: TParaAlignment read GetAlignment write SetAlignment; + property FirstIndent: Longint read GetFirstIndent write SetFirstIndent; + property HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle; + property LeftIndent: Longint read GetLeftIndent write SetLeftIndent; + property LineSpacing: Longint read GetLineSpacing write SetLineSpacing; + property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule; + property Numbering: TRxNumbering read GetNumbering write SetNumbering; + property NumberingStyle: TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle; + property NumberingTab: Word read GetNumberingTab write SetNumberingTab; + property RightIndent: Longint read GetRightIndent write SetRightIndent; + property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter; + property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore; + property Tab[Index: Byte]: Longint read GetTab write SetTab; + property TabCount: Integer read GetTabCount write SetTabCount; + property TableStyle: TParaTableStyle read GetTableStyle write SetTableStyle; + end; + +{ TOEMConversion } + + TOEMConversion = class(TConversion) + public + function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override; + function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override; + end; + +{ TRxCustomRichEdit } + + TUndoName = (unUnknown, unTyping, unDelete, unDragDrop, unCut, unPaste); + TRichSearchType = (stWholeWord, stMatchCase, stBackward, stSetSelection); + TRichSearchTypes = set of TRichSearchType; + TRichSelection = (stText, stObject, stMultiChar, stMultiObject); + TRichSelectionType = set of TRichSelection; + TRichLangOption = (rlAutoKeyboard, rlAutoFont, rlImeCancelComplete, + rlImeAlwaysSendNotify); + TRichLangOptions = set of TRichLangOption; + TRichStreamFormat = (sfDefault, sfRichText, sfPlainText); + TRichStreamMode = (smSelection, smPlainRtf, smNoObjects, smUnicode); + TRichStreamModes = set of TRichStreamMode; + TRichEditURLClickEvent = procedure(Sender: TObject; const URLText: string; + Button: TMouseButton) of object; + TRichEditProtectChangeEx = procedure(Sender: TObject; const Message: TMessage; + StartPos, EndPos: Integer; var AllowChange: Boolean) of object; + TRichEditFindErrorEvent = procedure(Sender: TObject; const FindText: string) of object; + TRichEditFindCloseEvent = procedure(Sender: TObject; Dialog: TFindDialog) of object; + + PRichConversionFormat = ^TRichConversionFormat; + TRichConversionFormat = record + ConversionClass: TConversionClass; + Extension: string; + PlainText: Boolean; + Next: PRichConversionFormat; + end; + + TRxCustomRichEdit = class(TCustomMemo) + private + FHideScrollBars: Boolean; + FSelectionBar: Boolean; + FAutoURLDetect: Boolean; + FWordSelection: Boolean; + FPlainText: Boolean; + FSelAttributes: TRxTextAttributes; + FDefAttributes: TRxTextAttributes; + FWordAttributes: TRxTextAttributes; + FParagraph: TRxParaAttributes; + FOldParaAlignment: TParaAlignment; + FScreenLogPixels: Integer; + FUndoLimit: Integer; + FRichEditStrings: TStrings; + FMemStream: TMemoryStream; + FHideSelection: Boolean; + FLangOptions: TRichLangOptions; + FModified: Boolean; + FLinesUpdating: Boolean; + FPageRect: TRect; + FClickRange: TCharRange; + FClickBtn: TMouseButton; + FFindDialog: TFindDialog; + FReplaceDialog: TReplaceDialog; + FLastFind: TFindDialog; + FAllowObjects: Boolean; + FCallback: TObject; + FRichEditOle: IUnknown; + FPopupVerbMenu: TPopupMenu; + FTitle: string; + FAutoVerbMenu: Boolean; + FAllowInPlace: Boolean; + FDefaultConverter: TConversionClass; + FOnSelChange: TNotifyEvent; + FOnResizeRequest: TRichEditResizeEvent; + FOnProtectChange: TRichEditProtectChange; + FOnProtectChangeEx: TRichEditProtectChangeEx; + FOnSaveClipboard: TRichEditSaveClipboard; + FOnURLClick: TRichEditURLClickEvent; + FOnTextNotFound: TRichEditFindErrorEvent; + FOnCloseFindDialog: TRichEditFindCloseEvent; + function GetAutoURLDetect: Boolean; + function GetWordSelection: Boolean; + function GetLangOptions: TRichLangOptions; + function GetCanRedo: Boolean; + function GetCanPaste: Boolean; + function GetRedoName: TUndoName; + function GetUndoName: TUndoName; + function GetStreamFormat: TRichStreamFormat; + function GetStreamMode: TRichStreamModes; + function GetSelectionType: TRichSelectionType; + procedure PopupVerbClick(Sender: TObject); + procedure ObjectPropsClick(Sender: TObject); + procedure CloseObjects; + procedure UpdateHostNames; + procedure SetAllowObjects(Value: Boolean); + procedure SetStreamFormat(Value: TRichStreamFormat); + procedure SetStreamMode(Value: TRichStreamModes); + procedure SetAutoURLDetect(Value: Boolean); + procedure SetWordSelection(Value: Boolean); + procedure SetHideScrollBars(Value: Boolean); + procedure SetHideSelection(Value: Boolean); + procedure SetTitle(const Value: string); + procedure SetLangOptions(Value: TRichLangOptions); + procedure SetRichEditStrings(Value: TStrings); + procedure SetDefAttributes(Value: TRxTextAttributes); + procedure SetSelAttributes(Value: TRxTextAttributes); + procedure SetWordAttributes(Value: TRxTextAttributes); + procedure SetSelectionBar(Value: Boolean); + procedure SetUndoLimit(Value: Integer); + procedure UpdateTextModes(Plain: Boolean); + procedure AdjustFindDialogPosition(Dialog: TFindDialog); + procedure SetupFindDialog(Dialog: TFindDialog; const SearchStr, + ReplaceStr: string); + function FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean; + function GetCanFindNext: Boolean; + procedure FindDialogFind(Sender: TObject); + procedure ReplaceDialogReplace(Sender: TObject); + procedure FindDialogClose(Sender: TObject); + procedure SetUIActive(Active: Boolean); + procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE; + procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE; + procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; + procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; + procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL; + procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY; + procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE; + procedure WMPaint(var Message: TWMPaint); message WM_PAINT; + procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; + procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT; +{$IFDEF Delphi5} + procedure WMRButtonUp(var Message: TMessage); message WM_RBUTTONUP; +{$ENDIF} + protected + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWindowHandle(const Params: TCreateParams); override; + procedure CreateWnd; override; + procedure DestroyWnd; override; + function GetPopupMenu: TPopupMenu; override; + procedure TextNotFound(Dialog: TFindDialog); virtual; + procedure RequestSize(const Rect: TRect); virtual; + procedure SelectionChange; dynamic; + function ProtectChange(const Message: TMessage; StartPos, + EndPos: Integer): Boolean; dynamic; + function SaveClipboard(NumObj, NumChars: Integer): Boolean; dynamic; + procedure URLClick(const URLText: string; Button: TMouseButton); dynamic; + procedure SetPlainText(Value: Boolean); virtual; + procedure CloseFindDialog(Dialog: TFindDialog); virtual; + procedure DoSetMaxLength(Value: Integer); override; + function GetSelLength: Integer; override; + function GetSelStart: Integer; override; + function GetSelText: string; override; + procedure SetSelLength(Value: Integer); override; + procedure SetSelStart(Value: Integer); override; + property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True; + property AllowObjects: Boolean read FAllowObjects write SetAllowObjects default True; + property AutoURLDetect: Boolean read GetAutoURLDetect write SetAutoURLDetect default True; + property AutoVerbMenu: Boolean read FAutoVerbMenu write FAutoVerbMenu default True; + property HideSelection: Boolean read FHideSelection write SetHideSelection default True; + property HideScrollBars: Boolean read FHideScrollBars + write SetHideScrollBars default True; + property Title: string read FTitle write SetTitle; + property LangOptions: TRichLangOptions read GetLangOptions write SetLangOptions default [rlAutoFont]; + property Lines: TStrings read FRichEditStrings write SetRichEditStrings; + property PlainText: Boolean read FPlainText write SetPlainText default False; + property SelectionBar: Boolean read FSelectionBar write SetSelectionBar default True; + property StreamFormat: TRichStreamFormat read GetStreamFormat write SetStreamFormat default sfDefault; + property StreamMode: TRichStreamModes read GetStreamMode write SetStreamMode default []; + property UndoLimit: Integer read FUndoLimit write SetUndoLimit default 100; + property WordSelection: Boolean read GetWordSelection write SetWordSelection default True; + property ScrollBars default ssBoth; + property TabStop default True; + property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard + write FOnSaveClipboard; + property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange; + property OnProtectChange: TRichEditProtectChange read FOnProtectChange + write FOnProtectChange; { obsolete } + property OnProtectChangeEx: TRichEditProtectChangeEx read FOnProtectChangeEx + write FOnProtectChangeEx; + property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest + write FOnResizeRequest; + property OnURLClick: TRichEditURLClickEvent read FOnURLClick write FOnURLClick; + property OnTextNotFound: TRichEditFindErrorEvent read FOnTextNotFound write FOnTextNotFound; + property OnCloseFindDialog: TRichEditFindCloseEvent read FOnCloseFindDialog + write FOnCloseFindDialog; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Clear; override; + procedure SetSelection(StartPos, EndPos: Longint; ScrollCaret: Boolean); + function GetSelection: TCharRange; + function GetTextRange(StartPos, EndPos: Longint): string; + function LineFromChar(CharIndex: Integer): Integer; + function GetLineIndex(LineNo: Integer): Integer; + function GetLineLength(CharIndex: Integer): Integer; + function WordAtCursor: string; + function FindText(const SearchStr: string; + StartPos, Length: Integer; Options: TRichSearchTypes): Integer; + function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; override; + function GetCaretPos: TPoint; override; + function GetCharPos(CharIndex: Integer): TPoint; + function InsertObjectDialog: Boolean; + function ObjectPropertiesDialog: Boolean; + function PasteSpecialDialog: Boolean; + function FindDialog(const SearchStr: string): TFindDialog; + function ReplaceDialog(const SearchStr, ReplaceStr: string): TReplaceDialog; + function FindNext: Boolean; + procedure Print(const Caption: string); virtual; + class procedure RegisterConversionFormat(const AExtension: string; + APlainText: Boolean; AConversionClass: TConversionClass); + procedure ClearUndo; + procedure Redo; + procedure StopGroupTyping; + property CanFindNext: Boolean read GetCanFindNext; + property CanRedo: Boolean read GetCanRedo; + property CanPaste: Boolean read GetCanPaste; + property RedoName: TUndoName read GetRedoName; + property UndoName: TUndoName read GetUndoName; + property DefaultConverter: TConversionClass read FDefaultConverter + write FDefaultConverter; + property DefAttributes: TRxTextAttributes read FDefAttributes write SetDefAttributes; + property SelAttributes: TRxTextAttributes read FSelAttributes write SetSelAttributes; + property WordAttributes: TRxTextAttributes read FWordAttributes write SetWordAttributes; + property PageRect: TRect read FPageRect write FPageRect; + property Paragraph: TRxParaAttributes read FParagraph; + property SelectionType: TRichSelectionType read GetSelectionType; + end; + + TRxRichEdit = class(TRxCustomRichEdit) + published + property Align; + property Alignment; + property AutoURLDetect; + property AutoVerbMenu; + property AllowObjects; + property AllowInPlace; + property Anchors; + property BiDiMode; + property BorderWidth; + property DragKind; + property BorderStyle; + property Color; + property Ctl3D; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property HideSelection; + property HideScrollBars; + property Title; + property ImeMode; + property ImeName; + property Constraints; + property ParentBiDiMode; + property LangOptions; + property Lines; + property MaxLength; + property ParentColor; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PlainText; + property PopupMenu; + property ReadOnly; + property ScrollBars; + property SelectionBar; + property ShowHint; + property StreamFormat; + property StreamMode; + property TabOrder; + property TabStop; + property UndoLimit; + property Visible; + property WantTabs; + property WantReturns; + property WordSelection; + property WordWrap; + property OnChange; + property OnDblClick; + property OnDragDrop; + property OnDragOver; +{$IFDEF Delphi5} + property OnContextPopup; +{$ENDIF} + property OnEndDock; + property OnStartDock; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnProtectChange; { obsolete } + property OnProtectChangeEx; + property OnResizeRequest; + property OnSaveClipboard; + property OnSelectionChange; + property OnStartDrag; + property OnTextNotFound; + property OnCloseFindDialog; + property OnURLClick; + end; + +var + RichEditVersion: TRichEditVersion; + +implementation + +uses Printers, ComStrs, OleConst, OleDlg, OleCtnrs; + +const + RTFConversionFormat: TRichConversionFormat = ( + ConversionClass: TConversion; + Extension: 'rtf'; + PlainText: False; + Next: nil); + TextConversionFormat: TRichConversionFormat = ( + ConversionClass: TConversion; + Extension: 'txt'; + PlainText: True; + Next: @RTFConversionFormat); + +var + ConversionFormatList: PRichConversionFormat = @TextConversionFormat; + +const + RichEdit10ModuleName = 'RICHED32.DLL'; + RichEdit20ModuleName = 'RICHED20.DLL'; +// for support RichEdit 3.0 + EM_SETTYPOGRAPHYOPTIONS = WM_USER + 202; + EM_GETTYPOGRAPHYOPTIONS = WM_USER + 203; + TO_ADVANCEDTYPOGRAPHY = 1; + TO_SIMPLELINEBREAK = 2; + FT_DOWN = 1; + +type + PENLink = ^TENLink; + PENOleOpFailed = ^TENOleOpFailed; + TFindTextEx = TFindTextExA; + + TTextRangeA = record + chrg: TCharRange; + lpstrText: PAnsiChar; + end; + TTextRangeW = record + chrg: TCharRange; + lpstrText: PWideChar; + end; + TTextRange = TTextRangeA; + +function ResStr(const Ident: string): string; +begin + Result := Ident; +end; + +{ TRxTextAttributes } + +const + AttrFlags: array[TRxAttributeType] of Word = (0, SCF_SELECTION, + SCF_WORD or SCF_SELECTION); + +constructor TRxTextAttributes.Create(AOwner: TRxCustomRichEdit; + AttributeType: TRxAttributeType); +begin + inherited Create; + RichEdit := AOwner; + FType := AttributeType; +end; + +procedure TRxTextAttributes.InitFormat(var Format: TCharFormat2); +begin + FillChar(Format, SizeOf(Format), 0); + if RichEditVersion >= 2 then Format.cbSize := SizeOf(Format) + else Format.cbSize := SizeOf(TCharFormat); +end; + +function TRxTextAttributes.GetConsistentAttributes: TRxConsistentAttributes; +var + Format: TCharFormat2; +begin + Result := []; + if RichEdit.HandleAllocated and (FType <> atDefaultText) then begin + InitFormat(Format); + SendMessage(RichEdit.Handle, EM_GETCHARFORMAT, + AttrFlags[FType], LPARAM(@Format)); + with Format do begin + if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold); + if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor); + if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace); + if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic); + if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize); + if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut); + if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline); + if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected); + if (dwMask and CFM_OFFSET) <> 0 then Include(Result, caOffset); + if (dwMask and CFM_HIDDEN) <> 0 then Include(result, caHidden); + if RichEditVersion >= 2 then begin + if (dwMask and CFM_LINK) <> 0 then Include(Result, caLink); + if (dwMask and CFM_BACKCOLOR) <> 0 then Include(Result, caBackColor); + if (dwMask and CFM_DISABLED) <> 0 then Include(Result, caDisabled); + if (dwMask and CFM_WEIGHT) <> 0 then Include(Result, caWeight); + if (dwMask and CFM_SUBSCRIPT) <> 0 then Include(Result, caSubscript); + if (dwMask and CFM_REVAUTHOR) <> 0 then Include(Result, caRevAuthor); + end; + end; + end; +end; + +procedure TRxTextAttributes.GetAttributes(var Format: TCharFormat2); +begin + InitFormat(Format); + if RichEdit.HandleAllocated then + SendMessage(RichEdit.Handle, EM_GETCHARFORMAT, AttrFlags[FType], + LPARAM(@Format)); +end; + +procedure TRxTextAttributes.SetAttributes(var Format: TCharFormat2); +begin + if RichEdit.HandleAllocated then + SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, AttrFlags[FType], + LPARAM(@Format)); +end; + +function TRxTextAttributes.GetCharset: TFontCharset; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + Result := Format.bCharset; +end; + +procedure TRxTextAttributes.SetCharset(Value: TFontCharset); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do + begin + dwMask := CFM_CHARSET; + bCharSet := Value; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetProtected: Boolean; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + with Format do + Result := (dwEffects and CFE_PROTECTED) <> 0; +end; + +procedure TRxTextAttributes.SetProtected(Value: Boolean); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := CFM_PROTECTED; + if Value then dwEffects := CFE_PROTECTED; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetLink: Boolean; +var + Format: TCharFormat2; +begin + Result := False; + if RichEditVersion < 2 then Exit; + GetAttributes(Format); + with Format do Result := (dwEffects and CFE_LINK) <> 0; +end; + +procedure TRxTextAttributes.SetLink(Value: Boolean); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_LINK; + if Value then dwEffects := CFE_LINK; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetRevAuthorIndex: Byte; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + Result := Format.bRevAuthor; +end; + +procedure TRxTextAttributes.SetRevAuthorIndex(Value: Byte); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_REVAUTHOR; + bRevAuthor := Value; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetHidden: Boolean; +var + Format: TCharFormat2; +begin + Result := False; + if RichEditVersion < 2 then Exit; + GetAttributes(Format); + Result := Format.dwEffects and CFE_HIDDEN <> 0; +end; + +procedure TRxTextAttributes.SetHidden(Value: Boolean); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_HIDDEN; + if Value then dwEffects := CFE_HIDDEN; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetDisabled: Boolean; +var + Format: TCharFormat2; +begin + Result := False; + if RichEditVersion < 2 then Exit; + GetAttributes(Format); + Result := Format.dwEffects and CFE_DISABLED <> 0; +end; + +procedure TRxTextAttributes.SetDisabled(Value: Boolean); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_DISABLED; + if Value then dwEffects := CFE_DISABLED; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetColor: TColor; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + with Format do + if (dwEffects and CFE_AUTOCOLOR) <> 0 then Result := clWindowText + else Result := crTextColor; +end; + +procedure TRxTextAttributes.SetColor(Value: TColor); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := CFM_COLOR; + if (Value = clWindowText) or (Value = clDefault) then + dwEffects := CFE_AUTOCOLOR + else crTextColor := ColorToRGB(Value); + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetBackColor: TColor; +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then begin + Result := clWindow; + Exit; + end; + GetAttributes(Format); + with Format do + if (dwEffects and CFE_AUTOBACKCOLOR) <> 0 then Result := clWindow + else Result := crBackColor; +end; + +procedure TRxTextAttributes.SetBackColor(Value: TColor); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_BACKCOLOR; + if (Value = clWindow) or (Value = clDefault) then + dwEffects := CFE_AUTOBACKCOLOR + else crBackColor := ColorToRGB(Value); + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetName: TFontName; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + Result := Format.szFaceName; +end; + +procedure TRxTextAttributes.SetName(Value: TFontName); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := CFM_FACE; + StrPLCopy(szFaceName, Value, SizeOf(szFaceName)); + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetStyle: TFontStyles; +var + Format: TCharFormat2; +begin + Result := []; + GetAttributes(Format); + with Format do begin + if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold); + if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic); + if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline); + if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut); + end; +end; + +procedure TRxTextAttributes.SetStyle(Value: TFontStyles); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT; + if fsBold in Value then dwEffects := dwEffects or CFE_BOLD; + if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC; + if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE; + if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetUnderlineType: TUnderlineType; +var + Format: TCharFormat2; +begin + Result := utNone; + if RichEditVersion < 2 then Exit; + GetAttributes(Format); + with Format do begin + if (dwEffects and CFE_UNDERLINE <> 0) and + (dwMask and CFM_UNDERLINETYPE = CFM_UNDERLINETYPE) then + Result := TUnderlineType(bUnderlineType); + end; +end; + +procedure TRxTextAttributes.SetUnderlineType(Value: TUnderlineType); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := CFM_UNDERLINETYPE or CFM_UNDERLINE; + bUnderlineType := Ord(Value); + if Value <> utNone then dwEffects := dwEffects or CFE_UNDERLINE; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetOffset: Integer; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + Result := Format.yOffset div 20; +end; + +procedure TRxTextAttributes.SetOffset(Value: Integer); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := DWORD(CFM_OFFSET); + yOffset := Value * 20; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetSize: Integer; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + Result := Format.yHeight div 20; +end; + +procedure TRxTextAttributes.SetSize(Value: Integer); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + dwMask := DWORD(CFM_SIZE); + yHeight := Value * 20; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetHeight: Integer; +begin + Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72); +end; + +procedure TRxTextAttributes.SetHeight(Value: Integer); +begin + Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels); +end; + +function TRxTextAttributes.GetPitch: TFontPitch; +var + Format: TCharFormat2; +begin + GetAttributes(Format); + case (Format.bPitchAndFamily and $03) of + DEFAULT_PITCH: Result := fpDefault; + VARIABLE_PITCH: Result := fpVariable; + FIXED_PITCH: Result := fpFixed; + else Result := fpDefault; + end; +end; + +procedure TRxTextAttributes.SetPitch(Value: TFontPitch); +var + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + case Value of + fpVariable: bPitchAndFamily := VARIABLE_PITCH; + fpFixed: bPitchAndFamily := FIXED_PITCH; + else bPitchAndFamily := DEFAULT_PITCH; + end; + end; + SetAttributes(Format); +end; + +function TRxTextAttributes.GetSubscriptStyle: TSubscriptStyle; +var + Format: TCharFormat2; +begin + Result := ssNone; + if RichEditVersion < 2 then Exit; + GetAttributes(Format); + with Format do begin + if (dwEffects and CFE_SUBSCRIPT) <> 0 then + Result := ssSubscript + else if (dwEffects and CFE_SUPERSCRIPT) <> 0 then + Result := ssSuperscript; + end; +end; + +procedure TRxTextAttributes.SetSubscriptStyle(Value: TSubscriptStyle); +var + Format: TCharFormat2; +begin + if RichEditVersion < 2 then Exit; + InitFormat(Format); + with Format do begin + dwMask := DWORD(CFM_SUBSCRIPT); + case Value of + ssSubscript: dwEffects := CFE_SUBSCRIPT; + ssSuperscript: dwEffects := CFE_SUPERSCRIPT; + end; + end; + SetAttributes(Format); +end; + +procedure TRxTextAttributes.AssignFont(Font: TFont); +var + LogFont: TLogFont; + Format: TCharFormat2; +begin + InitFormat(Format); + with Format do begin + case Font.Pitch of + fpVariable: bPitchAndFamily := VARIABLE_PITCH; + fpFixed: bPitchAndFamily := FIXED_PITCH; + else bPitchAndFamily := DEFAULT_PITCH; + end; + dwMask := dwMask or CFM_SIZE or CFM_BOLD or CFM_ITALIC or + CFM_UNDERLINE or CFM_STRIKEOUT or CFM_FACE or CFM_COLOR; + yHeight := Font.Size * 20; + if fsBold in Font.Style then dwEffects := dwEffects or CFE_BOLD; + if fsItalic in Font.Style then dwEffects := dwEffects or CFE_ITALIC; + if fsUnderline in Font.Style then dwEffects := dwEffects or CFE_UNDERLINE; + if fsStrikeOut in Font.Style then dwEffects := dwEffects or CFE_STRIKEOUT; + StrPLCopy(szFaceName, Font.Name, SizeOf(szFaceName)); + if (Font.Color = clWindowText) or (Font.Color = clDefault) then + dwEffects := CFE_AUTOCOLOR + else crTextColor := ColorToRGB(Font.Color); + dwMask := dwMask or CFM_CHARSET; + bCharSet := Font.Charset; + if GetObject(Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then begin + dwMask := dwMask or DWORD(CFM_WEIGHT); + wWeight := Word(LogFont.lfWeight); + end; + end; + SetAttributes(Format); +end; + +procedure TRxTextAttributes.Assign(Source: TPersistent); +var + Format: TCharFormat2; +begin + if Source is TFont then AssignFont(TFont(Source)) + else if Source is TTextAttributes then begin + Name := TTextAttributes(Source).Name; + Charset := TTextAttributes(Source).Charset; + Style := TTextAttributes(Source).Style; + Pitch := TTextAttributes(Source).Pitch; + Color := TTextAttributes(Source).Color; + end + else if Source is TRxTextAttributes then begin + TRxTextAttributes(Source).GetAttributes(Format); + SetAttributes(Format); + end + else inherited Assign(Source); +end; + +procedure TRxTextAttributes.AssignTo(Dest: TPersistent); +begin + if Dest is TFont then begin + TFont(Dest).Color := Color; + TFont(Dest).Name := Name; + TFont(Dest).Charset := Charset; + TFont(Dest).Style := Style; + TFont(Dest).Size := Size; + TFont(Dest).Pitch := Pitch; + end + else if Dest is TTextAttributes then begin + TTextAttributes(Dest).Color := Color; + TTextAttributes(Dest).Name := Name; + TTextAttributes(Dest).Charset := Charset; + TTextAttributes(Dest).Style := Style; + TTextAttributes(Dest).Pitch := Pitch; + end + else inherited AssignTo(Dest); +end; + +{ TRxParaAttributes } + +constructor TRxParaAttributes.Create(AOwner: TRxCustomRichEdit); +begin + inherited Create; + RichEdit := AOwner; +end; + +procedure TRxParaAttributes.InitPara(var Paragraph: TParaFormat2); +begin + FillChar(Paragraph, SizeOf(Paragraph), 0); + if RichEditVersion >= 2 then + Paragraph.cbSize := SizeOf(Paragraph) + else + Paragraph.cbSize := SizeOf(TParaFormat); +end; + +procedure TRxParaAttributes.GetAttributes(var Paragraph: TParaFormat2); +begin + InitPara(Paragraph); + if RichEdit.HandleAllocated then + SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph)); +end; + +procedure TRxParaAttributes.SetAttributes(var Paragraph: TParaFormat2); +begin + RichEdit.HandleNeeded; { we REALLY need the handle for BiDi } + if RichEdit.HandleAllocated then begin + if RichEdit.UseRightToLeftAlignment then + if Paragraph.wAlignment = PFA_LEFT then + Paragraph.wAlignment := PFA_RIGHT + else if Paragraph.wAlignment = PFA_RIGHT then + Paragraph.wAlignment := PFA_LEFT; + SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph)); + end; +end; + +function TRxParaAttributes.GetAlignment: TParaAlignment; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := TParaAlignment(Paragraph.wAlignment - 1); +end; + +procedure TRxParaAttributes.SetAlignment(Value: TParaAlignment); +var + Paragraph: TParaFormat2; +begin + InitPara(Paragraph); + with Paragraph do + begin + dwMask := PFM_ALIGNMENT; + wAlignment := Ord(Value) + 1; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetNumbering: TRxNumbering; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := TRxNumbering(Paragraph.wNumbering); + if RichEditVersion = 1 then + if Result <> nsNone then Result := nsBullet; +end; + +procedure TRxParaAttributes.SetNumbering(Value: TRxNumbering); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion = 1 then + if Value <> nsNone then Value := TRxNumbering(PFN_BULLET); + case Value of + nsNone: LeftIndent := 0; + else if LeftIndent < 10 then LeftIndent := 10; + end; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_NUMBERING; + wNumbering := Ord(Value); + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetNumberingStyle: TRxNumberingStyle; +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then + Result := nsSimple + else begin + GetAttributes(Paragraph); + Result := TRxNumberingStyle(Paragraph.wNumberingStyle); + end; +end; + +procedure TRxParaAttributes.SetNumberingStyle(Value: TRxNumberingStyle); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_NUMBERINGSTYLE; + wNumberingStyle := Ord(Value); + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetNumberingTab: Word; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.wNumberingTab div 20; +end; + +procedure TRxParaAttributes.SetNumberingTab(Value: Word); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_NUMBERINGTAB; + wNumberingTab := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetFirstIndent: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dxStartIndent div 20; +end; + +procedure TRxParaAttributes.SetFirstIndent(Value: Longint); +var + Paragraph: TParaFormat2; +begin + InitPara(Paragraph); + with Paragraph do + begin + dwMask := PFM_STARTINDENT; + dxStartIndent := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetHeadingStyle: THeadingStyle; +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 3 then Result := 0 + else begin + GetAttributes(Paragraph); + Result := Paragraph.sStyle; + end; +end; + +procedure TRxParaAttributes.SetHeadingStyle(Value: THeadingStyle); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 3 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_STYLE; + sStyle := Value; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetLeftIndent: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dxOffset div 20; +end; + +procedure TRxParaAttributes.SetLeftIndent(Value: Longint); +var + Paragraph: TParaFormat2; +begin + InitPara(Paragraph); + with Paragraph do + begin + dwMask := PFM_OFFSET; + dxOffset := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetRightIndent: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dxRightIndent div 20; +end; + +procedure TRxParaAttributes.SetRightIndent(Value: Longint); +var + Paragraph: TParaFormat2; +begin + InitPara(Paragraph); + with Paragraph do + begin + dwMask := PFM_RIGHTINDENT; + dxRightIndent := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetSpaceAfter: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dySpaceAfter div 20; +end; + +procedure TRxParaAttributes.SetSpaceAfter(Value: Longint); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_SPACEAFTER; + dySpaceAfter := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetSpaceBefore: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dySpaceBefore div 20; +end; + +procedure TRxParaAttributes.SetSpaceBefore(Value: Longint); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_SPACEBEFORE; + dySpaceBefore := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetLineSpacing: Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.dyLineSpacing div 20; +end; + +procedure TRxParaAttributes.SetLineSpacing(Value: Longint); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + GetAttributes(Paragraph); + with Paragraph do begin + dwMask := PFM_LINESPACING; + dyLineSpacing := Value * 20; + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetLineSpacingRule: TLineSpacingRule; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := TLineSpacingRule(Paragraph.bLineSpacingRule); +end; + +procedure TRxParaAttributes.SetLineSpacingRule(Value: TLineSpacingRule); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + GetAttributes(Paragraph); + with Paragraph do begin + dwMask := PFM_LINESPACING; + bLineSpacingRule := Ord(Value); + end; + SetAttributes(Paragraph); +end; + +function TRxParaAttributes.GetTab(Index: Byte): Longint; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.rgxTabs[Index] div 20; +end; + +procedure TRxParaAttributes.SetTab(Index: Byte; Value: Longint); +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + with Paragraph do + begin + rgxTabs[Index] := Value * 20; + dwMask := PFM_TABSTOPS; + if cTabCount < Index then cTabCount := Index; + SetAttributes(Paragraph); + end; +end; + +function TRxParaAttributes.GetTabCount: Integer; +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + Result := Paragraph.cTabCount; +end; + +procedure TRxParaAttributes.SetTabCount(Value: Integer); +var + Paragraph: TParaFormat2; +begin + GetAttributes(Paragraph); + with Paragraph do + begin + dwMask := PFM_TABSTOPS; + cTabCount := Value; + SetAttributes(Paragraph); + end; +end; + +function TRxParaAttributes.GetTableStyle: TParaTableStyle; +var + Paragraph: TParaFormat2; +begin + Result := tsNone; + if RichEditVersion < 2 then Exit; + GetAttributes(Paragraph); + with Paragraph do begin + if (wReserved and PFE_TABLEROW) <> 0 then + Result := tsTableRow + else if (wReserved and PFE_TABLECELLEND) <> 0 then + Result := tsTableCellEnd + else if (wReserved and PFE_TABLECELL) <> 0 then + Result := tsTableCell; + end; +end; + +procedure TRxParaAttributes.SetTableStyle(Value: TParaTableStyle); +var + Paragraph: TParaFormat2; +begin + if RichEditVersion < 2 then Exit; + InitPara(Paragraph); + with Paragraph do begin + dwMask := PFM_TABLE; + case Value of + tsTableRow: wReserved := PFE_TABLEROW; + tsTableCellEnd: wReserved := PFE_TABLECELLEND; + tsTableCell: wReserved := PFE_TABLECELL; + end; + end; + SetAttributes(Paragraph); +end; + +procedure TRxParaAttributes.AssignTo(Dest: TPersistent); +var + I: Integer; +begin + if Dest is TParaAttributes then begin + with TParaAttributes(Dest) do begin +// if Self.Alignment = paJustify then Alignment := taLeftJustify +// else + Alignment := TAlignment(Self.Alignment); + FirstIndent := Self.FirstIndent; + LeftIndent := Self.LeftIndent; + RightIndent := Self.RightIndent; + if Self.Numbering <> nsNone then + Numbering := TNumberingStyle(nsBullet) + else Numbering := TNumberingStyle(nsNone); + for I := 0 to MAX_TAB_STOPS - 1 do + Tab[I] := Self.Tab[I]; + end; + end + else inherited AssignTo(Dest); +end; + +procedure TRxParaAttributes.Assign(Source: TPersistent); +var + I: Integer; + Paragraph: TParaFormat2; +begin + if Source is TParaAttributes then begin + Alignment := TParaAlignment(TParaAttributes(Source).Alignment); + FirstIndent := TParaAttributes(Source).FirstIndent; + LeftIndent := TParaAttributes(Source).LeftIndent; + RightIndent := TParaAttributes(Source).RightIndent; + Numbering := TRxNumbering(TParaAttributes(Source).Numbering); + for I := 0 to MAX_TAB_STOPS - 1 do + Tab[I] := TParaAttributes(Source).Tab[I]; + end + else if Source is TRxParaAttributes then begin + TRxParaAttributes(Source).GetAttributes(Paragraph); + SetAttributes(Paragraph); + end + else inherited Assign(Source); +end; + +{ OLE utility routines } + +function WStrLen(Str: PWideChar): Integer; +begin + Result := 0; + while Str[Result] <> #0 do Inc(Result); +end; + +procedure ReleaseObject(var Obj); +begin + if IUnknown(Obj) <> nil then begin + IUnknown(Obj) := nil; + end; +end; + +procedure CreateStorage(var Storage: IStorage); +var + LockBytes: ILockBytes; +begin + OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes)); + try + OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_READWRITE + or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage)); + finally + ReleaseObject(LockBytes); + end; +end; + +procedure DestroyMetaPict(MetaPict: HGlobal); +begin + if MetaPict <> 0 then begin + DeleteMetaFile(PMetaFilePict(GlobalLock(MetaPict))^.hMF); + GlobalUnlock(MetaPict); + GlobalFree(MetaPict); + end; +end; + +function OleSetDrawAspect(OleObject: IOleObject; Iconic: Boolean; + IconMetaPict: HGlobal; var DrawAspect: Longint): HResult; +var + OleCache: IOleCache; + EnumStatData: IEnumStatData; + OldAspect, AdviseFlags, Connection: Longint; + TempMetaPict: HGlobal; + FormatEtc: TFormatEtc; + Medium: TStgMedium; + ClassID: TCLSID; + StatData: TStatData; +begin + Result := S_OK; + OldAspect := DrawAspect; + if Iconic then begin + DrawAspect := DVASPECT_ICON; + AdviseFlags := ADVF_NODATA; + end + else begin + DrawAspect := DVASPECT_CONTENT; + AdviseFlags := ADVF_PRIMEFIRST; + end; + if (DrawAspect <> OldAspect) or (DrawAspect = DVASPECT_ICON) then begin + Result := OleObject.QueryInterface(IOleCache, OleCache); + if Succeeded(Result) then + try + if DrawAspect <> OldAspect then begin + { Setup new cache with the new aspect } + FillChar(FormatEtc, SizeOf(FormatEtc), 0); + FormatEtc.dwAspect := DrawAspect; + FormatEtc.lIndex := -1; + Result := OleCache.Cache(FormatEtc, AdviseFlags, Connection); + end; + if Succeeded(Result) and (DrawAspect = DVASPECT_ICON) then begin + TempMetaPict := 0; + if IconMetaPict = 0 then begin + if Succeeded(OleObject.GetUserClassID(ClassID)) then begin + TempMetaPict := OleGetIconOfClass(ClassID, nil, True); + IconMetaPict := TempMetaPict; + end; + end; + try + FormatEtc.cfFormat := CF_METAFILEPICT; + FormatEtc.ptd := nil; + FormatEtc.dwAspect := DVASPECT_ICON; + FormatEtc.lIndex := -1; + FormatEtc.tymed := TYMED_MFPICT; + Medium.tymed := TYMED_MFPICT; + Medium.hMetaFilePict := IconMetaPict; + Medium.unkForRelease := nil; + Result := OleCache.SetData(FormatEtc, Medium, False); + finally + DestroyMetaPict(TempMetaPict); + end; + end; + if Succeeded(Result) and (DrawAspect <> OldAspect) then begin + { remove any existing caches that are set up for the old display aspect } + OleCache.EnumCache(EnumStatData); + if EnumStatData <> nil then + try + while EnumStatData.Next(1, StatData, nil) = 0 do + if StatData.formatetc.dwAspect = OldAspect then + OleCache.Uncache(StatData.dwConnection); + finally + ReleaseObject(EnumStatData); + end; + end; + finally + ReleaseObject(OleCache); + end; + if Succeeded(Result) and (DrawAspect <> DVASPECT_ICON) then + OleObject.Update; + end; +end; + +function GetIconMetaPict(OleObject: IOleObject; DrawAspect: Longint): HGlobal; +var + DataObject: IDataObject; + FormatEtc: TFormatEtc; + Medium: TStgMedium; + ClassID: TCLSID; +begin + Result := 0; + if DrawAspect = DVASPECT_ICON then begin + OleObject.QueryInterface(IDataObject, DataObject); + if DataObject <> nil then begin + FormatEtc.cfFormat := CF_METAFILEPICT; + FormatEtc.ptd := nil; + FormatEtc.dwAspect := DVASPECT_ICON; + FormatEtc.lIndex := -1; + FormatEtc.tymed := TYMED_MFPICT; + if Succeeded(DataObject.GetData(FormatEtc, Medium)) then + Result := Medium.hMetaFilePict; + ReleaseObject(DataObject); + end; + end; + if Result = 0 then begin + OleCheck(OleObject.GetUserClassID(ClassID)); + Result := OleGetIconOfClass(ClassID, nil, True); + end; +end; + +{ Return the first piece of a moniker } + +function OleStdGetFirstMoniker(Moniker: IMoniker): IMoniker; +var + Mksys: Longint; + EnumMoniker: IEnumMoniker; +begin + Result := nil; + if Moniker <> nil then begin + if (Moniker.IsSystemMoniker(Mksys) = 0) and + (Mksys = MKSYS_GENERICCOMPOSITE) then + begin + if Moniker.Enum(True, EnumMoniker) <> 0 then Exit; + EnumMoniker.Next(1, Result, nil); + ReleaseObject(EnumMoniker); + end + else begin + Result := Moniker; + end; + end; +end; + +{ Return length of file moniker piece of the given moniker } + +function OleStdGetLenFilePrefixOfMoniker(Moniker: IMoniker): Integer; +var + MkFirst: IMoniker; + BindCtx: IBindCtx; + Mksys: Longint; + P: PWideChar; +begin + Result := 0; + if Moniker <> nil then begin + MkFirst := OleStdGetFirstMoniker(Moniker); + if MkFirst <> nil then begin + if (MkFirst.IsSystemMoniker(Mksys) = 0) and + (Mksys = MKSYS_FILEMONIKER) then + begin + if CreateBindCtx(0, BindCtx) = 0 then begin + if (MkFirst.GetDisplayName(BindCtx, nil, P) = 0) and (P <> nil) then + begin + Result := WStrLen(P); + CoTaskMemFree(P); + end; + ReleaseObject(BindCtx); + end; + end; + ReleaseObject(MkFirst); + end; + end; +end; + +function CoAllocCStr(const S: string): PChar; +begin + Result := StrCopy(CoTaskMemAlloc(Length(S) + 1), PChar(S)); +end; + +function WStrToString(P: PWideChar): string; +begin + Result := ''; + if P <> nil then begin + Result := WideCharToString(P); + CoTaskMemFree(P); + end; +end; + +function GetFullNameStr(OleObject: IOleObject): string; +var + P: PWideChar; +begin + OleObject.GetUserType(USERCLASSTYPE_FULL, P); + Result := WStrToString(P); +end; + +function GetShortNameStr(OleObject: IOleObject): string; +var + P: PWideChar; +begin + OleObject.GetUserType(USERCLASSTYPE_SHORT, P); + Result := WStrToString(P); +end; + +function GetDisplayNameStr(OleLink: IOleLink): string; +var + P: PWideChar; +begin + OleLink.GetSourceDisplayName(P); + Result := WStrToString(P); +end; + +function GetVCLFrameForm(Form: TCustomForm): IVCLFrameForm; +begin + if Form.OleFormObject = nil then TOleForm.Create(Form); + Result := Form.OleFormObject as IVCLFrameForm; +end; + +function IsFormMDIChild(Form: TCustomForm): Boolean; +begin + Result := (Form is TForm) and (TForm(Form).FormStyle = fsMDIChild); +end; + +{ Clipboard formats } + +var + CFEmbeddedObject: Integer; + CFLinkSource: Integer; + CFRtf: Integer; + CFRtfNoObjs: Integer; + +const + CF_EMBEDDEDOBJECT = 'Embedded Object'; + CF_LINKSOURCE = 'Link Source'; + +{************************************************************************} + +{ OLE Extensions to the Rich Text Editor } +{ Converted from RICHOLE.H } + +{ Structure passed to GetObject and InsertObject } + +type + _ReObject = record + cbStruct: DWORD; { Size of structure } + cp: ULONG; { Character position of object } + clsid: TCLSID; { Class ID of object } + poleobj: IOleObject; { OLE object interface } + pstg: IStorage; { Associated storage interface } + polesite: IOleClientSite; { Associated client site interface } + sizel: TSize; { Size of object (may be 0,0) } + dvAspect: Longint; { Display aspect to use } + dwFlags: DWORD; { Object status flags } + dwUser: DWORD; { Dword for user's use } + end; + TReObject = _ReObject; + +const + +{ Flags to specify which interfaces should be returned in the structure above } + + REO_GETOBJ_NO_INTERFACES = $00000000; + REO_GETOBJ_POLEOBJ = $00000001; + REO_GETOBJ_PSTG = $00000002; + REO_GETOBJ_POLESITE = $00000004; + REO_GETOBJ_ALL_INTERFACES = $00000007; + +{ Place object at selection } + + REO_CP_SELECTION = ULONG(-1); + +{ Use character position to specify object instead of index } + + REO_IOB_SELECTION = ULONG(-1); + REO_IOB_USE_CP = ULONG(-2); + +{ Object flags } + + REO_NULL = $00000000; { No flags } + REO_READWRITEMASK = $0000003F; { Mask out RO bits } + REO_DONTNEEDPALETTE = $00000020; { Object doesn't need palette } + REO_BLANK = $00000010; { Object is blank } + REO_DYNAMICSIZE = $00000008; { Object defines size always } + REO_INVERTEDSELECT = $00000004; { Object drawn all inverted if sel } + REO_BELOWBASELINE = $00000002; { Object sits below the baseline } + REO_RESIZABLE = $00000001; { Object may be resized } + REO_LINK = $80000000; { Object is a link (RO) } + REO_STATIC = $40000000; { Object is static (RO) } + REO_SELECTED = $08000000; { Object selected (RO) } + REO_OPEN = $04000000; { Object open in its server (RO) } + REO_INPLACEACTIVE = $02000000; { Object in place active (RO) } + REO_HILITED = $01000000; { Object is to be hilited (RO) } + REO_LINKAVAILABLE = $00800000; { Link believed available (RO) } + REO_GETMETAFILE = $00400000; { Object requires metafile (RO) } + +{ Flags for IRichEditOle.GetClipboardData, } +{ IRichEditOleCallback.GetClipboardData and } +{ IRichEditOleCallback.QueryAcceptData } + + RECO_PASTE = $00000000; { paste from clipboard } + RECO_DROP = $00000001; { drop } + RECO_COPY = $00000002; { copy to the clipboard } + RECO_CUT = $00000003; { cut to the clipboard } + RECO_DRAG = $00000004; { drag } + +{ RichEdit GUIDs } + +{ IID_IRichEditOle: TGUID = ( + D1:$00020D00;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46)); + IID_IRichEditOleCallback: TGUID = ( + D1:$00020D03;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));} + +type + +{ + * IRichEditOle + * + * Purpose: + * Interface used by the client of RichEdit to perform OLE-related + * operations. + * + * The methods herein may just want to be regular Windows messages. +} + + IRichEditOle = interface(IUnknown) + ['{00020d00-0000-0000-c000-000000000046}'] + function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall; + function GetObjectCount: HResult; stdcall; + function GetLinkCount: HResult; stdcall; + function GetObject(iob: Longint; out reobject: TReObject; + dwFlags: DWORD): HResult; stdcall; + function InsertObject(var reobject: TReObject): HResult; stdcall; + function ConvertObject(iob: Longint; rclsidNew: TIID; + lpstrUserTypeNew: LPCSTR): HResult; stdcall; + function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall; + function SetHostNames(lpstrContainerApp: LPCSTR; + lpstrContainerObj: LPCSTR): HResult; stdcall; + function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall; + function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall; + function HandsOffStorage(iob: Longint): HResult; stdcall; + function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall; + function InPlaceDeactivate: HResult; stdcall; + function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; + function GetClipboardData(var chrg: TCharRange; reco: DWORD; + out dataobj: IDataObject): HResult; stdcall; + function ImportDataObject(dataobj: IDataObject; cf: TClipFormat; + hMetaPict: HGLOBAL): HResult; stdcall; + end; + +{ + * IRichEditOleCallback + * + * Purpose: + * Interface used by the RichEdit to get OLE-related stuff from the + * application using RichEdit. +} + + IRichEditOleCallback = interface(IUnknown) + ['{00020d03-0000-0000-c000-000000000046}'] + function GetNewStorage(out stg: IStorage): HResult; stdcall; + function GetInPlaceContext(out Frame: IOleInPlaceFrame; + out Doc: IOleInPlaceUIWindow; + lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall; + function ShowContainerUI(fShow: BOOL): HResult; stdcall; + function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; + cp: Longint): HResult; stdcall; + function DeleteObject(const oleobj: IOleObject): HResult; stdcall; + function QueryAcceptData(const dataobj: IDataObject; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; + hMetaPict: HGLOBAL): HResult; stdcall; + function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; + function GetClipboardData(const chrg: TCharRange; reco: DWORD; + out dataobj: IDataObject): HResult; stdcall; + function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; + var dwEffect: DWORD): HResult; stdcall; + function GetContextMenu(seltype: Word; const oleobj: IOleObject; + const chrg: TCharRange; out menu: HMENU): HResult; stdcall; + end; + +{************************************************************************} + +{ TRichEditOleCallback } + +type + TRichEditOleCallback = class(TObject, IUnknown, IRichEditOleCallback) + private + FDocForm: IVCLFrameForm; + FFrameForm: IVCLFrameForm; + FAccelTable: HAccel; + FAccelCount: Integer; + FAutoScroll: Boolean; + procedure CreateAccelTable; + procedure DestroyAccelTable; + procedure AssignFrame; + private + FRefCount: Longint; + FRichEdit: TRxCustomRichEdit; + public + constructor Create(RichEdit: TRxCustomRichEdit); + destructor Destroy; override; + function QueryInterface(const iid: TGUID; out Obj): HResult; stdcall; + function _AddRef: Longint; stdcall; + function _Release: Longint; stdcall; + function GetNewStorage(out stg: IStorage): HResult; stdcall; + function GetInPlaceContext(out Frame: IOleInPlaceFrame; + out Doc: IOleInPlaceUIWindow; + lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall; + function GetClipboardData(const chrg: TCharRange; reco: DWORD; + out dataobj: IDataObject): HResult; stdcall; + function GetContextMenu(seltype: Word; const oleobj: IOleObject; + const chrg: TCharRange; out menu: HMENU): HResult; stdcall; + function ShowContainerUI(fShow: BOOL): HResult; stdcall; + function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; + cp: Longint): HResult; stdcall; + function DeleteObject(const oleobj: IOleObject): HResult; stdcall; + function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat; + reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult; stdcall; + function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; + function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; + var dwEffect: DWORD): HResult; stdcall; + end; + +constructor TRichEditOleCallback.Create(RichEdit: TRxCustomRichEdit); +begin + inherited Create; + FRichEdit := RichEdit; +end; + +destructor TRichEditOleCallback.Destroy; +begin + DestroyAccelTable; + FFrameForm := nil; + FDocForm := nil; + inherited Destroy; +end; + +function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult; +begin + if GetInterface(iid, Obj) then Result := S_OK + else Result := E_NOINTERFACE; +end; + +function TRichEditOleCallback._AddRef: Longint; +begin + Inc(FRefCount); + Result := FRefCount; +end; + +function TRichEditOleCallback._Release: Longint; +begin + Dec(FRefCount); + Result := FRefCount; +end; + +procedure TRichEditOleCallback.CreateAccelTable; +var + Menu: TMainMenu; +begin + if (FAccelTable = 0) and Assigned(FFrameForm) then begin + Menu := FFrameForm.Form.Menu; + if Menu <> nil then + Menu.GetOle2AcceleratorTable(FAccelTable, FAccelCount, [0, 2, 4]); + end; +end; + +procedure TRichEditOleCallback.DestroyAccelTable; +begin + if FAccelTable <> 0 then begin + DestroyAcceleratorTable(FAccelTable); + FAccelTable := 0; + FAccelCount := 0; + end; +end; + +procedure TRichEditOleCallback.AssignFrame; +begin + if (GetParentForm(FRichEdit) <> nil) and not Assigned(FFrameForm) and + FRichEdit.AllowInPlace then + begin + FDocForm := GetVCLFrameForm(ValidParentForm(FRichEdit)); + FFrameForm := FDocForm; + if IsFormMDIChild(FDocForm.Form) then + FFrameForm := GetVCLFrameForm(Application.MainForm); + end; +end; + +function TRichEditOleCallback.GetNewStorage( + out stg: IStorage): HResult; +begin + try + CreateStorage(stg); + Result := S_OK; + except + Result:= E_OUTOFMEMORY; + end; +end; + +function TRichEditOleCallback.GetInPlaceContext( + out Frame: IOleInPlaceFrame; + out Doc: IOleInPlaceUIWindow; + lpFrameInfo: POleInPlaceFrameInfo): HResult; +begin + AssignFrame; + if Assigned(FFrameForm) and FRichEdit.AllowInPlace then begin + Frame := FFrameForm; + Doc := FDocForm; + CreateAccelTable; + with lpFrameInfo^ do begin + fMDIApp := False; + FFrameForm.GetWindow(hWndFrame); + hAccel := FAccelTable; + cAccelEntries := FAccelCount; + end; + Result := S_OK; + end + else Result := E_NOTIMPL; +end; + +function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage; + cp: Longint): HResult; +begin + Result := NOERROR; +end; + +function TRichEditOleCallback.DeleteObject(const oleobj: IOleObject): HResult; +begin + if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE); + Result := NOERROR; +end; + +function TRichEditOleCallback.QueryAcceptData(const dataobj: IDataObject; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; + hMetaPict: HGLOBAL): HResult; +begin + Result := S_OK; +end; + +function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: BOOL): HResult; +begin + Result := NOERROR; +end; + +function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD; + out dataobj: IDataObject): HResult; +begin + Result := E_NOTIMPL; +end; + +function TRichEditOleCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; + var dwEffect: DWORD): HResult; +begin + Result := E_NOTIMPL; +end; + +function TRichEditOleCallback.GetContextMenu(seltype: Word; + const oleobj: IOleObject; const chrg: TCharRange; + out menu: HMENU): HResult; +begin + Result := E_NOTIMPL; +end; + +function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult; +begin + if not fShow then AssignFrame; + if Assigned(FFrameForm) then begin + if fShow then begin + FFrameForm.SetMenu(0, 0, 0); + FFrameForm.ClearBorderSpace; + FRichEdit.SetUIActive(False); + DestroyAccelTable; + TForm(FFrameForm.Form).AutoScroll := FAutoScroll; + FFrameForm := nil; + FDocForm := nil; + end + else begin + FAutoScroll := TForm(FFrameForm.Form).AutoScroll; + TForm(FFrameForm.Form).AutoScroll := False; + FRichEdit.SetUIActive(True); + end; + Result := S_OK; + end + else Result := E_NOTIMPL; +end; + +{ TOleUIObjInfo - helper interface for Object Properties dialog } + +type + TOleUIObjInfo = class(TInterfacedObject, IOleUIObjInfo) + private + FRichEdit: TRxCustomRichEdit; + FReObject: TReObject; + public + constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject); + function GetObjectInfo(dwObject: Longint; + var dwObjSize: Longint; var lpszLabel: PChar; + var lpszType: PChar; var lpszShortType: PChar; + var lpszLocation: PChar): HResult; stdcall; + function GetConvertInfo(dwObject: Longint; var ClassID: TCLSID; + var wFormat: Word; var ConvertDefaultClassID: TCLSID; + var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult; stdcall; + function ConvertObject(dwObject: Longint; + const clsidNew: TCLSID): HResult; stdcall; + function GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal; + var dvAspect: Longint; var nCurrentScale: Integer): HResult; stdcall; + function SetViewInfo(dwObject: Longint; hMetaPict: HGlobal; + dvAspect: Longint; nCurrentScale: Integer; + bRelativeToOrig: BOOL): HResult; stdcall; + end; + +constructor TOleUIObjInfo.Create(RichEdit: TRxCustomRichEdit; + ReObject: TReObject); +begin + inherited Create; + FRichEdit := RichEdit; + FReObject := ReObject; +end; + +function TOleUIObjInfo.GetObjectInfo(dwObject: Longint; + var dwObjSize: Longint; var lpszLabel: PChar; + var lpszType: PChar; var lpszShortType: PChar; + var lpszLocation: PChar): HResult; +begin + if @dwObjSize <> nil then + dwObjSize := -1 { Unknown size }; + if @lpszLabel <> nil then + lpszLabel := CoAllocCStr(GetFullNameStr(FReObject.poleobj)); + if @lpszType <> nil then + lpszType := CoAllocCStr(GetFullNameStr(FReObject.poleobj)); + if @lpszShortType <> nil then + lpszShortType := CoAllocCStr(GetShortNameStr(FReObject.poleobj)); + if (@lpszLocation <> nil) then begin + if Trim(FRichEdit.Title) <> '' then + lpszLocation := CoAllocCStr(Format('%s - %s', + [FRichEdit.Title, Application.Title])) + else + lpszLocation := CoAllocCStr(Application.Title); + end; + Result := S_OK; +end; + +function TOleUIObjInfo.GetConvertInfo(dwObject: Longint; var ClassID: TCLSID; + var wFormat: Word; var ConvertDefaultClassID: TCLSID; + var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult; +begin + FReObject.poleobj.GetUserClassID(ClassID); + Result := S_OK; +end; + +function TOleUIObjInfo.ConvertObject(dwObject: Longint; + const clsidNew: TCLSID): HResult; +begin + Result := E_NOTIMPL; +end; + +function TOleUIObjInfo.GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal; + var dvAspect: Longint; var nCurrentScale: Integer): HResult; +begin + if @hMetaPict <> nil then + hMetaPict := GetIconMetaPict(FReObject.poleobj, FReObject.dvAspect); + if @dvAspect <> nil then dvAspect := FReObject.dvAspect; + if @nCurrentScale <> nil then nCurrentScale := 0; + Result := S_OK; +end; + +function TOleUIObjInfo.SetViewInfo(dwObject: Longint; hMetaPict: HGlobal; + dvAspect: Longint; nCurrentScale: Integer; + bRelativeToOrig: BOOL): HResult; +var + Iconic: Boolean; +begin + if Assigned(FRichEdit.FRichEditOle) then begin + case dvAspect of + DVASPECT_CONTENT: + Iconic := False; + DVASPECT_ICON: + Iconic := True; + else + Iconic := FReObject.dvAspect = DVASPECT_ICON; + end; + IRichEditOle(FRichEdit.FRichEditOle).InPlaceDeactivate; + Result := OleSetDrawAspect(FReObject.poleobj, Iconic, hMetaPict, + FReObject.dvAspect); + if Succeeded(Result) then + IRichEditOle(FRichEdit.FRichEditOle).SetDvaspect( + Longint(REO_IOB_SELECTION), FReObject.dvAspect); + end + else Result := E_NOTIMPL; +end; + +{ TOleUILinkInfo - helper interface for Object Properties dialog } + +type + TOleUILinkInfo = class(TInterfacedObject, IOleUILinkInfo) + private + FReObject: TReObject; + FRichEdit: TRxCustomRichEdit; + FOleLink: IOleLink; + public + constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject); + function GetNextLink(dwLink: Longint): Longint; stdcall; + function SetLinkUpdateOptions(dwLink: Longint; + dwUpdateOpt: Longint): HResult; stdcall; + function GetLinkUpdateOptions(dwLink: Longint; + var dwUpdateOpt: Longint): HResult; stdcall; + function SetLinkSource(dwLink: Longint; pszDisplayName: PChar; + lenFileName: Longint; var chEaten: Longint; + fValidateSource: BOOL): HResult; stdcall; + function GetLinkSource(dwLink: Longint; var pszDisplayName: PChar; + var lenFileName: Longint; var pszFullLinkType: PChar; + var pszShortLinkType: PChar; var fSourceAvailable: BOOL; + var fIsSelected: BOOL): HResult; stdcall; + function OpenLinkSource(dwLink: Longint): HResult; stdcall; + function UpdateLink(dwLink: Longint; fErrorMessage: BOOL; + fErrorAction: BOOL): HResult; stdcall; + function CancelLink(dwLink: Longint): HResult; stdcall; + function GetLastUpdate(dwLink: Longint; + var LastUpdate: TFileTime): HResult; stdcall; + end; + +procedure LinkError(const Ident: string); +begin + Application.MessageBox(PChar(Ident), PChar(SLinkProperties), + MB_OK or MB_ICONSTOP); +end; + +constructor TOleUILinkInfo.Create(RichEdit: TRxCustomRichEdit; + ReObject: TReObject); +begin + inherited Create; + FReObject := ReObject; + FRichEdit := RichEdit; + OleCheck(FReObject.poleobj.QueryInterface(IOleLink, FOleLink)); +end; + +function TOleUILinkInfo.GetNextLink(dwLink: Longint): Longint; +begin + if dwLink = 0 then Result := Longint(FRichEdit) + else Result := 0; +end; + +function TOleUILinkInfo.SetLinkUpdateOptions(dwLink: Longint; + dwUpdateOpt: Longint): HResult; +begin + Result := FOleLink.SetUpdateOptions(dwUpdateOpt); + if Succeeded(Result) then FRichEdit.Modified := True; +end; + +function TOleUILinkInfo.GetLinkUpdateOptions(dwLink: Longint; + var dwUpdateOpt: Longint): HResult; +begin + Result := FOleLink.GetUpdateOptions(dwUpdateOpt); +end; + +function TOleUILinkInfo.SetLinkSource(dwLink: Longint; pszDisplayName: PChar; + lenFileName: Longint; var chEaten: Longint; + fValidateSource: BOOL): HResult; +var + DisplayName: string; + Buffer: array[0..255] of WideChar; +begin + Result := E_FAIL; + if fValidateSource then begin + DisplayName := pszDisplayName; + if Succeeded(FOleLink.SetSourceDisplayName(StringToWideChar(DisplayName, + Buffer, SizeOf(Buffer) div 2))) then + begin + chEaten := Length(DisplayName); + try + OleCheck(FReObject.poleobj.Update); + except + Application.HandleException(FRichEdit); + end; + Result := S_OK; + end; + end + else LinkError(SInvalidLinkSource); +end; + +function TOleUILinkInfo.GetLinkSource(dwLink: Longint; var pszDisplayName: PChar; + var lenFileName: Longint; var pszFullLinkType: PChar; + var pszShortLinkType: PChar; var fSourceAvailable: BOOL; + var fIsSelected: BOOL): HResult; +var + Moniker: IMoniker; +begin + if @pszDisplayName <> nil then + pszDisplayName := CoAllocCStr(GetDisplayNameStr(FOleLink)); + if @lenFileName <> nil then begin + lenFileName := 0; + FOleLink.GetSourceMoniker(Moniker); + if Moniker <> nil then begin + lenFileName := OleStdGetLenFilePrefixOfMoniker(Moniker); + ReleaseObject(Moniker); + end; + end; + if @pszFullLinkType <> nil then + pszFullLinkType := CoAllocCStr(GetFullNameStr(FReObject.poleobj)); + if @pszShortLinkType <> nil then + pszShortLinkType := CoAllocCStr(GetShortNameStr(FReObject.poleobj)); + Result := S_OK; +end; + +function TOleUILinkInfo.OpenLinkSource(dwLink: Longint): HResult; +begin + try + OleCheck(FReObject.poleobj.DoVerb(OLEIVERB_SHOW, nil, FReObject.polesite, + 0, FRichEdit.Handle, FRichEdit.ClientRect)); + except + Application.HandleException(FRichEdit); + end; + Result := S_OK; +end; + +function TOleUILinkInfo.UpdateLink(dwLink: Longint; fErrorMessage: BOOL; + fErrorAction: BOOL): HResult; +begin + try + OleCheck(FReObject.poleobj.Update); + except + Application.HandleException(FRichEdit); + end; + Result := S_OK; +end; + +function TOleUILinkInfo.CancelLink(dwLink: Longint): HResult; +begin + LinkError(SCannotBreakLink); + Result := E_NOTIMPL; +end; + +function TOleUILinkInfo.GetLastUpdate(dwLink: Longint; + var LastUpdate: TFileTime): HResult; +begin + Result := S_OK; +end; + +{ Get RichEdit OLE interface } + +function GetRichEditOle(Wnd: HWnd; var RichEditOle): Boolean; +begin + Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, Longint(@RichEditOle)) <> 0; +end; + +{ TRichEditStrings } + +const + ReadError = $0001; + WriteError = $0002; + NoError = $0000; + +type + TRichEditStrings = class(TStrings) + private + RichEdit: TRxCustomRichEdit; + FFormat: TRichStreamFormat; + FMode: TRichStreamModes; + FConverter: TConversion; + procedure EnableChange(const Value: Boolean); + protected + function Get(Index: Integer): string; override; + function GetCount: Integer; override; + procedure Put(Index: Integer; const S: string); override; + procedure SetUpdateState(Updating: Boolean); override; + procedure SetTextStr(const Value: string); override; + public + destructor Destroy; override; + procedure Clear; override; + procedure AddStrings(Strings: TStrings); override; + procedure Delete(Index: Integer); override; + procedure Insert(Index: Integer; const S: string); override; + procedure LoadFromFile(const FileName: string); override; + procedure LoadFromStream(Stream: TStream); override; + procedure SaveToFile(const FileName: string); override; + procedure SaveToStream(Stream: TStream); override; + property Format: TRichStreamFormat read FFormat write FFormat; + property Mode: TRichStreamModes read FMode write FMode; + end; + +destructor TRichEditStrings.Destroy; +begin + FConverter.Free; + inherited Destroy; +end; + +procedure TRichEditStrings.AddStrings(Strings: TStrings); +var + SelChange: TNotifyEvent; +begin + SelChange := RichEdit.OnSelectionChange; + RichEdit.OnSelectionChange := nil; + try + inherited AddStrings(Strings); + finally + RichEdit.OnSelectionChange := SelChange; + end; +end; + +function TRichEditStrings.GetCount: Integer; +begin + with RichEdit do begin + Result := SendMessage(Handle, EM_GETLINECOUNT, 0, 0); + if GetLineLength(GetLineIndex(Result - 1)) = 0 then Dec(Result); + end; +end; + +function TRichEditStrings.Get(Index: Integer): string; +var + Text: array[0..4095] of Char; + L: Integer; +begin + Word((@Text)^) := SizeOf(Text); + L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text)); + if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2) + else if (RichEditVersion >= 2) and (Text[L - 1] = #13) then Dec(L); + SetString(Result, Text, L); +end; + +procedure TRichEditStrings.Put(Index: Integer; const S: string); +var + Selection: TCharRange; +begin + if Index >= 0 then + begin + Selection.cpMin := RichEdit.GetLineIndex(Index); + if Selection.cpMin <> -1 then begin + Selection.cpMax := Selection.cpMin + + RichEdit.GetLineLength(Selection.cpMin); + SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection)); + RichEdit.FLinesUpdating := True; + try + SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S))); + finally + RichEdit.FLinesUpdating := False; + end; + end; + end; +end; + +procedure TRichEditStrings.Insert(Index: Integer; const S: string); +var + L: Integer; + Selection: TCharRange; + Fmt: PChar; + Str: string; +begin + if Index >= 0 then begin + Selection.cpMin := RichEdit.GetLineIndex(Index); + if Selection.cpMin >= 0 then begin + if RichEditVersion = 1 then Fmt := '%s'#13#10 + else Fmt := '%s'#13; + end + else begin + Selection.cpMin := RichEdit.GetLineIndex(Index - 1); + if Selection.cpMin < 0 then Exit; + L := RichEdit.GetLineLength(Selection.cpMin); + if L = 0 then Exit; + Inc(Selection.cpMin, L); + if RichEditVersion = 1 then Fmt := #13#10'%s' + else Fmt := #13'%s'; + end; + Selection.cpMax := Selection.cpMin; + SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection)); + Str := SysUtils.Format(Fmt, [S]); + RichEdit.FLinesUpdating := True; + try + SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Str))); + finally + RichEdit.FLinesUpdating := False; + end; + if RichEditVersion = 1 then + if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then + raise EOutOfResources.Create(ResStr(sRichEditInsertError)); + end; +end; + +procedure TRichEditStrings.Delete(Index: Integer); +const + Empty: PChar = ''; +var + Selection: TCharRange; +begin + if Index < 0 then Exit; + Selection.cpMin := RichEdit.GetLineIndex(Index); + if Selection.cpMin <> -1 then begin + Selection.cpMax := RichEdit.GetLineIndex(Index + 1); + if Selection.cpMax = -1 then + Selection.cpMax := Selection.cpMin + + RichEdit.GetLineLength(Selection.cpMin); + SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection)); + RichEdit.FLinesUpdating := True; + try + SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty)); + finally + RichEdit.FLinesUpdating := False; + end; + end; +end; + +procedure TRichEditStrings.Clear; +begin + RichEdit.Clear; +end; + +procedure TRichEditStrings.SetUpdateState(Updating: Boolean); +begin + if RichEdit.Showing then + SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0); + if not Updating then begin + RichEdit.Refresh; + RichEdit.Perform(CM_TEXTCHANGED, 0, 0); + end; +end; + +procedure TRichEditStrings.EnableChange(const Value: Boolean); +var + EventMask: Longint; +begin + with RichEdit do begin + EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0); + if Value then + EventMask := EventMask or ENM_CHANGE + else + EventMask := EventMask and not ENM_CHANGE; + SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask); + end; +end; + +procedure TRichEditStrings.SetTextStr(const Value: string); +begin + EnableChange(False); + try + inherited SetTextStr(Value); + finally + EnableChange(True); + end; +end; + +function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler; +asm + PUSH ESI + PUSH EDI + MOV EDI,EAX + MOV ESI,EDX + MOV EDX,EAX + CLD +@@1: LODSB +@@2: OR AL,AL + JE @@4 + CMP AL,0AH + JE @@3 + STOSB + CMP AL,0DH + JNE @@1 + MOV AL,0AH + STOSB + LODSB + CMP AL,0AH + JE @@1 + JMP @@2 +@@3: MOV EAX,0A0DH + STOSW + JMP @@1 +@@4: STOSB + LEA EAX,[EDI-1] + SUB EAX,EDX + POP EDI + POP ESI +end; + +function StreamSave(dwCookie: Longint; pbBuff: PByte; + cb: Longint; var pcb: Longint): Longint; stdcall; +var + StreamInfo: PRichEditStreamInfo; +begin + Result := NoError; + StreamInfo := PRichEditStreamInfo(Pointer(dwCookie)); + try + pcb := 0; + if StreamInfo^.Converter <> nil then + pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb); + except + Result := WriteError; + end; +end; + +function StreamLoad(dwCookie: Longint; pbBuff: PByte; + cb: Longint; var pcb: Longint): Longint; stdcall; +var + Buffer, pBuff: PChar; + StreamInfo: PRichEditStreamInfo; +begin + Result := NoError; + StreamInfo := PRichEditStreamInfo(Pointer(dwCookie)); + Buffer := StrAlloc(cb + 1); + try + cb := cb div 2; + pcb := 0; + pBuff := Buffer + cb; + try + if StreamInfo^.Converter <> nil then + pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb); + if pcb > 0 then + begin + pBuff[pcb] := #0; + if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0; + pcb := AdjustLineBreaks(Buffer, pBuff); + Move(Buffer^, pbBuff^, pcb); + end; + except + Result := ReadError; + end; + finally + StrDispose(Buffer); + end; +end; + +procedure TRichEditStrings.LoadFromStream(Stream: TStream); +var + EditStream: TEditStream; + Position: Longint; + TextType: Longint; + StreamInfo: TRichEditStreamInfo; + Converter: TConversion; +begin + StreamInfo.Stream := Stream; + if FConverter <> nil then Converter := FConverter + else Converter := RichEdit.DefaultConverter.Create; + StreamInfo.Converter := Converter; + try + with EditStream do + begin + dwCookie := Longint(Pointer(@StreamInfo)); + pfnCallBack := @StreamLoad; + dwError := 0; + end; + Position := Stream.Position; + case FFormat of + sfDefault: + if RichEdit.PlainText then TextType := SF_TEXT + else TextType := SF_RTF; + sfRichText: TextType := SF_RTF; + else {sfPlainText} TextType := SF_TEXT; + end; + if TextType = SF_RTF then begin + if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF; + end; + if TextType = SF_TEXT then begin + if (smUnicode in Mode) and (RichEditVersion > 1) then + TextType := TextType or SF_UNICODE; + end; + if smSelection in Mode then TextType := TextType or SFF_SELECTION; + SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream)); + if (EditStream.dwError <> 0) then begin + Stream.Position := Position; + if (TextType and SF_RTF = SF_RTF) then TextType := SF_TEXT + else TextType := SF_RTF; + SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream)); + if EditStream.dwError <> 0 then + raise EOutOfResources.Create(ResStr(sRichEditLoadFail)); + end; + RichEdit.SetSelection(0, 0, True); + finally + if FConverter = nil then Converter.Free; + end; +end; + +procedure TRichEditStrings.SaveToStream(Stream: TStream); +var + EditStream: TEditStream; + TextType: Longint; + StreamInfo: TRichEditStreamInfo; + Converter: TConversion; +begin + if FConverter <> nil then Converter := FConverter + else Converter := RichEdit.DefaultConverter.Create; + StreamInfo.Stream := Stream; + StreamInfo.Converter := Converter; + try + with EditStream do + begin + dwCookie := Longint(Pointer(@StreamInfo)); + pfnCallBack := @StreamSave; + dwError := 0; + end; + case FFormat of + sfDefault: + if RichEdit.PlainText then TextType := SF_TEXT + else TextType := SF_RTF; + sfRichText: TextType := SF_RTF; + else {sfPlainText} TextType := SF_TEXT; + end; + if TextType = SF_RTF then begin + if smNoObjects in Mode then TextType := SF_RTFNOOBJS; + if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF; + end + else if TextType = SF_TEXT then begin + if (smUnicode in Mode) and (RichEditVersion > 1) then + TextType := TextType or SF_UNICODE; + end; + if smSelection in Mode then TextType := TextType or SFF_SELECTION; + SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream)); + if EditStream.dwError <> 0 then + raise EOutOfResources.Create(ResStr(sRichEditSaveFail)); + finally + if FConverter = nil then Converter.Free; + end; +end; + +procedure TRichEditStrings.LoadFromFile(const FileName: string); +var + Ext: string; + Convert: PRichConversionFormat; + SaveFormat: TRichStreamFormat; +begin + Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename)); + System.Delete(Ext, 1, 1); + Convert := ConversionFormatList; + while Convert <> nil do + with Convert^ do + if Extension <> Ext then Convert := Next + else Break; + if (FConverter = nil) and (Convert <> nil) then + FConverter := Convert^.ConversionClass.Create; + try + SaveFormat := Format; + try + if Convert <> nil then begin + if Convert^.PlainText then FFormat := sfPlainText + else FFormat := sfRichText; + end; + inherited LoadFromFile(FileName); + finally + FFormat := SaveFormat; + end; + except + FConverter.Free; + FConverter := nil; + raise; + end; +end; + +procedure TRichEditStrings.SaveToFile(const FileName: string); +var + Ext: string; + Convert: PRichConversionFormat; + SaveFormat: TRichStreamFormat; +begin + Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename)); + System.Delete(Ext, 1, 1); + Convert := ConversionFormatList; + while Convert <> nil do + with Convert^ do + if Extension <> Ext then Convert := Next + else Break; + if (FConverter = nil) and (Convert <> nil) then + FConverter := Convert^.ConversionClass.Create; + try + SaveFormat := Format; + try + if Convert <> nil then begin + if Convert^.PlainText then FFormat := sfPlainText + else FFormat := sfRichText; + end; + inherited SaveToFile(FileName); + finally + FFormat := SaveFormat; + end; + except + FConverter.Free; + FConverter := nil; + raise; + end; +end; + +{ TOEMConversion } + +function TOEMConversion.ConvertReadStream(Stream: TStream; Buffer: PChar; + BufSize: Integer): Integer; +var + Mem: TMemoryStream; +begin + Mem := TMemoryStream.Create; + try + Mem.SetSize(BufSize); + Result := inherited ConvertReadStream(Stream, PChar(Mem.Memory), BufSize); + OemToCharBuff(PChar(Mem.Memory), Buffer, Result); + finally + Mem.Free; + end; +end; + +function TOEMConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar; + BufSize: Integer): Integer; +var + Mem: TMemoryStream; +begin + Mem := TMemoryStream.Create; + try + Mem.SetSize(BufSize); + CharToOemBuff(Buffer, PChar(Mem.Memory), BufSize); + Result := inherited ConvertWriteStream(Stream, PChar(Mem.Memory), BufSize); + finally + Mem.Free; + end; +end; + +{ TRxCustomRichEdit } + +constructor TRxCustomRichEdit.Create(AOwner: TComponent); +var + DC: HDC; +begin + inherited Create(AOwner); + ControlStyle := ControlStyle - [csSetCaption]; + FSelAttributes := TRxTextAttributes.Create(Self, atSelected); + FDefAttributes := TRxTextAttributes.Create(Self, atDefaultText); + FWordAttributes := TRxTextAttributes.Create(Self, atWord); + FParagraph := TRxParaAttributes.Create(Self); + FRichEditStrings := TRichEditStrings.Create; + TRichEditStrings(FRichEditStrings).RichEdit := Self; + TabStop := True; + Width := 185; + Height := 89; + AutoSize := False; + DoubleBuffered := False; + FAllowObjects := True; + FAllowInPlace := True; + FAutoVerbMenu := True; + FHideSelection := True; + FHideScrollBars := True; + ScrollBars := ssBoth; + FSelectionBar := True; + FLangOptions := [rlAutoFont]; + DC := GetDC(0); + FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY); + ReleaseDC(0, DC); + DefaultConverter := TConversion; + FOldParaAlignment := TParaAlignment(Alignment); + FUndoLimit := 100; + FAutoURLDetect := True; + FWordSelection := True; + with FClickRange do begin + cpMin := -1; + cpMax := -1; + end; + FCallback := TRichEditOleCallback.Create(Self); + Perform(CM_PARENTBIDIMODECHANGED, 0, 0); +end; + +destructor TRxCustomRichEdit.Destroy; +begin + FLastFind := nil; + FSelAttributes.Free; + FDefAttributes.Free; + FWordAttributes.Free; + FParagraph.Free; + FRichEditStrings.Free; + FMemStream.Free; + FPopupVerbMenu.Free; + FFindDialog.Free; + FReplaceDialog.Free; + inherited Destroy; + { be sure that callback object is destroyed after inherited Destroy } + TRichEditOleCallback(FCallback).Free; +end; + +procedure TRxCustomRichEdit.Clear; +begin + CloseObjects; + inherited Clear; + Modified := False; +end; + +procedure TRxCustomRichEdit.CreateParams(var Params: TCreateParams); +const + HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0); + HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0); + WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL); + SelectionBars: array[Boolean] of DWORD = (0, ES_SELECTIONBAR); +begin + inherited CreateParams(Params); + case RichEditVersion of + 1: CreateSubClass(Params, RICHEDIT_CLASS10A); + else CreateSubClass(Params, RICHEDIT_CLASS); + end; + with Params do begin + Style := (Style and not (WS_HSCROLL or WS_VSCROLL)) or ES_SAVESEL or + (WS_CLIPSIBLINGS or WS_CLIPCHILDREN); + { NOTE: WS_CLIPCHILDREN and WS_CLIPSIBLINGS are essential otherwise } + { once the object is inserted you see some painting problems. } + Style := Style and not (WS_HSCROLL or WS_VSCROLL); + if ScrollBars in [ssVertical, ssBoth] then + Style := Style or WS_VSCROLL; + if (ScrollBars in [ssHorizontal, ssBoth]) and not WordWrap then + Style := Style or WS_HSCROLL; + Style := Style or HideScrollBars[FHideScrollBars] or + SelectionBars[FSelectionBar] or HideSelections[FHideSelection] and + not WordWraps[WordWrap]; + WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); + end; +end; + +procedure TRxCustomRichEdit.CreateWnd; +var + StreamFmt: TRichStreamFormat; + Mode: TRichStreamModes; + DesignMode: Boolean; + Mask: Longint; +begin + StreamFmt := TRichEditStrings(Lines).Format; + Mode := TRichEditStrings(Lines).Mode; + inherited CreateWnd; + if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then + Font.Charset := GetDefFontCharSet; + Mask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED; + if RichEditVersion >= 2 then Mask := Mask or ENM_LINK; + SendMessage(Handle, EM_SETEVENTMASK, 0, Mask); + SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color)); + DoSetMaxLength(MaxLength); + SetWordSelection(FWordSelection); + if RichEditVersion >= 2 then begin + SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0); + SendMessage(Handle, EM_SETTYPOGRAPHYOPTIONS, TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY); + FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, FUndoLimit, 0); + UpdateTextModes(PlainText); + SetLangOptions(FLangOptions); + end; + if FAllowObjects then begin + SendMessage(Handle, EM_SETOLECALLBACK, 0, + LPARAM(TRichEditOleCallback(FCallback) as IRichEditOleCallback)); + GetRichEditOle(Handle, FRichEditOle); + UpdateHostNames; + end; + if FMemStream <> nil then begin + FMemStream.ReadBuffer(DesignMode, SizeOf(DesignMode)); + if DesignMode then begin + TRichEditStrings(Lines).Format := sfPlainText; + TRichEditStrings(Lines).Mode := []; + end; + try + Lines.LoadFromStream(FMemStream); + FMemStream.Free; + FMemStream := nil; + finally + TRichEditStrings(Lines).Format := StreamFmt; + TRichEditStrings(Lines).Mode := Mode; + end; + end; + if RichEditVersion < 2 then + SendMessage(Handle, WM_SETFONT, 0, 0); + Modified := FModified; +end; + +procedure TRxCustomRichEdit.DestroyWnd; +var + StreamFmt: TRichStreamFormat; + Mode: TRichStreamModes; + DesignMode: Boolean; +begin + FModified := Modified; + FMemStream := TMemoryStream.Create; + StreamFmt := TRichEditStrings(Lines).Format; + Mode := TRichEditStrings(Lines).Mode; + DesignMode := (csDesigning in ComponentState); + FMemStream.WriteBuffer(DesignMode, SizeOf(DesignMode)); + if DesignMode then begin + TRichEditStrings(Lines).Format := sfPlainText; + TRichEditStrings(Lines).Mode := []; + end; + try + Lines.SaveToStream(FMemStream); + FMemStream.Position := 0; + finally + TRichEditStrings(Lines).Format := StreamFmt; + TRichEditStrings(Lines).Mode := Mode; + end; + inherited DestroyWnd; +end; + +procedure TRxCustomRichEdit.SetAllowObjects(Value: Boolean); +begin + if FAllowObjects <> Value then begin + FAllowObjects := Value; + RecreateWnd; + end; +end; + +procedure TRxCustomRichEdit.UpdateHostNames; +var + AppName: string; +begin + if HandleAllocated and Assigned(FRichEditOle) then begin + AppName := Application.Title; + if Trim(AppName) = '' then + AppName := ExtractFileName(Application.ExeName); + if Trim(Title) = '' then + IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(AppName)) + else + IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(Title)); + end; +end; + +procedure TRxCustomRichEdit.SetTitle(const Value: string); +begin + if FTitle <> Value then begin + FTitle := Value; + UpdateHostNames; + end; +end; + +function TRxCustomRichEdit.GetPopupMenu: TPopupMenu; +var + EnumOleVerb: IEnumOleVerb; + OleVerb: TOleVerb; + Item: TMenuItem; + ReObject: TReObject; +begin + FPopupVerbMenu.Free; + FPopupVerbMenu := nil; + Result := inherited GetPopupMenu; + if FAutoVerbMenu and (SelectionType = [stObject]) and + Assigned(FRichEditOle) then + begin + FillChar(ReObject, SizeOf(ReObject), 0); + ReObject.cbStruct := SizeOf(ReObject); + if Succeeded(IRichEditOle(FRichEditOle).GetObject( + Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ)) then + try + if Assigned(ReObject.poleobj) and + (ReObject.dwFlags and REO_INPLACEACTIVE = 0) then + begin + FPopupVerbMenu := TPopupMenu.Create(Self); + if ReObject.poleobj.EnumVerbs(EnumOleVerb) = 0 then + try + while (EnumOleVerb.Next(1, OleVerb, nil) = 0) and + (OleVerb.lVerb >= 0) and + (OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) do + begin + Item := TMenuItem.Create(FPopupVerbMenu); + Item.Caption := WideCharToString(OleVerb.lpszVerbName); + Item.Tag := OleVerb.lVerb; + Item.Default := (OleVerb.lVerb = OLEIVERB_PRIMARY); + Item.OnClick := PopupVerbClick; + FPopupVerbMenu.Items.Add(Item); + end; + finally + ReleaseObject(EnumOleVerb); + end; + if (Result <> nil) and (Result.Items.Count > 0) then begin + Item := TMenuItem.Create(FPopupVerbMenu); + Item.Caption := '-'; + Result.Items.Add(Item); + Item := TMenuItem.Create(FPopupVerbMenu); + Item.Caption := Format(ResStr(SPropDlgCaption), + [GetFullNameStr(ReObject.poleobj)]); + Item.OnClick := ObjectPropsClick; + Result.Items.Add(Item); + if FPopupVerbMenu.Items.Count > 0 then begin + FPopupVerbMenu.Items.Caption := GetFullNameStr(ReObject.poleobj); + Result.Items.Add(FPopupVerbMenu.Items); + end; + end + else if FPopupVerbMenu.Items.Count > 0 then begin + Item := TMenuItem.Create(FPopupVerbMenu); + Item.Caption := Format(ResStr(SPropDlgCaption), + [GetFullNameStr(ReObject.poleobj)]); + Item.OnClick := ObjectPropsClick; + FPopupVerbMenu.Items.Insert(0, Item); + Result := FPopupVerbMenu; + end; + end; + finally + ReleaseObject(ReObject.poleobj); + end; + end; +end; + +procedure TRxCustomRichEdit.PopupVerbClick(Sender: TObject); +var + ReObject: TReObject; +begin + if Assigned(FRichEditOle) then begin + FillChar(ReObject, SizeOf(ReObject), 0); + ReObject.cbStruct := SizeOf(ReObject); + if Succeeded(IRichEditOle(FRichEditOle).GetObject( + Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ or + REO_GETOBJ_POLESITE)) then + try + if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then + OleCheck(ReObject.poleobj.DoVerb((Sender as TMenuItem).Tag, nil, + ReObject.polesite, 0, Handle, ClientRect)); + finally + ReleaseObject(ReObject.polesite); + ReleaseObject(ReObject.poleobj); + end; + end; +end; + +procedure TRxCustomRichEdit.ObjectPropsClick(Sender: TObject); +begin + ObjectPropertiesDialog; +end; + +procedure TRxCustomRichEdit.WMSetFont(var Message: TWMSetFont); +begin + FDefAttributes.Assign(Font); +end; + +procedure TRxCustomRichEdit.CMFontChanged(var Message: TMessage); +begin + inherited; + FDefAttributes.Assign(Font); +end; + +procedure TRxCustomRichEdit.CreateWindowHandle(const Params: TCreateParams); +var + Bounds: TRect; +begin + Bounds := BoundsRect; + inherited CreateWindowHandle(Params); + if HandleAllocated then BoundsRect := Bounds; +end; + +procedure TRxCustomRichEdit.DoSetMaxLength(Value: Integer); +begin + { The rich edit control's default maximum amount of text is 32K } + { Let's set it at 16M by default } + if Value = 0 then Value := $FFFFFF; + SendMessage(Handle, EM_EXLIMITTEXT, 0, Value); +end; + +function TRxCustomRichEdit.GetCaretPos: TPoint; +var + CharRange: TCharRange; +begin + SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange)); + Result.X := CharRange.cpMax; + Result.Y := LineFromChar(Result.X); + Dec(Result.X, GetLineIndex(-1)); +end; + +function TRxCustomRichEdit.GetSelLength: Integer; +begin + with GetSelection do + Result := cpMax - cpMin; +end; + +function TRxCustomRichEdit.GetSelStart: Integer; +begin + Result := GetSelection.cpMin; +end; + +function TRxCustomRichEdit.GetSelText: string; +begin + with GetSelection do + Result := GetTextRange(cpMin, cpMax); +end; + +function TRxCustomRichEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; +var + S: string; +begin + S := SelText; + Result := Length(S); + if BufSize < Length(S) then Result := BufSize; + StrPLCopy(Buffer, S, Result); +end; + +procedure TRxCustomRichEdit.CMBiDiModeChanged(var Message: TMessage); +var + AParagraph: TParaFormat2; +begin + HandleNeeded; { we REALLY need the handle for BiDi } + inherited; + Paragraph.GetAttributes(AParagraph); + AParagraph.dwMask := PFM_ALIGNMENT; + AParagraph.wAlignment := Ord(Alignment) + 1; + Paragraph.SetAttributes(AParagraph); +end; + +procedure TRxCustomRichEdit.SetHideScrollBars(Value: Boolean); +begin + if HideScrollBars <> Value then begin + FHideScrollBars := Value; + RecreateWnd; + end; +end; + +procedure TRxCustomRichEdit.SetSelectionBar(Value: Boolean); +begin + if FSelectionBar <> Value then begin + FSelectionBar := Value; + RecreateWnd; + end; +end; + +procedure TRxCustomRichEdit.SetHideSelection(Value: Boolean); +begin + if HideSelection <> Value then begin + FHideSelection := Value; + SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LPARAM(True)); + end; +end; + +function TRxCustomRichEdit.GetAutoURLDetect: Boolean; +begin + Result := FAutoURLDetect; + if HandleAllocated and not (csDesigning in ComponentState) then begin + if RichEditVersion >= 2 then + Result := Boolean(SendMessage(Handle, EM_GETAUTOURLDETECT, 0, 0)); + end; +end; + +procedure TRxCustomRichEdit.SetAutoURLDetect(Value: Boolean); +begin + if Value <> FAutoURLDetect then begin + FAutoURLDetect := Value; + if HandleAllocated and (RichEditVersion >= 2) then + SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0); + end; +end; + +function TRxCustomRichEdit.GetWordSelection: Boolean; +begin + Result := FWordSelection; + if HandleAllocated then + Result := (SendMessage(Handle, EM_GETOPTIONS, 0, 0) and + ECO_AUTOWORDSELECTION) <> 0; +end; + +procedure TRxCustomRichEdit.SetWordSelection(Value: Boolean); +var + Options: LPARAM; +begin + FWordSelection := Value; + if HandleAllocated then begin + Options := SendMessage(Handle, EM_GETOPTIONS, 0, 0); + if Value then Options := Options or ECO_AUTOWORDSELECTION + else Options := Options and not ECO_AUTOWORDSELECTION; + SendMessage(Handle, EM_SETOPTIONS, ECOOP_SET, Options); + end; +end; + +const + RichLangOptions: array[TRichLangOption] of DWORD = (IMF_AUTOKEYBOARD, + IMF_AUTOFONT, IMF_IMECANCELCOMPLETE, IMF_IMEALWAYSSENDNOTIFY); + +function TRxCustomRichEdit.GetLangOptions: TRichLangOptions; +var + Flags: Longint; + I: TRichLangOption; +begin + Result := FLangOptions; + if HandleAllocated and not (csDesigning in ComponentState) and + (RichEditVersion >= 2) then + begin + Result := []; + Flags := SendMessage(Handle, EM_GETLANGOPTIONS, 0, 0); + for I := Low(TRichLangOption) to High(TRichLangOption) do + if Flags and RichLangOptions[I] <> 0 then Include(Result, I); + end; +end; + +procedure TRxCustomRichEdit.SetLangOptions(Value: TRichLangOptions); +var + Flags: DWORD; + I: TRichLangOption; +begin + FLangOptions := Value; + if HandleAllocated and (RichEditVersion >= 2) then begin + Flags := 0; + for I := Low(TRichLangOption) to High(TRichLangOption) do + if I in Value then Flags := Flags or RichLangOptions[I]; + SendMessage(Handle, EM_SETLANGOPTIONS, 0, LPARAM(Flags)); + end; +end; + +procedure TRxCustomRichEdit.SetSelAttributes(Value: TRxTextAttributes); +begin + FSelAttributes.Assign(Value); +end; + +function TRxCustomRichEdit.GetCanRedo: Boolean; +begin + Result := False; + if HandleAllocated and (RichEditVersion >= 2) then + Result := SendMessage(Handle, EM_CANREDO, 0, 0) <> 0; +end; + +function TRxCustomRichEdit.GetCanPaste: Boolean; +begin + Result := False; + if HandleAllocated then + Result := SendMessage(Handle, EM_CANPASTE, 0, 0) <> 0; +end; + +function TRxCustomRichEdit.GetRedoName: TUndoName; +begin + Result := unUnknown; + if (RichEditVersion >= 2) and HandleAllocated then + Result := TUndoName(SendMessage(Handle, EM_GETREDONAME, 0, 0)); +end; + +function TRxCustomRichEdit.GetUndoName: TUndoName; +begin + Result := unUnknown; + if (RichEditVersion >= 2) and HandleAllocated then + Result := TUndoName(SendMessage(Handle, EM_GETUNDONAME, 0, 0)); +end; + +function TRxCustomRichEdit.GetSelectionType: TRichSelectionType; +const + SelTypes: array[TRichSelection] of Integer = ( + SEL_TEXT, SEL_OBJECT, SEL_MULTICHAR, SEL_MULTIOBJECT); +var + Selection: Integer; + I: TRichSelection; +begin + Result := []; + if HandleAllocated then begin + Selection := SendMessage(Handle, EM_SELECTIONTYPE, 0, 0); + for I := Low(TRichSelection) to High(TRichSelection) do + if SelTypes[I] and Selection <> 0 then Include(Result, I); + end; +end; + +function TRxCustomRichEdit.GetSelection: TCharRange; +begin + SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Result)); +end; + +procedure TRxCustomRichEdit.SetSelection(StartPos, EndPos: Longint; + ScrollCaret: Boolean); +var + CharRange: TCharRange; +begin + with CharRange do begin + cpMin := StartPos; + cpMax := EndPos; + end; + SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange)); + if ScrollCaret then SendMessage(Handle, EM_SCROLLCARET, 0, 0); +end; + +procedure TRxCustomRichEdit.SetSelLength(Value: Integer); +begin + with GetSelection do SetSelection(cpMin, cpMin + Value, True); +end; + +procedure TRxCustomRichEdit.SetSelStart(Value: Integer); +begin + SetSelection(Value, Value, False); +end; + +function TRxCustomRichEdit.GetCharPos(CharIndex: Integer): TPoint; +var + Res: Longint; +begin + FillChar(Result, SizeOf(Result), 0); + if HandleAllocated then begin + if RichEditVersion = 2 then begin + Res := SendMessage(Handle, Messages.EM_POSFROMCHAR, CharIndex, 0); + Result.X := LoWord(Res); + Result.Y := HiWord(Res); + end + else { RichEdit 1.0 and 3.0 } + SendMessage(Handle, Messages.EM_POSFROMCHAR, WPARAM(@Result), CharIndex); + end; +end; + +function TRxCustomRichEdit.GetTextRange(StartPos, EndPos: Longint): string; +var + TextRange: TTextRange; +begin + SetLength(Result, EndPos - StartPos + 1); + TextRange.chrg.cpMin := StartPos; + TextRange.chrg.cpMax := EndPos; + TextRange.lpstrText := PAnsiChar(Result); + SetLength(Result, SendMessage(Handle, EM_GETTEXTRANGE, 0, Longint(@TextRange))); +end; + +function TRxCustomRichEdit.WordAtCursor: string; +var + Range: TCharRange; +begin + Result := ''; + if HandleAllocated then begin + Range.cpMax := SelStart; + if Range.cpMax = 0 then Range.cpMin := 0 + else if SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMax) <> 0 then + Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, Range.cpMax) + else + Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_LEFT, Range.cpMax); + while SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMin) <> 0 do + Inc(Range.cpMin); + Range.cpMax := SendMessage(Handle, EM_FINDWORDBREAK, WB_RIGHTBREAK, Range.cpMax); + Result := Trim(GetTextRange(Range.cpMin, Range.cpMax)); + end; +end; + +function TRxCustomRichEdit.LineFromChar(CharIndex: Integer): Integer; +begin + Result := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, CharIndex); +end; + +function TRxCustomRichEdit.GetLineIndex(LineNo: Integer): Integer; +begin + Result := SendMessage(Handle, EM_LINEINDEX, LineNo, 0); +end; + +function TRxCustomRichEdit.GetLineLength(CharIndex: Integer): Integer; +begin + Result := SendMessage(Handle, EM_LINELENGTH, CharIndex, 0); +end; + +procedure TRxCustomRichEdit.SetUndoLimit(Value: Integer); +begin + if (Value <> FUndoLimit) then begin + FUndoLimit := Value; + if (RichEditVersion >= 2) and HandleAllocated then + FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, Value, 0); + end; +end; + +procedure TRxCustomRichEdit.SetDefAttributes(Value: TRxTextAttributes); +begin + FDefAttributes.Assign(Value); +end; + +procedure TRxCustomRichEdit.SetWordAttributes(Value: TRxTextAttributes); +begin + FWordAttributes.Assign(Value); +end; + +function TRxCustomRichEdit.GetStreamFormat: TRichStreamFormat; +begin + Result := TRichEditStrings(Lines).Format; +end; + +function TRxCustomRichEdit.GetStreamMode: TRichStreamModes; +begin + Result := TRichEditStrings(Lines).Mode; +end; + +procedure TRxCustomRichEdit.SetStreamFormat(Value: TRichStreamFormat); +begin + TRichEditStrings(Lines).Format := Value; +end; + +procedure TRxCustomRichEdit.SetStreamMode(Value: TRichStreamModes); +begin + TRichEditStrings(Lines).Mode := Value; +end; + +procedure TRxCustomRichEdit.SetPlainText(Value: Boolean); +var + MemStream: TStream; + StreamFmt: TRichStreamFormat; + Mode: TRichStreamModes; +begin + if PlainText <> Value then begin + if HandleAllocated and (RichEditVersion >= 2) then begin + MemStream := TMemoryStream.Create; + try + StreamFmt := TRichEditStrings(Lines).Format; + Mode := TRichEditStrings(Lines).Mode; + try + if (csDesigning in ComponentState) or Value then + TRichEditStrings(Lines).Format := sfPlainText + else TRichEditStrings(Lines).Format := sfRichText; + TRichEditStrings(Lines).Mode := []; + Lines.SaveToStream(MemStream); + MemStream.Position := 0; + TRichEditStrings(Lines).EnableChange(False); + try + SendMessage(Handle, WM_SETTEXT, 0, 0); + UpdateTextModes(Value); + FPlainText := Value; + finally + TRichEditStrings(Lines).EnableChange(True); + end; + Lines.LoadFromStream(MemStream); + finally + TRichEditStrings(Lines).Format := StreamFmt; + TRichEditStrings(Lines).Mode := Mode; + end; + finally + MemStream.Free; + end; + end; + FPlainText := Value; + end; +end; + +procedure TRxCustomRichEdit.UpdateTextModes(Plain: Boolean); +const + TextModes: array[Boolean] of DWORD = (TM_RICHTEXT, TM_PLAINTEXT); + UndoModes: array[Boolean] of DWORD = (TM_SINGLELEVELUNDO, TM_MULTILEVELUNDO); +begin + if (RichEditVersion >= 2) and HandleAllocated then begin + SendMessage(Handle, EM_SETTEXTMODE, TextModes[Plain] or + UndoModes[FUndoLimit > 1], 0); + end; +end; + +procedure TRxCustomRichEdit.CMColorChanged(var Message: TMessage); +begin + inherited; + SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color)) +end; + +procedure TRxCustomRichEdit.EMReplaceSel(var Message: TMessage); +var + CharRange: TCharRange; +begin + Perform(EM_EXGETSEL, 0, Longint(@CharRange)); + with CharRange do + cpMax := cpMin + Integer(StrLen(PChar(Message.lParam))); + if (FUndoLimit > 1) and (RichEditVersion >= 2) and not FLinesUpdating then + Message.wParam := 1; { allow Undo } + inherited; + if not FLinesUpdating then begin + Perform(EM_EXSETSEL, 0, Longint(@CharRange)); + Perform(EM_SCROLLCARET, 0, 0); + end; +end; + +procedure TRxCustomRichEdit.SetRichEditStrings(Value: TStrings); +begin + FRichEditStrings.Assign(Value); +end; + +procedure TRxCustomRichEdit.CloseObjects; +var + I: Integer; + ReObject: TReObject; +begin + if Assigned(FRichEditOle) then begin + FillChar(ReObject, SizeOf(ReObject), 0); + ReObject.cbStruct := SizeOf(ReObject); + with IRichEditOle(FRichEditOle) do begin + for I := GetObjectCount - 1 downto 0 do + if Succeeded(GetObject(I, ReObject, REO_GETOBJ_POLEOBJ)) then begin + if ReObject.dwFlags and REO_INPLACEACTIVE <> 0 then + IRichEditOle(FRichEditOle).InPlaceDeactivate; + ReObject.poleobj.Close(OLECLOSE_NOSAVE); + ReleaseObject(ReObject.poleobj); + end; + end; + end; +end; + +function TRxCustomRichEdit.PasteSpecialDialog: Boolean; + + procedure SetPasteEntry(var Entry: TOleUIPasteEntry; Format: TClipFormat; + tymed: DWORD; const FormatName, ResultText: string; Flags: DWORD); + begin + with Entry do begin + fmtetc.cfFormat := Format; + fmtetc.dwAspect := DVASPECT_CONTENT; + fmtetc.lIndex := -1; + fmtetc.tymed := tymed; + if FormatName <> '' then lpstrFormatName := PChar(FormatName) + else lpstrFormatName := '%s'; + if ResultText <> '' then lpstrResultText := PChar(ResultText) + else lpstrResultText := '%s'; + dwFlags := Flags; + end; + end; + +const + PasteFormatCount = 6; +var + Data: TOleUIPasteSpecial; + PasteFormats: array[0..PasteFormatCount - 1] of TOleUIPasteEntry; + Format: Integer; + OleClientSite: IOleClientSite; + Storage: IStorage; + OleObject: IOleObject; + ReObject: TReObject; + Selection: TCharRange; +begin + Result := False; + if not CanPaste or not Assigned(FRichEditOle) then Exit; + FillChar(Data, SizeOf(Data), 0); + FillChar(PasteFormats, SizeOf(PasteFormats), 0); + with Data do begin + cbStruct := SizeOf(Data); + hWndOwner := Handle; + arrPasteEntries := @PasteFormats; + cPasteEntries := PasteFormatCount; + arrLinkTypes := @CFLinkSource; + cLinkTypes := 1; + dwFlags := PSF_SELECTPASTE; + end; + SetPasteEntry(PasteFormats[0], CFEmbeddedObject, TYMED_ISTORAGE, '', '', + OLEUIPASTE_PASTE or OLEUIPASTE_ENABLEICON); + SetPasteEntry(PasteFormats[1], CFLinkSource, TYMED_ISTREAM, '', '', + OLEUIPASTE_LINKTYPE1 or OLEUIPASTE_ENABLEICON); + SetPasteEntry(PasteFormats[2], CFRtf, TYMED_ISTORAGE, + CF_RTF, CF_RTF, OLEUIPASTE_PASTE); + SetPasteEntry(PasteFormats[3], CFRtfNoObjs, TYMED_ISTORAGE, + CF_RTFNOOBJS, CF_RTFNOOBJS, OLEUIPASTE_PASTE); + SetPasteEntry(PasteFormats[4], CF_TEXT, TYMED_HGLOBAL, + 'Unformatted text', 'text without any formatting', OLEUIPASTE_PASTE); + SetPasteEntry(PasteFormats[5], CF_BITMAP, TYMED_GDI, + 'Windows Bitmap', 'bitmap image', OLEUIPASTE_PASTE); + try + if OleUIPasteSpecial(Data) = OLEUI_OK then begin + Result := True; + if Data.nSelectedIndex in [0, 1] then begin + { CFEmbeddedObject, CFLinkSource } + FillChar(ReObject, SizeOf(TReObject), 0); + IRichEditOle(FRichEditOle).GetClientSite(OleClientSite); + Storage := nil; + try + CreateStorage(Storage); + case Data.nSelectedIndex of + 0: OleCheck(OleCreateFromData(Data.lpSrcDataObj, IOleObject, + OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject)); + 1: OleCheck(OleCreateLinkFromData(Data.lpSrcDataObj, IOleObject, + OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject)); + end; + try + with ReObject do begin + cbStruct := SizeOf(TReObject); + cp := REO_CP_SELECTION; + poleobj := OleObject; + OleObject.GetUserClassID(clsid); + pstg := Storage; + polesite := OleClientSite; + dvAspect := DVASPECT_CONTENT; + dwFlags := REO_RESIZABLE; + OleCheck(OleSetDrawAspect(OleObject, + Data.dwFlags and PSF_CHECKDISPLAYASICON <> 0, + Data.hMetaPict, dvAspect)); + end; + SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection)); + Selection.cpMax := Selection.cpMin + 1; + OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject)); + SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection)); + IRichEditOle(FRichEditOle).SetDvaspect( + Longint(REO_IOB_SELECTION), ReObject.dvAspect); + finally + ReleaseObject(OleObject); + end; + finally + ReleaseObject(OleClientSite); + ReleaseObject(Storage); + end; + end + else begin + Format := PasteFormats[Data.nSelectedIndex].fmtetc.cfFormat; + OleCheck(IRichEditOle(FRichEditOle).ImportDataObject( + Data.lpSrcDataObj, Format, Data.hMetaPict)); + end; + SendMessage(Handle, EM_SCROLLCARET, 0, 0); + end; + finally + DestroyMetaPict(Data.hMetaPict); + ReleaseObject(Data.lpSrcDataObj); + end; +end; + +function TRxCustomRichEdit.InsertObjectDialog: Boolean; +var + Data: TOleUIInsertObject; + NameBuffer: array[0..255] of Char; + OleClientSite: IOleClientSite; + Storage: IStorage; + OleObject: IOleObject; + ReObject: TReObject; + IsNewObject: Boolean; + Selection: TCharRange; +begin + FillChar(Data, SizeOf(Data), 0); + FillChar(NameBuffer, SizeOf(NameBuffer), 0); + FillChar(ReObject, SizeOf(TReObject), 0); + if Assigned(FRichEditOle) then begin + IRichEditOle(FRichEditOle).GetClientSite(OleClientSite); + Storage := nil; + try + CreateStorage(Storage); + with Data do begin + cbStruct := SizeOf(Data); + dwFlags := IOF_SELECTCREATENEW or IOF_VERIFYSERVERSEXIST or + IOF_CREATENEWOBJECT or IOF_CREATEFILEOBJECT or IOF_CREATELINKOBJECT; + hWndOwner := Handle; + lpszFile := NameBuffer; + cchFile := SizeOf(NameBuffer); + iid := IOleObject; + oleRender := OLERENDER_DRAW; + lpIOleClientSite := OleClientSite; + lpIStorage := Storage; + ppvObj := @OleObject; + end; + try + Result := OleUIInsertObject(Data) = OLEUI_OK; + if Result then + try + IsNewObject := Data.dwFlags and IOF_SELECTCREATENEW = IOF_SELECTCREATENEW; + with ReObject do begin + cbStruct := SizeOf(TReObject); + cp := REO_CP_SELECTION; + clsid := Data.clsid; + poleobj := OleObject; + pstg := Storage; + polesite := OleClientSite; + dvAspect := DVASPECT_CONTENT; + dwFlags := REO_RESIZABLE; + if IsNewObject then dwFlags := dwFlags or REO_BLANK; + OleCheck(OleSetDrawAspect(OleObject, + Data.dwFlags and IOF_CHECKDISPLAYASICON <> 0, + Data.hMetaPict, dvAspect)); + end; + SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection)); + Selection.cpMax := Selection.cpMin + 1; + OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject)); + SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection)); + SendMessage(Handle, EM_SCROLLCARET, 0, 0); + IRichEditOle(FRichEditOle).SetDvaspect( + Longint(REO_IOB_SELECTION), ReObject.dvAspect); + if IsNewObject then OleObject.DoVerb(OLEIVERB_SHOW, nil, + OleClientSite, 0, Handle, ClientRect); + finally + ReleaseObject(OleObject); + end; + finally + DestroyMetaPict(Data.hMetaPict); + end; + finally + ReleaseObject(OleClientSite); + ReleaseObject(Storage); + end; + end + else Result := False; +end; + +function TRxCustomRichEdit.ObjectPropertiesDialog: Boolean; +var + ObjectProps: TOleUIObjectProps; + PropSheet: TPropSheetHeader; + GeneralProps: TOleUIGnrlProps; + ViewProps: TOleUIViewProps; + LinkProps: TOleUILinkProps; + DialogCaption: string; + ReObject: TReObject; +begin + Result := False; + if not Assigned(FRichEditOle) or (SelectionType <> [stObject]) then Exit; + FillChar(ObjectProps, SizeOf(ObjectProps), 0); + FillChar(PropSheet, SizeOf(PropSheet), 0); + FillChar(GeneralProps, SizeOf(GeneralProps), 0); + FillChar(ViewProps, SizeOf(ViewProps), 0); + FillChar(LinkProps, SizeOf(LinkProps), 0); + FillChar(ReObject, SizeOf(ReObject), 0); + ReObject.cbStruct := SizeOf(ReObject); + if Succeeded(IRichEditOle(FRichEditOle).GetObject(Longint(REO_IOB_SELECTION), + ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)) then + if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then begin + ObjectProps.cbStruct := SizeOf(ObjectProps); + ObjectProps.dwFlags := OPF_DISABLECONVERT; + ObjectProps.lpPS := @PropSheet; + ObjectProps.lpObjInfo := TOleUIObjInfo.Create(Self, ReObject); + if (ReObject.dwFlags and REO_LINK) <> 0 then begin + ObjectProps.dwFlags := ObjectProps.dwFlags or OPF_OBJECTISLINK; + ObjectProps.lpLinkInfo := TOleUILinkInfo.Create(Self, ReObject); + end; + ObjectProps.lpGP := @GeneralProps; + ObjectProps.lpVP := @ViewProps; + ObjectProps.lpLP := @LinkProps; + PropSheet.dwSize := SizeOf(PropSheet); + PropSheet.hWndParent := Handle; + PropSheet.hInstance := MainInstance; + DialogCaption := Format(ResStr(SPropDlgCaption), + [GetFullNameStr(ReObject.poleobj)]); + PropSheet.pszCaption := PChar(DialogCaption); + GeneralProps.cbStruct := SizeOf(GeneralProps); + ViewProps.cbStruct := SizeOf(ViewProps); + ViewProps.dwFlags := VPF_DISABLESCALE; + LinkProps.cbStruct := SizeOf(LinkProps); + LinkProps.dwFlags := ELF_DISABLECANCELLINK; + Result := OleUIObjectProperties(ObjectProps) = OLEUI_OK; + end; +end; + +procedure TRxCustomRichEdit.Print(const Caption: string); +var + Range: TFormatRange; + LastChar, MaxLen, LogX, LogY, OldMap: Integer; + SaveRect: TRect; + TextLenEx: TGetTextLengthEx; +begin + FillChar(Range, SizeOf(TFormatRange), 0); + with Printer, Range do begin + Title := Caption; + BeginDoc; + hdc := Handle; + hdcTarget := hdc; + LogX := GetDeviceCaps(Handle, LOGPIXELSX); + LogY := GetDeviceCaps(Handle, LOGPIXELSY); + if IsRectEmpty(PageRect) then begin + rc.right := PageWidth * 1440 div LogX; + rc.bottom := PageHeight * 1440 div LogY; + end + else begin + rc.left := PageRect.Left * 1440 div LogX; + rc.top := PageRect.Top * 1440 div LogY; + rc.right := PageRect.Right * 1440 div LogX; + rc.bottom := PageRect.Bottom * 1440 div LogY; + end; + rcPage := rc; + SaveRect := rc; + LastChar := 0; + if RichEditVersion >= 2 then begin + with TextLenEx do begin + flags := GTL_DEFAULT; + codepage := CP_ACP; + end; + MaxLen := Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0); + end + else MaxLen := GetTextLen; + chrg.cpMax := -1; + { ensure printer DC is in text map mode } + OldMap := SetMapMode(hdc, MM_TEXT); + SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); { flush buffer } + try + repeat + rc := SaveRect; + chrg.cpMin := LastChar; + LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range)); + if (LastChar < MaxLen) and (LastChar <> -1) then NewPage; + until (LastChar >= MaxLen) or (LastChar = -1); + EndDoc; + finally + SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); { flush buffer } + SetMapMode(hdc, OldMap); { restore previous map mode } + end; + end; +end; + +var + Painting: Boolean = False; + +procedure TRxCustomRichEdit.WMPaint(var Message: TWMPaint); +var + R, R1: TRect; +begin + if RichEditVersion >= 2 then + inherited + else begin + if GetUpdateRect(Handle, R, True) then + begin + with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom); + if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True); + end; + if Painting then + Invalidate + else begin + Painting := True; + try + inherited; + finally + Painting := False; + end; + end; + end; +end; + +procedure TRxCustomRichEdit.WMDestroy(var Msg: TWMDestroy); +begin + CloseObjects; + ReleaseObject(FRichEditOle); + inherited; +end; + +procedure TRxCustomRichEdit.WMMouseMove(var Message: TMessage); +begin + inherited; +end; + +procedure TRxCustomRichEdit.WMSetCursor(var Message: TWMSetCursor); +begin + inherited; +end; + +{$IFDEF Delphi5} +procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage); +begin + { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, } + { so we get no WM_CONTEXTMENU message. Simulate message here. } +// if Win32MajorVersion < 5 then + Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint( + ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos))))); + inherited; +end; +{$ENDIF} + +procedure TRxCustomRichEdit.CNNotify(var Message: TWMNotify); +var + AMsg: TMessage; +begin + with Message do + case NMHdr^.code of + EN_SELCHANGE: SelectionChange; + EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc); + EN_SAVECLIPBOARD: + with PENSaveClipboard(NMHdr)^ do + if not SaveClipboard(cObjectCount, cch) then Result := 1; + EN_PROTECTED: + with PENProtected(NMHdr)^ do begin + AMsg.Msg := Msg; + AMsg.WParam := WParam; + AMsg.LParam := LParam; + AMsg.Result := 0; + if not ProtectChange(AMsg, chrg.cpMin, chrg.cpMax) then + Result := 1; + end; + EN_LINK: + with PENLink(NMHdr)^ do begin + case Msg of + WM_RBUTTONDOWN: + begin + FClickRange := chrg; + FClickBtn := mbRight; + end; + WM_RBUTTONUP: + begin + if (FClickBtn = mbRight) and (FClickRange.cpMin = chrg.cpMin) and + (FClickRange.cpMax = chrg.cpMax) then + URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbRight); + with FClickRange do begin + cpMin := -1; + cpMax := -1; + end; + end; + WM_LBUTTONDOWN: + begin + FClickRange := chrg; + FClickBtn := mbLeft; + end; + WM_LBUTTONUP: + begin + if (FClickBtn = mbLeft) and (FClickRange.cpMin = chrg.cpMin) and + (FClickRange.cpMax = chrg.cpMax) then + URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbLeft); + with FClickRange do begin + cpMin := -1; + cpMax := -1; + end; + end; + end; + end; + EN_STOPNOUNDO: + begin + { cannot allocate enough memory to maintain the undo state } + end; + end; +end; + +function TRxCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean; +begin + Result := True; + if Assigned(OnSaveClipboard) then + OnSaveClipboard(Self, NumObj, NumChars, Result); +end; + +function TRxCustomRichEdit.ProtectChange(const Message: TMessage; StartPos, + EndPos: Integer): Boolean; +begin + Result := False; + if Assigned(OnProtectChangeEx) then + OnProtectChangeEx(Self, Message, StartPos, EndPos, Result) + else if Assigned(OnProtectChange) then + OnProtectChange(Self, StartPos, EndPos, Result); +end; + +procedure TRxCustomRichEdit.SelectionChange; +begin + if Assigned(OnSelectionChange) then OnSelectionChange(Self); +end; + +procedure TRxCustomRichEdit.RequestSize(const Rect: TRect); +begin + if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect); +end; + +procedure TRxCustomRichEdit.URLClick(const URLText: string; Button: TMouseButton); +begin + if Assigned(OnURLClick) then OnURLClick(Self, URLText, Button); +end; + +function TRxCustomRichEdit.FindText(const SearchStr: string; + StartPos, Length: Integer; Options: TRichSearchTypes): Integer; +var + Find: TFindTextEx; + Flags: Integer; +begin + with Find.chrg do begin + cpMin := StartPos; + cpMax := cpMin + Abs(Length); + end; + if RichEditVersion >= 2 then begin + if not (stBackward in Options) then Flags := FT_DOWN + else Flags := 0; + end + else begin + Options := Options - [stBackward]; + Flags := 0; + end; + if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD; + if stMatchCase in Options then Flags := Flags or FT_MATCHCASE; + Find.lpstrText := PChar(SearchStr); + Result := SendMessage(Handle, EM_FINDTEXTEX, Flags, Longint(@Find)); + if (Result >= 0) and (stSetSelection in Options) then begin + SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Find.chrgText)); + SendMessage(Handle, EM_SCROLLCARET, 0, 0); + end; +end; + +procedure TRxCustomRichEdit.ClearUndo; +begin + SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0); +end; + +procedure TRxCustomRichEdit.Redo; +begin + SendMessage(Handle, EM_REDO, 0, 0); +end; + +procedure TRxCustomRichEdit.StopGroupTyping; +begin + if (RichEditVersion >= 2) and HandleAllocated then + SendMessage(Handle, EM_STOPGROUPTYPING, 0, 0); +end; + +procedure TRxCustomRichEdit.SetUIActive(Active: Boolean); +var + Form: TCustomForm; +begin + try + Form := GetParentForm(Self); + if Form <> nil then + if Active then begin + if (Form.ActiveOleControl <> nil) and + (Form.ActiveOleControl <> Self) then + Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0); + Form.ActiveOleControl := Self; + if AllowInPlace and CanFocus then SetFocus; + end + else begin + if Form.ActiveOleControl = Self then Form.ActiveOleControl := nil; + if (Form.ActiveControl = Self) and AllowInPlace then begin + Windows.SetFocus(Handle); + SelectionChange; + end; + end; + except + Application.HandleException(Self); + end; +end; + +procedure TRxCustomRichEdit.CMDocWindowActivate(var Message: TMessage); +begin + if Assigned(FCallback) then + with TRichEditOleCallback(FCallback) do + if Assigned(FDocForm) and IsFormMDIChild(FDocForm.Form) then begin + if Message.WParam = 0 then begin + FFrameForm.SetMenu(0, 0, 0); + FFrameForm.ClearBorderSpace; + end; + end; +end; + +procedure TRxCustomRichEdit.CMUIDeactivate(var Message: TMessage); +begin + if (GetParentForm(Self) <> nil) and Assigned(FRichEditOle) and + (GetParentForm(Self).ActiveOleControl = Self) then + {IRichEditOle(FRichEditOle).InPlaceDeactivate}; +end; + +{ Find & Replace Dialogs } + +procedure TRxCustomRichEdit.SetupFindDialog(Dialog: TFindDialog; + const SearchStr, ReplaceStr: string); +begin + with Dialog do begin + if SearchStr <> '' then FindText := SearchStr; + if RichEditVersion = 1 then + Options := Options + [frHideUpDown, frDown]; + OnFind := FindDialogFind; + OnClose := FindDialogClose; + end; + if Dialog is TReplaceDialog then + with TReplaceDialog(Dialog) do begin + if ReplaceStr <> '' then ReplaceText := ReplaceStr; + OnReplace := ReplaceDialogReplace; + end; +end; + +function TRxCustomRichEdit.FindDialog(const SearchStr: string): TFindDialog; +begin + if FFindDialog = nil then begin + FFindDialog := TFindDialog.Create(Self); + if FReplaceDialog <> nil then + FFindDialog.FindText := FReplaceDialog.FindText; + end; + Result := FFindDialog; + SetupFindDialog(FFindDialog, SearchStr, ''); + FFindDialog.Execute; +end; + +function TRxCustomRichEdit.ReplaceDialog(const SearchStr, + ReplaceStr: string): TReplaceDialog; +begin + if FReplaceDialog = nil then begin + FReplaceDialog := TReplaceDialog.Create(Self); + if FFindDialog <> nil then + FReplaceDialog.FindText := FFindDialog.FindText; + end; + Result := FReplaceDialog; + SetupFindDialog(FReplaceDialog, SearchStr, ReplaceStr); + FReplaceDialog.Execute; +end; + +function TRxCustomRichEdit.GetCanFindNext: Boolean; +begin + Result := HandleAllocated and (FLastFind <> nil) and + (FLastFind.FindText <> ''); +end; + +function TRxCustomRichEdit.FindNext: Boolean; +begin + if CanFindNext then Result := FindEditText(FLastFind, False, True) + else Result := False; +end; + +procedure TRxCustomRichEdit.AdjustFindDialogPosition(Dialog: TFindDialog); +var + TextRect, R: TRect; +begin + if Dialog.Handle = 0 then Exit; + with TextRect do begin + TopLeft := ClientToScreen(GetCharPos(SelStart)); + BottomRight := ClientToScreen(GetCharPos(SelStart + SelLength)); + Inc(Bottom, 20); + end; + with Dialog do begin + GetWindowRect(Handle, R); + if PtInRect(R, TextRect.TopLeft) or PtInRect(R, TextRect.BottomRight) then + begin + if TextRect.Top > R.Bottom - R.Top + 20 then + OffsetRect(R, 0, TextRect.Top - R.Bottom - 20) + else begin + if TextRect.Top + R.Bottom - R.Top < GetSystemMetrics(SM_CYSCREEN) then + OffsetRect(R, 0, 40 + TextRect.Top - R.Top); + end; + Position := R.TopLeft; + end; + end; +end; + +function TRxCustomRichEdit.FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean; +var + Length, StartPos: Integer; + SrchOptions: TRichSearchTypes; + + function Max(A, B: Longint): Longint; + begin + if A > B then Result := A + else Result := B; + end; + + function Min(A, B: Longint): Longint; + begin + if A < B then Result := A + else Result := B; + end; + +begin + with TFindDialog(Dialog) do begin + SrchOptions := [stSetSelection]; + if frDown in Options then begin + StartPos := Max(SelStart, SelStart + SelLength); + Length := System.Length(Text) - StartPos + 1; + end + else begin + SrchOptions := SrchOptions + [stBackward]; + StartPos := Min(SelStart, SelStart + SelLength); + Length := StartPos + 1; + end; + if frMatchCase in Options then + SrchOptions := SrchOptions + [stMatchCase]; + if frWholeWord in Options then + SrchOptions := SrchOptions + [stWholeWord]; + Result := Self.FindText(FindText, StartPos, Length, SrchOptions) >= 0; + if FindText <> '' then FLastFind := Dialog; + if Result then begin + if AdjustPos then AdjustFindDialogPosition(Dialog); + end + else if Events then TextNotFound(Dialog); + end; +end; + +procedure TRxCustomRichEdit.TextNotFound(Dialog: TFindDialog); +begin + with Dialog do + if Assigned(FOnTextNotFound) then FOnTextNotFound(Self, FindText); +end; + +procedure TRxCustomRichEdit.FindDialogFind(Sender: TObject); +begin + FindEditText(TFindDialog(Sender), True, True); +end; + +procedure TRxCustomRichEdit.ReplaceDialogReplace(Sender: TObject); +var + Cnt: Integer; + SaveSelChange: TNotifyEvent; +begin + with TReplaceDialog(Sender) do begin + if (frReplaceAll in Options) then begin + Cnt := 0; + SaveSelChange := FOnSelChange; + TRichEditStrings(Lines).EnableChange(False); + try + FOnSelChange := nil; + while FindEditText(TFindDialog(Sender), False, False) do begin + SelText := ReplaceText; + Inc(Cnt); + end; + if Cnt = 0 then TextNotFound(TFindDialog(Sender)) + else AdjustFindDialogPosition(TFindDialog(Sender)); + finally + TRichEditStrings(Lines).EnableChange(True); + FOnSelChange := SaveSelChange; + if Cnt > 0 then begin + Change; + SelectionChange; + end; + end; + end + else if (frReplace in Options) then begin + if FindEditText(TFindDialog(Sender), True, True) then + SelText := ReplaceText; + end; + end; +end; + +procedure TRxCustomRichEdit.FindDialogClose(Sender: TObject); +begin + CloseFindDialog(Sender as TFindDialog); +end; + +procedure TRxCustomRichEdit.CloseFindDialog(Dialog: TFindDialog); +begin + if Assigned(FOnCloseFindDialog) then FOnCloseFindDialog(Self, Dialog); +end; + +{ Conversion formats } + +procedure AppendConversionFormat(const Ext: string; Plain: Boolean; + AClass: TConversionClass); +var + NewRec: PRichConversionFormat; +begin + New(NewRec); + with NewRec^ do begin + Extension := AnsiLowerCaseFileName(Ext); + PlainText := Plain; + ConversionClass := AClass; + Next := ConversionFormatList; + end; + ConversionFormatList := NewRec; +end; + +class procedure TRxCustomRichEdit.RegisterConversionFormat(const AExtension: string; + APlainText: Boolean; AConversionClass: TConversionClass); +begin + AppendConversionFormat(AExtension, APlainText, AConversionClass); +end; + +{ Initialization part } + +var + OldError: Longint; + FLibHandle: THandle; + Ver: TOsVersionInfo; + +initialization + RichEditVersion := 1; + OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX); + try + FLibHandle := LoadLibrary(RichEdit20ModuleName); + if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0; + if FLibHandle = 0 then begin + FLibHandle := LoadLibrary(RichEdit10ModuleName); + if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0; + end + else begin + RichEditVersion := 2; + Ver.dwOSVersionInfoSize := SizeOf(Ver); + GetVersionEx(Ver); + with Ver do begin + if (dwPlatformId = VER_PLATFORM_WIN32_NT) and + (dwMajorVersion >= 5) then + RichEditVersion := 3; + end; + end; + finally + SetErrorMode(OldError); + end; + CFEmbeddedObject := RegisterClipboardFormat(CF_EMBEDDEDOBJECT); + CFLinkSource := RegisterClipboardFormat(CF_LINKSOURCE); + CFRtf := RegisterClipboardFormat(CF_RTF); + CFRtfNoObjs := RegisterClipboardFormat(CF_RTFNOOBJS); +finalization + if FLibHandle <> 0 then FreeLibrary(FLibHandle); +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRichEditor.dfm b/official/4.2/Source/frxRichEditor.dfm new file mode 100644 index 0000000..85dc971 Binary files /dev/null and b/official/4.2/Source/frxRichEditor.dfm differ diff --git a/official/4.2/Source/frxRichEditor.pas b/official/4.2/Source/frxRichEditor.pas new file mode 100644 index 0000000..6fe0a50 --- /dev/null +++ b/official/4.2/Source/frxRichEditor.pas @@ -0,0 +1,487 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ RichEdit design editor } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRichEditor; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Menus, ExtCtrls, Buttons, frxClass, frxRich, frxCustomEditors, + frxCtrls, frxRichEdit, ImgList, frxDock, ToolWin, ComCtrls +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxRichEditor = class(TfrxViewEditor) + public + function Edit: Boolean; override; + function HasEditor: Boolean; override; + procedure GetMenuItems; override; + function Execute(Tag: Integer; Checked: Boolean): Boolean; override; + end; + + TfrxRichEditorForm = class(TForm) + OpenDialog: TOpenDialog; + SaveDialog: TSaveDialog; + SpeedBar: TToolBar; + Ruler: TPanel; + FontDialog1: TFontDialog; + FirstInd: TLabel; + LeftInd: TLabel; + RulerLine: TBevel; + RightInd: TLabel; + BoldB: TToolButton; + ItalicB: TToolButton; + LeftAlignB: TToolButton; + CenterAlignB: TToolButton; + RightAlignB: TToolButton; + UnderlineB: TToolButton; + BulletsB: TToolButton; + TTB: TToolButton; + CancelB: TToolButton; + OkB: TToolButton; + ExprB: TToolButton; + FontNameCB: TfrxFontComboBox; + FontSizeCB: TfrxComboBox; + OpenB: TToolButton; + SaveB: TToolButton; + UndoB: TToolButton; + Sep1: TToolButton; + Sep2: TToolButton; + Sep3: TfrxTBPanel; + Sep4: TToolButton; + Sep5: TToolButton; + BlockAlignB: TToolButton; + + procedure SelectionChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FileOpen(Sender: TObject); + procedure FileSaveAs(Sender: TObject); + procedure EditUndo(Sender: TObject); + procedure SelectFont(Sender: TObject); + procedure RulerResize(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure BoldBClick(Sender: TObject); + procedure AlignButtonClick(Sender: TObject); + procedure FontNameCBChange(Sender: TObject); + procedure BulletsBClick(Sender: TObject); + procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure CancelBClick(Sender: TObject); + procedure OkBClick(Sender: TObject); + procedure ExprBClick(Sender: TObject); + procedure FontSizeCBChange(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + { Private declarations } + FDragging: Boolean; + FDragOfs: Integer; + FRichView: TfrxRichView; + FUpdating: Boolean; + RichEdit1: TrxRichEdit; + function CurrText: TrxTextAttributes; + procedure SetupRuler; + procedure SetEditRect; + public + { Public declarations } + property RichView: TfrxRichView read FRichView write FRichView; + end; + + +implementation + +{$R *.DFM} + +uses frxDsgnIntf, frxRes; + + +const + RulerAdj = 4/3; + GutterWid = 6; + + +{ TfrxRichEditor } + +function TfrxRichEditor.HasEditor: Boolean; +begin + Result := True; +end; + +function TfrxRichEditor.Edit: Boolean; +begin + with TfrxRichEditorForm.Create(Designer) do + begin + RichView := TfrxRichView(Component); + Result := ShowModal = mrOk; + Free; + end; +end; + +function TfrxRichEditor.Execute(Tag: Integer; Checked: Boolean): Boolean; +var + i: Integer; + c: TfrxComponent; + v: TfrxRichView; +begin + Result := inherited Execute(Tag, Checked); + + for i := 0 to Designer.SelectedObjects.Count - 1 do + begin + c := Designer.SelectedObjects[i]; + if (c is TfrxRichView) and not (rfDontModify in c.Restrictions) then + begin + v := TfrxRichView(c); + case Tag of + 1: v.AllowExpressions := Checked; + 2: if Checked then + v.StretchMode := smActualHeight else + v.StretchMode := smDontStretch; + 3: if Checked then + v.StretchMode := smMaxHeight else + v.StretchMode := smDontStretch; + end; + + Result := True; + end; + end; +end; + +procedure TfrxRichEditor.GetMenuItems; +var + v: TfrxRichView; +begin + v := TfrxRichView(Component); + + AddItem(frxResources.Get('mvExpr'), 1, v.AllowExpressions); + AddItem('-', -1); + AddItem(frxResources.Get('mvStretch'), 2, v.StretchMode = smActualHeight); + AddItem(frxResources.Get('mvStretchToMax'), 3, v.StretchMode = smMaxHeight); + + inherited; +end; + + +{ TfrxRichEditorForm } + +procedure TfrxRichEditorForm.SelectionChange(Sender: TObject); +begin + with RichEdit1.Paragraph do + try + FUpdating := True; + FirstInd.Left := Trunc(FirstIndent * RulerAdj) - 4 + GutterWid; + LeftInd.Left := Trunc((LeftIndent + FirstIndent) * RulerAdj) - 4 + GutterWid; + RightInd.Left := Ruler.ClientWidth - 6 - Trunc((RightIndent + GutterWid) * RulerAdj); + BoldB.Down := fsBold in RichEdit1.SelAttributes.Style; + ItalicB.Down := fsItalic in RichEdit1.SelAttributes.Style; + UnderlineB.Down := fsUnderline in RichEdit1.SelAttributes.Style; + BulletsB.Down := Boolean(Numbering); + FontSizeCB.Text := IntToStr(RichEdit1.SelAttributes.Size); + FontNameCB.Text := RichEdit1.SelAttributes.Name; + case Alignment of + paLeftJustify: LeftAlignB.Down := True; + paCenter: CenterAlignB.Down := True; + paRightJustify: RightAlignB.Down := True; + paJustify: BlockAlignB.Down := True; + end; + finally + FUpdating := False; + end; +end; + +function TfrxRichEditorForm.CurrText: TrxTextAttributes; +begin + if RichEdit1.SelLength > 0 then + Result := RichEdit1.SelAttributes else + Result := RichEdit1.DefAttributes; +end; + +procedure TfrxRichEditorForm.SetupRuler; +var + I: Integer; + S: String; +begin + SetLength(S, 201); + I := 1; + while I < 200 do + begin + S[I] := #9; + S[I+1] := '|'; + Inc(I, 2); + end; + Ruler.Caption := S; +end; + +procedure TfrxRichEditorForm.SetEditRect; +var + R: TRect; +begin + with RichEdit1 do + begin + R := Rect(GutterWid, 0, ClientWidth - GutterWid, ClientHeight); + SendMessage(Handle, EM_SETRECT, 0, Longint(@R)); + end; +end; + +{ Event Handlers } + +procedure TfrxRichEditorForm.FormResize(Sender: TObject); +begin + SetEditRect; + SelectionChange(Sender); +end; + +procedure TfrxRichEditorForm.FormPaint(Sender: TObject); +begin + SetEditRect; +end; + +procedure TfrxRichEditorForm.FileOpen(Sender: TObject); +begin + OpenDialog.Filter := frxResources.Get('ftRichFile') + ' (*.rtf)|*.rtf'; + if OpenDialog.Execute then + begin + RichEdit1.Lines.LoadFromFile(OpenDialog.FileName); + RichEdit1.SetFocus; + SelectionChange(Self); + end; +end; + +procedure TfrxRichEditorForm.FileSaveAs(Sender: TObject); +begin + SaveDialog.Filter := frxResources.Get('ftRichFile') + ' (*.rtf)|*.rtf|' + + frxResources.Get('ftTextFile') + ' (*.txt)|*.txt'; + if SaveDialog.Execute then + RichEdit1.Lines.SaveToFile(ChangeFileExt(SaveDialog.FileName, '.rtf')); +end; + +procedure TfrxRichEditorForm.EditUndo(Sender: TObject); +begin + with RichEdit1 do + if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0); +end; + +procedure TfrxRichEditorForm.SelectFont(Sender: TObject); +begin + FontDialog1.Font.Assign(RichEdit1.SelAttributes); + if FontDialog1.Execute then + CurrText.Assign(FontDialog1.Font); + RichEdit1.SetFocus; +end; + +procedure TfrxRichEditorForm.RulerResize(Sender: TObject); +begin + RulerLine.Width := Ruler.ClientWidth - RulerLine.Left * 2; +end; + +procedure TfrxRichEditorForm.BoldBClick(Sender: TObject); +var + s: TFontStyles; +begin + if FUpdating then Exit; + s := []; + if BoldB.Down then s := s + [fsBold]; + if ItalicB.Down then s := s + [fsItalic]; + if UnderlineB.Down then s := s + [fsUnderline]; + CurrText.Style := s; +end; + +procedure TfrxRichEditorForm.AlignButtonClick(Sender: TObject); +begin + if FUpdating then Exit; + case TControl(Sender).Tag of + 0: RichEdit1.Paragraph.Alignment := paLeftJustify; + 1: RichEdit1.Paragraph.Alignment := paCenter; + 2: RichEdit1.Paragraph.Alignment := paRightJustify; + 3: RichEdit1.Paragraph.Alignment := paJustify; + end; +end; + +procedure TfrxRichEditorForm.FontNameCBChange(Sender: TObject); +begin + if FUpdating then Exit; + CurrText.Name := FontNameCB.Text; + RichEdit1.SetFocus; +end; + +procedure TfrxRichEditorForm.BulletsBClick(Sender: TObject); +begin + if FUpdating then Exit; + RichEdit1.Paragraph.Numbering := TrxNumbering(BulletsB.Down); +end; + +{ Ruler Indent Dragging } + +procedure TfrxRichEditorForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FDragOfs := (TLabel(Sender).Width div 2); + TLabel(Sender).Left := TLabel(Sender).Left + X - FDragOfs; + FDragging := True; +end; + +procedure TfrxRichEditorForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +begin + if FDragging then + TLabel(Sender).Left := TLabel(Sender).Left + X - FDragOfs +end; + +procedure TfrxRichEditorForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FDragging := False; + RichEdit1.Paragraph.FirstIndent := + Trunc((FirstInd.Left + FDragOfs - GutterWid) / RulerAdj); + LeftIndMouseUp(Sender, Button, Shift, X, Y); +end; + +procedure TfrxRichEditorForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FDragging := False; + RichEdit1.Paragraph.LeftIndent := + Trunc((LeftInd.Left + FDragOfs - GutterWid) / RulerAdj) - RichEdit1.Paragraph.FirstIndent; + SelectionChange(Sender); +end; + +procedure TfrxRichEditorForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FDragging := False; + RichEdit1.Paragraph.RightIndent := + Trunc((Ruler.ClientWidth - RightInd.Left + FDragOfs - 2) / RulerAdj) - 2 * GutterWid; + SelectionChange(Sender); +end; + +procedure TfrxRichEditorForm.CancelBClick(Sender: TObject); +begin + ModalResult := mrCancel; +end; + +procedure TfrxRichEditorForm.OkBClick(Sender: TObject); +begin + ModalResult := mrOk; +end; + +procedure TfrxRichEditorForm.ExprBClick(Sender: TObject); +var + s, s1, s2: String; + + function BracketCount: Integer; + var + i: Integer; + begin + Result := 0; + for i := 1 to Length(s) do + if s[i] = '<' then + Inc(Result); + end; + +begin + s := TfrxCustomDesigner(Owner).InsertExpression(''); + if s <> '' then + begin + s1 := RichView.ExpressionDelimiters; + s2 := Copy(s1, Pos(',', s1) + 1, 255); + s1 := Copy(s1, 1, Pos(',', s1) - 1); + if (s[1] = '<') and (s[Length(s)] = '>') and (BracketCount = 1) then + s := Copy(s, 2, Length(s) - 2); + RichEdit1.SelText := s1 + s + s2; + end; +end; + +procedure TfrxRichEditorForm.FontSizeCBChange(Sender: TObject); +begin + CurrText.Size := StrToInt(FontSizeCB.Text); + RichEdit1.SetFocus; +end; + +procedure TfrxRichEditorForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(4200); + OpenB.Hint := frxGet(4201); + SaveB.Hint := frxGet(4202); + UndoB.Hint := frxGet(4203); + TTB.Hint := frxGet(4204); + ExprB.Hint := frxGet(4205); + CancelB.Hint := frxGet(2); + OkB.Hint := frxGet(1); + BoldB.Hint := frxGet(4206); + ItalicB.Hint := frxGet(4207); + UnderlineB.Hint := frxGet(4208); + LeftAlignB.Hint := frxGet(4209); + CenterAlignB.Hint := frxGet(4210); + RightAlignB.Hint := frxGet(4211); + BlockAlignB.Hint := frxGet(4212); + BulletsB.Hint := frxGet(4213); + + RichEdit1 := TrxRichEdit.Create(Self); + RichEdit1.Parent := Self; + RichEdit1.Align := alClient; + RichEdit1.OnSelectionChange := SelectionChange; + + SpeedBar.Images := frxResources.MainButtonImages; + Icon := TForm(Owner).Icon; + OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)); + SaveDialog.InitialDir := OpenDialog.InitialDir; + SetupRuler; + SelectionChange(Self); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxRichEditorForm.FormShow(Sender: TObject); +begin + frxAssignRich(RichView.RichEdit, RichEdit1); + RichEdit1.SetFocus; +end; + +procedure TfrxRichEditorForm.FormHide(Sender: TObject); +begin + if ModalResult = mrOk then + frxAssignRich(RichEdit1, RichView.RichEdit); +end; + + +procedure TfrxRichEditorForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +initialization + frxComponentEditors.Register(TfrxRichView, TfrxRichEditor); + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxRichRTTI.pas b/official/4.2/Source/frxRichRTTI.pas new file mode 100644 index 0000000..e6d82a2 --- /dev/null +++ b/official/4.2/Source/frxRichRTTI.pas @@ -0,0 +1,71 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Rich RTTI } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxRichRTTI; + +interface + +{$I frx.inc} + +implementation + +uses + Windows, Classes, SysUtils, Forms, fs_iinterpreter, fs_iformsrtti, frxRich, + frxRichEdit, frxClassRTTI +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TFunctions = class(TfsRTTIModule) + private + 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 + AddClass(TrxRichEdit, 'TWinControl'); + with AddClass(TfrxRichView, 'TfrxView') do + AddProperty('RichEdit', 'TrxRichEdit', GetProp, nil); + end; +end; + +function TFunctions.GetProp(Instance: TObject; ClassType: TClass; + const PropName: String): Variant; +begin + Result := 0; + + if ClassType = TfrxRichView then + begin + if PropName = 'RICHEDIT' then + Result := Integer(TfrxRichView(Instance).RichEdit) + end +end; + + +initialization + fsRTTIModules.Add(TFunctions); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxSearchDialog.dfm b/official/4.2/Source/frxSearchDialog.dfm new file mode 100644 index 0000000..67c8984 Binary files /dev/null and b/official/4.2/Source/frxSearchDialog.dfm differ diff --git a/official/4.2/Source/frxSearchDialog.pas b/official/4.2/Source/frxSearchDialog.pas new file mode 100644 index 0000000..b0d9bf0 --- /dev/null +++ b/official/4.2/Source/frxSearchDialog.pas @@ -0,0 +1,95 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Search dialog } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxSearchDialog; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls; + +type + TfrxSearchDialog = class(TForm) + ReplacePanel: TPanel; + ReplaceL: TLabel; + ReplaceE: TEdit; + Panel2: TPanel; + TextL: TLabel; + TextE: TEdit; + Panel3: TPanel; + OkB: TButton; + CancelB: TButton; + SearchL: TGroupBox; + CaseCB: TCheckBox; + TopCB: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure FormHide(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + public + end; + + +implementation + +uses frxRes; + +{$R *.DFM} + +var + LastText: String; + +procedure TfrxSearchDialog.FormCreate(Sender: TObject); +begin + Caption := frxGet(300); + TextL.Caption := frxGet(301); + SearchL.Caption := frxGet(302); + ReplaceL.Caption := frxGet(303); + TopCB.Caption := frxGet(304); + CaseCB.Caption := frxGet(305); + OkB.Caption := frxGet(1); + CancelB.Caption := frxGet(2); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxSearchDialog.FormShow(Sender: TObject); +begin + TextE.Text := LastText; + TextE.SetFocus; + TextE.SelectAll; +end; + +procedure TfrxSearchDialog.FormHide(Sender: TObject); +begin + if ModalResult = mrOk then + LastText := TextE.Text; +end; + +procedure TfrxSearchDialog.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxStdWizard.dfm b/official/4.2/Source/frxStdWizard.dfm new file mode 100644 index 0000000..ed4335d Binary files /dev/null and b/official/4.2/Source/frxStdWizard.dfm differ diff --git a/official/4.2/Source/frxStdWizard.pas b/official/4.2/Source/frxStdWizard.pas new file mode 100644 index 0000000..f9d8692 --- /dev/null +++ b/official/4.2/Source/frxStdWizard.pas @@ -0,0 +1,1092 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Standard Report wizard } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxStdWizard; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, ComCtrls, ExtCtrls, frxClass, frxDesgn; + +type + TfrxStdWizard = class(TfrxCustomWizard) + public + class function GetDescription: String; override; + function Execute: Boolean; override; + end; + + TfrxDotMatrixWizard = class(TfrxCustomWizard) + public + class function GetDescription: String; override; + function Execute: Boolean; override; + end; + + TfrxStdEmptyWizard = class(TfrxCustomWizard) + public + class function GetDescription: String; override; + function Execute: Boolean; override; + end; + + TfrxDMPEmptyWizard = class(TfrxCustomWizard) + public + class function GetDescription: String; override; + function Execute: Boolean; override; + end; + + TfrxStdWizardForm = class(TForm) + Pages: TPageControl; + FieldsTab: TTabSheet; + GroupsTab: TTabSheet; + LayoutTab: TTabSheet; + FieldsLB: TListBox; + AddFieldB: TSpeedButton; + AddAllFieldsB: TSpeedButton; + RemoveFieldB: TSpeedButton; + RemoveAllFieldsB: TSpeedButton; + SelectedFieldsLB: TListBox; + SelectedFieldsL: TLabel; + FieldUpB: TSpeedButton; + FieldDownB: TSpeedButton; + AvailableFieldsLB: TListBox; + AddGroupB: TSpeedButton; + RemoveGroupB: TSpeedButton; + GroupsLB: TListBox; + GroupsL: TLabel; + GroupUpB: TSpeedButton; + GroupDownB: TSpeedButton; + AvailableFieldsL: TLabel; + BackB: TButton; + NextB: TButton; + FinishB: TButton; + FitWidthCB: TCheckBox; + Step2L: TLabel; + Step3L: TLabel; + Step4L: TLabel; + StyleTab: TTabSheet; + Step5L: TLabel; + ScrollBox1: TScrollBox; + StylePB: TPaintBox; + StyleLB: TListBox; + OrientationL: TGroupBox; + LayoutL: TGroupBox; + PortraitImg: TImage; + LandscapeImg: TImage; + PortraitRB: TRadioButton; + LandscapeRB: TRadioButton; + TabularRB: TRadioButton; + ColumnarRB: TRadioButton; + DataTab: TTabSheet; + DatasetsCB: TComboBox; + Step1L: TLabel; + NewTableB: TButton; + NewQueryB: TButton; + ScrollBox2: TScrollBox; + LayoutPB: TPaintBox; + AvailableFieldsL1: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure DatasetsCBClick(Sender: TObject); + procedure AddFieldBClick(Sender: TObject); + procedure AddAllFieldsBClick(Sender: TObject); + procedure RemoveFieldBClick(Sender: TObject); + procedure RemoveAllFieldsBClick(Sender: TObject); + procedure AddGroupBClick(Sender: TObject); + procedure RemoveGroupBClick(Sender: TObject); + procedure FieldUpBClick(Sender: TObject); + procedure FieldDownBClick(Sender: TObject); + procedure GroupUpBClick(Sender: TObject); + procedure GroupDownBClick(Sender: TObject); + procedure NextBClick(Sender: TObject); + procedure BackBClick(Sender: TObject); + procedure GroupsTabShow(Sender: TObject); + procedure StylePBPaint(Sender: TObject); + procedure PortraitRBClick(Sender: TObject); + procedure PagesChange(Sender: TObject); + procedure StyleLBClick(Sender: TObject); + procedure FinishBClick(Sender: TObject); + procedure NewTableBClick(Sender: TObject); + procedure NewQueryBClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure LayoutPBPaint(Sender: TObject); + procedure TabularRBClick(Sender: TObject); + private + FDesigner: TfrxDesignerForm; + FDotMatrix: Boolean; + FLayoutReport: TfrxReport; + FReport: TfrxReport; + FStyleReport: TfrxReport; + FStyleSheet: TfrxStyleSheet; + procedure DrawSample(PaintBox: TPaintBox; Report: TfrxReport); + procedure FillDatasets; + procedure FillFields; + procedure NewDBItem(const wizName: String); + procedure UpdateAvailableFields; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + +implementation + +{$R *.DFM} +{$R *.RES} + +uses + frxEditReportData, frxDsgnIntf, frxRes, frxUtils, frxDMPClass, + IniFiles, Registry, Printers; + +const + StyleReport = +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +''; + + LayoutTabularReport = +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +''; + + LayoutColumnarReport = +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +'' + +''; + + + Style = +'' + +'' + +'' + +'' + +'' + +'' + +''; + + + +{ TfrxStdWizard } + +class function TfrxStdWizard.GetDescription: String; +begin + Result := frxResources.Get('wzStd'); +end; + +function TfrxStdWizard.Execute: Boolean; +begin + with TfrxStdWizardForm.Create(Owner) do + begin + FDesigner := TfrxDesignerForm(Self.Designer); + FReport := Report; + Result := ShowModal = mrOk; + Free; + end; +end; + + +{ TfrxDotMatrixWizard } + +class function TfrxDotMatrixWizard.GetDescription: String; +begin + Result := frxResources.Get('wzDMP'); +end; + +function TfrxDotMatrixWizard.Execute: Boolean; +begin + with TfrxStdWizardForm.Create(Owner) do + begin + FDesigner := TfrxDesignerForm(Self.Designer); + FDotMatrix := True; + FReport := Report; + Result := ShowModal = mrOk; + Free; + end; +end; + + +{ TfrxStdEmptyWizard } + +class function TfrxStdEmptyWizard.GetDescription: String; +begin + Result := frxResources.Get('wzStdEmpty'); +end; + +function TfrxStdEmptyWizard.Execute: Boolean; +var + Page: TfrxPage; +begin + Result := True; + try + Designer.Lock; + Report.Clear; + Report.FileName := ''; + Report.DotMatrixReport := False; + + Page := TfrxDataPage.Create(Report); + Page.Name := 'Data'; + Page := TfrxReportPage.Create(Report); + Page.Name := 'Page1'; + TfrxReportPage(Page).SetDefaults; + finally + Designer.ReloadReport; + end; +end; + + +{ TfrxDMPEmptyWizard } + +class function TfrxDMPEmptyWizard.GetDescription: String; +begin + Result := frxResources.Get('wzDMPEmpty'); +end; + +function TfrxDMPEmptyWizard.Execute: Boolean; +var + Page: TfrxPage; +begin + Result := True; + try + Designer.Lock; + Report.Clear; + Report.FileName := ''; + Report.DotMatrixReport := True; + + Page := TfrxDataPage.Create(Report); + Page.Name := 'Data'; + Page := TfrxDMPPage.Create(Report); + Page.Name := 'Page1'; + TfrxReportPage(Page).SetDefaults; + finally + Designer.ReloadReport; + end; +end; + + +{ TfrxStdWizardForm } + +constructor TfrxStdWizardForm.Create(AOwner: TComponent); +var + s: TStringStream; +begin + inherited; + FStyleReport := TfrxReport.Create(nil); + s := TStringStream.Create(StyleReport); + FStyleReport.LoadFromStream(s); + s.Free; + FLayoutReport := TfrxReport.Create(nil); + + FStyleSheet := TfrxStyleSheet.Create; + if FileExists(ExtractFilePath(Application.ExeName) + 'wizstyle.xml') then + FStyleSheet.LoadFromFile(ExtractFilePath(Application.ExeName) + 'wizstyle.xml') + else + begin + s := TStringStream.Create(Style); + FStyleSheet.LoadFromStream(s); + s.Free; + end; +end; + +destructor TfrxStdWizardForm.Destroy; +begin + FStyleReport.Free; + FLayoutReport.Free; + FStyleSheet.Free; + inherited; +end; + +procedure TfrxStdWizardForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(5600); + DataTab.Caption := frxGet(5601); + FieldsTab.Caption := frxGet(5602); + GroupsTab.Caption := frxGet(5603); + LayoutTab.Caption := frxGet(5604); + StyleTab.Caption := frxGet(5605); + Step1L.Caption := frxGet(5606); + Step2L.Caption := frxGet(5607); + Step3L.Caption := frxGet(5608); + Step4L.Caption := frxGet(5609); + Step5L.Caption := frxGet(5610); + AddFieldB.Caption := frxGet(5611); + AddAllFieldsB.Caption := frxGet(5612); + RemoveFieldB.Caption := frxGet(5613); + RemoveAllFieldsB.Caption := frxGet(5614); + AddGroupB.Caption := frxGet(5615); + RemoveGroupB.Caption := frxGet(5616); + SelectedFieldsL.Caption := frxGet(5617); + AvailableFieldsL.Caption := frxGet(5618); + AvailableFieldsL1.Caption := frxGet(5618); + GroupsL.Caption := frxGet(5619); + OrientationL.Caption := frxGet(5620); + LayoutL.Caption := frxGet(5621); + PortraitRB.Caption := frxGet(5622); + LandscapeRB.Caption := frxGet(5623); + TabularRB.Caption := frxGet(5624); + ColumnarRB.Caption := frxGet(5625); + FitWidthCB.Caption := frxGet(5626); + BackB.Caption := frxGet(5627); + NextB.Caption := frxGet(5628); + FinishB.Caption := frxGet(5629); + NewTableB.Caption := frxGet(5630); + NewQueryB.Caption := frxGet(5631); + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxStdWizardForm.FormShow(Sender: TObject); +var + Page: TfrxPage; +begin + FDesigner.Lock; + FReport.Clear; + + Page := TfrxDataPage.Create(FReport); + Page.Name := 'Data'; + + if FDotMatrix then + Page := TfrxDMPPage.Create(FReport) else + Page := TfrxReportPage.Create(FReport); + Page.Name := 'Page1'; + TfrxReportPage(Page).SetDefaults; + FDesigner.ReloadReport; + + FillDatasets; + DatasetsCB.ItemIndex := 0; + DatasetsCBClick(nil); + + FStyleSheet.GetList(StyleLB.Items); + StyleLB.ItemIndex := 0; + StyleLBClick(nil); + + TabularRBClick(nil); + if FDotMatrix then + StyleTab.Free; +end; + +procedure TfrxStdWizardForm.FillDatasets; +var + i: Integer; + ds: TfrxDataSet; + dsList: TStringList; +begin + dsList := TStringList.Create; + frxGetDataSetList(dsList); + dsList.Sort; + + DatasetsCB.Clear; + + for i := 0 to dsList.Count - 1 do + begin + ds := TfrxDataSet(dsList.Objects[i]); + if ds is TfrxCustomDBDataSet then + DatasetsCB.Items.AddObject(ds.UserName, ds); + end; + + dsList.Free; +end; + +procedure TfrxStdWizardForm.FillFields; +var + ds: TfrxDataSet; +begin + FieldsLB.Clear; + SelectedFieldsLB.Clear; + UpdateAvailableFields; + + if DatasetsCB.ItemIndex <> -1 then + begin + ds := TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]); + ds.GetFieldList(FieldsLB.Items); + end; + + if FieldsLB.Items.Count <> 0 then + begin + FieldsLB.ItemIndex := 0; + FieldsLB.Selected[0] := True; + end; +end; + +procedure TfrxStdWizardForm.UpdateAvailableFields; +begin + AvailableFieldsLB.Items := SelectedFieldsLB.Items; + GroupsLB.Clear; +end; + +procedure TfrxStdWizardForm.NewDBItem(const wizName: String); +var + i: Integer; + wiz: TfrxCustomWizard; +begin + for i := 0 to frxWizards.Count - 1 do + if frxWizards[i].ClassRef.ClassName = wizName then + begin + wiz := TfrxCustomWizard(frxWizards[i].ClassRef.NewInstance); + wiz.Create(FDesigner); + try + FReport.Datasets.Clear; + if wiz.Execute then + begin + FillDatasets; + DatasetsCB.ItemIndex := DatasetsCB.Items.IndexOf(FReport.Datasets[0].Dataset.UserName); + DatasetsCBClick(nil); + FReport.Datasets.Clear; + FDesigner.ReloadReport; + end; + finally + wiz.Free; + end; + break; + end; +end; + +procedure TfrxStdWizardForm.DrawSample(PaintBox: TPaintBox; Report: TfrxReport); +var + i: Integer; + c: TfrxComponent; +begin + with PaintBox do + begin + Canvas.Pen.Color := clBlack; + Canvas.Brush.Color := clWindow; + Canvas.Rectangle(0, 0, Width, Height); + + for i := 0 to Report.AllObjects.Count - 1 do + begin + c := Report.AllObjects[i]; + if c is TfrxCustomMemoView then + with TfrxCustomMemoView(c) do + Draw(Canvas, 1, 1, 10, 10); + end; + end; +end; + +procedure TfrxStdWizardForm.DatasetsCBClick(Sender: TObject); +begin + FillFields; +end; + +procedure TfrxStdWizardForm.NewTableBClick(Sender: TObject); +begin + NewDBItem('TfrxDBTableWizard'); +end; + +procedure TfrxStdWizardForm.NewQueryBClick(Sender: TObject); +begin + NewDBItem('TfrxDBQueryWizard'); +end; + +procedure TfrxStdWizardForm.AddFieldBClick(Sender: TObject); +var + i, j: Integer; +begin + if FieldsLB.ItemIndex = -1 then Exit; + + i := 0; + j := -1; + while i < FieldsLB.Items.Count do + if FieldsLB.Selected[i] then + begin + if j = -1 then + j := i; + SelectedFieldsLB.Items.Add(FieldsLB.Items[i]); + FieldsLB.Items.Delete(i); + end + else + Inc(i); + + if j = FieldsLB.Items.Count then + Dec(j); + if j <> -1 then + begin + FieldsLB.ItemIndex := j; + FieldsLB.Selected[j] := True; + end; + + UpdateAvailableFields; +end; + +procedure TfrxStdWizardForm.AddAllFieldsBClick(Sender: TObject); +begin + if FieldsLB.Items.Count = 0 then Exit; + FillFields; + SelectedFieldsLB.Items := FieldsLB.Items; + FieldsLB.Items.Clear; + UpdateAvailableFields; +end; + +procedure TfrxStdWizardForm.RemoveFieldBClick(Sender: TObject); +var + i, j: Integer; +begin + if SelectedFieldsLB.ItemIndex = -1 then Exit; + + i := 0; + j := -1; + while i < SelectedFieldsLB.Items.Count do + if SelectedFieldsLB.Selected[i] then + begin + if j = -1 then + j := i; + FieldsLB.Items.Add(SelectedFieldsLB.Items[i]); + SelectedFieldsLB.Items.Delete(i); + end + else + Inc(i); + + if j = SelectedFieldsLB.Items.Count then + Dec(j); + if j <> -1 then + begin + SelectedFieldsLB.ItemIndex := j; + SelectedFieldsLB.Selected[j] := True; + end; + + UpdateAvailableFields; +end; + +procedure TfrxStdWizardForm.RemoveAllFieldsBClick(Sender: TObject); +begin + FillFields; +end; + +procedure TfrxStdWizardForm.AddGroupBClick(Sender: TObject); +var + i: Integer; +begin + i := AvailableFieldsLB.ItemIndex; + if i = -1 then Exit; + GroupsLB.Items.Add(AvailableFieldsLB.Items[i]); + AvailableFieldsLB.Items.Delete(i); + AvailableFieldsLB.ItemIndex := i; +end; + +procedure TfrxStdWizardForm.RemoveGroupBClick(Sender: TObject); +var + i: Integer; +begin + i := GroupsLB.ItemIndex; + if i = -1 then Exit; + AvailableFieldsLB.Items.Add(GroupsLB.Items[i]); + GroupsLB.Items.Delete(i); + GroupsLB.ItemIndex := i; +end; + +procedure TfrxStdWizardForm.FieldUpBClick(Sender: TObject); +var + i: Integer; +begin + i := SelectedFieldsLB.ItemIndex; + if i < 1 then Exit; + SelectedFieldsLB.Items.Exchange(i, i - 1); + UpdateAvailableFields; +end; + +procedure TfrxStdWizardForm.FieldDownBClick(Sender: TObject); +var + i: Integer; +begin + i := SelectedFieldsLB.ItemIndex; + if (i = -1) or (SelectedFieldsLB.Items.Count = 0) or + (i = SelectedFieldsLB.Items.Count - 1) then Exit; + SelectedFieldsLB.Items.Exchange(i, i + 1); + SelectedFieldsLB.ItemIndex := i + 1; + UpdateAvailableFields; +end; + +procedure TfrxStdWizardForm.GroupUpBClick(Sender: TObject); +var + i: Integer; +begin + i := GroupsLB.ItemIndex; + if i < 1 then Exit; + GroupsLB.Items.Exchange(i, i - 1); +end; + +procedure TfrxStdWizardForm.GroupDownBClick(Sender: TObject); +var + i: Integer; +begin + i := GroupsLB.ItemIndex; + if (i = -1) or (i = GroupsLB.Items.Count - 1) then Exit; + GroupsLB.Items.Exchange(i, i + 1); + GroupsLB.ItemIndex := i + 1; +end; + +procedure TfrxStdWizardForm.NextBClick(Sender: TObject); +begin + Pages.SelectNextPage(True); + PagesChange(nil); +end; + +procedure TfrxStdWizardForm.BackBClick(Sender: TObject); +begin + Pages.SelectNextPage(False); + PagesChange(nil); +end; + +procedure TfrxStdWizardForm.PagesChange(Sender: TObject); +begin + if not FDotMatrix then + NextB.Enabled := Pages.ActivePage <> StyleTab else + NextB.Enabled := Pages.ActivePage <> LayoutTab; + BackB.Enabled := Pages.ActivePage <> DataTab; +end; + +procedure TfrxStdWizardForm.GroupsTabShow(Sender: TObject); +begin + AvailableFieldsLB.ItemIndex := 0; +end; + +procedure TfrxStdWizardForm.StylePBPaint(Sender: TObject); +begin + DrawSample(StylePB, FStyleReport); +end; + +procedure TfrxStdWizardForm.LayoutPBPaint(Sender: TObject); +begin + DrawSample(LayoutPB, FLayoutReport); +end; + +procedure TfrxStdWizardForm.PortraitRBClick(Sender: TObject); +begin + PortraitImg.Visible := PortraitRB.Checked; + LandscapeImg.Visible := LandscapeRB.Checked; +end; + +procedure TfrxStdWizardForm.StyleLBClick(Sender: TObject); +begin + FStyleReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]); + StylePBPaint(nil); +end; + +procedure TfrxStdWizardForm.TabularRBClick(Sender: TObject); +var + s: TStringStream; +begin + if TabularRB.Checked then + s := TStringStream.Create(LayoutTabularReport) + else + s := TStringStream.Create(LayoutColumnarReport); + FLayoutReport.LoadFromStream(s); + s.Free; + FLayoutReport.Styles := FStyleSheet[0]; + LayoutPBPaint(nil); +end; + +procedure TfrxStdWizardForm.FinishBClick(Sender: TObject); +var + DataSet: TfrxDataSet; + Page: TfrxReportPage; + Band: TfrxBand; + Memo: TfrxCustomMemoView; + CurY, PageWidth, MaxHeaderWidth: Extended; + Widths, HeaderWidths, DataWidths: array of Extended; + + function Duplicate(n: Integer): String; + begin + Result := ''; + SetLength(Result, n); + FillChar(Result[1], n, '0'); + end; + + function CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView; + begin + if FDotMatrix then + Result := TfrxDMPMemoView.Create(Parent) else + Result := TfrxMemoView.Create(Parent); + if Parent <> nil then + Result.CreateUniqueName; + end; + + procedure CreatePage; + begin + Page := TfrxReportPage(FReport.Pages[1]); + if PortraitRB.Checked then + Page.Orientation := poPortrait else + Page.Orientation := poLandscape; + PageWidth := (Page.PaperWidth - Page.LeftMargin - Page.RightMargin) * 96 / 25.4; + end; + + procedure CreateWidthsArray; + var + i, FieldsCount: Integer; + HeaderMemo, DataMemo: TfrxCustomMemoView; + MaxWidth, HeadersWidth, GapWidth: Extended; + Style: TfrxStyles; + begin + FieldsCount := AvailableFieldsLB.Items.Count; + SetLength(Widths, FieldsCount); + SetLength(HeaderWidths, FieldsCount); + SetLength(DataWidths, FieldsCount); + + HeaderMemo := CreateMemo(nil); + DataMemo := CreateMemo(nil); + if not FDotMatrix then + begin + Style := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]); + HeaderMemo.ApplyStyle(Style.Find('Header')); + DataMemo.ApplyStyle(Style.Find('Data')); + end; + + MaxWidth := 0; + HeadersWidth := 0; + MaxHeaderWidth := 0; + GapWidth := 0; + for i := 0 to FieldsCount - 1 do + begin + HeaderMemo.Text := AvailableFieldsLB.Items[i]; + DataMemo.Text := Duplicate(DataSet.DisplayWidth[AvailableFieldsLB.Items[i]]); + HeaderWidths[i] := HeaderMemo.CalcWidth; + DataWidths[i] := DataMemo.CalcWidth; + if HeaderWidths[i] > DataWidths[i] then + Widths[i] := HeaderWidths[i] + else + begin + Widths[i] := DataWidths[i]; + GapWidth := GapWidth + DataWidths[i] - HeaderWidths[i]; + end; + MaxWidth := MaxWidth + Widths[i]; + HeadersWidth := HeadersWidth + HeaderWidths[i]; + if HeaderWidths[i] > MaxHeaderWidth then + MaxHeaderWidth := HeaderWidths[i]; + end; + + if FitWidthCB.Checked and (MaxWidth > PageWidth) then + begin + if HeadersWidth > PageWidth then + begin + for i := 0 to FieldsCount - 1 do + Widths[i] := HeaderWidths[i] / (HeadersWidth / PageWidth); + end + else + begin + for i := 0 to FieldsCount - 1 do + if HeaderWidths[i] < DataWidths[i] then + Widths[i] := Widths[i] - (DataWidths[i] - HeaderWidths[i]) / + GapWidth * (MaxWidth - PageWidth); + end; + end; + + HeaderMemo.Free; + DataMemo.Free; + end; + + procedure CreateTitle; + begin + Band := TfrxReportTitle.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, 0, 0, fr01cm * 7); + CurY := 30; + + Memo := CreateMemo(Band); + Memo.SetBounds(0, 0, 0, fr01cm * 6); + Memo.Align := baWidth; + Memo.HAlign := haCenter; + Memo.VAlign := vaCenter; + Memo.Text := 'Report'; + Memo.Style := 'Title'; + end; + + procedure CreateHeader; + var + i: Integer; + X, Y: Extended; + HeaderMemo: TfrxCustomMemoView; + begin + if ColumnarRB.Checked then Exit; + + Band := TfrxPageHeader.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, CurY, 0, fr01cm * 7); + + HeaderMemo := CreateMemo(Band); + HeaderMemo.SetBounds(0, 0, PageWidth, 0); + HeaderMemo.Style := 'Header line'; + + X := 0; + Y := 0; + for i := 0 to AvailableFieldsLB.Items.Count - 1 do + begin + if X + Widths[i] > PageWidth + 1 then + begin + X := 0; + Y := Y + fr01cm * 6; + end; + + Memo := CreateMemo(Band); + Memo.SetBounds(X, Y, Widths[i], fr01cm * 6); + Memo.Text := AvailableFieldsLB.Items[i]; + Memo.Style := 'Header'; + + X := X + Widths[i]; + end; + + Band.Height := Y + fr01cm * 6; + HeaderMemo.Height := Band.Height; + if FDotMatrix then + HeaderMemo.Free; + CurY := CurY + Band.Height; + end; + + procedure CreateGroupHeaders; + var + i: Integer; + begin + for i := 0 to GroupsLB.Items.Count - 1 do + begin + Band := TfrxGroupHeader.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, CurY, 0, fr01cm * 7); + TfrxGroupHeader(Band).Condition := DataSet.UserName + '."' + GroupsLB.Items[i] + '"'; + CurY := CurY + 30; + + Memo := CreateMemo(Band); + Memo.SetBounds(0, 0, 0, fr01cm * 6); + Memo.Align := baWidth; + Memo.VAlign := vaCenter; + Memo.DataSet := DataSet; + Memo.DataField := GroupsLB.Items[i]; + Memo.Style := 'Group header'; + end; + end; + + procedure CreateData; + var + i: Integer; + X, Y: Extended; + begin + Band := TfrxMasterData.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, CurY, 0, 0); + TfrxMasterData(Band).DataSet := DataSet; + CurY := CurY + 30; + + X := 0; + Y := 0; + for i := 0 to AvailableFieldsLB.Items.Count - 1 do + begin + if ColumnarRB.Checked then + begin + Memo := CreateMemo(Band); + Memo.SetBounds(0, Y, MaxHeaderWidth, fr01cm * 5); + Memo.Text := AvailableFieldsLB.Items[i]; + Memo.Style := 'Header'; + + Memo := CreateMemo(Band); + Memo.SetBounds(MaxHeaderWidth + fr01cm * 5, Y, DataWidths[i], fr01cm * 5); + Memo.DataSet := DataSet; + Memo.DataField := AvailableFieldsLB.Items[i]; + Memo.Style := 'Data'; + + Y := Y + fr01cm * 5; + end + else + begin + if X + Widths[i] > PageWidth + 1 then + begin + X := 0; + Y := Y + fr01cm * 5; + end; + + Memo := CreateMemo(Band); + Memo.SetBounds(X, Y, Widths[i], fr01cm * 5); + Memo.DataSet := DataSet; + Memo.DataField := AvailableFieldsLB.Items[i]; + Memo.Style := 'Data'; + + X := X + Widths[i]; + end; + end; + + Band.Height := Y + fr01cm * 5; + CurY := CurY + Band.Height; + end; + + procedure CreateGroupFooters; + var + i: Integer; + begin + CurY := 1000; + for i := GroupsLB.Items.Count - 1 downto 0 do + begin + Band := TfrxGroupFooter.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, CurY, 0, 0); + CurY := CurY - 30; + end; + end; + + procedure CreateFooter; + begin + Band := TfrxPageFooter.Create(Page); + Band.CreateUniqueName; + Band.SetBounds(0, 1000, 0, fr01cm * 7); + + Memo := CreateMemo(Band); + Memo.Align := baWidth; + Memo.Frame.Typ := [ftTop]; + Memo.Frame.Width := 2; + + Memo := CreateMemo(Band); + Memo.SetBounds(0, 1, 0, fr01cm * 6); + Memo.AutoWidth := True; + Memo.Text := '[Date] [Time]'; + + Memo := CreateMemo(Band); + Memo.SetBounds(100, 1, fr1cm * 2, fr01cm * 6); + Memo.Align := baRight; + Memo.HAlign := haRight; + Memo.Text := 'Page [Page#]'; + end; + +begin + try + FDesigner.Lock; + FReport.FileName := ''; + FReport.DotMatrixReport := FDotMatrix; + + DataSet := nil; + FReport.DataSets.Clear; + if DatasetsCB.ItemIndex <> -1 then + begin + DataSet := TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]); + FReport.DataSets.Add(DataSet); + end; + + CreatePage; + CreateWidthsArray; + CreateTitle; + CreateHeader; + CreateGroupHeaders; + CreateData; + CreateGroupFooters; + CreateFooter; + + if not FDotMatrix then + FReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]); + + finally + FDesigner.ReloadReport; + Widths := nil; + HeaderWidths := nil; + DataWidths := nil; + end; +end; + +procedure TfrxStdWizardForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + + +initialization + frxWizards.Register1(TfrxStdWizard, 1); + frxWizards.Register1(TfrxStdEmptyWizard, 0); +{$IFNDEF FR_LITE} + frxWizards.Register1(TfrxDotMatrixWizard, 1); + frxWizards.Register1(TfrxDMPEmptyWizard, 0); +{$ENDIF} + +finalization + frxWizards.Unregister(TfrxStdWizard); + frxWizards.Unregister(TfrxStdEmptyWizard); +{$IFNDEF FR_LITE} + frxWizards.Unregister(TfrxDotMatrixWizard); + frxWizards.Unregister(TfrxDMPEmptyWizard); +{$ENDIF} + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxStdWizard.res b/official/4.2/Source/frxStdWizard.res new file mode 100644 index 0000000..cee610b Binary files /dev/null and b/official/4.2/Source/frxStdWizard.res differ diff --git a/official/4.2/Source/frxSynMemo.pas b/official/4.2/Source/frxSynMemo.pas new file mode 100644 index 0000000..e706d2c --- /dev/null +++ b/official/4.2/Source/frxSynMemo.pas @@ -0,0 +1,1996 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Syntax memo control } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxSynMemo; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, + Forms, frxCtrls, fs_iparser, frxPopupForm; + +type + TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString, + caNumber); + TCharAttributes = set of TCharAttr; + + TfrxCodeCompletionEvent = procedure(const Name: String; List: TStrings) of object; + + TfrxSyntaxMemo = class(TfrxScrollWin) + private + FActiveLine: Integer; + FAllowLinesChange: Boolean; + FBlockColor: TColor; + FBlockFontColor: TColor; + FBookmarks: array[0..9] of Integer; + FCharHeight: Integer; + FCharWidth: Integer; + FCommentAttr: TFont; + FCompletionForm: TfrxPopupForm; + FCompletionLB: TListBox; + FDoubleClicked: Boolean; + FDown: Boolean; + FGutterWidth: Integer; + FIsMonoType: Boolean; + FKeywordAttr: TFont; + FMaxLength: Integer; + FMessage: String; + FModified: Boolean; + FMoved: Boolean; + FNumberAttr: TFont; + FOffset: TPoint; + FOnChangePos: TNotifyEvent; + FOnChangeText: TNotifyEvent; + FOnCodeCompletion: TfrxCodeCompletionEvent; + FParser: TfsParser; + FPos: TPoint; + FStringAttr: TFont; + FSelEnd: TPoint; + FSelStart: TPoint; + FShowGutter: boolean; + FSynStrings: TStrings; + FSyntax: String; + FTempPos: TPoint; + FText: TStringList; + FTextAttr: TFont; + FUndo: TStringList; + FUpdatingSyntax: Boolean; + FWindowSize: TPoint; + FBreakPoints: TStringList; + function GetCharAttr(Pos: TPoint): TCharAttributes; + function GetLineBegin(Index: Integer): Integer; + function GetPlainTextPos(Pos: TPoint): Integer; + function GetPosPlainText(Pos: Integer): TPoint; + function GetRunLine(Index: Integer): Boolean; + function GetSelText: String; + function GetText: TStrings; + function LineAt(Index: Integer): String; + function LineLength(Index: Integer): Integer; + function Pad(n: Integer): String; + procedure AddSel; + procedure AddUndo; + procedure ClearSel; + procedure ClearSyntax(ClearFrom: Integer); + procedure CompletionLBDblClick(Sender: TObject); + procedure CompletionLBDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); + procedure CompletionLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure CorrectBookmark(Line, Delta: Integer); + procedure CreateSynArray(EndLine: Integer); + procedure DoBackspace; + procedure DoChange; + procedure DoChar(Ch: Char); + procedure DoCodeCompletion; + procedure DoCtrlI; + procedure DoCtrlU; + procedure DoCtrlR; + procedure DoCtrlL; + procedure DoDel; + procedure DoDown; + procedure DoEnd(Ctrl: Boolean); + procedure DoHome(Ctrl: Boolean); + procedure DoLeft; + procedure DoPgUp; + procedure DoPgDn; + procedure DoReturn; + procedure DoRight; + procedure DoUp; + procedure EnterIndent; + procedure LinesChange(Sender: TObject); + procedure SetActiveLine(Line: Integer); + procedure SetCommentAttr(Value: TFont); + procedure SetKeywordAttr(Value: TFont); + procedure SetNumberAttr(const Value: TFont); + procedure SetRunLine(Index: Integer; const Value: Boolean); + procedure SetSelText(const Value: String); + procedure SetShowGutter(Value: Boolean); + procedure SetStringAttr(Value: TFont); + procedure SetSyntax(const Value: String); + procedure SetText(Value: TStrings); + procedure SetTextAttr(Value: TFont); + procedure ShiftSelected(ShiftRight: Boolean); + procedure ShowCaretPos; + procedure TabIndent; + procedure UnIndent; + procedure UpdateScrollBar; + procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; + procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + protected + procedure DblClick; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyPress(var Key: Char); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseWheelDown(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure MouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure OnHScrollChange(Sender: TObject); override; + procedure OnVScrollChange(Sender: TObject); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + procedure CopyToClipboard; + procedure CutToClipboard; + procedure PasteFromClipboard; + procedure SelectAll; + procedure SetPos(x, y: Integer); + procedure ShowMessage(const s: String); + procedure Undo; + procedure UpdateView; + function Find(const SearchText: String; CaseSensitive: Boolean; + var SearchFrom: Integer): Boolean; + function GetPlainPos: Integer; + function GetPos: TPoint; + function IsBookmark(Line: Integer): Integer; + procedure AddBookmark(Line, Number: Integer); + procedure DeleteBookmark(Number: Integer); + procedure GotoBookmark(Number: Integer); + procedure AddBreakPoint(Number: Integer; const Condition: String); + procedure ToggleBreakPoint(Number: Integer; const Condition: String); + procedure DeleteBreakPoint(Number: Integer); + procedure DeleteF4BreakPoints; + function IsBreakPoint(Number: Integer): Boolean; + function GetBreakPointCondition(Number: Integer): String; + + property ActiveLine: Integer read FActiveLine write SetActiveLine; + property BlockColor: TColor read FBlockColor write FBlockColor; + property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor; + property BreakPoints: TStringList read FBreakPoints; + property Color; + property CommentAttr: TFont read FCommentAttr write SetCommentAttr; + property Font; + property GutterWidth: Integer read FGutterWidth write FGutterWidth; + property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr; + property Modified: Boolean read FModified write FModified; + property NumberAttr: TFont read FNumberAttr write SetNumberAttr; + property RunLine[Index: Integer]: Boolean read GetRunLine write SetRunLine; + property SelText: String read GetSelText write SetSelText; + property StringAttr: TFont read FStringAttr write SetStringAttr; + property TextAttr: TFont read FTextAttr write SetTextAttr; + property Lines: TStrings read GetText write SetText; + property Syntax: String read FSyntax write SetSyntax; + property ShowGutter: boolean read FShowGutter write SetShowGutter; + property OnChangePos: TNotifyEvent read FOnChangePos write FOnChangePos; + property OnChangeText: TNotifyEvent read FOnChangeText write FOnChangeText; + property OnCodeCompletion: TfrxCodeCompletionEvent read FOnCodeCompletion + write FOnCodeCompletion; + property OnDragDrop; + property OnDragOver; + property OnKeyDown; + end; + + +implementation + + +uses Clipbrd, fs_itools, frxXML; + +const + SQLKeywords = + 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' + + 'base_name,before,begin,between,by,cache,call,cast,check,column,commit,' + + 'committed,computed,conditional,constraint,containing,count,create,' + + 'current,cursor,database,debug,declare,default,delete,desc,descending,' + + 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' + + 'exists,exit,external,extract,filter,for,foreign,from,full,function,' + + 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' + + 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' + + 'or,order,outer,parameter,password,plan,position,primary,privileges,' + + 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' + + 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' + + 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' + + 'view,wait,when,where,while,with,work'; + + WordChars = ['a'..'z', 'A'..'Z', 'а'..'я', 'А'..'Я', '0'..'9', '_']; + + +{ TfrxSyntaxMemo } + +constructor TfrxSyntaxMemo.Create(AOwner: TComponent); +var + i: Integer; +begin + inherited; + DoubleBuffered := True; + TabStop := True; + Cursor := crIBeam; + Color := clWindow; + + FBreakPoints := TStringList.Create; + + FBlockColor := clHighlight; + FBlockFontColor := clHighlightText; + + FCommentAttr := TFont.Create; + FCommentAttr.Color := clNavy; + FCommentAttr.Style := [fsItalic]; + + FKeywordAttr := TFont.Create; + FKeywordAttr.Color := clWindowText; + FKeywordAttr.Style := [fsBold]; + + FNumberAttr := TFont.Create; + FNumberAttr.Color := clGreen; + FNumberAttr.Style := []; + + FStringAttr := TFont.Create; + FStringAttr.Color := clNavy; + FStringAttr.Style := []; + + FTextAttr := TFont.Create; + FTextAttr.Color := clWindowText; + FTextAttr.Style := []; + + Font.Size := 10; + Font.Name := 'Courier New'; + + FText := TStringList.Create; + FParser := TfsParser.Create; + FParser.SkipSpace := False; + FParser.UseY := False; + FSynStrings := TStringList.Create; + FUndo := TStringList.Create; + FText.Add(''); + FText.OnChange := LinesChange; + FMaxLength := 1024; + FMoved := True; + SetPos(1, 1); + + ShowGutter := True; + OnMouseWheelUp := MouseWheelUp; + OnMouseWheelDown := MouseWheelDown; + + FActiveLine := -1; + for i := 0 to 9 do + FBookmarks[i] := -1; +end; + +destructor TfrxSyntaxMemo.Destroy; +begin + FBreakPoints.Free; + FCommentAttr.Free; + FKeywordAttr.Free; + FNumberAttr.Free; + FStringAttr.Free; + FTextAttr.Free; + FText.Free; + FUndo.Free; + FSynStrings.Free; + FParser.Free; + inherited; +end; + +procedure TfrxSyntaxMemo.WMKillFocus(var Msg: TWMKillFocus); +begin + inherited; + HideCaret(Handle); + DestroyCaret; +end; + +procedure TfrxSyntaxMemo.WMSetFocus(var Msg: TWMSetFocus); +begin + inherited; + CreateCaret(Handle, 0, 2, FCharHeight); + ShowCaretPos; +end; + +procedure TfrxSyntaxMemo.ShowCaretPos; +begin + if FPos.X > FOffset.X then + begin + SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth, + FCharHeight * (FPos.Y - 1 - FOffset.Y)); + ShowCaret(Handle); + end + else + SetCaretPos(-100, -100); + if Assigned(FOnChangePos) then + FOnChangePos(Self); +end; + +procedure TfrxSyntaxMemo.CMFontChanged(var Message: TMessage); +var + b: TBitmap; +begin + FCommentAttr.Size := Font.Size; + FCommentAttr.Name := Font.Name; + FKeywordAttr.Size := Font.Size; + FKeywordAttr.Name := Font.Name; + FNumberAttr.Size := Font.Size; + FNumberAttr.Name := Font.Name; + FStringAttr.Size := Font.Size; + FStringAttr.Name := Font.Name; + FTextAttr.Size := Font.Size; + FTextAttr.Name := Font.Name; + + b := TBitmap.Create; + with b.Canvas do + begin + Font.Assign(Self.Font); + Font.Style := [fsBold]; + FCharHeight := TextHeight('Wg') + 1; + FCharWidth := TextWidth('W'); + FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0; + end; + b.Free; +end; + +procedure TfrxSyntaxMemo.Resize; +begin + inherited; + if FCharWidth = 0 then Exit; + FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth, + ClientHeight div FCharHeight); + HorzPage := FWindowSize.X; + VertPage := FWindowSize.Y; + UpdateScrollBar; +end; + +procedure TfrxSyntaxMemo.UpdateScrollBar; +begin + VertRange := FText.Count; + HorzRange := FMaxLength; + LargeChange := FWindowSize.Y; + VertPosition := FOffset.Y; + HorzPosition := FOffset.X; +end; + +function TfrxSyntaxMemo.GetText: TStrings; +//var +// i: Integer; +begin +// FAllowLinesChange := False; +// for i := 0 to FText.Count - 1 do +// FText[i] := LineAt(i); + Result := FText; + FAllowLinesChange := True; +end; + +function TfrxSyntaxMemo.GetPlainPos: Integer; +begin + Result := GetPlainTextPos(FPos); +end; + +function TfrxSyntaxMemo.GetPos: TPoint; +begin + Result := FPos; +end; + +procedure TfrxSyntaxMemo.SetText(Value: TStrings); +begin + FAllowLinesChange := True; + FText.Assign(Value); +end; + +procedure TfrxSyntaxMemo.SetSyntax(const Value: String); +var + sl: TStringList; + + procedure GetGrammar; + var + Grammar: TfrxXMLDocument; + ss: TStringStream; + ParserRoot, xi: TfrxXMLItem; + i: Integer; + Name, PropText: String; + begin + Grammar := TfrxXMLDocument.Create; + ss := TStringStream.Create(fsGetLanguage(Value)); + Grammar.LoadFromStream(ss); + ss.Free; + + ParserRoot := Grammar.Root.FindItem('parser'); + xi := ParserRoot.FindItem('keywords'); + for i := 0 to xi.Count - 1 do + FParser.Keywords.Add(xi[i].Name); + + for i := 0 to ParserRoot.Count - 1 do + begin + Name := LowerCase(ParserRoot[i].Name); + PropText := ParserRoot[i].Prop['text']; + if Name = 'identchars' then + FParser.ConstructCharset(PropText) + else if Name = 'commentline1' then + FParser.CommentLine1 := PropText + else if Name = 'commentline2' then + FParser.CommentLine2 := PropText + else if Name = 'commentblock1' then + FParser.CommentBlock1 := PropText + else if Name = 'commentblock2' then + FParser.CommentBlock2 := PropText + else if Name = 'stringquotes' then + FParser.StringQuotes := PropText + else if Name = 'hexsequence' then + FParser.HexSequence := PropText + end; + + Grammar.Free; + end; + +begin + FSyntax := Value; + FParser.Keywords.Clear; + sl := TStringList.Create; + if AnsiCompareText(Value, 'SQL') = 0 then + begin + sl.CommaText := SQLKeywords; + FParser.Keywords.Assign(sl); + FParser.CommentLine1 := '--'; + FParser.CommentLine2 := ''; + FParser.CommentBlock1 := '/*,*/'; + FParser.CommentBlock2 := ''; + FParser.StringQuotes := '"'; + FParser.HexSequence := '0x'; + end + else + begin + fsGetLanguageList(sl); + if sl.IndexOf(Value) <> -1 then + GetGrammar; + end; + + ClearSyntax(1); + sl.Free; +end; + +procedure TfrxSyntaxMemo.SetCommentAttr(Value: TFont); +begin + FCommentAttr.Assign(Value); + Repaint; +end; + +procedure TfrxSyntaxMemo.SetKeywordAttr(Value: TFont); +begin + FKeywordAttr.Assign(Value); + Repaint; +end; + +procedure TfrxSyntaxMemo.SetNumberAttr(const Value: TFont); +begin + FNumberAttr.Assign(Value); + Repaint; +end; + +procedure TfrxSyntaxMemo.SetStringAttr(Value: TFont); +begin + FStringAttr.Assign(Value); + Repaint; +end; + +procedure TfrxSyntaxMemo.SetTextAttr(Value: TFont); +begin + FTextAttr.Assign(Value); + Repaint; +end; + +procedure TfrxSyntaxMemo.SetActiveLine(Line: Integer); +begin + FActiveLine := Line; + Repaint; +end; + +procedure TfrxSyntaxMemo.DoChange; +begin + FModified := True; + if Assigned(FOnChangeText) then + FOnChangeText(Self); +end; + +procedure TfrxSyntaxMemo.LinesChange(Sender: TObject); +begin + if FAllowLinesChange then + begin + FAllowLinesChange := False; + if FText.Count = 0 then + FText.Add(''); + ClearSyntax(1); + FMoved := True; + FUndo.Clear; + FPos := Point(1, 1); + FOffset := Point(0, 0); + ClearSel; + ShowCaretPos; + UpdateScrollBar; + end; +end; + +procedure TfrxSyntaxMemo.ShowMessage(const s: String); +begin + FMessage := s; + Repaint; +end; + +procedure TfrxSyntaxMemo.CopyToClipboard; +begin + if FSelStart.X <> 0 then + Clipboard.AsText := SelText; +end; + +procedure TfrxSyntaxMemo.CutToClipboard; +begin + if FSelStart.X <> 0 then + begin + Clipboard.AsText := SelText; + SelText := ''; + end; + CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y); + Repaint; +end; + +procedure TfrxSyntaxMemo.PasteFromClipboard; +begin + SelText := Clipboard.AsText; +end; + +procedure TfrxSyntaxMemo.SelectAll; +begin + SetPos(0, 0); + FSelStart := FPos; + SetPos(LineLength(FText.Count - 1) + 1, FText.Count); + FSelEnd := FPos; + Repaint; +end; + +function TfrxSyntaxMemo.LineAt(Index: Integer): String; +begin + if Index < FText.Count then + Result := TrimRight(FText[Index]) + else + Result := ''; +end; + +function TfrxSyntaxMemo.LineLength(Index: Integer): Integer; +begin + Result := Length(LineAt(Index)); +end; + +function TfrxSyntaxMemo.Pad(n: Integer): String; +begin + Result := ''; + SetLength(result, n); + FillChar(result[1], n, ' '); +end; + +procedure TfrxSyntaxMemo.AddUndo; +begin + if not FMoved then exit; + FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text); + if FUndo.Count > 32 then + FUndo.Delete(0); + FMoved := False; +end; + +procedure TfrxSyntaxMemo.Undo; +var + s: String; +begin + FMoved := True; + if FUndo.Count = 0 then exit; + s := FUndo[FUndo.Count - 1]; + FPos.X := StrToInt(Copy(s, 1, 5)); + FPos.Y := StrToInt(Copy(s, 6, 5)); + FAllowLinesChange := False; + FText.Text := Copy(s, 11, Length(s) - 10); + FAllowLinesChange := True; + FUndo.Delete(FUndo.Count - 1); + SetPos(FPos.X, FPos.Y); + ClearSyntax(1); + DoChange; +end; + +function TfrxSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer; +var + i: Integer; +begin + Result := 0; + for i := 0 to Pos.Y - 2 do + Result := Result + Length(FText[i]) + 2; + Result := Result + Pos.X; +end; + +function TfrxSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint; +var + i: Integer; + s: String; +begin + Result := Point(0, 1); + s := FText.Text; + i := 1; + while i <= Pos do + if s[i] = #13 then + begin + Inc(i, 2); + if i <= Pos then + begin + Inc(Result.Y); + Result.X := 0; + end + else + Inc(Result.X); + end + else + begin + Inc(i); + Inc(Result.X); + end; +end; + +function TfrxSyntaxMemo.GetLineBegin(Index: Integer): Integer; +var + s: String; +begin + s := FText[Index]; + Result := 1; + if Trim(s) <> '' then + for Result := 1 to Length(s) do + if s[Result] <> ' ' then + break; +end; + +procedure TfrxSyntaxMemo.TabIndent; +begin + SelText := Pad((FPos.X div 8 + 1) * 8 - FPos.X); +end; + +procedure TfrxSyntaxMemo.EnterIndent; +var + res: Integer; +begin + if Trim(FText[FPos.Y - 1]) = '' then + res := FPos.X else + res := GetLineBegin(FPos.Y - 1); + + if FPos.X = 1 then + CorrectBookmark(FPos.Y - 1, 1) else + CorrectBookmark(FPos.Y, 1); + + FPos := Point(1, FPos.Y + 1); + SelText := Pad(res - 1); +end; + +procedure TfrxSyntaxMemo.UnIndent; +var + i, res: Integer; +begin + i := FPos.Y - 2; + res := FPos.X - 1; + CorrectBookmark(FPos.Y, -1); + while i >= 0 do + begin + res := GetLineBegin(i); + if (res < FPos.X) and (Trim(FText[i]) <> '') then + break else + Dec(i); + end; + FSelStart := FPos; + FSelEnd := FPos; + Dec(FSelEnd.X, FPos.X - res); + SelText := ''; +end; + +procedure TfrxSyntaxMemo.ShiftSelected(ShiftRight: Boolean); +var + i, ib, ie: Integer; + s: String; + Shift: Integer; +begin + AddUndo; + if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then + begin + ib := FSelStart.Y - 1; + ie := FSelEnd.Y - 1; + end + else + begin + ib := FSelEnd.Y - 1; + ie := FSelStart.Y - 1; + end; + if FSelEnd.X = 1 then + Dec(ie); + + Shift := 2; + if not ShiftRight then + for i := ib to ie do + begin + s := FText[i]; + if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then + Shift := GetLineBegin(i) - 1; + end; + + for i := ib to ie do + begin + s := FText[i]; + if ShiftRight then + s := Pad(Shift) + s + else if Trim(s) <> '' then + Delete(s, 1, Shift); + FText[i] := s; + end; + + ClearSyntax(FSelStart.Y); + DoChange; +end; + +function TfrxSyntaxMemo.GetSelText: String; +var + p1, p2: TPoint; + i: Integer; +begin + if FSelStart.X = 0 then + begin + Result := ''; + Exit; + end; + + if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then + begin + p1 := FSelStart; + p2 := FSelEnd; + Dec(p2.X); + end + else + begin + p1 := FSelEnd; + p2 := FSelStart; + Dec(p2.X); + end; + + if LineLength(p1.Y - 1) < p1.X then + begin + Inc(p1.Y); + p1.X := 1; + end; + if LineLength(p2.Y - 1) < p2.X then + p2.X := LineLength(p2.Y - 1); + + i := GetPlainTextPos(p1); + Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1); +end; + +procedure TfrxSyntaxMemo.SetSelText(const Value: String); +var + p1, p2, p3: TPoint; + i: Integer; + s: String; +begin + AddUndo; + if FSelStart.X = 0 then + begin + p1 := FPos; + p2 := p1; + Dec(p2.X); + end + else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then + begin + p1 := FSelStart; + p2 := FSelEnd; + Dec(p2.X); + end + else + begin + p1 := FSelEnd; + p2 := FSelStart; + Dec(p2.X); + end; + + 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; + i := p3.Y; + if p2.Y < i then + i := p2.Y; + if p1.Y < i then + i := p1.Y; + ClearSyntax(i); +end; + +procedure TfrxSyntaxMemo.ClearSel; +begin + if FSelStart.X <> 0 then + begin + FSelStart := Point(0, 0); + Repaint; + end; +end; + +procedure TfrxSyntaxMemo.AddSel; +begin + if FSelStart.X = 0 then + FSelStart := FTempPos; + FSelEnd := FPos; + Repaint; +end; + +procedure TfrxSyntaxMemo.SetPos(x, y: Integer); +begin + if FMessage <> '' then + begin + FMessage := ''; + Repaint; + end; + + if x > FMaxLength then x := FMaxLength; + if x < 1 then x := 1; + if y > FText.Count then y := FText.Count; + if y < 1 then y := 1; + + FPos := Point(x, y); + if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit; + + if FOffset.Y >= FText.Count then + FOffset.Y := FText.Count - 1; + + if FPos.X > FOffset.X + FWindowSize.X then + begin + Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X)); + Repaint; + end + else if FPos.X <= FOffset.X then + begin + Dec(FOffset.X, FOffset.X - FPos.X + 1); + Repaint; + end + else if FPos.Y > FOffset.Y + FWindowSize.Y then + begin + Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y)); + Repaint; + end + else if FPos.Y <= FOffset.Y then + begin + Dec(FOffset.Y, FOffset.Y - FPos.Y + 1); + Repaint; + end; + + ShowCaretPos; + UpdateScrollBar; + +end; + +procedure TfrxSyntaxMemo.OnHScrollChange(Sender: TObject); +begin + FOffset.X := HorzPosition; + if FOffset.X > 1024 then + FOffset.X := 1024; + ShowCaretPos; + Repaint; +end; + +procedure TfrxSyntaxMemo.OnVScrollChange(Sender: TObject); +begin + FOffset.Y := VertPosition; + if FOffset.Y > FText.Count then + FOffset.Y := FText.Count; + ShowCaretPos; + Repaint; +end; + +procedure TfrxSyntaxMemo.DblClick; +var + s: String; +begin + FDoubleClicked := True; + DoCtrlL; + FSelStart := FPos; + s := LineAt(FPos.Y - 1); + if s <> '' then + while s[FPos.X] in WordChars do + Inc(FPos.X); + FSelEnd := FPos; + Repaint; +end; + +procedure TfrxSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if FDoubleClicked then + begin + FDoubleClicked := False; + Exit; + end; + + FMoved := True; + if not Focused then + SetFocus; + FDown := True; + + X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X; + Y := Y div FCharHeight + 1 + FOffset.Y; + FTempPos := FPos; + SetPos(X, Y); + if ssShift in Shift then + AddSel + else + ClearSel; +end; + +procedure TfrxSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + if FDown then + begin + FTempPos := FPos; + FPos.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X; + FPos.Y := Y div FCharHeight + 1 + FOffset.Y; + if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then + begin + SetPos(FPos.X, FPos.Y); + AddSel; + end; + end; + + if X < FGutterWidth then + Cursor := crArrow + else + Cursor := crIBeam; +end; + +procedure TfrxSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FDown := False; + if X < FGutterWidth then + ToggleBreakPoint(FPos.Y, ''); +end; + +procedure TfrxSyntaxMemo.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; + + else + MyKey := False; + end; + + if Shift = [ssCtrl] then + if Key = 65 then // Ctrl+A Select all + begin + SelectAll; + end + else if Key = 89 then // Ctrl+Y Delete line + begin + if FText.Count > FPos.Y then + begin + FMoved := True; + AddUndo; + FText.Delete(FPos.Y - 1); + CorrectBookmark(FPos.Y, -1); + DoChange; + end + else if FText.Count = FPos.Y then + begin + FMoved := True; + AddUndo; + FText[FPos.Y - 1] := ''; + FPos.X := 1; + SetPos(FPos.X, FPos.Y); + DoChange; + end; + ClearSyntax(FPos.Y); + end + else if Key in [48..57] then + GotoBookmark(Key - 48) + else if Key = 32 then // Ctrl+Space code completion + begin + if Assigned(FOnCodeCompletion) then + DoCodeCompletion; + MyKey := True; + end + else if Key = Ord('C') then + begin + CopyToClipboard; + MyKey := True; + end + else if Key = Ord('V') then + begin + PasteFromClipboard; + MyKey := True; + end + else if Key = Ord('X') then + begin + CutToClipboard; + MyKey := True; + end + else if Key = Ord('I') then + begin + DoCtrlI; + MyKey := True; + end + else if Key = Ord('U') then + begin + DoCtrlU; + MyKey := True; + end + else if Key = Ord('Z') then + begin + Undo; + MyKey := True; + end; + + if Shift = [ssCtrl, ssShift] then + if Key in [48..57] then + if IsBookmark(FPos.Y - 1) < 0 then + AddBookmark(FPos.Y - 1, Key - 48) + else if IsBookmark(FPos.Y - 1) = (Key - 48) then + DeleteBookmark(Key - 48); + + if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then + begin + FMoved := True; + if ssShift in Shift then + AddSel else + ClearSel; + end + else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then + FMoved := True; + + if MyKey then + Key := 0; +end; + +procedure TfrxSyntaxMemo.KeyPress(var Key: Char); +var + MyKey, ControlKeyDown: Boolean; +begin + inherited; + + ControlKeyDown := (((GetKeyState(VK_LCONTROL) and not $7FFF) <> 0) or + ((GetKeyState(VK_RCONTROL) and not $7FFF) <> 0)) and + (GetKeyState(VK_RMENU) >= 0); + MyKey := True; + + if ((Key = #32) and not ControlKeyDown) or (Key in [#33..#255]) then + begin + DoChar(Key); + FMoved := False; + end + else + MyKey := False; + + if MyKey then + Key := #0; +end; + +procedure TfrxSyntaxMemo.DoCodeCompletion; +var + p: TPoint; + + function GetCompletionString: String; + var + i: Integer; + s: String; + fl1, fl2: Boolean; + fl3, fl4: Integer; + begin + Result := ''; + s := LineAt(FPos.Y - 1); + s := Trim(Copy(s, 1, FPos.X)); + + fl1 := False; + fl2 := False; + fl3 := 0; + fl4 := 0; + + i := Length(s); + while i > 1 do + begin + Dec(i); + if (s[i] = '''') and not fl2 then + fl1 := not fl1 + else if (s[i] = '"') and not fl1 then + fl2 := not fl2 + else if not fl1 and not fl2 and (s[i] = ')') then + Inc(fl3) + else if not fl1 and not fl2 and (s[i] = '(') and (fl3 > 0) then + Dec(fl3) + else if not fl1 and not fl2 and (s[i] = ']') then + Inc(fl4) + else if not fl1 and not fl2 and (s[i] = '[') and (fl4 > 0) then + Dec(fl4) + else if not fl1 and not fl2 and (fl3 = 0) and (fl4 = 0) then + if s[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', ' '] then + Result := s[i] + Result + else + break; + end; + end; + +begin + FCompletionForm := TfrxPopupForm.Create(Self); + FCompletionLB := TListBox.Create(FCompletionForm); + with FCompletionLB do + begin + Parent := FCompletionForm; + Ctl3D := False; + Align := alClient; + ItemHeight := ItemHeight + 2; + Style := lbOwnerDrawFixed; + Sorted := True; + OnDblClick := CompletionLBDblClick; + OnKeyDown := CompletionLBKeyDown; + OnDrawItem := CompletionLBDrawItem; + if Assigned(FOnCodeCompletion) then + FOnCodeCompletion(GetCompletionString, Items); + + p := Self.ClientToScreen( + Point(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth, + FCharHeight * (FPos.Y - FOffset.Y))); + FCompletionForm.SetBounds(p.X, p.Y, 300, 100); + FCompletionForm.Show; + end; +end; + +procedure TfrxSyntaxMemo.CompletionLBDblClick(Sender: TObject); +var + s, s1: String; + i: Integer; + stepBack: Boolean; +begin + if FCompletionLB.ItemIndex <> -1 then + begin + s := FCompletionLB.Items[FCompletionLB.ItemIndex]; + i := 2; + while (i <= Length(s)) and (s[i] in WordChars) do + Inc(i); + s1 := Copy(s, 1, i - 1); + stepBack := (i <= Length(s)) and (s[i] = '('); + if stepBack then + s1 := s1 + '()'; + SelText := s1; + if stepBack then + DoLeft; + end; + FCompletionForm.Close; +end; + +procedure TfrxSyntaxMemo.CompletionLBKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + FCompletionForm.Close; + if Key = VK_RETURN then + CompletionLBDblClick(nil); +end; + +procedure TfrxSyntaxMemo.CompletionLBDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +var + i, w: Integer; + s: String; +begin + with FCompletionLB.Canvas do + begin + FillRect(ARect); + if Index <> -1 then + begin + i := Integer(FCompletionLB.Items.Objects[Index]); + s := ''; + Font.Color := clFuchsia; + if Pos('Constructor', FCompletionLB.Items[Index]) <> 0 then + s := 'constructor' + else + case i of + 0: begin s := 'var'; Font.Color := clBlue; end; + 1: begin s := 'property'; Font.Color := clBlue; end; + 2: s := 'procedure'; + 3: s := 'function'; + end; + + if odSelected in State then + Font.Color := clWhite; + Font.Style := []; + TextOut(ARect.Left + 2, ARect.Top + 2, s); + w := TextWidth('constructor'); + Font.Color := clBlack; + if odSelected in State then + Font.Color := clWhite; + Font.Style := [fsBold]; + s := FCompletionLB.Items[Index]; + i := 1; + while (i <= Length(s)) and (s[i] in WordChars) do + Inc(i); + s := Copy(s, 1, i - 1); + TextOut(ARect.Left + w + 6, ARect.Top + 2, s); + w := w + TextWidth(s); + Font.Style := []; + s := Copy(FCompletionLB.Items[Index], i, 255); + if Pos(': Constructor', s) <> 0 then + s := Copy(s, 1, Pos(': Constructor', s) - 1); + TextOut(ARect.Left + w + 6, ARect.Top + 2, s); + end; + end; +end; + +procedure TfrxSyntaxMemo.DoLeft; +begin + Dec(FPos.X); + if FPos.X < 1 then + FPos.X := 1; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoRight; +begin + Inc(FPos.X); + if FPos.X > FMaxLength then + FPos.X := FMaxLength; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoUp; +begin + Dec(FPos.Y); + if FPos.Y < 1 then + FPos.Y := 1; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoDown; +begin + Inc(FPos.Y); + if FPos.Y > FText.Count then + FPos.Y := FText.Count; + SetPos(FPos.X, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoHome(Ctrl: Boolean); +begin + if Ctrl then + SetPos(1, 1) else + SetPos(1, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoEnd(Ctrl: Boolean); +begin + if Ctrl then + SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else + SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoPgUp; +begin + if FOffset.Y > FWindowSize.Y then + begin + Dec(FOffset.Y, FWindowSize.Y - 1); + Dec(FPos.Y, FWindowSize.Y - 1); + end + else + begin + if FOffset.Y > 0 then + begin + Dec(FPos.Y, FOffset.Y); + FOffset.Y := 0; + end + else + FPos.Y := 1; + end; + SetPos(FPos.X, FPos.Y); + Repaint; +end; + +procedure TfrxSyntaxMemo.DoPgDn; +begin + if FOffset.Y + FWindowSize.Y < FText.Count then + begin + Inc(FOffset.Y, FWindowSize.Y - 1); + Inc(FPos.Y, FWindowSize.Y - 1); + end + else + begin + FOffset.Y := FText.Count; + FPos.Y := FText.Count; + end; + SetPos(FPos.X, FPos.Y); + Repaint; +end; + +procedure TfrxSyntaxMemo.DoReturn; +var + s: String; +begin + s := LineAt(FPos.Y - 1); + FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1); + FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength)); + EnterIndent; +end; + +procedure TfrxSyntaxMemo.DoDel; +var + s: String; +begin + FMessage := ''; + if FSelStart.X <> 0 then + SelText := '' + else + begin + s := FText[FPos.Y - 1]; + AddUndo; + if FPos.X <= LineLength(FPos.Y - 1) then + begin + Delete(s, FPos.X, 1); + FText[FPos.Y - 1] := s; + end + else if FPos.Y < FText.Count then + begin + s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y); + FText[FPos.Y - 1] := s; + FText.Delete(FPos.Y); + CorrectBookmark(FPos.Y, -1); + end; + UpdateScrollBar; + ClearSyntax(FPos.Y); + DoChange; + end; +end; + +procedure TfrxSyntaxMemo.DoBackspace; +var + s: String; +begin + FMessage := ''; + if FSelStart.X <> 0 then + SelText := '' + else + begin + s := FText[FPos.Y - 1]; + if FPos.X > 1 then + begin + if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then + UnIndent + else + begin + AddUndo; + if Trim(s) <> '' then + begin + Delete(s, FPos.X - 1, 1); + FText[FPos.Y - 1] := s; + DoLeft; + end + else + DoHome(False); + ClearSyntax(FPos.Y); + DoChange; + end; + end + else if FPos.Y > 1 then + begin + AddUndo; + CorrectBookmark(FPos.Y, -1); + s := LineAt(FPos.Y - 2); + FText[FPos.Y - 2] := s + FText[FPos.Y - 1]; + FText.Delete(FPos.Y - 1); + SetPos(Length(s) + 1, FPos.Y - 1); + ClearSyntax(FPos.Y); + DoChange; + end; + end; +end; + +procedure TfrxSyntaxMemo.DoCtrlI; +begin + if FSelStart.X <> 0 then + ShiftSelected(True); +end; + +procedure TfrxSyntaxMemo.DoCtrlU; +begin + if FSelStart.X <> 0 then + ShiftSelected(False); +end; + +procedure TfrxSyntaxMemo.DoCtrlL; +var + i: Integer; + s: String; +begin + s := FText.Text; + i := Length(LineAt(FPos.Y - 1)); + if FPos.X > i then + FPos.X := i; + + i := GetPlainTextPos(FPos); + + Dec(i); + while (i > 0) and not (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 TfrxSyntaxMemo.DoCtrlR; +var + i: Integer; + s: String; +begin + s := FText.Text; + i := Length(LineAt(FPos.Y - 1)); + if FPos.X > i then + begin + DoDown; + DoHome(False); + FPos.X := 0; + end; + + i := GetPlainTextPos(FPos); + + while (i < Length(s)) and (s[i] in WordChars) do + Inc(i); + while (i < Length(s)) and not (s[i] in WordChars) do + if s[i] = #13 then + begin + while (i > 1) and (s[i - 1] = ' ') do + Dec(i); + break; + end + else + Inc(i); + + FPos := GetPosPlainText(i); + SetPos(FPos.X, FPos.Y); +end; + +procedure TfrxSyntaxMemo.DoChar(Ch: Char); +begin + SelText := Ch; +end; + +function TfrxSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes; + + function IsBlock: Boolean; + var + p1, p2, p3: Integer; + begin + Result := False; + if FSelStart.X = 0 then Exit; + + p1 := FSelStart.X + FSelStart.Y * FMaxLength; + p2 := FSelEnd.X + FSelEnd.Y * FMaxLength; + if p1 > p2 then + begin + p3 := p1; + p1 := p2; + p2 := p3; + end; + p3 := Pos.X + Pos.Y * FMaxLength; + Result := (p3 >= p1) and (p3 < p2); + end; + + function CharAttr: TCharAttr; + var + s: String; + begin + if Pos.Y - 1 < FSynStrings.Count then + begin + s := FSynStrings[Pos.Y - 1]; + if Pos.X <= Length(s) then + Result := TCharAttr(Ord(s[Pos.X])) else + Result := caText; + end + else + Result := caText; + end; + +begin + Result := [CharAttr]; + if IsBlock then + Result := Result + [caBlock]; +end; + +procedure TfrxSyntaxMemo.Paint; +var + i, j, j1: Integer; + a, a1: TCharAttributes; + s: String; + + procedure SetAttr(a: TCharAttributes; Line: Integer); + begin + with Canvas do + begin + Brush.Color := Color; + + if caText in a then + Font.Assign(FTextAttr); + + if caComment in a then + Font.Assign(FCommentAttr); + + if caKeyword in a then + Font.Assign(FKeywordAttr); + + if caNumber in a then + Font.Assign(FNumberAttr); + + if caString in a then + Font.Assign(FStringAttr); + + if (caBlock in a) or (Line = FActiveLine - 1) then + begin + Brush.Color := FBlockColor; + Font.Color := FBlockFontColor; + end; + + Font.Charset := Self.Font.Charset; + end; + end; + + procedure MyTextOut(x, y: Integer; const s: String); + var + i: Integer; + begin + if FIsMonoType then + begin + Canvas.FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight)); + Canvas.TextOut(x, y, s) + end + else + with Canvas do + begin + FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight)); + for i := 1 to Length(s) do + TextOut(x + (i - 1) * FCharWidth, y, s[i]); + MoveTo(x + Length(s) * FCharWidth, y); + end; + end; + + procedure DrawLineMarks(Line, Y: Integer); + begin + if not FShowGutter then Exit; + if IsBookmark(Line) >= 0 then + with Canvas do + begin + Brush.Color := clBlack; + FillRect(Rect(13, Y + 3, 23, Y + 14)); + Brush.Color := clGreen; + FillRect(Rect(12, Y + 4, 22, Y + 15)); + Font.Name := 'Tahoma'; + Font.Color := clWhite; + Font.Style := [fsBold]; + Font.Size := 7; + TextOut(14, Y + 4, IntToStr(IsBookmark(Line))); + end; + if RunLine[Line + 1] then + with Canvas do + begin + Brush.Color := clBlue; + Pen.Color := clBlack; + Ellipse(4, Y + 7, 8, Y + 11); + Pixels[5, Y + 7] := clAqua; + Pixels[4, Y + 8] := clAqua; + end; + if IsBreakPoint(Line + 1) then + with Canvas do + begin + Brush.Color := clRed; + Pen.Color := clRed; + Ellipse(2, Y + 4, 13, Y + 15); + end; + end; + +begin + inherited; + + with Canvas do + begin + Brush.Color := clBtnFace; + FillRect(Rect(0, 0, FGutterWidth - 2, Height)); + Pen.Color := clBtnHighlight; + MoveTo(FGutterWidth - 4, 0); + LineTo(FGutterWidth - 4, Height + 1); + + if FUpdatingSyntax then Exit; + CreateSynArray(FOffset.Y + FWindowSize.Y - 1); + + for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do + begin + if i >= FText.Count then break; + + s := FText[i]; + PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight); + j1 := FOffset.X + 1; + a := GetCharAttr(Point(j1, i + 1)); + a1 := a; + + for j := j1 to FOffset.X + FWindowSize.X do + begin + if j > Length(s) then break; + + a1 := GetCharAttr(Point(j, i + 1)); + if a1 <> a then + begin + SetAttr(a, i); + MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1)); + a := a1; + j1 := j; + end; + end; + + SetAttr(a, i); + MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength)); + if (caBlock in GetCharAttr(Point(1, i + 1))) or (i = FActiveLine - 1) then + MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3)); + + DrawLineMarks(i, PenPos.Y); + end; + + if FMessage <> '' then + begin + Font.Name := 'Tahoma'; + Font.Color := clWhite; + Font.Style := [fsBold]; + Font.Size := 8; + Brush.Color := clMaroon; + FillRect(Rect(0, ClientHeight - TextHeight('|') - 6, ClientWidth, ClientHeight)); + TextOut(6, ClientHeight - TextHeight('|') - 5, FMessage); + end + end; +end; + +procedure TfrxSyntaxMemo.ClearSyntax(ClearFrom: Integer); +begin + Dec(ClearFrom); + if ClearFrom < 1 then + ClearFrom := 1; + FUpdatingSyntax := True; + while FSynStrings.Count > ClearFrom - 1 do + FSynStrings.Delete(FSynStrings.Count - 1); + FUpdatingSyntax := False; + Repaint; +end; + +procedure TfrxSyntaxMemo.CreateSynArray(EndLine: Integer); +var + i, j, n, Max: Integer; + FSyn, s: String; + attr: TCharAttr; +begin + if EndLine >= FText.Count then + EndLine := FText.Count - 1; + if EndLine <= FSynStrings.Count - 1 then Exit; + + FUpdatingSyntax := True; + FAllowLinesChange := False; + + for i := FSynStrings.Count to EndLine do + FSynStrings.Add(FText[i]); + FSyn := FSynStrings.Text; + FParser.Text := FText.Text; + Max := Length(FSyn); + + for i := Length(FSyn) downto 1 do + if FSyn[i] = Chr(Ord(caText)) then + begin + j := i; + while (j > 1) and (FSyn[j] = Chr(Ord(caText))) do + Dec(j); + FParser.Position := j + 1; + break; + end; + + while FParser.Position < Max do + begin + n := FParser.Position; + FParser.SkipSpaces; + for i := n to FParser.Position - 1 do + if i <= Max then + if FSyn[i] > #31 then + FSyn[i] := Chr(Ord(caComment)); + + attr := caText; + n := FParser.Position; + s := FParser.GetWord; + if s <> '' then + begin + if FParser.IsKeyword(s) then + attr := caKeyword; + end + else + begin + s := FParser.GetNumber; + if s <> '' then + attr := caNumber + else + begin + s := FParser.GetString; + if s <> '' then + attr := caString else + FParser.Position := FParser.Position + 1 + end + end; + + for i := n to FParser.Position - 1 do + if i <= Max then + if FSyn[i] > #31 then + FSyn[i] := Chr(Ord(attr)); + end; + + FSynStrings.Text := FSyn; + FUpdatingSyntax := False; + FAllowLinesChange := True; +end; + +procedure TfrxSyntaxMemo.UpdateView; +begin + Invalidate; +end; + +procedure TfrxSyntaxMemo.MouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + VertPosition := VertPosition - SmallChange; +end; + +procedure TfrxSyntaxMemo.MouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + VertPosition := VertPosition + SmallChange; +end; + +procedure TfrxSyntaxMemo.SetShowGutter(Value: Boolean); +begin + FShowGutter := Value; + if Value then + FGutterWidth := 30 else + FGutterWidth := 0; + Repaint; +end; + +function TfrxSyntaxMemo.IsBookmark(Line: Integer): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to 9 do + if FBookmarks[i] = Line then + begin + Result := i; + break; + end; +end; + +procedure TfrxSyntaxMemo.AddBookmark(Line, Number: Integer); +begin + if Number < Length(FBookmarks) then + begin + FBookmarks[Number] := Line; + Repaint; + end; +end; + +procedure TfrxSyntaxMemo.DeleteBookmark(Number: Integer); +begin + if Number < Length(FBookmarks) then + begin + FBookmarks[Number] := -1; + Repaint; + end; +end; + +procedure TfrxSyntaxMemo.CorrectBookmark(Line, Delta: Integer); +var + i: Integer; +begin + for i := 0 to Length(FBookmarks) - 1 do + if FBookmarks[i] >= Line then + Inc(FBookmarks[i], Delta); +end; + +procedure TfrxSyntaxMemo.GotoBookmark(Number : Integer); +begin + if Number < Length(FBookmarks) then + if FBookmarks[Number] >= 0 then + SetPos(0, FBookmarks[Number] + 1); +end; + +function TfrxSyntaxMemo.GetRunLine(Index: Integer): Boolean; +begin + if (Index < 1) or (Index > FText.Count) then + Result := False else + Result := FText.Objects[Index - 1] = Pointer(1); +end; + +procedure TfrxSyntaxMemo.SetRunLine(Index: Integer; const Value: Boolean); +begin + if (Index < 1) or (Index > FText.Count) then Exit; + if Value then + FText.Objects[Index - 1] := Pointer(1) else + FText.Objects[Index - 1] := Pointer(0); +end; + +function TfrxSyntaxMemo.Find(const SearchText: String; + CaseSensitive: Boolean; var SearchFrom: Integer): Boolean; +var + i: Integer; + s: String; +begin + i := 0; + Result := False; + if FText.Count > 1 then + begin + s := FText.Text; + if SearchFrom = 0 then + SearchFrom := 1; + s := Copy(s, SearchFrom, Length(s) - SearchFrom + 1); + if CaseSensitive then + begin + i := Pos(SearchText, s); + if i <> 0 then + Result := True; + end + else + begin + i := Pos(AnsiUpperCase(SearchText), AnsiUpperCase(s)); + if i <> 0 then + Result := True; + end; + end; + + if Result then + begin + Inc(SearchFrom, i); + FSelStart := GetPosPlainText(SearchFrom - 1); + FSelEnd := Point(FSelStart.X + Length(SearchText), FSelStart.Y); + Inc(SearchFrom, Length(SearchText)); + SetPos(FSelStart.X, FSelStart.Y); + Repaint; + end; +end; + +procedure TfrxSyntaxMemo.AddBreakPoint(Number: Integer; const Condition: String); +begin + FBreakPoints.AddObject(Condition, TObject(Number)); + Repaint; +end; + +procedure TfrxSyntaxMemo.ToggleBreakPoint(Number: Integer; const Condition: String); +begin + if IsBreakPoint(Number) then + DeleteBreakPoint(Number) + else + AddBreakPoint(Number, Condition); +end; + +procedure TfrxSyntaxMemo.DeleteBreakPoint(Number: Integer); +begin + if IsBreakPoint(Number) then + FBreakPoints.Delete(FBreakPoints.IndexOfObject(TObject(Number))); + Repaint; +end; + +function TfrxSyntaxMemo.IsBreakPoint(Number: Integer): Boolean; +begin + Result := FBreakPoints.IndexOfObject(TObject(Number)) <> -1; +end; + +function TfrxSyntaxMemo.GetBreakPointCondition(Number: Integer): String; +begin + Result := ''; + if IsBreakPoint(Number) then + Result := FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))]; +end; + +procedure TfrxSyntaxMemo.DeleteF4BreakPoints; +var + i: Integer; +begin + i := 0; + while i < FBreakPoints.Count do + if FBreakPoints[i] = 'F4' then + FBreakPoints.Delete(i) + else + Inc(i); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxTee10.bdsproj b/official/4.2/Source/frxTee10.bdsproj new file mode 100644 index 0000000..833a6b8 --- /dev/null +++ b/official/4.2/Source/frxTee10.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + frxTee10.dpk + + + 7.0 + + + diff --git a/official/4.2/Source/frxTee10.dpk b/official/4.2/Source/frxTee10.dpk new file mode 100644 index 0000000..f7a741c --- /dev/null +++ b/official/4.2/Source/frxTee10.dpk @@ -0,0 +1,50 @@ +// Package file for Delphi 2006 + +package frxTee10; + +{$I frx.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, TEEUI, {$ENDIF} +{$IFDEF TeeChartStd7}TEE710, TEEUI710, {$ENDIF} +{$IFDEF TeeChart4} TEE410, TEEPRO410, {$ENDIF} +{$IFDEF TeeChart5} TEE510, TEEPRO510, {$ENDIF} +{$IFDEF TeeChart6} TEE610, TEEPRO610, {$ENDIF} +{$IFDEF TeeChart7} TEE710, TEEPRO710, {$ENDIF} + fs10, + fsTee10, + frx10; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee11.bdsproj b/official/4.2/Source/frxTee11.bdsproj new file mode 100644 index 0000000..e0fc17b --- /dev/null +++ b/official/4.2/Source/frxTee11.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + frxTee11.dpk + + + 7.0 + + + diff --git a/official/4.2/Source/frxTee11.dpk b/official/4.2/Source/frxTee11.dpk new file mode 100644 index 0000000..cbe6ebf --- /dev/null +++ b/official/4.2/Source/frxTee11.dpk @@ -0,0 +1,50 @@ +// Package file for Delphi 2007 + +package frxTee11; + +{$I frx.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, TEEUI, {$ENDIF} +{$IFDEF TeeChartStd7}TEE710, TEEUI710, {$ENDIF} +{$IFDEF TeeChart4} TEE410, TEEPRO410, {$ENDIF} +{$IFDEF TeeChart5} TEE510, TEEPRO510, {$ENDIF} +{$IFDEF TeeChart6} TEE610, TEEPRO610, {$ENDIF} +{$IFDEF TeeChart7} TEE710, TEEPRO710, {$ENDIF} + fs11, + fsTee11, + frx11; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee4.bpk b/official/4.2/Source/frxTee4.bpk new file mode 100644 index 0000000..c246e5b --- /dev/null +++ b/official/4.2/Source/frxTee4.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 = frxTee4.bpl +OBJFILES = frxRegTee.obj frxTee4.obj frxChart.obj frxChartEditor.obj frxChartRTTI.obj +RESFILES = frx4.res frxReg.dcr +RESDEPEN = $(RESFILES) +LIBFILES = +LIBRARIES = +SPARELIBS = VCL40.lib +PACKAGES = vcl40.bpi vclsmp40.bpi vcljpg40.bpi tee40.bpi teeui40.bpi vclx40.bpi fs4.bpi fsTee4.bpi frx4.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 4.0 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=Fast Reports Inc. +FileDescription=FastReport +FileVersion=4.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=4.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/4.2/Source/frxTee4.cpp b/official/4.2/Source/frxTee4.cpp new file mode 100644 index 0000000..bb0c6a4 --- /dev/null +++ b/official/4.2/Source/frxTee4.cpp @@ -0,0 +1,28 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("frx4.res"); +USEPACKAGE("vcl40.bpi"); +USEUNIT("frxRegTee.pas"); +USEUNIT("frxChart.pas"); +USEUNIT("frxChartEditor.pas"); +USEUNIT("frxChartRTTI.pas"); +USERES("frxReg.dcr"); +USEPACKAGE("vclsmp40.bpi"); +USEPACKAGE("vclx40.bpi"); +USEPACKAGE("vcljpg40.bpi"); +USEPACKAGE("tee40.bpi"); +USEPACKAGE("teeui40.bpi"); +USEPACKAGE("fs4.bpi"); +USEPACKAGE("fsTee4.bpi"); +USEPACKAGE("frx4.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/4.2/Source/frxTee4.dpk b/official/4.2/Source/frxTee4.dpk new file mode 100644 index 0000000..45fa6d8 --- /dev/null +++ b/official/4.2/Source/frxTee4.dpk @@ -0,0 +1,49 @@ +// Package file for Delphi 4 + +package frxTee4; + +{$I frx.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, TEEUI40, {$ENDIF} +{$IFDEF TeeChart4} TEE44, TEEPRO44, {$ENDIF} +{$IFDEF TeeChart5} TEE54, TEEPRO54, {$ENDIF} +{$IFDEF TeeChart6} TEE64, TEEPRO64, {$ENDIF} +{$IFDEF TeeChart7} TEE74, TEEPRO74, {$ENDIF} + fs4, + fsTee4, + frx4; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee5.bpk b/official/4.2/Source/frxTee5.bpk new file mode 100644 index 0000000..5838bc8 --- /dev/null +++ b/official/4.2/Source/frxTee5.bpk @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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=Fast Reports Inc. +FileDescription=FastReport +FileVersion=4.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=4.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 + + \ No newline at end of file diff --git a/official/4.2/Source/frxTee5.cpp b/official/4.2/Source/frxTee5.cpp new file mode 100644 index 0000000..2d987a5 --- /dev/null +++ b/official/4.2/Source/frxTee5.cpp @@ -0,0 +1,28 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("frx5.res"); +USEUNIT("frxRegTee.pas"); +USEUNIT("frxChart.pas"); +USEUNIT("frxChartEditor.pas"); +USEUNIT("frxChartRTTI.pas"); +USERES("frxReg.dcr"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("vclsmp50.bpi"); +USEPACKAGE("vclx50.bpi"); +USEPACKAGE("vcljpg50.bpi"); +USEPACKAGE("tee50.bpi"); +USEPACKAGE("teeui50.bpi"); +USEPACKAGE("fs5.bpi"); +USEPACKAGE("fsTee5.bpi"); +USEPACKAGE("frx5.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/4.2/Source/frxTee5.dpk b/official/4.2/Source/frxTee5.dpk new file mode 100644 index 0000000..49fd7d1 --- /dev/null +++ b/official/4.2/Source/frxTee5.dpk @@ -0,0 +1,49 @@ +// Package file for Delphi 5 + +package frxTee5; + +{$I frx.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, TEEUI50, {$ENDIF} +{$IFDEF TeeChart4} TEE45, TEEPRO45, {$ENDIF} +{$IFDEF TeeChart5} TEE55, TEEPRO55, {$ENDIF} +{$IFDEF TeeChart6} TEE65, TEEPRO65, {$ENDIF} +{$IFDEF TeeChart7} TEE75, TEEPRO75, {$ENDIF} + fs5, + fsTee5, + frx5; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee6.bpk b/official/4.2/Source/frxTee6.bpk new file mode 100644 index 0000000..7866c5a --- /dev/null +++ b/official/4.2/Source/frxTee6.bpk @@ -0,0 +1,139 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[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=Fast Reports Inc. +FileDescription=FastReport +FileVersion=4.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=4.0.0.0 +Comments= + +[HistoryLists\hlIncludePath] +Count=1 +Item0=$(BCB)\Projects;$(BCB)\include;$(BCB)\include\vcl + +[HistoryLists\hlLibraryPath] +Count=1 +Item0=$(BCB)\Projects;$(BCB)\lib\obj;$(BCB)\lib + +[HistoryLists\hlDebugSourcePath] +Count=1 +Item0=$(BCB)\source\vcl + +[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/4.2/Source/frxTee6.cpp b/official/4.2/Source/frxTee6.cpp new file mode 100644 index 0000000..48ce892 --- /dev/null +++ b/official/4.2/Source/frxTee6.cpp @@ -0,0 +1,18 @@ +//--------------------------------------------------------------------------- + +#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/4.2/Source/frxTee6.dpk b/official/4.2/Source/frxTee6.dpk new file mode 100644 index 0000000..02d205d --- /dev/null +++ b/official/4.2/Source/frxTee6.dpk @@ -0,0 +1,49 @@ +// Package file for Delphi 6 + +package frxTee6; + +{$I frx.inc} +{$I tee.inc} + +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + VCL, +{$IFDEF TeeChartStd} TEE, TEEUI, {$ENDIF} +{$IFDEF TeeChart4} TEE46, TEEPRO46, {$ENDIF} +{$IFDEF TeeChart5} TEE56, TEEPRO56, {$ENDIF} +{$IFDEF TeeChart6} TEE66, TEEPRO66, {$ENDIF} +{$IFDEF TeeChart7} TEE76, TEEPRO76, {$ENDIF} + fs6, + fsTee6, + frx6; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee7.dpk b/official/4.2/Source/frxTee7.dpk new file mode 100644 index 0000000..c34f08d --- /dev/null +++ b/official/4.2/Source/frxTee7.dpk @@ -0,0 +1,49 @@ +// Package file for Delphi 7 + +package frxTee7; + +{$I frx.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, TEEUI, {$ENDIF} +{$IFDEF TeeChart4} TEE47, TEEPRO47, {$ENDIF} +{$IFDEF TeeChart5} TEE57, TEEPRO57, {$ENDIF} +{$IFDEF TeeChart6} TEE67, TEEPRO67, {$ENDIF} +{$IFDEF TeeChart7} TEE77, TEEPRO77, {$ENDIF} + fs7, + fsTee7, + frx7; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxTee9.bdsproj b/official/4.2/Source/frxTee9.bdsproj new file mode 100644 index 0000000..ee432f3 --- /dev/null +++ b/official/4.2/Source/frxTee9.bdsproj @@ -0,0 +1,19 @@ +п»ї + + + + + + + + + + + frxTee9.dpk + + + 7.0 + + + diff --git a/official/4.2/Source/frxTee9.dpk b/official/4.2/Source/frxTee9.dpk new file mode 100644 index 0000000..2a6cd3d --- /dev/null +++ b/official/4.2/Source/frxTee9.dpk @@ -0,0 +1,49 @@ +// Package file for Delphi 2005 + +package frxTee9; + +{$I frx.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, TEEUI, {$ENDIF} +{$IFDEF TeeChart4} TEE49, TEEPRO49, {$ENDIF} +{$IFDEF TeeChart5} TEE59, TEEPRO59, {$ENDIF} +{$IFDEF TeeChart6} TEE69, TEEPRO69, {$ENDIF} +{$IFDEF TeeChart7} TEE79, TEEPRO79, {$ENDIF} + fs9, + fsTee9, + frx9; + +contains + frxChart in 'frxChart.pas', + frxChartEditor in 'frxChartEditor.pas', + frxChartHelpers in 'frxChartHelpers.pas', + frxChartRTTI in 'frxChartRTTI.pas'; + +end. diff --git a/official/4.2/Source/frxUnicodeCtrls.pas b/official/4.2/Source/frxUnicodeCtrls.pas new file mode 100644 index 0000000..c70f4b4 --- /dev/null +++ b/official/4.2/Source/frxUnicodeCtrls.pas @@ -0,0 +1,582 @@ +{*******************************************************} +{ The Delphi Unicode Controls Project } +{ } +{ http://home.ccci.org/wolbrink } +{ } +{ Copyright (c) 2002, Troy Wolbrink (wolbrink@ccci.org) } +{ } +{*******************************************************} + +unit frxUnicodeCtrls; + +interface + +{$I frx.inc} + +uses Windows, Messages, Classes, Controls, Forms, StdCtrls; + +type + TUnicodeEdit = class(TEdit) + private + procedure SetSelText(const Value: WideString); + function GetText: WideString; + procedure SetText(const Value: WideString); + protected + procedure CreateWindowHandle(const Params: TCreateParams); override; + function GetSelText: WideString; reintroduce; + public + property SelText: WideString read GetSelText write SetSelText; + property Text: WideString read GetText write SetText; + end; + + TUnicodeMemo = class(TMemo) + private + procedure SetSelText(const Value: WideString); + function GetText: WideString; + procedure SetText(const Value: WideString); + protected + procedure CreateWindowHandle(const Params: TCreateParams); override; + function GetSelText: WideString; reintroduce; + public + property SelText: WideString read GetSelText write SetSelText; + property Text: WideString read GetText write SetText; + end; + + +implementation + +uses SysUtils, Graphics, Imm; + +const + UNICODE_CLASS_EXT = '.UnicodeClass'; + ANSI_UNICODE_HOLDER = $FF; + +var + UnicodeCreationControl: TWinControl = nil; + Win32PlatformIsUnicode: Boolean; + Win32PlatformIsXP: Boolean; + +{$IFDEF Delphi6} +function MakeObjectInstance(Method: TWndMethod): Pointer; +begin + Result := Classes.MakeObjectInstance(Method); +end; + +procedure FreeObjectInstance(ObjectInstance: Pointer); +begin + Classes.FreeObjectInstance(ObjectInstance); +end; +{$ENDIF} + +function IsUnicodeCreationControl(Handle: HWND): Boolean; +begin + Result := (UnicodeCreationControl <> nil) + and (UnicodeCreationControl.HandleAllocated) + and (UnicodeCreationControl.Handle = Handle); +end; + +function WMNotifyFormatResult(FromHandle: HWND): Integer; +begin + if Win32PlatformIsUnicode + and (IsWindowUnicode(FromHandle) or IsUnicodeCreationControl(FromHandle)) then + Result := NFR_UNICODE + else + Result := NFR_ANSI; +end; + +function IsTextMessage(Msg: UINT): Boolean; +begin + // WM_CHAR is omitted because of the special handling it receives + Result := (Msg = WM_SETTEXT) + or (Msg = WM_GETTEXT) + or (Msg = WM_GETTEXTLENGTH); +end; + +procedure MakeWMCharMsgSafeForAnsi(var Message: TMessage); +begin + with TWMChar(Message) do begin + Assert(Msg = WM_CHAR); + Assert(Unused = 0); + if (CharCode > Word(High(AnsiChar))) then begin + Unused := CharCode; + CharCode := ANSI_UNICODE_HOLDER; + end; + end; +end; + +procedure RestoreWMCharMsg(var Message: TMessage); +begin + with TWMChar(Message) do begin + Assert(Message.Msg = WM_CHAR); + if (Unused > 0) + and (CharCode = ANSI_UNICODE_HOLDER) then + CharCode := Unused; + Unused := 0; + end; +end; + +//----------------------------------------------------------------------------------- +type + TAccessControl = class(TControl); + TAccessWinControl = class(TWinControl); + + TWinControlTrap = class(TComponent) + private + WinControl_ObjectInstance: Pointer; + ObjectInstance: Pointer; + DefObjectInstance: Pointer; + function IsInSubclassChain(Control: TWinControl): Boolean; + procedure SubClassWindowProc; + private + FControl: TAccessWinControl; + Handle: THandle; + PrevWin32Proc: Pointer; + PrevDefWin32Proc: Pointer; + PrevWindowProc: TWndMethod; + private + LastWin32Msg: UINT; + Win32ProcLevel: Integer; + IDEWindow: Boolean; + DestroyTrap: Boolean; + TestForNull: Boolean; + FoundNull: Boolean; + {$IFDEF TNT_VERIFY_WINDOWPROC} + LastVerifiedWindowProc: TWndMethod; + {$ENDIF} + procedure Win32Proc(var Message: TMessage); + procedure DefWin32Proc(var Message: TMessage); + procedure WindowProc(var Message: TMessage); + private + procedure SubClassControl(Params_Caption: PAnsiChar); + procedure UnSubClassUnicodeControl; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +constructor TWinControlTrap.Create(AOwner: TComponent); +begin + FControl := TAccessWinControl(AOwner as TWinControl); + inherited Create(nil); + FControl.FreeNotification(Self); + + WinControl_ObjectInstance := MakeObjectInstance(FControl.MainWndProc); + ObjectInstance := MakeObjectInstance(Win32Proc); + DefObjectInstance := MakeObjectInstance(DefWin32Proc); +end; + +destructor TWinControlTrap.Destroy; +begin + FreeObjectInstance(ObjectInstance); + FreeObjectInstance(DefObjectInstance); + FreeObjectInstance(WinControl_ObjectInstance); + inherited; +end; + +procedure TWinControlTrap.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (AComponent = FControl) and (Operation = opRemove) then begin + FControl := nil; + if Win32ProcLevel = 0 then + Free + else + DestroyTrap := True; + end; +end; + +procedure TWinControlTrap.SubClassWindowProc; +begin + if not IsInSubclassChain(FControl) then begin + PrevWindowProc := FControl.WindowProc; + FControl.WindowProc := Self.WindowProc; + end; +end; + +procedure TWinControlTrap.SubClassControl(Params_Caption: PAnsiChar); +begin + // initialize trap object + Handle := FControl.Handle; + PrevWin32Proc := Pointer(GetWindowLongW(FControl.Handle, GWL_WNDPROC)); + PrevDefWin32Proc := FControl.DefWndProc; + + // subclass Window Procedures + SetWindowLongW(FControl.Handle, GWL_WNDPROC, Integer(ObjectInstance)); + FControl.DefWndProc := DefObjectInstance; + SubClassWindowProc; +end; + +function SameWndMethod(A, B: TWndMethod): Boolean; +begin + Result := @A = @B; +end; + +var + PendingRecreateWndTrapList: TList = nil; + +procedure TWinControlTrap.UnSubClassUnicodeControl; +begin + // restore window procs (restore WindowProc only if we are still the direct subclass) + if SameWndMethod(FControl.WindowProc, Self.WindowProc) then + FControl.WindowProc := PrevWindowProc; + TAccessWinControl(FControl).DefWndProc := PrevDefWin32Proc; + SetWindowLongW(FControl.Handle, GWL_WNDPROC, Integer(PrevWin32Proc)); + + if IDEWindow then + DestroyTrap := True + else if not (csDestroying in FControl.ComponentState) then + // control not being destroyed, probably recreating window + PendingRecreateWndTrapList.Add(Self); +end; + +var + Finalized: Boolean; { If any tnt controls are still around after finalization it must be due to a memory leak. + Windows will still try to send a WM_DESTROY, but we will just ignore it if we're finalized. } + +procedure TWinControlTrap.Win32Proc(var Message: TMessage); +begin + if (not Finalized) then begin + Inc(Win32ProcLevel); + try + with Message do begin + LastWin32Msg := Msg; + Result := CallWindowProcW(PrevWin32Proc, Handle, Msg, wParam, lParam); + end; + finally + Dec(Win32ProcLevel); + end; + if (Win32ProcLevel = 0) and (DestroyTrap) then + Free; + end else if (Message.Msg = WM_DESTROY) then + FControl.WindowHandle := 0 +end; + +procedure TWinControlTrap.DefWin32Proc(var Message: TMessage); +begin + with Message do begin + if Msg = WM_NOTIFYFORMAT then + Result := WMNotifyFormatResult(Message.wParam) + else begin + if (Msg = WM_CHAR) then begin + RestoreWMCharMsg(Message) + end; + if (Msg = WM_IME_CHAR) and (not Win32PlatformIsXP) then + begin + { In Windows XP, DefWindowProc handles WM_IME_CHAR fine for VCL windows. } + { Before XP, DefWindowProc will sometimes produce incorrect, non-Unicode WM_CHAR. } + { Also, using PostMessageW on Windows 2000 didn't always produce the correct results. } + Message.Result := SendMessageW(Handle, WM_CHAR, wParam, lParam) + end else begin + if (Msg = WM_DESTROY) then begin + UnSubClassUnicodeControl; {The reason for doing this in DefWin32Proc is because in D9, TWinControl.WMDestroy() does a perform(WM_TEXT) operation. } + end; + { Normal DefWindowProc } + Result := CallWindowProcW(PrevDefWin32Proc, Handle, Msg, wParam, lParam); + end; + end; + end; +end; + +function TWinControlTrap.IsInSubclassChain(Control: TWinControl): Boolean; +var + Message: TMessage; +begin + if SameWndMethod(Control.WindowProc, TAccessWinControl(Control).WndProc) then + Result := False { no subclassing } + else if SameWndMethod(Control.WindowProc, Self.WindowProc) then + Result := True { directly subclassed } + else begin + TestForNull := True; + FoundNull := False; + ZeroMemory(@Message, SizeOf(Message)); + Message.Msg := WM_NULL; + Control.WindowProc(Message); + Result := FoundNull; { indirectly subclassed } + end; +end; + +procedure TWinControlTrap.WindowProc(var Message: TMessage); +var + CameFromWindows: Boolean; +begin + if TestForNull and (Message.Msg = WM_NULL) then + FoundNull := True; + + if (not FControl.HandleAllocated) then + FControl.WndProc(Message) + else begin + CameFromWindows := LastWin32Msg <> WM_NULL; + LastWin32Msg := WM_NULL; + with Message do begin + if (not CameFromWindows) + and (IsTextMessage(Msg)) then + Result := SendMessageA(Handle, Msg, wParam, lParam) + else begin + if (Msg = WM_CHAR) then begin + MakeWMCharMsgSafeForAnsi(Message); + end; + PrevWindowProc(Message) + end; + end; + end; +end; + +//---------------------------------------------------------------------------------- + +function FindOrCreateWinControlTrap(Control: TWinControl): TWinControlTrap; +var + i: integer; +begin + // find or create trap object + Result := nil; + for i := PendingRecreateWndTrapList.Count - 1 downto 0 do begin + if TWinControlTrap(PendingRecreateWndTrapList[i]).FControl = Control then begin + Result := TWinControlTrap(PendingRecreateWndTrapList[i]); + PendingRecreateWndTrapList.Delete(i); + break; { found it } + end; + end; + if Result = nil then + Result := TWinControlTrap.Create(Control); +end; + +procedure SubClassUnicodeControl(Control: TWinControl; Params_Caption: PAnsiChar; IDEWindow: Boolean = False); +var + WinControlTrap: TWinControlTrap; +begin + if not IsWindowUnicode(Control.Handle) then + raise Exception.Create('Internal Error: SubClassUnicodeControl.Control is not Unicode.'); + + WinControlTrap := FindOrCreateWinControlTrap(Control); + WinControlTrap.SubClassControl(Params_Caption); + WinControlTrap.IDEWindow := IDEWindow; +end; + + +//----------------------------------------------- CREATE/DESTROY UNICODE HANDLE + +var + WindowAtom: TAtom; + ControlAtom: TAtom; + WindowAtomString: AnsiString; + ControlAtomString: AnsiString; + +type + TWndProc = function(HWindow: HWnd; Message, WParam, LParam: Longint): Longint; stdcall; + +function InitWndProcW(HWindow: HWnd; Message, WParam, LParam: Longint): Longint; stdcall; + + function GetObjectInstance(Control: TWinControl): Pointer; + var + WinControlTrap: TWinControlTrap; + begin + WinControlTrap := FindOrCreateWinControlTrap(Control); + PendingRecreateWndTrapList.Add(WinControlTrap); + Result := WinControlTrap.WinControl_ObjectInstance; + end; + +var + ObjectInstance: Pointer; +begin + TAccessWinControl(CreationControl).WindowHandle := HWindow; + ObjectInstance := GetObjectInstance(CreationControl); + {Controls.InitWndProc converts control to ANSI here by calling SetWindowLongA()!} + SetWindowLongW(HWindow, GWL_WNDPROC, Integer(ObjectInstance)); + if (GetWindowLongW(HWindow, GWL_STYLE) and WS_CHILD <> 0) + and (GetWindowLongW(HWindow, GWL_ID) = 0) then + SetWindowLongW(HWindow, GWL_ID, Integer(HWindow)); + SetProp(HWindow, MakeIntAtom(ControlAtom), THandle(CreationControl)); + SetProp(HWindow, MakeIntAtom(WindowAtom), THandle(CreationControl)); + CreationControl := nil; + Result := TWndProc(ObjectInstance)(HWindow, Message, WParam, lParam); +end; + +procedure RegisterUnicodeClass(Params: TCreateParams; out WideWinClassName: WideString; IDEWindow: Boolean = False); +var + TempClass: TWndClassW; + WideClass: TWndClassW; + ClassRegistered: Boolean; + InitialProc: TFNWndProc; +begin + if IDEWindow then + InitialProc := @InitWndProc + else + InitialProc := @InitWndProcW; + + with Params do begin + WideWinClassName := WinClassName + UNICODE_CLASS_EXT; + ClassRegistered := GetClassInfoW(hInstance, PWideChar(WideWinClassName), TempClass); + if (not ClassRegistered) or (TempClass.lpfnWndProc <> InitialProc) + then begin + if ClassRegistered then Win32Check(Windows.UnregisterClassW(PWideChar(WideWinClassName), hInstance)); + // Prepare a TWndClassW record + WideClass := TWndClassW(WindowClass); + WideClass.hInstance := hInstance; + WideClass.lpfnWndProc := InitialProc; + WideClass.lpszMenuName := PWideChar(WideString(WindowClass.lpszMenuName)); + WideClass.lpszClassName := PWideChar(WideWinClassName); + + // Register the UNICODE class + RegisterClassW(WideClass); + end; + end; +end; + +procedure CreateUnicodeHandle(Control: TWinControl; const Params: TCreateParams; + const SubClass: WideString; IDEWindow: Boolean = False); +var + TempSubClass: TWndClassW; + WideWinClassName: WideString; + Handle: THandle; +begin + if (not Win32PlatformIsUnicode) then begin + with Params do + TAccessWinControl(Control).WindowHandle := CreateWindowEx(ExStyle, WinClassName, + Caption, Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param); + end else begin + // SubClass the unicode version of this control by getting the correct DefWndProc + if (SubClass <> '') + and GetClassInfoW(Params.WindowClass.hInstance, PWideChar(SubClass), TempSubClass) then + TAccessWinControl(Control).DefWndProc := TempSubClass.lpfnWndProc + else + TAccessWinControl(Control).DefWndProc := @DefWindowProcW; + + // make sure Unicode window class is registered + RegisterUnicodeClass(Params, WideWinClassName, IDEWindow); + + // Create UNICODE window handle + UnicodeCreationControl := Control; + try + with Params do + Handle := CreateWindowExW(ExStyle, PWideChar(WideWinClassName), nil, + Style, X, Y, Width, Height, WndParent, 0, hInstance, Param); + TAccessWinControl(Control).WindowHandle := Handle; + if IDEWindow then + SetWindowLongW(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC)); + finally + UnicodeCreationControl := nil; + end; + + SubClassUnicodeControl(Control, Params.Caption, IDEWindow); + end; +end; + + +//----------------------------------------------- GET/SET WINDOW TEXT + +function WideGetWindowText(Control: TWinControl): WideString; +begin + if (not Control.HandleAllocated) + or (not IsWindowUnicode(Control.Handle)) then begin + // NO HANDLE -OR- NOT UNICODE + result := TAccessWinControl(Control).Text; + end else begin + // UNICODE & HANDLE + SetLength(Result, GetWindowTextLengthW(Control.Handle) + 1); + GetWindowTextW(Control.Handle, PWideChar(Result), Length(Result)); + SetLength(Result, Length(Result) - 1); + end; +end; + +procedure WideSetWindowText(Control: TWinControl; const Text: WideString); +begin + if (not Control.HandleAllocated) + or (not IsWindowUnicode(Control.Handle)) then begin + // NO HANDLE -OR- NOT UNICODE + TAccessWinControl(Control).Text := Text; + end else if WideGetWindowText(Control) <> Text then begin + // UNICODE & HANDLE + SetWindowTextW(Control.Handle, PWideChar(Text)); + Control.Perform(CM_TEXTCHANGED, 0, 0); + end; +end; + + + +{ TUnicodeEdit } + +procedure TUnicodeEdit.CreateWindowHandle(const Params: TCreateParams); +begin + CreateUnicodeHandle(Self, Params, 'EDIT'); +end; + +function TUnicodeEdit.GetSelText: WideString; +begin + Result := Copy(GetText, SelStart + 1, SelLength); +end; + +function TUnicodeEdit.GetText: WideString; +begin + Result := WideGetWindowText(Self); +end; + +procedure TUnicodeEdit.SetSelText(const Value: WideString); +begin + SendMessageW(Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value))); +end; + +procedure TUnicodeEdit.SetText(const Value: WideString); +begin + WideSetWindowText(Self, Value); +end; + + +{ TUnicodeMemo } + +procedure TUnicodeMemo.CreateWindowHandle(const Params: TCreateParams); +begin + CreateUnicodeHandle(Self, Params, 'EDIT'); +end; + +function TUnicodeMemo.GetSelText: WideString; +begin + Result := Copy(GetText, SelStart + 1, SelLength); +end; + +function TUnicodeMemo.GetText: WideString; +begin + Result := WideGetWindowText(Self); +end; + +procedure TUnicodeMemo.SetSelText(const Value: WideString); +begin + SendMessageW(Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value))); +end; + +procedure TUnicodeMemo.SetText(const Value: WideString); +begin + WideSetWindowText(Self, Value); +end; + + +procedure InitControls; +var + Controls_HInstance: Cardinal; +begin + Controls_HInstance := FindClassHInstance(TWinControl); + WindowAtomString := Format('Delphi%.8X',[GetCurrentProcessID]); + ControlAtomString := Format('ControlOfs%.8X%.8X', [Controls_HInstance, GetCurrentThreadID]); + WindowAtom := (GlobalAddAtom(PAnsiChar(WindowAtomString))); + ControlAtom := (GlobalAddAtom(PAnsiChar(ControlAtomString))); +end; + +initialization + Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT); + Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) + or (Win32MajorVersion > 5); + PendingRecreateWndTrapList := TList.Create; + InitControls; + +finalization + GlobalDeleteAtom(ControlAtom); + GlobalDeleteAtom(WindowAtom); + PendingRecreateWndTrapList.Free; + PendingRecreateWndTrapList := nil; + Finalized := True; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxUnicodeUtils.pas b/official/4.2/Source/frxUnicodeUtils.pas new file mode 100644 index 0000000..6f1524c --- /dev/null +++ b/official/4.2/Source/frxUnicodeUtils.pas @@ -0,0 +1,637 @@ +{*******************************************************} +{ The Delphi Unicode Controls Project } +{ } +{ http://home.ccci.org/wolbrink } +{ } +{ Copyright (c) 2002, Troy Wolbrink (wolbrink@ccci.org) } +{ } +{*******************************************************} + +unit frxUnicodeUtils; + +interface + +{$I frx.inc} + +uses Windows, Classes, SysUtils; + +type + TWString = record + WString: WideString; + Obj: TObject; + end; + + TWideStrings = class(TPersistent) + private + FWideStringList: TList; + function Get(Index: Integer): WideString; + procedure Put(Index: Integer; const S: WideString); + function GetObject(Index: Integer): TObject; + procedure PutObject(Index: Integer; const Value: TObject); + procedure ReadData(Reader: TReader); + procedure ReadDataW(Reader: TReader); + procedure WriteDataW(Writer: TWriter); + function GetTextStr: WideString; + procedure SetTextStr(const Value: WideString); + protected + procedure AssignTo(Dest: TPersistent); override; + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function Count: Integer; + procedure Clear; + procedure Delete(Index: Integer); + function Add(const S: WideString): Integer; + procedure AddStrings(Strings: TWideStrings); + function AddObject(const S: WideString; AObject: TObject): Integer; + function IndexOf(const S: WideString): Integer; + procedure Insert(Index: Integer; const S: WideString); + procedure LoadFromFile(const FileName: WideString); + procedure LoadFromStream(Stream: TStream); + procedure LoadFromWStream(Stream: TStream); + procedure SaveToFile(const FileName: WideString); + procedure SaveToStream(Stream: TStream); + property Objects[Index: Integer]: TObject read GetObject write PutObject; + property Strings[Index: Integer]: WideString read Get write Put; default; + property Text: WideString read GetTextStr write SetTextStr; + end; + + +{$IFNDEF Delphi6} +function Utf8Encode(const WS: WideString): String; +function UTF8Decode(const S: String): WideString; +function VarToWideStr(const V: Variant): WideString; +{$ENDIF} +function AnsiToUnicode(const s: String; Charset: UINT): WideString; + + +implementation + +const + sLineBreak = #13#10; + WideLineSeparator = WideChar($2028); + NameValueSeparator = '='; + + +{$IFNDEF Delphi6} +function Utf8Encode(const WS: WideString): String; +var + L: Integer; + Temp: String; + + function ToUtf8(Dest: PChar; MaxDestBytes: Cardinal; + Source: PWideChar; SourceChars: Cardinal): Cardinal; + var + i, count: Cardinal; + c: Cardinal; + begin + Result := 0; + if Source = nil then Exit; + count := 0; + i := 0; + if Dest <> nil then + begin + while (i < SourceChars) and (count < MaxDestBytes) do + begin + c := Cardinal(Source[i]); + Inc(i); + if c <= $7F then + begin + Dest[count] := Char(c); + Inc(count); + end + else if c > $7FF then + begin + if count + 3 > MaxDestBytes then + break; + Dest[count] := Char($E0 or (c shr 12)); + Dest[count+1] := Char($80 or ((c shr 6) and $3F)); + Dest[count+2] := Char($80 or (c and $3F)); + Inc(count,3); + end + else // $7F < Source[i] <= $7FF + begin + if count + 2 > MaxDestBytes then + break; + Dest[count] := Char($C0 or (c shr 6)); + Dest[count+1] := Char($80 or (c and $3F)); + Inc(count,2); + end; + end; + if count >= MaxDestBytes then count := MaxDestBytes-1; + Dest[count] := #0; + end + else + begin + while i < SourceChars do + begin + c := Integer(Source[i]); + Inc(i); + if c > $7F then + begin + if c > $7FF then + Inc(count); + Inc(count); + end; + Inc(count); + end; + end; + Result := count+1; + end; + +begin + Result := ''; + if WS = '' then Exit; + SetLength(Temp, Length(WS) * 3); + L := ToUtf8(PChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS)); + if L > 0 then + SetLength(Temp, L-1) + else + Temp := ''; + Result := Temp; +end; + +function Utf8Decode(const S: String): WideString; +var + L: Integer; + Temp: WideString; + + function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; + var + i, count: Cardinal; + c: Byte; + wc: Cardinal; + begin + if Source = nil then + begin + Result := 0; + Exit; + end; + Result := Cardinal(-1); + count := 0; + i := 0; + if Dest <> nil then + begin + while (i < SourceBytes) and (count < MaxDestChars) do + begin + wc := Cardinal(Source[i]); + Inc(i); + if (wc and $80) <> 0 then + begin + wc := wc and $3F; + if i > SourceBytes then Exit; // incomplete multibyte char + if (wc and $20) <> 0 then + begin + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then Exit; // malformed trail byte or out of range char + if i > SourceBytes then Exit; // incomplete multibyte char + wc := (wc shl 6) or (c and $3F); + end; + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then Exit; // malformed trail byte + + Dest[count] := WideChar((wc shl 6) or (c and $3F)); + end + else + Dest[count] := WideChar(wc); + Inc(count); + end; + if count >= MaxDestChars then count := MaxDestChars-1; + Dest[count] := #0; + end + else + begin + while (i <= SourceBytes) do + begin + c := Byte(Source[i]); + Inc(i); + if (c and $80) <> 0 then + begin + if (c and $F0) = $F0 then Exit; // too many bytes for UCS2 + if (c and $40) = 0 then Exit; // malformed lead byte + if i > SourceBytes then Exit; // incomplete multibyte char + + if (Byte(Source[i]) and $C0) <> $80 then Exit; // malformed trail byte + Inc(i); + if i > SourceBytes then Exit; // incomplete multibyte char + if ((c and $20) <> 0) and ((Byte(Source[i]) and $C0) <> $80) then Exit; // malformed trail byte + Inc(i); + end; + Inc(count); + end; + end; + Result := count+1; + end; + +begin + Result := ''; + if S = '' then Exit; + SetLength(Temp, Length(S)); + + L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S)); + if L > 0 then + SetLength(Temp, L-1) + else + Temp := ''; + Result := Temp; +end; + +function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString; +begin + if not VarIsNull(V) then + Result := V + else + Result := ADefault; +end; + +function VarToWideStr(const V: Variant): WideString; +begin + Result := VarToWideStrDef(V, ''); +end; +{$ENDIF} + + +{ TWideStrings } + +constructor TWideStrings.Create; +begin + FWideStringList := TList.Create; +end; + +destructor TWideStrings.Destroy; +begin + Clear; + FWideStringList.Free; + inherited; +end; + +procedure TWideStrings.Clear; +var + Index: Integer; + PWStr: ^TWString; +begin + for Index := 0 to FWideStringList.Count-1 do + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + Dispose(PWStr); + end; + FWideStringList.Clear; +end; + +function TWideStrings.Get(Index: Integer): WideString; +var + PWStr: ^TWString; +begin + Result := ''; + if ( (Index >= 0) and (Index < FWideStringList.Count) ) then + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + Result := PWStr^.WString; + end; +end; + +procedure TWideStrings.Put(Index: Integer; const S: WideString); +begin + Insert(Index, S); +end; + +function TWideStrings.GetObject(Index: Integer): TObject; +var + PWStr: ^TWString; +begin + Result := nil; + if ( (Index >= 0) and (Index < FWideStringList.Count) ) then + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + Result := PWStr^.Obj; + end; +end; + +procedure TWideStrings.PutObject(Index: Integer; const Value: TObject); +var + PWStr: ^TWString; +begin + if ( (Index >= 0) and (Index < FWideStringList.Count) ) then + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + PWStr^.Obj := Value; + end; +end; + +function TWideStrings.Add(const S: WideString): Integer; +var + PWStr: ^TWString; +begin + New(PWStr); + PWStr^.WString := S; + PWStr^.Obj := nil; + Result := FWideStringList.Add(PWStr); +end; + +procedure TWideStrings.Delete(Index: Integer); +var + PWStr: ^TWString; +begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + Dispose(PWStr); + FWideStringList.Delete(Index); +end; + +function TWideStrings.IndexOf(const S: WideString): Integer; +var + Index: Integer; + PWStr: ^TWString; +begin + Result := -1; + for Index := 0 to FWideStringList.Count -1 do + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + begin + if S = PWStr^.WString then + begin + Result := Index; + break; + end; + end; + end; +end; + +function TWideStrings.Count: Integer; +begin + Result := FWideStringList.Count; +end; + +procedure TWideStrings.Insert(Index: Integer; const S: WideString); +var + PWStr: ^TWString; +begin + if((Index < 0) or (Index > FWideStringList.Count)) then + raise Exception.Create('Wide String Out of Bounds'); + if Index < FWideStringList.Count then + begin + PWStr := FWideStringList.Items[Index]; + if PWStr <> nil then + PWStr.WString := S; + end + else + Add(S); +end; + +procedure TWideStrings.AddStrings(Strings: TWideStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings[I], Strings.Objects[I]); +end; + +function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer; +begin + Result := Add(S); + PutObject(Result, AObject); +end; + +procedure TWideStrings.Assign(Source: TPersistent); +var + I: Integer; +begin + if Source is TWideStrings then + begin + Clear; + AddStrings(TWideStrings(Source)); + end + else if Source is TStrings then + begin + Clear; + for I := 0 to TStrings(Source).Count - 1 do + AddObject(TStrings(Source)[I], TStrings(Source).Objects[I]); + end + else + inherited Assign(Source); +end; + +procedure TWideStrings.AssignTo(Dest: TPersistent); +var + I: Integer; +begin + if Dest is TWideStrings then + Dest.Assign(Self) + else if Dest is TStrings then + begin + TStrings(Dest).BeginUpdate; + try + TStrings(Dest).Clear; + for I := 0 to Count - 1 do + TStrings(Dest).AddObject(Strings[I], Objects[I]); + finally + TStrings(Dest).EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +procedure TWideStrings.DefineProperties(Filer: TFiler); +begin + // compatibility + Filer.DefineProperty('Strings', ReadData, nil, Count > 0); + Filer.DefineProperty('UTF8', ReadDataW, WriteDataW, Count > 0); +end; + +function TWideStrings.GetTextStr: WideString; +var + I, L, Size, Count: Integer; + P: PWideChar; + S, LB: WideString; +begin + Count := FWideStringList.Count; + Size := 0; + LB := sLineBreak; + for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB)); + SetString(Result, nil, Size); + P := Pointer(Result); + for I := 0 to Count - 1 do + begin + S := Get(I); + L := Length(S); + if L <> 0 then + begin + System.Move(Pointer(S)^, P^, L * SizeOf(WideChar)); + Inc(P, L); + end; + L := Length(LB); + if L <> 0 then + begin + System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar)); + Inc(P, L); + end; + end; +end; + +procedure TWideStrings.LoadFromFile(const FileName: WideString); +var + Stream: TStream; +begin + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TWideStrings.LoadFromStream(Stream: TStream); +var + Size: Integer; + S: WideString; + ansiS: String; + sign: Word; +begin + Size := Stream.Size - Stream.Position; + sign := 0; + if Size > 2 then + Stream.Read(sign, 2); + + if sign = $FEFF then + begin + Dec(Size, 2); + SetLength(S, Size div 2); + Stream.Read(S[1], Size); + SetTextStr(S); + end + else + begin + Stream.Seek(-2, soFromCurrent); + SetLength(ansiS, Size); + Stream.Read(ansiS[1], Size); + SetTextStr(ansiS); + end; +end; + +procedure TWideStrings.LoadFromWStream(Stream: TStream); +var + Size: Integer; + S: WideString; +begin + Size := Stream.Size - Stream.Position; + SetLength(S, Size div 2); + Stream.Read(S[1], Size); + SetTextStr(S); +end; + +procedure TWideStrings.ReadData(Reader: TReader); +begin + Clear; + Reader.ReadListBegin; + while not Reader.EndOfList do + if Reader.NextValue in [vaString, vaLString] then + Add(Reader.ReadString) {TStrings compatiblity} + else + Add(Reader.ReadWideString); + Reader.ReadListEnd; +end; + +procedure TWideStrings.ReadDataW(Reader: TReader); +begin + Clear; + Reader.ReadListBegin; + while not Reader.EndOfList do + Add(Utf8Decode(Reader.ReadString)); + Reader.ReadListEnd; +end; + +procedure TWideStrings.SaveToFile(const FileName: WideString); +var + Stream: TStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TWideStrings.SaveToStream(Stream: TStream); +var + SW: WideString; +begin + SW := GetTextStr; + Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar)); +end; + +procedure TWideStrings.SetTextStr(const Value: WideString); +var + P, Start: PWideChar; + S: WideString; +begin + Clear; + P := Pointer(Value); + if P <> nil then + while P^ <> #0 do + begin + Start := P; + while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) and (P^ <> WideLineSeparator) do + Inc(P); + SetString(S, Start, P - Start); + Add(S); + if P^ = #13 then Inc(P); + if P^ = #10 then Inc(P); + if P^ = WideLineSeparator then Inc(P); + end; +end; + +procedure TWideStrings.WriteDataW(Writer: TWriter); +var + I: Integer; +begin + Writer.WriteListBegin; + for I := 0 to Count - 1 do + Writer.WriteString(Utf8Encode(Get(I))); + Writer.WriteListEnd; +end; + +function TranslateCharsetInfo(lpSrc: DWORD; var lpCs: TCharsetInfo; + dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo'; + +function CharSetToCodePage(ciCharset: DWORD): Cardinal; +var + C: TCharsetInfo; +begin + if ciCharset = DEFAULT_CHARSET then + Result := GetACP + else + begin + Win32Check(TranslateCharsetInfo(ciCharset, C, TCI_SRCCHARSET)); + Result := C.ciACP; + end; +end; + +function AnsiToUnicode(const s: String; Charset: UINT): WideString; +var + CodePage: Integer; + InputLength, OutputLength: Integer; +begin + CodePage := CharSetToCodePage(Charset); + InputLength := Length(S); + OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0); + SetLength(Result, OutputLength); + MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength); +end; + + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxUtils.pas b/official/4.2/Source/frxUtils.pas new file mode 100644 index 0000000..dc22ba6 --- /dev/null +++ b/official/4.2/Source/frxUtils.pas @@ -0,0 +1,1030 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Various routines } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxUtils; + +interface + +{$I frx.inc} + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, + StdCtrls, Menus, ImgList, ActnList, ComCtrls, frxClass +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TfrxRectArea = class + public + X, Y, X1, Y1: Extended; + constructor Create(c: TfrxComponent); overload; + constructor Create(Left, Top, Right, Bottom: Extended); overload; + function InterceptsX(a: TfrxRectArea): Boolean; + function InterceptsY(a: TfrxRectArea): Boolean; + function InterceptX(a: TfrxRectArea): TfrxRectArea; + function InterceptY(a: TfrxRectArea): TfrxRectArea; + function Max(x1, x2: Extended): Extended; + function Min(x1, x2: Extended): Extended; + end; + + +function frxFindComponent(Owner: TComponent; const Name: String): TComponent; +procedure frxGetComponents(Owner: TComponent; ClassRef: TClass; + List: TStrings; Skip: TComponent); +function frxGetFullName(Owner: TComponent; c: TComponent): String; +procedure frxSetCommaText(const Text: String; sl: TStrings; Comma: Char = ';'); +function frxRemoveQuotes(const s: String): String; +function frxStreamToString(Stream: TStream): String; +procedure frxStringToStream(const s: String; Stream: TStream); +function frxStrToFloat(s: String): Extended; +function frxFloatToStr(d: Extended): String; +function frxRect(ALeft, ATop, ARight, ABottom: Extended): TfrxRect; +function frxPoint(X, Y: Extended): TfrxPoint; +function frxGetBrackedVariable(const Str, OpenBracket, CloseBracket: String; + var i, j: Integer): String; +function frxGetBrackedVariableW(const Str, OpenBracket, CloseBracket: WideString; + var i, j: Integer): WideString; +procedure frxCommonErrorHandler(Report: TfrxReport; const Text: String); +procedure frxErrorMsg(const Text: String); +procedure frxInfoMsg(const Text: String); +function frxConfirmMsg(const Text: String; Buttons: Integer): Integer; +function frxIsValidFloat(const Value: string): Boolean; +procedure frxAssignImages(Bitmap: TBitmap; dx, dy: Integer; + ImgList1: TImageList; ImgList2: TImageList = nil); +procedure frxDrawTransparent(Canvas: TCanvas; x, y: Integer; bmp: TBitmap); +procedure frxDrawGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic; + IsPrinting: Boolean); +procedure frxParsePageNumbers(const PageNumbers: String; List: TStrings; + Total: Integer); +function HTMLRGBColor(Color: TColor): string; +procedure frxWriteCollection(Collection: TCollection; Writer: TWriter; + Owner: TfrxComponent); +procedure frxReadCollection(Collection: TCollection; Reader: TReader; + Owner: TfrxComponent); +function GetAppFileName: String; +function GetAppPath: String; +function GetTemporaryFolder: String; +function GetTempFile: String; +function frxCreateTempFile(const TempDir: String): String; +{$IFNDEF Delphi7} +function frFloat2Str(const Value: Extended; const Prec: Integer = 2): String; +{$ELSE} +function frFloat2Str(const Value: Extended; const Prec: Integer = 2; const Sep: Char = '.'): String; +{$ENDIF} +function frxReverseString(const AText: string): string; +function frxStreamCRC32(Stream: TStream): Cardinal; +function frxUnixPath2WinPath(const Path: string): string; + + +implementation + +uses frxXMLSerializer, frxRes, TypInfo; + + +{ TfrxRectArea } + +constructor TfrxRectArea.Create(c: TfrxComponent); +begin + Create(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height); +end; + +constructor TfrxRectArea.Create(Left, Top, Right, Bottom: Extended); +begin + X := Left; + Y := Top; + X1 := Right; + Y1 := Bottom; +end; + +function TfrxRectArea.InterceptsX(a: TfrxRectArea): Boolean; +begin + Result := False; + if (a.X < X1 - 1e-4) and (a.X1 > X + 1e-4) then + Result := True; +end; + +function TfrxRectArea.InterceptsY(a: TfrxRectArea): Boolean; +begin + Result := False; + if (a.Y < Y1 - 1e-4) and (a.Y1 > Y + 1e-4) then + Result := True; +end; + +function TfrxRectArea.InterceptX(a: TfrxRectArea): TfrxRectArea; +begin + Result := nil; + if InterceptsX(a) then + Result := TfrxRectArea.Create(Max(a.X, X), 0, Min(a.X1, X1), 0); +end; + +function TfrxRectArea.InterceptY(a: TfrxRectArea): TfrxRectArea; +begin + Result := nil; + if InterceptsY(a) then + Result := TfrxRectArea.Create(0, Max(a.Y, Y), 0, Min(a.Y1, Y1)); +end; + +function TfrxRectArea.Max(x1, x2: Extended): Extended; +begin + if x1 > x2 then + Result := x1 + else + Result := x2; +end; + +function TfrxRectArea.Min(x1, x2: Extended): Extended; +begin + if x1 < x2 then + Result := x1 + else + Result := x2; +end; + + + +const + CRCTable: array [0..255] of Cardinal = ( + 0000000000, 1996959894, 3993919788, 2567524794, + 0124634137, 1886057615, 3915621685, 2657392035, + 0249268274, 2044508324, 3772115230, 2547177864, + 0162941995, 2125561021, 3887607047, 2428444049, + 0498536548, 1789927666, 4089016648, 2227061214, + 0450548861, 1843258603, 4107580753, 2211677639, + 0325883990, 1684777152, 4251122042, 2321926636, + 0335633487, 1661365465, 4195302755, 2366115317, + 0997073096, 1281953886, 3579855332, 2724688242, + 1006888145, 1258607687, 3524101629, 2768942443, + 0901097722, 1119000684, 3686517206, 2898065728, + 0853044451, 1172266101, 3705015759, 2882616665, + 0651767980, 1373503546, 3369554304, 3218104598, + 0565507253, 1454621731, 3485111705, 3099436303, + 0671266974, 1594198024, 3322730930, 2970347812, + 0795835527, 1483230225, 3244367275, 3060149565, + 1994146192, 0031158534, 2563907772, 4023717930, + 1907459465, 0112637215, 2680153253, 3904427059, + 2013776290, 0251722036, 2517215374, 3775830040, + 2137656763, 0141376813, 2439277719, 3865271297, + 1802195444, 0476864866, 2238001368, 4066508878, + 1812370925, 0453092731, 2181625025, 4111451223, + 1706088902, 0314042704, 2344532202, 4240017532, + 1658658271, 0366619977, 2362670323, 4224994405, + 1303535960, 0984961486, 2747007092, 3569037538, + 1256170817, 1037604311, 2765210733, 3554079995, + 1131014506, 0879679996, 2909243462, 3663771856, + 1141124467, 0855842277, 2852801631, 3708648649, + 1342533948, 0654459306, 3188396048, 3373015174, + 1466479909, 0544179635, 3110523913, 3462522015, + 1591671054, 0702138776, 2966460450, 3352799412, + 1504918807, 0783551873, 3082640443, 3233442989, + 3988292384, 2596254646, 0062317068, 1957810842, + 3939845945, 2647816111, 0081470997, 1943803523, + 3814918930, 2489596804, 0225274430, 2053790376, + 3826175755, 2466906013, 0167816743, 2097651377, + 4027552580, 2265490386, 0503444072, 1762050814, + 4150417245, 2154129355, 0426522225, 1852507879, + 4275313526, 2312317920, 0282753626, 1742555852, + 4189708143, 2394877945, 0397917763, 1622183637, + 3604390888, 2714866558, 0953729732, 1340076626, + 3518719985, 2797360999, 1068828381, 1219638859, + 3624741850, 2936675148, 0906185462, 1090812512, + 3747672003, 2825379669, 0829329135, 1181335161, + 3412177804, 3160834842, 0628085408, 1382605366, + 3423369109, 3138078467, 0570562233, 1426400815, + 3317316542, 2998733608, 0733239954, 1555261956, + 3268935591, 3050360625, 0752459403, 1541320221, + 2607071920, 3965973030, 1969922972, 0040735498, + 2617837225, 3943577151, 1913087877, 0083908371, + 2512341634, 3803740692, 2075208622, 0213261112, + 2463272603, 3855990285, 2094854071, 0198958881, + 2262029012, 4057260610, 1759359992, 0534414190, + 2176718541, 4139329115, 1873836001, 0414664567, + 2282248934, 4279200368, 1711684554, 0285281116, + 2405801727, 4167216745, 1634467795, 0376229701, + 2685067896, 3608007406, 1308918612, 0956543938, + 2808555105, 3495958263, 1231636301, 1047427035, + 2932959818, 3654703836, 1088359270, 0936918000, + 2847714899, 3736837829, 1202900863, 0817233897, + 3183342108, 3401237130, 1404277552, 0615818150, + 3134207493, 3453421203, 1423857449, 0601450431, + 3009837614, 3294710456, 1567103746, 0711928724, + 3020668471, 3272380065, 1510334235, 0755167117); + +function frxStreamCRC32(Stream: TStream): Cardinal; +var + OldPos: Integer; + b: Byte; + c: Cardinal; +begin + OldPos := Stream.Position; + Stream.Position := 0; + c := $ffffffff; + while Stream.Position < Stream.Size do + begin + Stream.Read(b,1); + c := CrcTable[(c xor Cardinal(b)) and $ff] xor (c shr 8); + end; + Stream.Position := OldPos; + Result := c xor $ffffffff; +end; + +function frxFindComponent(Owner: TComponent; const Name: String): TComponent; +var + n: Integer; + s1, s2: String; +begin + Result := nil; + n := Pos('.', Name); + try + if n = 0 then + begin + if Owner <> nil then + Result := Owner.FindComponent(Name); + if (Result = nil) and (Owner is TfrxReport) and (Owner.Owner <> nil) then + Result := Owner.Owner.FindComponent(Name); + end + else + begin + s1 := Copy(Name, 1, n - 1); // module name + s2 := Copy(Name, n + 1, 255); // component name + Owner := FindGlobalComponent(s1); + if Owner <> nil then + begin + n := Pos('.', s2); + if n <> 0 then // frame name - Delphi5 + begin + s1 := Copy(s2, 1, n - 1); + s2 := Copy(s2, n + 1, 255); + Owner := Owner.FindComponent(s1); + if Owner <> nil then + Result := Owner.FindComponent(s2); + end + else + Result := Owner.FindComponent(s2); + end; + end; + except + on Exception do + raise EClassNotFound.Create('Missing ' + Name); + end; +end; + +{$HINTS OFF} +procedure frxGetComponents(Owner: TComponent; ClassRef: TClass; + List: TStrings; Skip: TComponent); +var + i, j: Integer; + + procedure EnumComponents(f: TComponent); + var + i: Integer; + c: TComponent; + begin +{$IFDEF Delphi5} + if f is TForm then + for i := 0 to TForm(f).ControlCount - 1 do + begin + c := TForm(f).Controls[i]; + if c is TFrame then + EnumComponents(c); + end; +{$ENDIF} + for i := 0 to f.ComponentCount - 1 do + begin + c := f.Components[i]; + if (c <> Skip) and (c is ClassRef) then + List.AddObject(frxGetFullName(Owner, c), c); + end; + end; + +begin + List.Clear; + if Owner is TfrxReport then + EnumComponents(Owner); + for i := 0 to Screen.FormCount - 1 do + EnumComponents(Screen.Forms[i]); + for i := 0 to Screen.DataModuleCount - 1 do + EnumComponents(Screen.DataModules[i]); +{$IFDEF Delphi6} // D6 bugfix + with Screen do + for i := 0 to CustomFormCount - 1 do + with CustomForms[i] do + if (ClassName = 'TDataModuleForm') then + for j := 0 to ComponentCount - 1 do + begin + if (Components[j] is TDataModule) then + EnumComponents(Components[j]); + end; +{$ENDIF} +end; +{$HINTS ON} + +function frxGetFullName(Owner: TComponent; c: TComponent): String; +var + o: TComponent; +begin + Result := ''; + if c = nil then Exit; + + o := c.Owner; + if (o = nil) or (o = Owner) or ((Owner is TfrxReport) and (o = Owner.Owner)) then + Result := c.Name + else if ((o is TForm) or (o is TDataModule)) then + Result := o.Name + '.' + c.Name +{$IFDEF Delphi5} + else if o is TFrame then + Result := o.Owner.Name + '.' + c.Owner.Name + '.' + c.Name +{$ENDIF} +end; + +procedure frxSetCommaText(const Text: String; sl: TStrings; Comma: Char = ';'); +var + i: Integer; + + function ExtractCommaName(s: string; var Pos: Integer): string; + var + i: Integer; + begin + i := Pos; + while (i <= Length(s)) and (s[i] <> Comma) do Inc(i); + Result := Copy(s, Pos, i - Pos); + if (i <= Length(s)) and (s[i] = Comma) then Inc(i); + Pos := i; + end; + +begin + i := 1; + sl.Clear; + while i <= Length(Text) do + sl.Add(ExtractCommaName(Text, i)); +end; + +function frxRemoveQuotes(const s: String): String; +begin + if (Length(s) > 2) and (s[1] = '"') and (s[Length(s)] = '"') then + Result := Copy(s, 2, Length(s) - 2) else + Result := s; +end; + +function frxStreamToString(Stream: TStream): String; +var + Size: Integer; + p: PChar; +begin + Size := Stream.Size; + SetLength(Result, Size * 2); + GetMem(p, Size); + + Stream.Position := 0; + Stream.Read(p^, Size); + + BinToHex(p, @Result[1], Size); + + FreeMem(p, Size); +end; + +procedure frxStringToStream(const s: String; Stream: TStream); +var + Size: Integer; + p: PChar; +begin + Size := Length(s) div 2; + GetMem(p, Size); + + HexToBin(@s[1], p, Size * 2); + + Stream.Position := 0; + Stream.Write(p^, Size); + + FreeMem(p, Size); +end; + +function frxStrToFloat(s: String): Extended; +var + i: Integer; +begin + for i := 1 to Length(s) do + if s[i] in [',', '.'] then + s[i] := DecimalSeparator; + while Pos(' ', s) <> 0 do + Delete(s, Pos(' ', s), 1); + Result := StrToFloat(s); +end; + +function frxFloatToStr(d: Extended): String; +begin + if Int(d) = d then + Result := FloatToStr(d) else + Result := Format('%2.2f', [d]); +end; + +function frxRect(ALeft, ATop, ARight, ABottom: Extended): TfrxRect; +begin + with Result do + begin + Left := ALeft; + Top := ATop; + Right := ARight; + Bottom := ABottom; + end; +end; + +function frxPoint(X, Y: Extended): TfrxPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +function frxGetBrackedVariable(const Str, OpenBracket, CloseBracket: String; + var i, j: Integer): String; +var + c: Integer; + fl1, fl2: Boolean; +begin + Result := ''; + j := i; + fl1 := True; + fl2 := True; + c := 0; + if (Str = '') or (j > Length(Str)) then Exit; + + Dec(j); + repeat + Inc(j); + if isDBCSLeadByte(Byte(Str[j])) then { if DBCS then skip 2 bytes } + Inc(j, 2); + + if fl1 and fl2 then + if Copy(Str, j, Length(OpenBracket)) = OpenBracket then + begin + if c = 0 then i := j; + Inc(c); + end + else if Copy(Str, j, Length(CloseBracket)) = CloseBracket then + Dec(c); + if fl1 then + if Str[j] = '"' then fl2 := not fl2; + if fl2 then + if Str[j] = '''' then fl1 := not fl1; + until (c = 0) or (j >= Length(Str)); + + Result := Copy(Str, i + Length(OpenBracket), j - i - Length(OpenBracket)); + if i <> j then + Inc(j, Length(CloseBracket) - 1); +end; + +function frxGetBrackedVariableW(const Str, OpenBracket, CloseBracket: WideString; + var i, j: Integer): WideString; +var + c: Integer; + fl1, fl2: Boolean; +begin + Result := ''; + j := i; + fl1 := True; + fl2 := True; + c := 0; + if (Str = '') or (j > Length(Str)) then Exit; + + Dec(j); + repeat + Inc(j); + if fl1 and fl2 then + if Copy(Str, j, Length(OpenBracket)) = OpenBracket then + begin + if c = 0 then i := j; + Inc(c); + end + else if Copy(Str, j, Length(CloseBracket)) = CloseBracket then + Dec(c); + if fl1 then + if Str[j] = '"' then fl2 := not fl2; + if fl2 then + if Str[j] = '''' then fl1 := not fl1; + until (c = 0) or (j >= Length(Str)); + + Result := Copy(Str, i + Length(OpenBracket), j - i - Length(OpenBracket)); + if i <> j then + Inc(j, Length(CloseBracket) - 1); +end; + +procedure frxCommonErrorHandler(Report: TfrxReport; const Text: String); +var + e: Exception; +begin + case Report.EngineOptions.NewSilentMode of + simMessageBoxes: frxErrorMsg(Text); + simReThrow: begin e := Exception.Create(Text); raise e; end; + end; +end; + +procedure frxErrorMsg(const Text: String); +begin + Application.MessageBox(PChar(Text), PChar(frxResources.Get('mbError')), + mb_Ok + mb_IconError); +end; + +function frxConfirmMsg(const Text: String; Buttons: Integer): Integer; +begin + Result := Application.MessageBox(PChar(Text), + PChar(frxResources.Get('mbConfirm')), mb_IconQuestion + Buttons); +end; + +procedure frxInfoMsg(const Text: String); +begin + Application.MessageBox(PChar(Text), PChar(frxResources.Get('mbInfo')), + mb_Ok + mb_IconInformation); +end; + +function frxIsValidFloat(const Value: string): Boolean; +begin + Result := True; + try + frxStrToFloat(Value); + except + Result := False; + end; +end; + +procedure frxAssignImages(Bitmap: TBitmap; dx, dy: Integer; + ImgList1: TImageList; ImgList2: TImageList = nil); +var + b: TBitmap; + x, y: Integer; + Done: Boolean; +begin + b := TBitmap.Create; + b.Width := dx; + b.Height := dy; + + x := 0; y := 0; + + repeat + b.Canvas.CopyRect(Rect(0, 0, dx, dy), Bitmap.Canvas, Rect(x, y, x + dx, y + dy)); + Done := y > Bitmap.Height; + + if not Done then + begin + ImgList1.AddMasked(b, b.TransparentColor); + if ImgList2 <> nil then + begin + Inc(x, dx); + b.Canvas.CopyRect(Rect(0, 0, dx, dy), Bitmap.Canvas, Rect(x, y, x + dx, y + dy)); + ImgList2.AddMasked(b, b.TransparentColor); + end; + end; + + Inc(x, dx); + if x >= Bitmap.Width then + begin + x := 0; + Inc(y, dy); + end; + until Done; + + b.Free; +end; + +procedure frxDrawTransparent(Canvas: TCanvas; x, y: Integer; bmp: TBitmap); +var + img: TImageList; +begin + if Assigned(bmp) then + begin + img := TImageList.Create(nil); + try + img.Width := bmp.Width; + img.Height := bmp.Height; + img.AddMasked(bmp, bmp.TransparentColor); + img.Draw(Canvas, x, y, 0); + img.Clear; + finally + img.Free; + end; + end; +end; + +procedure DrawBitmap(aCanvas: TCanvas; Dest: TRect; Bitmap: TBitmap); +var + Info: PBitmapInfo; + HInfo: HGLOBAL; + InfoSize: DWord; + Image: Pointer; + HImage: HGLOBAL; + ImageSize: DWord; +begin + with Bitmap do + begin + GetDIBSizes(Handle, InfoSize, ImageSize); + HInfo := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE, InfoSize); + Info := PBitmapInfo(GlobalLock(HInfo)); + try + HImage := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE, ImageSize); + Image := Pointer(GlobalLock(HImage)); + try + GetDIB(Handle, Palette, Info^, Image^); + SetStretchBltMode(ACanvas.Handle, STRETCH_HALFTONE); + with Info^.bmiHeader do + StretchDIBits(aCanvas.Handle, Dest.Left, Dest.Top, + Dest.RIght - Dest.Left, Dest.Bottom - Dest.Top, + 0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY); + finally + GlobalUnlock(HImage); + GlobalFree(HImage); + end; + finally + GlobalUnlock(HInfo); + GlobalFree(HInfo); + end; + end; +end; + +procedure frxDrawGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic; + IsPrinting: Boolean); +var + Bitmap: TBitmap; +begin + if (aGraph is TMetaFile) or not IsPrinting then + Canvas.StretchDraw(DestRect, aGraph) + else + begin + Bitmap := TBitmap.Create; + try + Bitmap.Width := aGraph.Width; + Bitmap.Height := aGraph.Height; + Bitmap.PixelFormat := pf32Bit; + Bitmap.Canvas.Draw(0, 0, aGraph); + DrawBitmap(Canvas, DestRect, Bitmap); + finally + Bitmap.Free; + end; + end +end; + +procedure frxParsePageNumbers(const PageNumbers: String; List: TStrings; + Total: Integer); +var + i, j, n1, n2: Integer; + s: String; + IsRange: Boolean; +begin + List.Clear; + s := PageNumbers; + while Pos(' ', s) <> 0 do + Delete(s, Pos(' ', s), 1); + if s = '' then Exit; + + if s[Length(s)] = '-' then + s := s + IntToStr(Total); + s := s + ','; + i := 1; j := 1; n1 := 1; + IsRange := False; + + while i <= Length(s) do + begin + if s[i] = ',' then + begin + n2 := StrToInt(Copy(s, j, i - j)); + j := i + 1; + if IsRange then + while n1 <= n2 do + begin + List.Add(IntToStr(n1)); + Inc(n1); + end + else + List.Add(IntToStr(n2)); + IsRange := False; + end + else if s[i] = '-' then + begin + IsRange := True; + n1 := StrToInt(Copy(s, j, i - j)); + j := i + 1; + end; + Inc(i); + end; +end; + +function HTMLRGBColor(Color: TColor): string; +var + TheRgbValue : TColorRef; +begin + TheRgbValue := ColorToRGB(Color); + Result := '#' + Format('%.2x%.2x%.2x', [GetRValue(TheRGBValue), GetGValue(TheRGBValue), GetBValue(TheRGBValue)]); +end; + + +procedure ConvertOneItem(Item: TCollectionItem; ToAnsi: Boolean); +var + i: Integer; + TypeInfo: PTypeInfo; + PropCount: Integer; + PropList: PPropList; + + function Convert(const Value: String): String; + var + i: Integer; + begin + Result := ''; + i := 1; + while i <= Length(Value) do + begin + if ToAnsi then + begin + if Value[i] >= #128 then + Result := Result + #1 + Chr(Ord(Value[i]) - 128) else + Result := Result + Value[i]; + end + else + begin + if (Value[i] = #1) and (i < Length(Value)) then + begin + Result := Result + Chr(Ord(Value[i + 1]) + 128); + Inc(i); + end + else + Result := Result + Value[i]; + end; + + Inc(i); + end; + end; + + procedure DoStrProp; + var + Value, NewValue: String; + begin + Value := GetStrProp(Item, PropList[i]); + NewValue := Convert(Value); + if Value <> NewValue then + SetStrProp(Item, PropList[i], NewValue); + end; + + procedure DoVariantProp; + var + Value: Variant; + begin + Value := GetVariantProp(Item, PropList[i]); + if (TVarData(Value).VType = varString) or (TVarData(Value).VType = varOleStr) then + begin + Value := Convert(Value); + SetVariantProp(Item, PropList[i], Value); + end; + end; + +begin + TypeInfo := Item.ClassInfo; + PropCount := GetTypeData(TypeInfo).PropCount; + GetMem(PropList, PropCount * SizeOf(PPropInfo)); + GetPropInfos(TypeInfo, PropList); + + try + for i := 0 to PropCount - 1 do + begin + case PropList[i].PropType^.Kind of + tkString, tkLString, tkWString: + DoStrProp; + + tkVariant: + DoVariantProp; + end; + end; + + finally + FreeMem(PropList, PropCount * SizeOf(PPropInfo)); + end; +end; + +procedure frxWriteCollection(Collection: TCollection; Writer: TWriter; + Owner: TfrxComponent); +var + i, l: Integer; + xs: TfrxXMLSerializer; + s: String; + vt: TValueType; +begin + if Owner.IsWriting then + begin + { called from SaveToStream } + Writer.WriteListBegin; + xs := TfrxXMLSerializer.Create(nil); + try + xs.Owner := Owner.Report; + for i := 0 to Collection.Count - 1 do + begin + Writer.WriteListBegin; + s := xs.ObjToXML(Collection.Items[i]); + vt := vaLString; + Writer.Write(vt, SizeOf(vt)); + l := Length(s); + Writer.Write(l, SizeOf(l)); + Writer.Write(s[1], l); + Writer.WriteListEnd; + end; + finally + Writer.WriteListEnd; + xs.Free; + end; + end + else + begin + { called from Delphi streamer } + Writer.WriteCollection(Collection); + end; +end; + +procedure frxReadCollection(Collection: TCollection; Reader: TReader; + Owner: TfrxComponent); +var + i: Integer; + vt: TValueType; + xs: TfrxXMLSerializer; + s: String; + Item: TCollectionItem; + NeedFree: Boolean; +begin + vt := Reader.ReadValue; + if vt <> vaCollection then + begin + { called from LoadFromStream } + NeedFree := False; + xs := nil; + if Owner.Report <> nil then + xs := TfrxXMLSerializer(Owner.Report.XMLSerializer); + + if xs = nil then + begin + xs := TfrxXMLSerializer.Create(nil); + xs.Owner := Owner.Report; + NeedFree := True; + end; + + try + Collection.Clear; + + while not Reader.EndOfList do + begin + Reader.ReadListBegin; + Item := Collection.Add; + s := Reader.ReadString; + if NeedFree then + xs.ReadPersistentStr(Owner.Report, Item, s) + else + xs.XMLToObj(s, Item); + Reader.ReadListEnd; + end; + finally + Reader.ReadListEnd; + if NeedFree then + xs.Free; + end; + end + else + begin + { called from Delphi streamer } + Reader.ReadCollection(Collection); + for i := 0 to Collection.Count - 1 do + ConvertOneItem(Collection.Items[i], False); + end; +end; + +function GetTemporaryFolder: String; +var + Path: String; +begin + Setlength(Path, MAX_PATH); + SetLength(Path, GetTempPath(MAX_PATH, @Path[1])); + Result := StrPas(@Path[1]); +end; + +function GetTempFile: String; +var + Path: String; + FileName: String; +begin + SetLength(Path, MAX_PATH); + SetLength(Path, GetTempPath(MAX_PATH, @Path[1])); + SetLength(FileName, MAX_PATH); + GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]); + Result := StrPas(@FileName[1]); +end; + +function frxCreateTempFile(const TempDir: String): String; +var + Path: String; + FileName: String; +begin + Path := TempDir; + if (Path <> '') and (Path[Length(Path)] <> '\') then + Path := Path + '\'; + SetLength(FileName, MAX_PATH); + if Path = '' then + begin + SetLength(Path, MAX_PATH); + SetLength(Path, GetTempPath(MAX_PATH, @Path[1])); + end + else begin + Path := Path + #0; + SetLength(Path, MAX_PATH); + end; + GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]); + Result := StrPas(@FileName[1]); +end; + +function GetAppFileName: String; +var + fName: String; + nsize: cardinal; +begin + nsize := MAX_PATH; + SetLength(fName,nsize); + SetLength(fName, GetModuleFileName(hinstance, pchar(fName), nsize)); + Result := fName; +end; + +function GetAppPath: String; +begin + Result := ExtractFilePath(GetAppFileName); +end; + +{$IFNDEF Delphi7} +function frFloat2Str(const Value: Extended; const Prec: Integer = 2): String; +var + i: Integer; + IntVal: Integer; +begin + IntVal := Trunc(Value); + if IntVal <> Value then + Result := Format('%.' + IntToStr(Prec)+ 'f', [Value]) + else + Result := IntToStr(IntVal); + if DecimalSeparator <> '.' then + begin + i := Pos(DecimalSeparator, Result); + if i > 0 then + Result[i] := '.'; + end; +end; +{$ELSE} +function frFloat2Str(const Value: Extended; const Prec: Integer = 2; const Sep: Char = '.'): String; +var + IntVal: Integer; + FormatSettings: TFormatSettings; +begin + IntVal := Trunc(Value); + if IntVal <> Value then + begin + GetLocaleFormatSettings(0, FormatSettings); + FormatSettings.DecimalSeparator := Sep; + FormatSettings.ThousandSeparator := Char(0); + Result := Format('%.' + IntToStr(Prec)+ 'f', [Value], FormatSettings) + end + else + Result := IntToStr(IntVal); +end; +{$ENDIF} + +function frxReverseString(const AText: string): string; +var + I: Integer; + P: PChar; +begin + SetLength(Result, Length(AText)); + P := PChar(Result); + for I := Length(AText) downto 1 do + begin + P^ := AText[I]; + Inc(P); + end; +end; + +function ChangeChars(const Str: string; FromChar, ToChar: Char): string; +var + I: Integer; +begin + Result := Str; + for I := 1 to Length(Result) do + if Result[I] = FromChar then + Result[I] := ToChar; +end; + +function frxUnixPath2WinPath(const Path: string): string; +begin + Result := ChangeChars(Path, '/', '\'); +end; + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxVariables.pas b/official/4.2/Source/frxVariables.pas new file mode 100644 index 0000000..7264c82 --- /dev/null +++ b/official/4.2/Source/frxVariables.pas @@ -0,0 +1,406 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ FR Variables } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxVariables; + +interface + +{$I frx.inc} + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, + frxXML +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxVariable = class(TCollectionItem) + private + FName: String; + FValue: Variant; + public + constructor Create(Collection: TCollection); override; + procedure Assign(Source: TPersistent); override; + published + property Name: String read FName write FName; + property Value: Variant read FValue write FValue; + end; + + TfrxVariables = class(TCollection) + private + function GetItems(Index: Integer): TfrxVariable; + function GetVariable(Index: String): Variant; + procedure SetVariable(Index: String; const Value: Variant); + public + constructor Create; + function Add: TfrxVariable; + function Insert(Index: Integer): TfrxVariable; + function IndexOf(const Name: String): Integer; + procedure AddVariable(const ACategory, AName: String; const AValue: Variant); + procedure DeleteCategory(const Name: String); + procedure DeleteVariable(const Name: String); + procedure GetCategoriesList(List: TStrings; ClearList: Boolean = True); + procedure GetVariablesList(const Category: String; List: TStrings); + procedure LoadFromFile(const FileName: String); + procedure LoadFromStream(Stream: TStream); + procedure LoadFromXMLItem(Item: TfrxXMLItem); + procedure SaveToFile(const FileName: String); + procedure SaveToStream(Stream: TStream); + procedure SaveToXMLItem(Item: TfrxXMLItem); + property Items[Index: Integer]: TfrxVariable read GetItems; + property Variables[Index: String]: Variant read GetVariable + write SetVariable; default; + end; + + TfrxArray = class(TCollection) + private + function GetItems(Index: Integer): TfrxVariable; + function GetVariable(Index: Variant): Variant; + procedure SetVariable(Index: Variant; const Value: Variant); + public + constructor Create; + function IndexOf(const Name: Variant): Integer; + property Items[Index: Integer]: TfrxVariable read GetItems; + property Variables[Index: Variant]: Variant read GetVariable + write SetVariable; default; + end; + + +implementation + +uses frxXMLSerializer; + + +{ TfrxVariable } + +constructor TfrxVariable.Create(Collection: TCollection); +begin + inherited; + FValue := Null; +end; + +procedure TfrxVariable.Assign(Source: TPersistent); +begin + if Source is TfrxVariable then + begin + FName := TfrxVariable(Source).Name; + FValue := TfrxVariable(Source).Value; + end; +end; + + +{ TfrxVariables } + +constructor TfrxVariables.Create; +begin + inherited Create(TfrxVariable); +end; + +function TfrxVariables.Add: TfrxVariable; +begin + Result := TfrxVariable(inherited Add); +end; + +function TfrxVariables.Insert(Index: Integer): TfrxVariable; +begin + Result := TfrxVariable(inherited Insert(Index)); +end; + +function TfrxVariables.GetItems(Index: Integer): TfrxVariable; +begin + Result := TfrxVariable(inherited Items[Index]); +end; + +function TfrxVariables.IndexOf(const Name: String): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to Count - 1 do + if AnsiCompareText(Name, Items[i].Name) = 0 then + begin + Result := i; + break; + end; +end; + +function TfrxVariables.GetVariable(Index: String): Variant; +var + i: Integer; +begin + i := IndexOf(Index); + if i <> -1 then + Result := Items[i].Value else + Result := Null; +end; + +procedure TfrxVariables.SetVariable(Index: String; const Value: Variant); +var + i: Integer; + v: TfrxVariable; +begin + i := IndexOf(Index); + if i <> -1 then + Items[i].Value := Value + else + begin + v := Add; + v.Name := Index; + v.Value := Value; + end; +end; + +procedure TfrxVariables.GetCategoriesList(List: TStrings; ClearList: Boolean = True); +var + i: Integer; + s: String; +begin + if ClearList then + List.Clear; + + for i := 0 to Count - 1 do + begin + s := Items[i].Name; + if (s <> '') and (s[1] = ' ') then + List.Add(Copy(s, 2, 255)); + end; +end; + +procedure TfrxVariables.GetVariablesList(const Category: String; List: TStrings); +var + i, j: Integer; + s: String; +begin + List.Clear; + for i := 0 to Count - 1 do + if (Category = '') or (AnsiCompareText(Items[i].Name, ' ' + Category) = 0) then + begin + if Category <> '' then + j := i + 1 else + j := i; + while j < Count do + begin + s := Items[j].Name; + Inc(j); + if (s <> '') and (s[1] <> ' ') then + List.Add(s) else + break + end; + break; + end; +end; + +procedure TfrxVariables.DeleteCategory(const Name: String); +var + i: Integer; +begin + i := 0; + while i < Count do + begin + if AnsiCompareText(Items[i].Name, ' ' + Name) = 0 then + begin + Items[i].Free; + while (i < Count) and (Items[i].Name[1] <> ' ') do + Items[i].Free; + break; + end; + Inc(i); + end; +end; + +procedure TfrxVariables.DeleteVariable(const Name: String); +var + i: Integer; +begin + i := IndexOf(Name); + if i <> -1 then + Items[i].Free; +end; + +procedure TfrxVariables.AddVariable(const ACategory, AName: String; + const AValue: Variant); +var + i: Integer; +begin + i := 0; + while i < Count do + begin + if AnsiCompareText(Items[i].Name, ' ' + ACategory) = 0 then + begin + Inc(i); + while (i < Count) and (Items[i].Name[1] <> ' ') do + Inc(i); + if i = Count then + with Add do + begin + Name := AName; + Value := AValue; + end + else + with Insert(i) do + begin + Name := AName; + Value := AValue; + end; + break; + end; + Inc(i); + end; +end; + +procedure TfrxVariables.LoadFromFile(const FileName: String); +var + f: TFileStream; +begin + f := TFileStream.Create(FileName, fmOpenRead); + try + LoadFromStream(f); + finally + f.Free; + end; +end; + +procedure TfrxVariables.LoadFromStream(Stream: TStream); +var + x: TfrxXMLDocument; +begin + Clear; + x := TfrxXMLDocument.Create; + try + x.LoadFromStream(Stream); + if CompareText(x.Root.Name, 'variables') = 0 then + LoadFromXMLItem(x.Root); + finally + x.Free; + end; +end; + +procedure TfrxVariables.LoadFromXMLItem(Item: TfrxXMLItem); +var + xs: TfrxXMLSerializer; + i: Integer; +begin + Clear; + xs := TfrxXMLSerializer.Create(nil); + try + for i := 0 to Item.Count - 1 do + if CompareText(Item[i].Name, 'item') = 0 then + xs.XMLToObj(Item[i].Text, Add); + finally + xs.Free; + end; +end; + +procedure TfrxVariables.SaveToFile(const FileName: String); +var + f: TFileStream; +begin + f := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(f); + finally + f.Free; + end; +end; + +procedure TfrxVariables.SaveToStream(Stream: TStream); +var + x: TfrxXMLDocument; +begin + x := TfrxXMLDocument.Create; + x.AutoIndent := True; + try + x.Root.Name := 'variables'; + SaveToXMLItem(x.Root); + x.SaveToStream(Stream); + finally + x.Free; + end; +end; + +procedure TfrxVariables.SaveToXMLItem(Item: TfrxXMLItem); +var + xi: TfrxXMLItem; + xs: TfrxXMLSerializer; + i: Integer; +begin + xs := TfrxXMLSerializer.Create(nil); + try + for i := 0 to Count - 1 do + begin + xi := Item.Add; + xi.Name := 'item'; + xi.Text := xs.ObjToXML(Items[i]); + end; + finally + xs.Free; + end; +end; + + +{ TfrxArray } + +constructor TfrxArray.Create; +begin + inherited Create(TfrxVariable); +end; + +function TfrxArray.GetItems(Index: Integer): TfrxVariable; +begin + Result := TfrxVariable(inherited Items[Index]); +end; + +function TfrxArray.IndexOf(const Name: Variant): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to Count - 1 do + if AnsiCompareText(VarToStr(Name), Items[i].Name) = 0 then + begin + Result := i; + break; + end; +end; + +function TfrxArray.GetVariable(Index: Variant): Variant; +var + i: Integer; +begin + i := IndexOf(Index); + if i <> -1 then + Result := Items[i].Value else + Result := Null; +end; + +procedure TfrxArray.SetVariable(Index: Variant; const Value: Variant); +var + i: Integer; + v: TfrxVariable; +begin + i := IndexOf(Index); + if i <> -1 then + Items[i].Value := Value + else + begin + v := TfrxVariable(inherited Add); + v.Name := Index; + v.Value := Value; + end; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxVersion.inc b/official/4.2/Source/frxVersion.inc new file mode 100644 index 0000000..b51d74e --- /dev/null +++ b/official/4.2/Source/frxVersion.inc @@ -0,0 +1 @@ +'4.3' \ No newline at end of file diff --git a/official/4.2/Source/frxWatchForm.dfm b/official/4.2/Source/frxWatchForm.dfm new file mode 100644 index 0000000..cf7458a Binary files /dev/null and b/official/4.2/Source/frxWatchForm.dfm differ diff --git a/official/4.2/Source/frxWatchForm.pas b/official/4.2/Source/frxWatchForm.pas new file mode 100644 index 0000000..85b4f25 --- /dev/null +++ b/official/4.2/Source/frxWatchForm.pas @@ -0,0 +1,178 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ Watches toolwindow } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxWatchForm; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, ToolWin, fs_iinterpreter +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + +type + TfrxWatchForm = class(TForm) + ToolBar1: TToolBar; + AddB: TToolButton; + DeleteB: TToolButton; + EditB: TToolButton; + WatchLB: TListBox; + procedure FormShow(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormDestroy(Sender: TObject); + procedure AddBClick(Sender: TObject); + procedure DeleteBClick(Sender: TObject); + procedure EditBClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + private + FScript: TfsScript; + FScriptRunning: Boolean; + FWatches: TStrings; + function CalcWatch(const s: String): String; + public + procedure UpdateWatches; + property Script: TfsScript read FScript write FScript; + property ScriptRunning: Boolean read FScriptRunning write FScriptRunning; + property Watches: TStrings read FWatches; + end; + + +implementation + +{$R *.DFM} + +uses frxRes, frxEvaluateForm; + +type + THackWinControl = class(TWinControl); + + +procedure TfrxWatchForm.FormCreate(Sender: TObject); +begin + Caption := frxGet(5900); + AddB.Hint := frxGet(5901); + DeleteB.Hint := frxGet(5902); + EditB.Hint := frxGet(5903); + FWatches := TStringList.Create; +{$IFDEF UseTabset} + WatchLB.BevelKind := bkFlat; +{$ELSE} + WatchLB.BorderStyle := bsSingle; +{$ENDIF} + + if UseRightToLeftAlignment then + FlipChildren(True); +end; + +procedure TfrxWatchForm.FormDestroy(Sender: TObject); +begin + FWatches.Free; +end; + +procedure TfrxWatchForm.FormShow(Sender: TObject); +begin + Toolbar1.Images := frxResources.MainButtonImages; +end; + +procedure TfrxWatchForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_F1 then + frxResources.Help(Self); +end; + +procedure TfrxWatchForm.AddBClick(Sender: TObject); +begin + with TfrxEvaluateForm.Create(Owner) do + begin + IsWatch := True; + if ShowModal = mrOk then + begin + Watches.Add(ExpressionE.Text); + UpdateWatches; + end; + Free; + end; +end; + +procedure TfrxWatchForm.DeleteBClick(Sender: TObject); +begin + if WatchLB.ItemIndex <> -1 then + begin + Watches.Delete(WatchLB.ItemIndex); + UpdateWatches; + end; +end; + +procedure TfrxWatchForm.EditBClick(Sender: TObject); +begin + if WatchLB.ItemIndex <> -1 then + with TfrxEvaluateForm.Create(Owner) do + begin + IsWatch := True; + ExpressionE.Text := Watches[WatchLB.ItemIndex]; + if ShowModal = mrOk then + begin + Watches[WatchLB.ItemIndex] := ExpressionE.Text; + UpdateWatches; + end; + Free; + end; +end; + +function TfrxWatchForm.CalcWatch(const s: String): String; +var + v: Variant; +begin + if (FScript <> nil) and (FScriptRunning) then + begin + v := FScript.Evaluate(s); + Result := VarToStr(v); + if TVarData(v).VType = varBoolean then + if Boolean(v) = True then + Result := 'True' else + Result := 'False' + else if (TVarData(v).VType = varString) or (TVarData(v).VType = varOleStr) then + Result := '''' + v + '''' + else if v = Null then + Result := 'Null'; + end + else + Result := 'not accessible'; +end; + +procedure TfrxWatchForm.UpdateWatches; +var + i: Integer; +begin + WatchLB.Items.BeginUpdate; + WatchLB.Items.Clear; + for i := 0 to Watches.Count - 1 do + WatchLB.Items.Add(Watches[i] + ': ' + CalcWatch(Watches[i])); + WatchLB.Items.EndUpdate; +end; + +procedure TfrxWatchForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := False; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxXML.pas b/official/4.2/Source/frxXML.pas new file mode 100644 index 0000000..6ba934e --- /dev/null +++ b/official/4.2/Source/frxXML.pas @@ -0,0 +1,944 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ XML document } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxXML; + +interface + +{$I frx.inc} + +uses + Windows, SysUtils, Classes +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxInvalidXMLException = class(Exception); + + TfrxXMLItem = class(TObject) + private + FData: Pointer; { optional item data } + FHiOffset: Byte; { hi-part of the offset } + FItems: TList; { subitems } + FLoaded: Boolean; { item is loaded, no need to call LoadItem } + FLoOffset: Integer; { lo-part of the offset } + FModified: Boolean; { item is modified (used by preview designer) } + FName: String; { item name } + FParent: TfrxXMLItem; { item parent } + FText: String; { item attributes } + FUnloadable: Boolean; + FValue: String; { item value Value } + function GetCount: Integer; + function GetItems(Index: Integer): TfrxXMLItem; + function GetOffset: Int64; + procedure SetOffset(const Value: Int64); + function GetProp(Index: String): String; + procedure SetProp(Index: String; const Value: String); + public + constructor Create; + destructor Destroy; override; + procedure AddItem(Item: TfrxXMLItem); + procedure Clear; + procedure InsertItem(Index: Integer; Item: TfrxXMLItem); + + function Add: TfrxXMLItem; + function Find(const Name: String): Integer; + function FindItem(const Name: String): TfrxXMLItem; + function IndexOf(Item: TfrxXMLItem): Integer; + function PropExists(const Index: String): Boolean; + function Root: TfrxXMLItem; + procedure DeleteProp(const Index: String); + + property Count: Integer read GetCount; + property Data: Pointer read FData write FData; + property Items[Index: Integer]: TfrxXMLItem read GetItems; default; + property Loaded: Boolean read FLoaded; + property Modified: Boolean read FModified write FModified; + property Name: String read FName write FName; +{ offset is the position of the item in the tempstream. This parameter is needed + for dynamically loading large files. Items that can be loaded on-demand must + have Unloadable = True (in run-time) or have 'ld="0"' parameter (in the file) } + property Offset: Int64 read GetOffset write SetOffset; + property Parent: TfrxXMLItem read FParent; + property Prop[Index: String]: String read GetProp write SetProp; + property Text: String read FText write FText; + property Unloadable: Boolean read FUnloadable write FUnloadable; + property Value: String read FValue write FValue; + end; + + TfrxXMLDocument = class(TObject) + private + FAutoIndent: Boolean; { use indents when writing document to a file } + FRoot: TfrxXMLItem; { root item } + FTempDir: String; { folder for temporary files } + FTempFile: String; { tempfile name } + FTempStream: TStream; { temp stream associated with tempfile } + FTempFileCreated: Boolean; { tempfile has been created - need to delete it } + procedure CreateTempFile; + procedure DeleteTempFile; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + procedure LoadItem(Item: TfrxXMLItem); + procedure UnloadItem(Item: TfrxXMLItem); + procedure SaveToStream(Stream: TStream); + procedure LoadFromStream(Stream: TStream; AllowPartialLoading: Boolean = False); + procedure SaveToFile(const FileName: String); + procedure LoadFromFile(const FileName: String); + + property AutoIndent: Boolean read FAutoIndent write FAutoIndent; + property Root: TfrxXMLItem read FRoot; + property TempDir: String read FTempDir write FTempDir; + end; + +{ TfrxXMLReader and TfrxXMLWriter are doing actual read/write to the XML file. + Read/write process is buffered. } + + TfrxXMLReader = class(TObject) + private + FBuffer: PChar; + FBufPos: Integer; + FBufEnd: Integer; + FPosition: Int64; + FSize: Int64; + FStream: TStream; + procedure SetPosition(const Value: Int64); + procedure ReadBuffer; + procedure ReadItem(var Name, Text: String); + public + constructor Create(Stream: TStream); + destructor Destroy; override; + procedure RaiseException; + procedure ReadHeader; + procedure ReadRootItem(Item: TfrxXMLItem; ReadChildren: Boolean = True); + property Position: Int64 read FPosition write SetPosition; + property Size: Int64 read FSize; + end; + + TfrxXMLWriter = class(TObject) + private + FAutoIndent: Boolean; + FBuffer: String; + FStream: TStream; + FTempStream: TStream; + procedure FlushBuffer; + procedure WriteLn(const s: String); + procedure WriteItem(Item: TfrxXMLItem; Level: Integer = 0); + public + constructor Create(Stream: TStream); + procedure WriteHeader; + procedure WriteRootItem(RootItem: TfrxXMLItem); + property TempStream: TStream read FTempStream write FTempStream; + end; + + +{ StrToXML changes '<', '>', '"', cr, lf symbols to its ascii codes } +function frxStrToXML(const s: String): String; + +{ ValueToXML convert a value to the valid XML string } +function frxValueToXML(const Value: Variant): String; + +{ XMLToStr is opposite to StrToXML function } +function frxXMLToStr(const s: String): String; + + +implementation + + +function frxStrToXML(const s: String): String; +const + SpecChars = ['<', '>', '"', #10, #13, '&']; +var + i, lenRes, resI, ch: Integer; + pRes: PChar; + + procedure ReplaceChars(var s: String; i: Integer); + begin + Insert('#' + IntToStr(Ord(s[i])) + ';', s, i + 1); + s[i] := '&'; + end; + +begin + lenRes := Length(s); + + if lenRes < 32 then + begin + Result := s; + for i := lenRes downto 1 do + if s[i] in SpecChars then + if s[i] <> '&' then + ReplaceChars(Result, i) + else + begin + if Copy(s, i + 1, 5) = 'quot;' then + begin + Delete(Result, i, 6); + Insert('"', Result, i); + end; + end; + Exit; + end; + + { speed optimized code } + SetLength(Result, lenRes); + pRes := PChar(Result) - 1; + resI := 1; + i := 1; + + while i <= Length(s) do + begin + if resI + 5 > lenRes then + begin + Inc(lenRes, 256); + SetLength(Result, lenRes); + pRes := PChar(Result) - 1; + end; + + if s[i] in SpecChars then + begin + if (s[i] = '&') and (i <= Length(s) - 5) and (s[i + 1] = 'q') and + (s[i + 2] = 'u') and (s[i + 3] = 'o') and (s[i + 4] = 't') and (s[i + 5] = ';') then + begin + pRes[resI] := '&'; + pRes[resI + 1] := '#'; + pRes[resI + 2] := '3'; + pRes[resI + 3] := '4'; + pRes[resI + 4] := ';'; + Inc(resI, 4); + Inc(i, 5); + end + else + begin + pRes[resI] := '&'; + pRes[resI + 1] := '#'; + + ch := Ord(s[i]); + if ch < 10 then + begin + pRes[resI + 2] := Chr(ch + $30); + Inc(resI, 3); + end + else if ch < 100 then + begin + pRes[resI + 2] := Chr(ch div 10 + $30); + pRes[resI + 3] := Chr(ch mod 10 + $30); + Inc(resI, 4); + end + else + begin + pRes[resI + 2] := Chr(ch div 100 + $30); + pRes[resI + 3] := Chr(ch mod 100 div 10 + $30); + pRes[resI + 4] := Chr(ch mod 10 + $30); + Inc(resI, 5); + end; + pRes[resI] := ';'; + end; + end + else + pRes[resI] := s[i]; + Inc(resI); + Inc(i); + end; + + SetLength(Result, resI - 1); +end; + +function frxXMLToStr(const s: String): String; +var + i, j, h, n: Integer; +begin + Result := s; + + i := 1; + n := Length(s); + while i < n do + begin + if Result[i] = '&' then + if (i + 3 <= n) and (Result[i + 1] = '#') then + begin + j := i + 3; + while Result[j] <> ';' do + Inc(j); + h := StrToInt(Copy(Result, i + 2, j - i - 2)); + Delete(Result, i, j - i); + Result[i] := Chr(h); + Dec(n, j - i); + end + else if Copy(Result, i + 1, 5) = 'quot;' then + begin + Delete(Result, i, 5); + Result[i] := '"'; + Dec(n, 5); + end; + Inc(i); + end; +end; + +function frxValueToXML(const Value: Variant): String; +begin + case TVarData(Value).VType of + varSmallint, varInteger, varByte: + Result := IntToStr(Value); + + varSingle, varDouble, varCurrency: + Result := FloatToStr(Value); + + varDate: + Result := DateToStr(Value); + + varOleStr, varString, varVariant: + Result := frxStrToXML(Value); + + varBoolean: + if Value = True then Result := '1' else Result := '0'; + + else + Result := ''; + end; +end; + + +{ TfrxXMLItem } + +constructor TfrxXMLItem.Create; +begin + FLoaded := True; +end; + +destructor TfrxXMLItem.Destroy; +begin + Clear; + if FParent <> nil then + FParent.FItems.Remove(Self); + inherited; +end; + +procedure TfrxXMLItem.Clear; +begin + if FItems <> nil then + begin + while FItems.Count > 0 do + TfrxXMLItem(FItems[0]).Free; + FItems.Free; + FItems := nil; + end; + if FUnloadable then + FLoaded := False; +end; + +function TfrxXMLItem.GetItems(Index: Integer): TfrxXMLItem; +begin + Result := TfrxXMLItem(FItems[Index]); +end; + +function TfrxXMLItem.GetCount: Integer; +begin + if FItems = nil then + Result := 0 else + Result := FItems.Count; +end; + +function TfrxXMLItem.Add: TfrxXMLItem; +begin + Result := TfrxXMLItem.Create; + AddItem(Result); +end; + +procedure TfrxXMLItem.AddItem(Item: TfrxXMLItem); +begin + if FItems = nil then + FItems := TList.Create; + + FItems.Add(Item); + if Item.FParent <> nil then + Item.FParent.FItems.Remove(Item); + Item.FParent := Self; +end; + +procedure TfrxXMLItem.InsertItem(Index: Integer; Item: TfrxXMLItem); +begin + AddItem(Item); + FItems.Delete(FItems.Count - 1); + FItems.Insert(Index, Item); +end; + +function TfrxXMLItem.Find(const Name: String): Integer; +var + i: Integer; +begin + Result := -1; + for i := 0 to Count - 1 do + if AnsiCompareText(Items[i].Name, Name) = 0 then + begin + Result := i; + break; + end; +end; + +function TfrxXMLItem.FindItem(const Name: String): TfrxXMLItem; +var + i: Integer; +begin + i := Find(Name); + if i = -1 then + begin + Result := Add; + Result.Name := Name; + end + else + Result := Items[i]; +end; + +function TfrxXMLItem.GetOffset: Int64; +begin + Result := Int64(FHiOffset) * $100000000 + Int64(FLoOffset); +end; + +procedure TfrxXMLItem.SetOffset(const Value: Int64); +begin + FHiOffset := Value div $100000000; + FLoOffset := Value mod $100000000; +end; + +function TfrxXMLItem.Root: TfrxXMLItem; +begin + Result := Self; + while Result.Parent <> nil do + Result := Result.Parent; +end; + +function TfrxXMLItem.GetProp(Index: String): String; +var + i: Integer; +begin + i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText)); + if i <> 0 then + begin + Result := Copy(FText, i + Length(Index + '="'), MaxInt); + Result := frxXMLToStr(Copy(Result, 1, Pos('"', Result) - 1)); + end + else + Result := ''; +end; + +procedure TfrxXMLItem.SetProp(Index: String; const Value: String); +var + i, j: Integer; + s: String; +begin + i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText)); + if i <> 0 then + begin + j := i + Length(Index + '="'); + while (j <= Length(FText)) and (FText[j] <> '"') do + Inc(j); + Delete(FText, i, j - i + 1); + end + else + i := Length(FText) + 1; + + s := Index + '="' + frxStrToXML(Value) + '"'; + if (i > 1) and (FText[i - 1] <> ' ') then + s := ' ' + s; + Insert(s, FText, i); +end; + +function TfrxXMLItem.PropExists(const Index: String): Boolean; +begin + Result := Pos(' ' + AnsiUppercase(Index) + '="', ' ' + AnsiUppercase(FText)) > 0; +end; + +procedure TfrxXMLItem.DeleteProp(const Index: String); +var + i: Integer; +begin + i := Pos(' ' + AnsiUppercase(Index) + '="', ' ' + AnsiUppercase(FText)); + if i > 0 then + begin + SetProp(Index, ''); + Delete(FText, i, Length(Index) + 4); + end; +end; + +function TfrxXMLItem.IndexOf(Item: TfrxXMLItem): Integer; +begin + Result := FItems.IndexOf(Item); +end; + + +{ TfrxXMLDocument } + +constructor TfrxXMLDocument.Create; +begin + FRoot := TfrxXMLItem.Create; +end; + +destructor TfrxXMLDocument.Destroy; +begin + DeleteTempFile; + FRoot.Free; + inherited; +end; + +procedure TfrxXMLDocument.Clear; +begin + FRoot.Clear; + DeleteTempFile; +end; + +procedure TfrxXMLDocument.CreateTempFile; +var + Path: String[64]; + FileName: String[255]; +begin + if FTempFileCreated then Exit; + + Path := FTempDir; + if Path = '' then + Path[0] := Chr(GetTempPath(64, @Path[1])) else + Path := Path + #0; + if (Path <> '') and (Path[Length(Path)] <> '\') then + Path := Path + '\'; + + GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]); + FTempFile := StrPas(@FileName[1]); + FTempStream := TFileStream.Create(FTempFile, fmOpenReadWrite); + FTempFileCreated := True; +end; + +procedure TfrxXMLDocument.DeleteTempFile; +begin + if FTempFileCreated then + begin + FTempStream.Free; + FTempStream := nil; + DeleteFile(FTempFile); + FTempFileCreated := False; + end; + if FTempStream <> nil then + FTempStream.Free; + FTempStream := nil; +end; + +procedure TfrxXMLDocument.LoadItem(Item: TfrxXMLItem); +var + rd: TfrxXMLReader; + Text: String; +begin + if (FTempStream = nil) or Item.FLoaded or not Item.FUnloadable then Exit; + + rd := TfrxXMLReader.Create(FTempStream); + try + rd.Position := Item.Offset; + Text := Item.Text; + rd.ReadRootItem(Item); + Item.Text := Text; + Item.FLoaded := True; + finally + rd.Free; + end; +end; + +procedure TfrxXMLDocument.UnloadItem(Item: TfrxXMLItem); +var + wr: TfrxXMLWriter; +begin + if not Item.FLoaded or not Item.FUnloadable then Exit; + + CreateTempFile; + FTempStream.Position := FTempStream.Size; + wr := TfrxXMLWriter.Create(FTempStream); + try + Item.Offset := FTempStream.Size; + wr.WriteRootItem(Item); + Item.Clear; + finally + wr.Free; + end; +end; + +procedure TfrxXMLDocument.LoadFromStream(Stream: TStream; + AllowPartialLoading: Boolean = False); +var + rd: TfrxXMLReader; +begin + DeleteTempFile; + + rd := TfrxXMLReader.Create(Stream); + try + FRoot.Clear; + FRoot.Offset := 0; + rd.ReadHeader; + rd.ReadRootItem(FRoot, not AllowPartialLoading); + finally + rd.Free; + end; + + if AllowPartialLoading then + FTempStream := Stream else + FTempStream := nil; +end; + +procedure TfrxXMLDocument.SaveToStream(Stream: TStream); +var + wr: TfrxXMLWriter; +begin + wr := TfrxXMLWriter.Create(Stream); + wr.TempStream := FTempStream; + wr.FAutoIndent := FAutoIndent; + + try + wr.WriteHeader; + wr.WriteRootItem(FRoot); + finally + wr.Free; + end; +end; + +procedure TfrxXMLDocument.LoadFromFile(const FileName: String); +var + s: TFileStream; +begin + s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + LoadFromStream(s, True); +end; + +procedure TfrxXMLDocument.SaveToFile(const FileName: String); +var + s: TFileStream; +begin + s := TFileStream.Create(FileName + '.tmp', fmCreate); + try + SaveToStream(s); + finally + s.Free; + end; + + DeleteTempFile; + DeleteFile(FileName); + RenameFile(FileName + '.tmp', FileName); + LoadFromFile(FileName); +end; + + +{ TfrxXMLReader } + +constructor TfrxXMLReader.Create(Stream: TStream); +begin + FStream := Stream; + FSize := Stream.Size; + FPosition := Stream.Position; + GetMem(FBuffer, 4096); +end; + +destructor TfrxXMLReader.Destroy; +begin + FreeMem(FBuffer, 4096); + FStream.Position := FPosition; + inherited; +end; + +procedure TfrxXMLReader.ReadBuffer; +begin + FBufEnd := FStream.Read(FBuffer^, 4096); + FBufPos := 0; +end; + +procedure TfrxXMLReader.SetPosition(const Value: Int64); +begin + FPosition := Value; + FStream.Position := Value; + FBufPos := 0; + FBufEnd := 0; +end; + +procedure TfrxXMLReader.RaiseException; +begin + raise TfrxInvalidXMLException.Create('Invalid file format'); +end; + +procedure TfrxXMLReader.ReadHeader; +var + s1, s2: String; +begin + ReadItem(s1, s2); + if Pos('?xml', s1) <> 1 then + RaiseException; +end; + +procedure TfrxXMLReader.ReadItem(var Name, Text: String); +var + c: Integer; + curpos, len: Integer; + state: (FindLeft, FindRight, FindComment, Done); + i, comment: Integer; + ps: PChar; +begin + Text := ''; + comment := 0; + state := FindLeft; + curpos := 0; + len := 4096; + SetLength(Name, len); + ps := @Name[1]; + + while FPosition < FSize do + begin + if FBufPos = FBufEnd then + ReadBuffer; + c := Ord(FBuffer[FBufPos]); + Inc(FBufPos); + Inc(FPosition); + + if state = FindLeft then + begin + if c = Ord('<') then + state := FindRight + end + else if state = FindRight then + begin + if c = Ord('>') then + begin + state := Done; + break; + end + else if c = Ord('<') then + RaiseException + else + begin + ps[curpos] := Chr(c); + Inc(curpos); + if (curpos = 3) and (Pos('!--', Name) = 1) then + begin + state := FindComment; + comment := 0; + curpos := 0; + end; + if curpos >= len - 1 then + begin + Inc(len, 4096); + SetLength(Name, len); + ps := @Name[1]; + end; + end; + end + else if State = FindComment then + begin + if comment = 2 then + begin + if c = Ord('>') then + state := FindLeft + else + comment := 0; + end + else begin + if c = Ord('-') then + Inc(comment) + else + comment := 0; + end; + end; + end; + + len := curpos; + SetLength(Name, len); + + if state = FindRight then + RaiseException; + if (Name <> '') and (Name[len] = ' ') then + SetLength(Name, len - 1); + + i := Pos(' ', Name); + if i <> 0 then + begin + Text := Copy(Name, i + 1, len - i); + Delete(Name, i, len - i + 1); + end; +end; + +procedure TfrxXMLReader.ReadRootItem(Item: TfrxXMLItem; ReadChildren: Boolean = True); +var + LastName: String; + + function DoRead(RootItem: TfrxXMLItem): Boolean; + var + n: Integer; + ChildItem: TfrxXMLItem; + Done: Boolean; + CurPos: Int64; + begin + Result := False; + CurPos := Position; + ReadItem(RootItem.FName, RootItem.FText); + LastName := RootItem.FName; + + if (RootItem.Name = '') or (RootItem.Name[1] = '/') then + begin + Result := True; + Exit; + end; + + n := Length(RootItem.Name); + if RootItem.Name[n] = '/' then + begin + SetLength(RootItem.FName, n - 1); + Exit; + end; + + n := Length(RootItem.Text); + if (n > 0) and (RootItem.Text[n] = '/') then + begin + SetLength(RootItem.FText, n - 1); + Exit; + end; + + repeat + ChildItem := TfrxXMLItem.Create; + Done := DoRead(ChildItem); + if not Done then + RootItem.AddItem(ChildItem) else + ChildItem.Free; + until Done; + + if (LastName <> '') and (AnsiCompareText(LastName, '/' + RootItem.Name) <> 0) then + RaiseException; + + n := Pos(' ld="0"', LowerCase(RootItem.Text)); + if n <> 0 then + Delete(RootItem.FText, n, 7); + if not ReadChildren and (n <> 0) then + begin + RootItem.Clear; + RootItem.Offset := CurPos; + RootItem.FUnloadable := True; + RootItem.FLoaded := False; + end; + end; + +begin + DoRead(Item); +end; + + +{ TfrxXMLWriter } + +constructor TfrxXMLWriter.Create(Stream: TStream); +begin + FStream := Stream; +end; + +procedure TfrxXMLWriter.FlushBuffer; +begin + if FBuffer <> '' then + FStream.Write(FBuffer[1], Length(FBuffer)); + FBuffer := ''; +end; + +procedure TfrxXMLWriter.WriteLn(const s: String); +begin + if not FAutoIndent then + Insert(s, FBuffer, MaxInt) else + Insert(s + #13#10, FBuffer, MaxInt); + if Length(FBuffer) > 4096 then + FlushBuffer; +end; + +procedure TfrxXMLWriter.WriteHeader; +begin + WriteLn(''); +end; + +function Dup(n: Integer): String; +begin + SetLength(Result, n); + FillChar(Result[1], n, ' '); +end; + +procedure TfrxXMLWriter.WriteItem(Item: TfrxXMLItem; Level: Integer = 0); +var + s: String; +begin + if (Item.FText <> '') or Item.FUnloadable then + begin + s := Item.FText; + if (s = '') or (s[1] <> ' ') then + s := ' ' + s; + if Item.FUnloadable then + s := s + 'ld="0"'; + end + else + s := ''; + + if Item.Count = 0 then + begin + if Item.Value = '' then + s := s + '/>' + else + s := s + '>' + Item.Value + '' + end + else + s := s + '>'; + if not FAutoIndent then + s := '<' + Item.Name + s else + s := Dup(Level) + '<' + Item.Name + s; + WriteLn(s); +end; + +procedure TfrxXMLWriter.WriteRootItem(RootItem: TfrxXMLItem); + + procedure DoWrite(RootItem: TfrxXMLItem; Level: Integer = 0); + var + i: Integer; + rd: TfrxXMLReader; + NeedClear: Boolean; + begin + NeedClear := False; + if not FAutoIndent then + Level := 0; + + if (FTempStream <> nil) and RootItem.FUnloadable and not RootItem.FLoaded then + begin + rd := TfrxXMLReader.Create(FTempStream); + try + rd.Position := RootItem.Offset; + rd.ReadRootItem(RootItem); + NeedClear := True; + finally + rd.Free; + end; + end; + + WriteItem(RootItem, Level); + for i := 0 to RootItem.Count - 1 do + DoWrite(RootItem[i], Level + 2); + if RootItem.Count > 0 then + if not FAutoIndent then + WriteLn('') else + WriteLn(Dup(Level) + ''); + + if NeedClear then + RootItem.Clear; + end; + +begin + DoWrite(RootItem); + FlushBuffer; +end; + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxXMLSerializer.pas b/official/4.2/Source/frxXMLSerializer.pas new file mode 100644 index 0000000..5383d59 --- /dev/null +++ b/official/4.2/Source/frxXMLSerializer.pas @@ -0,0 +1,806 @@ + +{******************************************} +{ } +{ FastReport v4.0 } +{ XML serializer } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxXMLSerializer; + +interface + +{$I frx.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + TypInfo, frxXML, frxClass +{$IFDEF Delphi6} +, Variants +{$ENDIF}; + + +type + TfrxGetAncestorEvent = procedure(const ComponentName: String; + var Ancestor: TPersistent) of object; + +{ TfrxXMLSerializer is the XML analogue of the Delphi component streaming - + TReader and TWriter } + + TfrxXMLSerializer = class(TObject) + private + FErrors: TStringList; + FFixups: TList; + FOwner: TfrxComponent; + FReader: TReader; + FReaderStream: TMemoryStream; + FSerializeDefaultValues: Boolean; + FStream: TStream; + FOnGetAncestor: TfrxGetAncestorEvent; + procedure AddFixup(Obj: TPersistent; p: PPropInfo; Value: String); + procedure ClearFixups; + procedure FixupReferences; + public + constructor Create(Stream: TStream); + destructor Destroy; override; + function ObjToXML(Obj: TPersistent; const Add: String = ''; Ancestor: TPersistent = nil): String; + function ReadComponent(Root: TfrxComponent): TfrxComponent; + function ReadComponentStr(Root: TfrxComponent; s: String; DontFixup: Boolean = False): TfrxComponent; + function WriteComponentStr(c: TfrxComponent): String; + procedure ReadRootComponent(Root: TfrxComponent; XMLItem: TfrxXMLItem = nil); + procedure ReadPersistentStr(Root: TComponent; Obj: TPersistent; const s: String); + procedure WriteComponent(c: TfrxComponent); + procedure WriteRootComponent(Root: TfrxComponent; SaveChildren: Boolean = True; + XMLItem: TfrxXMLItem = nil); + procedure XMLToObj(const s: String; Obj: TPersistent); + property Errors: TStringList read FErrors; + property Owner: TfrxComponent read FOwner write FOwner; + property Stream: TStream read FStream; + property SerializeDefaultValues: Boolean read FSerializeDefaultValues + write FSerializeDefaultValues; + property OnGetAncestor: TfrxGetAncestorEvent read FOnGetAncestor write FOnGetAncestor; + end; + + +implementation + +uses frxUtils, frxRes, frxUnicodeUtils; + + +type + TfrxFixupItem = class(TObject) + public + Obj: TPersistent; + PropInfo: PPropInfo; + Value: String; + end; + + THackComponent = class(TComponent); + THackPersistent = class(TPersistent); + THackReader = class(TReader); + + +{ TfrxXMLSerializer } + +constructor TfrxXMLSerializer.Create(Stream: TStream); +begin + FErrors := TStringList.Create; + FErrors.Sorted := True; + FErrors.Duplicates := dupIgnore; + FFixups := TList.Create; + FStream := Stream; + FReaderStream := TMemoryStream.Create; + FReader := TReader.Create(FReaderStream, 4096); +end; + +destructor TfrxXMLSerializer.Destroy; +begin + FErrors.Free; + FReader.Free; + FReaderStream.Free; + ClearFixups; + FFixups.Free; + inherited; +end; + +procedure TfrxXMLSerializer.ClearFixups; +begin + while FFixups.Count > 0 do + begin + TfrxFixupItem(FFixups[0]).Free; + FFixups.Delete(0); + end; +end; + +procedure TfrxXMLSerializer.AddFixup(Obj: TPersistent; p: PPropInfo; + Value: String); +var + Item: TfrxFixupItem; +begin + Item := TfrxFixupItem.Create; + Item.Obj := Obj; + Item.PropInfo := p; + Item.Value := Value; + FFixups.Add(Item); +end; + +procedure TfrxXMLSerializer.FixupReferences; +var + i: Integer; + Item: TfrxFixupItem; + Ref: TObject; +begin + for i := 0 to FFixups.Count - 1 do + begin + Item := FFixups[i]; + Ref := nil; + if FOwner <> nil then + Ref := FOwner.FindObject(Item.Value); + if Ref = nil then + Ref := frxFindComponent(FOwner, Item.Value); + if Ref <> nil then + SetOrdProp(Item.Obj, Item.PropInfo, Integer(Ref)); + end; + + FReader.FixupReferences; + FReader.EndReferences; + ClearFixups; +end; + +procedure TfrxXMLSerializer.XMLToObj(const s: String; Obj: TPersistent); +var + i, j, start, len, code: Integer; + i1, start1, len1: Integer; + Name, Value: String; + Obj1: TPersistent; + p: PPropInfo; + ps, ps1: PChar; + + procedure DoNonPublishedProps; + begin + FReaderStream.Clear; + frxStringToStream(Value, FReaderStream); + FReaderStream.Position := 0; + FReader.Position := 0; + + try + while FReader.Position < FReaderStream.Size do + THackReader(FReader).ReadProperty(Obj1); + except + end; + end; + +begin + { speed optimized code. affects the speed of loading prepared page in the preview } + len := Length(s); + i := 1; + ps := PChar(s) - 1; + while i < len do + begin + j := i; + len1 := len; + ps1 := ps; + while (j < len1) and (ps1[j] = ' ') do + Inc(j); + start := j; + while (j < len1) and (ps1[j] <> '=') do + Inc(j); + i := j; + if i < len then + begin + j := i - 1; + while (j > 0) and (ps1[j] = ' ') do + Dec(j); + Name := Copy(s, start, j - start + 1); + if Name = '' then break; + j := i; + len1 := len; + while (j < len1) and (ps1[j] <> '"') do + Inc(j); + start := j + 1; + Inc(j); + while (j < len1) and (ps1[j] <> '"') do + Inc(j); + i := j; + Value := Copy(s, start, i - start); + Inc(i); + + Obj1 := Obj; + + { check multiple properties } + len1 := Length(Name); + start1 := 1; + i1 := 1; + while (i1 < len1) and (Name[i1] <> '.') do + Inc(i1); + if i1 < len1 then + begin + while i1 < len1 do + begin + p := GetPropInfo(Obj1.ClassInfo, Copy(Name, start1, i1 - start1)); + if p = nil then + break; + Obj1 := TPersistent(GetOrdProp(Obj1, p)); + start1 := i1 + 1; + Inc(i1); + while (i1 < len1) and (Name[i1] <> '.') do + Inc(i1); + end; + Name := Copy(Name, start1, MaxInt); + end; + + try + if Length(Name) = 1 then + begin + { special properties } + case Name[1] of + 'x': + begin + TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Value); + continue; + end; + 'u': + begin + TfrxCustomMemoView(Obj1).Text := Utf8Decode(frxXMLToStr(Value)); + continue; + end; + 'l': + begin + TfrxComponent(Obj1).Left := frxStrToFloat(Value); + continue; + end; + 't': + begin + TfrxComponent(Obj1).Top := frxStrToFloat(Value); + continue; + end; + 'w': + begin + TfrxComponent(Obj1).Width := frxStrToFloat(Value); + continue; + end; + 'h': + begin + TfrxComponent(Obj1).Height := frxStrToFloat(Value); + continue; + end; + end; + end + else + begin + if Name = 'Text' then + begin + if Obj1 is TStrings then + begin + TStrings(Obj1).Text := frxXMLToStr(Value); + continue; + end + else if Obj1 is TWideStrings then + begin + TWideStrings(Obj1).Text := frxXMLToStr(Value); + continue; + end + else if Obj1 is TfrxCustomMemoView then + begin + TfrxCustomMemoView(Obj1).Text := Utf8Decode(frxXMLToStr(Value)); + continue; + end + end + else if Name = 'PropData' then + begin + DoNonPublishedProps; + continue; + end + else if (Obj1 is TfrxReport) and (Name = 'Name') then + continue; + end; + + p := GetPropInfo(Obj1.ClassInfo, Name); + if (p <> nil) and (p.SetProc <> nil) then + case p.PropType^.Kind of + tkInteger, tkSet, tkChar, tkWChar: + SetOrdProp(Obj1, p, StrToInt(Value)); + + tkEnumeration: + begin + Val(Value, j, code); + if code = 0 then + SetOrdProp(Obj1, p, j) else + SetOrdProp(Obj1, p, GetEnumValue(p.PropType^, Value)); + end; + + tkFloat: + SetFloatProp(Obj1, p, frxStrToFloat(Value)); + + tkString, tkLString, tkWString: + SetStrProp(Obj1, p, frxXMLToStr(Value)); + + tkClass: + AddFixup(Obj1, p, Value); + + tkVariant: + SetVariantProp(Obj1, p, frxXMLToStr(Value)); + end; + except + on E: Exception do + FErrors.Add(E.Message); + end; + end; + end; +end; + +function TfrxXMLSerializer.ObjToXML(Obj: TPersistent; const Add: String = ''; + Ancestor: TPersistent = nil): String; +var + TypeInfo: PTypeInfo; + PropCount: Integer; + PropList: PPropList; + i: Integer; + s: String; + ws: WideString; + Flag: Boolean; + + procedure DoOrdProp; + var + Value: Integer; + + function IsDefault: Boolean; + begin + if Ancestor <> nil then + Result := Value = GetOrdProp(Ancestor, PropList[i]) + else + Result := Value = PropList[i].Default; + end; + + begin + Value := GetOrdProp(Obj, PropList[i]); + if not IsDefault or FSerializeDefaultValues then + if PropList[i].PropType^.Kind = tkEnumeration then + s := GetEnumName(PropList[i].PropType^, Value) + else + s := IntToStr(Value); + end; + + procedure DoFloatProp; + var + Value: Extended; + + function IsDefault: Boolean; + begin + if Ancestor <> nil then + Result := Abs(Value - GetFloatProp(Ancestor, PropList[i])) < 1e-6 + else + Result := False; + end; + + begin + Value := GetFloatProp(Obj, PropList[i]); +// commented out due to bug with tfrxmemoview.linespacing=0 + if not IsDefault or FSerializeDefaultValues then + s := FloatToStr(Value); + end; + + procedure DoStrProp; + var + Value: String; + + function IsDefault: Boolean; + begin + if Ancestor <> nil then + Result := Value = GetStrProp(Ancestor, PropList[i]) + else + Result := Value = ''; + end; + + begin + Value := GetStrProp(Obj, PropList[i]); + if not IsDefault or FSerializeDefaultValues then + s := frxStrToXML(Value); + end; + + procedure DoVariantProp; + var + Value: Variant; + + function IsDefault: Boolean; + begin + if Ancestor <> nil then + Result := Value = GetVariantProp(Ancestor, PropList[i]) + else + Result := False; + end; + + begin + Value := GetVariantProp(Obj, PropList[i]); + if not IsDefault or FSerializeDefaultValues then + s := frxStrToXML(VarToStr(Value)); + end; + + procedure DoClassProp; + var + FClass: TClass; + FComp, FAncComp: TComponent; + FObj, FAncObj: TPersistent; + begin + FClass := GetTypeData(PropList[i].PropType^).ClassType; + if FClass.InheritsFrom(TComponent) then + begin + FComp := TComponent(GetOrdProp(Obj, PropList[i])); + if Ancestor <> nil then + FAncComp := TComponent(GetOrdProp(Ancestor, PropList[i])) + else + FAncComp := nil; + + if Ancestor <> nil then + begin + if (FComp = nil) and (FAncComp = nil) then Exit; + if (FComp <> nil) and (FAncComp <> nil) then + if CompareText(FComp.Name, FAncComp.Name) = 0 then Exit; + if (FComp = nil) and (FAncComp <> nil) then + begin + s := 'nil'; + Exit; + end; + end; + + if FComp <> nil then + s := frxGetFullName(FOwner, FComp); + end + else if FClass.InheritsFrom(TPersistent) then + begin + FObj := TPersistent(GetOrdProp(Obj, PropList[i])); + if Ancestor <> nil then + FAncObj := TPersistent(GetOrdProp(Ancestor, PropList[i])) + else + FAncObj := nil; + + if FObj is TStrings then + begin + if Ancestor <> nil then + if TStrings(FObj).Text = TStrings(FAncObj).Text then + Exit; + + s := TStrings(FObj).Text; + if (Length(s) >= 2) and + (s[Length(s) - 1] = #13) and (s[Length(s)] = #10) then + Delete(s, Length(s) - 1, 2); + s := ' ' + Add + PropList[i].Name + '.Text="' + + frxStrToXML(s) + '"'; + + end + else if FObj is TWideStrings then + begin + // skip, handle separately + end + else + s := ObjToXML(FObj, Add + PropList[i].Name + '.', FAncObj); + Flag := True; + end; + end; + + procedure DoNonPublishedProps; + var + wr: TWriter; + ms, AncMs: TMemoryStream; + begin + ms := TMemoryStream.Create; + try + wr := TWriter.Create(ms, 4096); + wr.Root := FOwner; + + try + THackPersistent(Obj).DefineProperties(wr); + finally + wr.Free; + end; + + if ms.Size > 0 then + begin + if Ancestor <> nil then + begin + AncMs := TMemoryStream.Create; + try + wr := TWriter.Create(AncMs, 4096); + wr.Root := FOwner; + + try + THackPersistent(Ancestor).DefineProperties(wr); + finally + wr.Free; + end; + if frxStreamCRC32(ms) = frxStreamCRC32(AncMs) then + Exit; + finally + AncMs.Free; + end; + end; + + s := frxStreamToString(ms); + Result := Result + ' ' + Add + 'PropData="' + s + '"'; + end; + finally + ms.Free; + end; + end; + +begin + Result := ''; + + TypeInfo := Obj.ClassInfo; + PropCount := GetTypeData(TypeInfo).PropCount; + GetMem(PropList, PropCount * SizeOf(PPropInfo)); + GetPropInfos(TypeInfo, PropList); + + try + if Obj is TfrxComponent then + begin + TfrxComponent(Obj).IsWriting := True; + if (Ancestor = nil) and Assigned(FOnGetAncestor) then + FOnGetAncestor(TfrxComponent(Obj).Name, Ancestor); + end; + + for i := 0 to PropCount - 1 do + begin + s := ''; + Flag := False; + + if IsStoredProp(Obj, PropList[i]) then + case PropList[i].PropType^.Kind of + tkInteger, tkSet, tkChar, tkWChar, tkEnumeration: + DoOrdProp; + + tkFloat: + DoFloatProp; + + tkString, tkLString, tkWString: + DoStrProp; + + tkClass: + DoClassProp; + + tkVariant: + DoVariantProp; + end; + + if s <> '' then + if Flag then + Result := Result + s + else + Result := Result + ' ' + Add + PropList[i].Name + '="' + s + '"'; + end; + + if Obj is TfrxCustomMemoView then + if (Ancestor = nil) or + (TfrxCustomMemoView(Obj).Text <> TfrxCustomMemoView(Ancestor).Text) then + begin + ws := TfrxCustomMemoView(Obj).Text; + if (Length(ws) >= 2) and + (ws[Length(ws) - 1] = #13) and (ws[Length(ws)] = #10) then + Delete(ws, Length(ws) - 1, 2); + Result := Result + ' Text="' + frxStrToXML(Utf8Encode(ws)) + '"'; + end; + + DoNonPublishedProps; + + finally + if Obj is TfrxComponent then + TfrxComponent(Obj).IsWriting := False; + FreeMem(PropList, PropCount * SizeOf(PPropInfo)); + end; +end; + +procedure TfrxXMLSerializer.ReadRootComponent(Root: TfrxComponent; + XMLItem: TfrxXMLItem = nil); +var + XMLDoc: TfrxXMLDocument; + CompList: TList; + + procedure DoRead(Item: TfrxXMLItem; Owner: TfrxComponent); + var + i: Integer; + c: TfrxComponent; + IsAncestor: Boolean; + begin + IsAncestor := CompareText(Item.Name, 'inherited') = 0; + if not IsAncestor then + try + FindClass(Item.Name); + except + FErrors.Add(frxResources.Get('xrCantFindClass') + ' ' + Item.Name); + Exit; + end; + + if Owner <> nil then + begin + c := FOwner.FindComponent(Item.Prop['Name']) as TfrxComponent; + if not IsAncestor and (c = nil) then + begin + c := TfrxComponent(FindClass(Item.Name).NewInstance); + c.Create(Owner); + end; + end + else + c := Root; + + if c <> nil then + begin + c.IsLoading := True; + XMLToObj(Item.Text, c); + CompList.Add(c); + + for i := 0 to Item.Count - 1 do + DoRead(Item[i], c); + end; + end; + + procedure DoLoaded; + var + i: Integer; + c: TfrxComponent; + begin + for i := 0 to CompList.Count - 1 do + begin + c := CompList[i]; + c.IsLoading := False; + if not (c is TfrxReport) then + THackComponent(c).Loaded; + end; + end; + +begin + if Owner = nil then + Owner := Root; + XMLDoc := nil; + CompList := TList.Create; + + if XMLItem = nil then + begin + XMLDoc := TfrxXMLDocument.Create; + XMLItem := XMLDoc.Root; + XMLDoc.LoadFromStream(FStream); + end; + + FReader.Root := FOwner; + FReader.BeginReferences; + try + DoRead(XMLItem, nil); + FixupReferences; + DoLoaded; + finally + if XMLDoc <> nil then + XMLDoc.Free; + CompList.Free; + end; +end; + +procedure TfrxXMLSerializer.WriteRootComponent(Root: TfrxComponent; + SaveChildren: Boolean = True; XMLItem: TfrxXMLItem = nil); +var + XMLDoc: TfrxXMLDocument; + + procedure DoWrite(Item: TfrxXMLItem; ARoot: TfrxComponent); + var + i: Integer; + begin + if ARoot.IsAncestor then + Item.Name := 'inherited' + else + Item.Name := ARoot.ClassName; + if ARoot = Root then + Item.Text := ObjToXML(ARoot) + else + Item.Text := 'Name="' + ARoot.Name + '"' + ObjToXML(ARoot); + + if SaveChildren then + for i := 0 to ARoot.Objects.Count - 1 do + DoWrite(Item.Add, ARoot.Objects[i]); + end; + +begin + if Owner = nil then + Owner := Root; + XMLDoc := nil; + + if XMLItem = nil then + begin + XMLDoc := TfrxXMLDocument.Create; + XMLItem := XMLDoc.Root; + XMLDoc.AutoIndent := True; + end; + + try + DoWrite(XMLItem, Root); + if XMLDoc <> nil then + XMLDoc.SaveToStream(FStream); + finally + if XMLDoc <> nil then + XMLDoc.Free; + end; +end; + +function TfrxXMLSerializer.ReadComponent(Root: TfrxComponent): TfrxComponent; +var + rd: TfrxXMLReader; + RootItem: TfrxXMLItem; +begin + rd := TfrxXMLReader.Create(FStream); + RootItem := TfrxXMLItem.Create; + + try + rd.ReadRootItem(RootItem, False); + Result := ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text); + finally + rd.Free; + RootItem.Free; + end; +end; + +procedure TfrxXMLSerializer.WriteComponent(c: TfrxComponent); +var + s: String; +begin + s := '<' + WriteComponentStr(c) + '/>'; + FStream.Write(s[1], Length(s)); +end; + +function TfrxXMLSerializer.ReadComponentStr(Root: TfrxComponent; + s: String; DontFixup: Boolean = False): TfrxComponent; +var + n: Integer; + s1: String; +begin + Owner := Root; + if Trim(s) = '' then + Result := nil + else + begin + n := Pos(' ', s); + s1 := Copy(s, n + 1, MaxInt); + Delete(s, n, MaxInt); + + Result := TfrxComponent(FindClass(s).NewInstance); + Result.Create(Root); + + FReader.Root := Root; + FReader.BeginReferences; + try + Result.IsLoading := True; + XMLToObj(s1, Result); + finally + if DontFixup then + begin + FReader.EndReferences; + ClearFixups; + end + else + FixupReferences; + Result.IsLoading := False; + if not (Result is TfrxReport) then + THackComponent(Result).Loaded; + end; + end; +end; + +function TfrxXMLSerializer.WriteComponentStr(c: TfrxComponent): String; +begin + Result := c.ClassName + ObjToXML(c); +end; + +procedure TfrxXMLSerializer.ReadPersistentStr(Root: TComponent; + Obj: TPersistent; const s: String); +begin + FReader.Root := Root; + FReader.BeginReferences; + XMLToObj(s, Obj); + FixupReferences; +end; + +end. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxZLib.pas b/official/4.2/Source/frxZLib.pas new file mode 100644 index 0000000..8b56abe --- /dev/null +++ b/official/4.2/Source/frxZLib.pas @@ -0,0 +1,629 @@ +{***************************************************************************** +* 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 frxZLib; + +interface + +{$I frx.inc} + +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; + +function inflateInit_(var strm: TZStreamRec; version: PChar; + recsize: Integer): Integer; forward; +function inflate(var strm: TZStreamRec; flush: Integer): Integer; forward; +function inflateEnd(var strm: TZStreamRec): Integer; forward; +function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; + recsize: Integer): Integer; forward; +function deflate(var strm: TZStreamRec; flush: Integer): Integer; forward; +function deflateEnd(var strm: TZStreamRec): Integer; forward; +{****************************************************************************} + + +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. + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxeReg.dcr b/official/4.2/Source/frxeReg.dcr new file mode 100644 index 0000000..e1d31f8 Binary files /dev/null and b/official/4.2/Source/frxeReg.dcr differ diff --git a/official/4.2/Source/frxrcClass.pas b/official/4.2/Source/frxrcClass.pas new file mode 100644 index 0000000..cfaca2d --- /dev/null +++ b/official/4.2/Source/frxrcClass.pas @@ -0,0 +1,221 @@ +{******************************************} +{ } +{ FastReport v4.0 } +{ Language resource file } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxrcClass; + +interface + +implementation + +uses frxRes; + +const resStr = +'1=OK' + #13#10 + +'2=Cancel' + #13#10 + +'3=All' + #13#10 + +'4=Current page' + #13#10 + +'5=Pages:' + #13#10 + +'6=Page breaks' + #13#10 + +'7=Page range' + #13#10 + +'8=Export settings' + #13#10 + +'9=Enter page numbers and/or page ranges, separated by commas. For example, 1,3,5-12' + #13#10 + +'======== TfrxPreviewForm ========' + #13#10 + +'100=Preview' + #13#10 + +'101=Print' + #13#10 + +'102=Print' + #13#10 + +'103=Open' + #13#10 + +'104=Open' + #13#10 + +'105=Save' + #13#10 + +'106=Save' + #13#10 + +'107=Export' + #13#10 + +'108=Export' + #13#10 + +'109=Find' + #13#10 + +'110=Find' + #13#10 + +'111=Whole Page' + #13#10 + +'112=Whole Page' + #13#10 + +'113=Page Width' + #13#10 + +'114=Page Width' + #13#10 + +'115=100%' + #13#10 + +'116=100%' + #13#10 + +'117=Two Pages' + #13#10 + +'118=Two Pages' + #13#10 + +'119=Zoom' + #13#10 + +'120=Page Settings' + #13#10 + +'121=Page Settings' + #13#10 + +'122=Outline' + #13#10 + +'123=Outline' + #13#10 + +'124=Zoom In' + #13#10 + +'125=Zoom In' + #13#10 + +'126=Zoom Out' + #13#10 + +'127=Zoom Out' + #13#10 + +'128=Outline' + #13#10 + +'129=Report outline' + #13#10 + +'130=Thumbnails' + #13#10 + +'131=Thumbnails' + #13#10 + +'132=Edit' + #13#10 + +'133=Edit Page' + #13#10 + +'134=First' + #13#10 + +'135=First Page' + #13#10 + +'136=Prior' + #13#10 + +'137=Prior Page' + #13#10 + +'138=Next' + #13#10 + +'139=Next Page' + #13#10 + +'140=Last' + #13#10 + +'141=Last Page' + #13#10 + +'142=Page Number' + #13#10 + +'' + #13#10 + +'150=Full Screen' + #13#10 + +'151=Export to PDF' + #13#10 + +'152=Send by E-mail' + #13#10 + +'zmPageWidth=Page width' + #13#10 + +'zmWholePage=Whole page' + #13#10 + +'======== TfrxPrintDialog ========' + #13#10 + +'200=Print' + #13#10 + +'201=Printer' + #13#10 + +'202=Pages' + #13#10 + +'203=Number of copies' + #13#10 + +'204=Collate' + #13#10 + +'205=Copies' + #13#10 + +'206=Print' + #13#10 + +'207=!Other' + #13#10 + +'208=Where:' + #13#10 + +'209=Properties...' + #13#10 + +'210=Print to file' + #13#10 + +'211=!Order' + #13#10 + +'212=Name:' + #13#10 + +'213=Print mode' + #13#10 + +'214=Print on sheet' + #13#10 + +'216=Duplex' + #13#10 + +'' + #13#10 + +'ppAll=All pages' + #13#10 + +'ppOdd=Odd pages' + #13#10 + +'ppEven=Even pages' + #13#10 + +'pgDefault=Default' + #13#10 + +'pmDefault=Default' + #13#10 + +'pmSplit=Split big pages' + #13#10 + +'pmJoin=Join small pages' + #13#10 + +'pmScale=Scale' + #13#10 + +'poDirect=!Direct (1-9)' + #13#10 + +'poReverse=!Reverse (9-1)' + #13#10 + +'======== TfrxSearchDialog ========' + #13#10 + +'300=Find Text' + #13#10 + +'301=Text to find:' + #13#10 + +'302=Search options' + #13#10 + +'303=Replace with' + #13#10 + +'304=Search from beginning' + #13#10 + +'305=Case sensitive' + #13#10 + +'' + #13#10 + +'======== TfrxPageSettingsForm ========' + #13#10 + +'400=Page Settings' + #13#10 + +'401=Width' + #13#10 + +'402=Height' + #13#10 + +'403=Size' + #13#10 + +'404=Orientation' + #13#10 + +'405=Left' + #13#10 + +'406=Top' + #13#10 + +'407=Right' + #13#10 + +'408=Bottom' + #13#10 + +'409=Margins' + #13#10 + +'410=Portrait' + #13#10 + +'411=Landscape' + #13#10 + +'412=Other' + #13#10 + +'413=Apply to the current page' + #13#10 + +'414=Apply to all pages' + #13#10 + +'' + #13#10 + +'======== TfrxDMPExportDialog ========' + #13#10 + +'500=Print' + #13#10 + +'501=Printer' + #13#10 + +'502=Pages' + #13#10 + +'503=Copies' + #13#10 + +'504=Number of copies' + #13#10 + +'505=Options' + #13#10 + +'506=Escape commands' + #13#10 + +'507=Print to file' + #13#10 + +'508=OEM codepage' + #13#10 + +'509=Pseudographic' + #13#10 + +'510=Printer file (*.prn)|*.prn' + #13#10 + +'' + #13#10 + +'======== TfrxProgress ========' + #13#10 + +'' + #13#10 + +'mbConfirm=Confirm' + #13#10 + +'mbError=Error' + #13#10 + +'mbInfo=Information' + #13#10 + +'xrCantFindClass=Cannot find class' + #13#10 + +'prVirtual=Virtual' + #13#10 + +'prDefault=Default' + #13#10 + +'prCustom=Custom' + #13#10 + +'enUnconnHeader=Unconnected header/footer' + #13#10 + +'enUnconnGroup=No data band for the group' + #13#10 + +'enUnconnGFooter=No group header for' + #13#10 + +'enBandPos=Incorrect band position:' + #13#10 + +'dbNotConn=DataSet %s is not connected to data' + #13#10 + +'dbFldNotFound=Field not found:' + #13#10 + +'clDSNotIncl=(dataset is not included in Report.DataSets)' + #13#10 + +'clUnknownVar=Unknown variable or datafield:' + #13#10 + +'clScrError=Script error at %s: %s' + #13#10 + +'clDSNotExist=Dataset "%s" does not exist' + #13#10 + +'clErrors=The following error(s) have occured:' + #13#10 + +'clExprError=Error in expression' + #13#10 + +'clFP3files=Prepared Report' + #13#10 + +'clSaving=Saving file...' + #13#10 + +'clCancel=Cancel' + #13#10 + +'clClose=Close' + #13#10 + +'clPrinting=Printing page' + #13#10 + +'clLoading=Loading file...' + #13#10 + +'clPageOf=Page %d of %d' + #13#10 + +'clFirstPass=First pass: page' + #13#10 + +'clNoPrinters=No printers installed on your system' + #13#10 + +'clDecompressError=Stream decompress error' + #13#10 + +'crFillMx=Filling the cross-tab...' + #13#10 + +'crBuildMx=Building the cross-tab...' + #13#10 + +'prRunningFirst=First pass: page %d' + #13#10 + +'prRunning=Preparing page %d' + #13#10 + +'prPrinting=Printing page %d' + #13#10 + +'prExporting=Exporting page %d' + #13#10 + +'uCm=cm' + #13#10 + +'uInch=in' + #13#10 + +'uPix=px' + #13#10 + +'uChar=chr' + #13#10 + +'dupDefault=Default' + #13#10 + +'dupVert=Vertical' + #13#10 + +'dupHorz=Horizontal' + #13#10 + +'dupSimpl=Simplex' + #13#10 + +'' + #13#10 + +'=========== FS strings ===============' + #13#10 + +'SLangNotFound=Language ''%s'' not found' + #13#10 + +'SInvalidLanguage=Invalid language definition' + #13#10 + +'SIdRedeclared=Identifier redeclared:' + #13#10 + +'SUnknownType=Unknown type:' + #13#10 + +'SIncompatibleTypes=Incompatible types' + #13#10 + +'SIdUndeclared=Undeclared identifier:' + #13#10 + +'SClassRequired=Class type required' + #13#10 + +'SIndexRequired=Index required' + #13#10 + +'SStringError=Strings do not have properties or methods' + #13#10 + +'SClassError=Class %s does not have a default property' + #13#10 + +'SArrayRequired=Array type required' + #13#10 + +'SVarRequired=Variable required' + #13#10 + +'SNotEnoughParams=Not enough actual parameters' + #13#10 + +'STooManyParams=Too many actual parameters' + #13#10 + +'SLeftCantAssigned=Left side cannot be assigned to' + #13#10 + +'SForError=For loop variable must be numeric variable' + #13#10 + +'SEventError=Event handler must be a procedure' + #13#10 + +'======== TfrxPreviewOutlineForm ========' + #13#10 + +'600=Expand all' + #13#10 + +'601=Collapse all' + #13#10 + +''; + +initialization + frxResources.AddStrings(resStr); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxrcDesgn.pas b/official/4.2/Source/frxrcDesgn.pas new file mode 100644 index 0000000..5183438 --- /dev/null +++ b/official/4.2/Source/frxrcDesgn.pas @@ -0,0 +1,947 @@ +{******************************************} +{ } +{ FastReport v4.0 } +{ Language resource file } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxrcDesgn; + +interface + +implementation + +uses frxRes; + +const resStr = +'======== TfrxObjectInspector ========' + #13#10 + +'2000=Object Inspector' + #13#10 + +'' + #13#10 + +'oiProp=Properties' + #13#10 + +'oiEvent=Events' + #13#10 + +'======== TfrxDataTreeForm ========' + #13#10 + +'2100=Data Tree' + #13#10 + +'2101=Data' + #13#10 + +'2102=Variables' + #13#10 + +'2103=Functions' + #13#10 + +'2104=Create field' + #13#10 + +'2105=Create caption' + #13#10 + +'2106=Classes' + #13#10 + +'' + #13#10 + +'dtNoData=No data available' + #13#10 + +'dtNoData1=Go "Report|Data..." menu to add an existing datasets to your report, or switch to "Data" tab and create new datasets.' + #13#10 + +'dtData=Data' + #13#10 + +'dtSysVar=System variables' + #13#10 + +'dtVar=Variables' + #13#10 + +'dtFunc=Functions' + #13#10 + +'======== TfrxReportTreeForm ========' + #13#10 + +'2200=Report Tree' + #13#10 + +'' + #13#10 + +'======== TfrxDesignerForm ========' + #13#10 + +'2300=Open Script File' + #13#10 + +'2301=Save Script to File' + #13#10 + +'2302=Run Script' + #13#10 + +'2303=Trace Into' + #13#10 + +'2304=Terminate Script' + #13#10 + +'2305=Evaluate' + #13#10 + +'2306=Language:' + #13#10 + +'2307=Align' + #13#10 + +'2308=Align Left' + #13#10 + +'2309=Align Middle' + #13#10 + +'2310=Align Right' + #13#10 + +'2311=Align Top' + #13#10 + +'2312=Align Center' + #13#10 + +'2313=Align Bottom' + #13#10 + +'2314=Space Horizontally' + #13#10 + +'2315=Space Vertically' + #13#10 + +'2316=Center Horizontally in Band' + #13#10 + +'2317=Center Vertically in Band' + #13#10 + +'2318=Same Width' + #13#10 + +'2319=Same Height' + #13#10 + +'2320=Text' + #13#10 + +'2321=Style' + #13#10 + +'2322=Font Name' + #13#10 + +'2323=Font Size' + #13#10 + +'2324=Bold' + #13#10 + +'2325=Italic' + #13#10 + +'2326=Underline' + #13#10 + +'2327=Font Color' + #13#10 + +'2328=Highlight' + #13#10 + +'2329=Text Rotation' + #13#10 + +'2330=Align Left' + #13#10 + +'2331=Align Center' + #13#10 + +'2332=Align Right' + #13#10 + +'2333=Justify' + #13#10 + +'2334=Align Top' + #13#10 + +'2335=Align Middle' + #13#10 + +'2336=Align Bottom' + #13#10 + +'2337=Frame' + #13#10 + +'2338=Top Line' + #13#10 + +'2339=Bottom Line' + #13#10 + +'2340=Left Line' + #13#10 + +'2341=Right Line' + #13#10 + +'2342=All Frame Lines' + #13#10 + +'2343=No Frame' + #13#10 + +'2344=Shadow' + #13#10 + +'2345=Background Color' + #13#10 + +'2346=Frame Color' + #13#10 + +'2347=Frame Style' + #13#10 + +'2348=Frame Width' + #13#10 + +'2349=Standard' + #13#10 + +'2350=New Report' + #13#10 + +'2351=Open Report' + #13#10 + +'2352=Save Report' + #13#10 + +'2353=Preview' + #13#10 + +'2354=New Report Page' + #13#10 + +'2355=New Dialog Page' + #13#10 + +'2356=Delete Page' + #13#10 + +'2357=Page Settings' + #13#10 + +'2358=Variables' + #13#10 + +'2359=Cut' + #13#10 + +'2360=Copy' + #13#10 + +'2361=Paste' + #13#10 + +'2362=Copy Formatting' + #13#10 + +'2363=Undo' + #13#10 + +'2364=Redo' + #13#10 + +'2365=Group' + #13#10 + +'2366=Ungroup' + #13#10 + +'2367=Show Grid' + #13#10 + +'2368=Align to Grid' + #13#10 + +'2369=Fit to Grid' + #13#10 + +'2370=Zoom' + #13#10 + +'2371=Extra Tools' + #13#10 + +'2372=Select Tool' + #13#10 + +'2373=Hand Tool' + #13#10 + +'2374=Zoom Tool' + #13#10 + +'2375=Edit Text Tool' + #13#10 + +'2376=Copy Format Tool' + #13#10 + +'2377=Insert Band' + #13#10 + +'2378=&File' + #13#10 + +'2379=&Edit' + #13#10 + +'2380=Find...' + #13#10 + +'2381=Find Next' + #13#10 + +'2382=Replace...' + #13#10 + +'2383=&Report' + #13#10 + +'2384=Data...' + #13#10 + +'2385=Options...' + #13#10 + +'2386=Styles...' + #13#10 + +'2387=&View' + #13#10 + +'2388=Toolbars' + #13#10 + +'2389=Standard' + #13#10 + +'2390=Text' + #13#10 + +'2391=Frame' + #13#10 + +'2392=Alignment Palette' + #13#10 + +'2393=Extra Tools' + #13#10 + +'2394=Object Inspector' + #13#10 + +'2395=Data Tree' + #13#10 + +'2396=Report Tree' + #13#10 + +'2397=Rulers' + #13#10 + +'2398=Guides' + #13#10 + +'2399=Delete Guides' + #13#10 + +'2400=Options...' + #13#10 + +'2401=&Help' + #13#10 + +'2402=Help Contents...' + #13#10 + +'2403=About FastReport...' + #13#10 + +'2404=Tab Order...' + #13#10 + +'2405=Undo' + #13#10 + +'2406=Redo' + #13#10 + +'2407=Cut' + #13#10 + +'2408=Copy' + #13#10 + +'2409=Paste' + #13#10 + +'2410=Group' + #13#10 + +'2411=Ungroup' + #13#10 + +'2412=Delete' + #13#10 + +'2413=Delete Page' + #13#10 + +'2414=Select All' + #13#10 + +'2415=Edit...' + #13#10 + +'2416=Bring to Front' + #13#10 + +'2417=Send to Back' + #13#10 + +'2418=New...' + #13#10 + +'2419=New Report' + #13#10 + +'2420=New Page' + #13#10 + +'2421=New Dialog' + #13#10 + +'2422=Open...' + #13#10 + +'2423=Save' + #13#10 + +'2424=Save As...' + #13#10 + +'2425=Variables...' + #13#10 + +'2426=Page Settings...' + #13#10 + +'2427=Preview' + #13#10 + +'2428=Exit' + #13#10 + +'2429=Report Title' + #13#10 + +'2430=Report Summary' + #13#10 + +'2431=Page Header' + #13#10 + +'2432=Page Footer' + #13#10 + +'2433=Header' + #13#10 + +'2434=Footer' + #13#10 + +'2435=Master Data' + #13#10 + +'2436=Detail Data' + #13#10 + +'2437=Subdetail Data' + #13#10 + +'2438=Data 4th level' + #13#10 + +'2439=Data 5th level' + #13#10 + +'2440=Data 6th level' + #13#10 + +'2441=Group Header' + #13#10 + +'2442=Group Footer' + #13#10 + +'2443=Child' + #13#10 + +'2444=Column Header' + #13#10 + +'2445=Column Footer' + #13#10 + +'2446=Overlay' + #13#10 + +'2447=Vertical bands' + #13#10 + +'2448=Header' + #13#10 + +'2449=Footer' + #13#10 + +'2450=Master Data' + #13#10 + +'2451=Detail Data' + #13#10 + +'2452=Subdetail Data' + #13#10 + +'2453=Group Header' + #13#10 + +'2454=Group Footer' + #13#10 + +'2455=Child' + #13#10 + +'2456=0°' + #13#10 + +'2457=45°' + #13#10 + +'2458=90°' + #13#10 + +'2459=180°' + #13#10 + +'2460=270°' + #13#10 + +'2461=Font Settings' + #13#10 + +'2462=Bold' + #13#10 + +'2463=Italic' + #13#10 + +'2464=Underline' + #13#10 + +'2465=SuperScript' + #13#10 + +'2466=SubScript' + #13#10 + +'2467=Condensed' + #13#10 + +'2468=Wide' + #13#10 + +'2469=12 cpi' + #13#10 + +'2470=15 cpi' + #13#10 + +'2471=Report (*.fr3)|*.fr3' + #13#10 + +'2472=Pascal files (*.pas)|*.pas|C++ files (*.cpp)|*.cpp|JavaScript files (*.js)|*.js|Basic files (*.vb)|*.vb|All files|*.*' + #13#10 + +'2473=Pascal files (*.pas)|*.pas|C++ files (*.cpp)|*.cpp|JavaScript files (*.js)|*.js|Basic files (*.vb)|*.vb|All files|*.*' + #13#10 + +'2474=Connections...' + #13#10 + +'' + #13#10 + +'2475=Language' + #13#10 + +'2476=Toggle breakpoint' + #13#10 + +'2477=Run to cursor' + #13#10 + +'2478=!Add child band' + #13#10 + +'dsCm=Centimeters' + #13#10 + +'dsInch=Inches' + #13#10 + +'dsPix=Pixels' + #13#10 + +'dsChars=Characters' + #13#10 + +'dsCode=Code' + #13#10 + +'dsData=Data' + #13#10 + +'dsPage=Page' + #13#10 + +'dsRepFilter=Report (*.fr3)|*.fr3' + #13#10 + +'dsComprRepFilter=Compressed report (*.fr3)|*.fr3' + #13#10 + +'dsSavePreviewChanges=Save changes to preview page?' + #13#10 + +'dsSaveChangesTo=Save changes to' + #13#10 + +'dsCantLoad=Couldn''t load file' + #13#10 + +'dsStyleFile=Style' + #13#10 + +'dsCantFindProc=Could not locate the main proc' + #13#10 + +'dsClearScript=This will clear all code. Do you want to continue?' + #13#10 + +'dsNoStyle=No style' + #13#10 + +'dsStyleSample=Style sample' + #13#10 + +'dsTextNotFound=Text ''%s'' not found' + #13#10 + +'dsReplace=Replace this occurence of ''%s''?' + #13#10 + +'======== TfrxAboutForm ========' + #13#10 + +'2600=About FastReport' + #13#10 + +'2601=Visit our webpage for more info:' + #13#10 + +'2602=Sales:' + #13#10 + +'2603=Support:' + #13#10 + +'' + #13#10 + +'======== TfrxPageEditorForm ========' + #13#10 + +'2700=Page Options' + #13#10 + +'2701=Paper' + #13#10 + +'2702=Width' + #13#10 + +'2703=Height' + #13#10 + +'2704=Size' + #13#10 + +'2705=Orientation' + #13#10 + +'2706=Left' + #13#10 + +'2707=Top' + #13#10 + +'2708=Right' + #13#10 + +'2709=Bottom' + #13#10 + +'2710=Margins' + #13#10 + +'2711=Paper Source' + #13#10 + +'2712=First page' + #13#10 + +'2713=Other pages' + #13#10 + +'2714=Portrait' + #13#10 + +'2715=Landscape' + #13#10 + +'2716=Other options' + #13#10 + +'2717=Columns' + #13#10 + +'2718=Number' + #13#10 + +'2719=Width' + #13#10 + +'2720=Positions' + #13#10 + +'2721=Other' + #13#10 + +'2722=Duplex' + #13#10 + +'2723=Print to previous page' + #13#10 + +'2724=Mirror margins' + #13#10 + +'2725=Large height in design mode' + #13#10 + +'2726=Endless page width' + #13#10 + +'2727=Endless page height' + #13#10 + +'' + #13#10 + +'======== TfrxReportDataForm ========' + #13#10 + +'2800=Select Report Datasets' + #13#10 + +'' + #13#10 + +'======== TfrxVarEditorForm ========' + #13#10 + +'2900=Edit Variables' + #13#10 + +'2901=Category' + #13#10 + +'2902=Variable' + #13#10 + +'2903=Edit' + #13#10 + +'2904=Delete' + #13#10 + +'2905=List' + #13#10 + +'2906=Load' + #13#10 + +'2907=Save' + #13#10 + +'2908=Expression:' + #13#10 + +'2909=Dictionary (*.fd3)|*.fd3' + #13#10 + +'2910=Dictionary (*.fd3)|*.fd3' + #13#10 + +'' + #13#10 + +'vaNoVar=(no variables defined)' + #13#10 + +'vaVar=Variables' + #13#10 + +'vaDupName=Duplicate name' + #13#10 + +'======== TfrxOptionsEditor ========' + #13#10 + +'3000=Designer Options' + #13#10 + +'3001=Grid' + #13#10 + +'3002=Type' + #13#10 + +'3003=Size' + #13#10 + +'3004=Dialog form:' + #13#10 + +'3005=Other' + #13#10 + +'3006=Fonts' + #13#10 + +'3007=Code window' + #13#10 + +'3008=Memo editor' + #13#10 + +'3009=Size' + #13#10 + +'3010=Size' + #13#10 + +'3011=Colors' + #13#10 + +'3012=Gap between bands:' + #13#10 + +'3013=cm' + #13#10 + +'3014=in' + #13#10 + +'3015=pt' + #13#10 + +'3016=pt' + #13#10 + +'3017=pt' + #13#10 + +'3018=Centimeters:' + #13#10 + +'3019=Inches:' + #13#10 + +'3020=Pixels:' + #13#10 + +'3021=Show grid' + #13#10 + +'3022=Align to Grid' + #13#10 + +'3023=Show editor after insert' + #13#10 + +'3024=Use object''s font settings' + #13#10 + +'3025=Workspace' + #13#10 + +'3026=Tool windows' + #13#10 + +'3027=LCD grid color' + #13#10 + +'3028=Free bands placement' + #13#10 + +'3029=Show drop-down fields list' + #13#10 + +'3030=Show startup screen' + #13#10 + +'3031=Restore defaults' + #13#10 + +'3032=Show band captions' + #13#10 + +'' + #13#10 + +'======== TfrxDataBandEditorForm ========' + #13#10 + +'3100=Select DataSet' + #13#10 + +'3101=Number of records:' + #13#10 + +'' + #13#10 + +'dbNotAssigned=[not assigned]' + #13#10 + +'======== TfrxGroupEditorForm ========' + #13#10 + +'3200=Group' + #13#10 + +'3201=Break on' + #13#10 + +'3202=Options' + #13#10 + +'3203=Data field' + #13#10 + +'3204=Expression' + #13#10 + +'3205=Keep group together' + #13#10 + +'3206=Start new page' + #13#10 + +'3207=Show in outline' + #13#10 + +'' + #13#10 + +'======== TfrxSysMemoEditorForm ========' + #13#10 + +'3300=System Memo' + #13#10 + +'3301=Data band' + #13#10 + +'3302=DataSet' + #13#10 + +'3303=DataField' + #13#10 + +'3304=Function' + #13#10 + +'3305=Expression' + #13#10 + +'3306=Aggregate value' + #13#10 + +'3307=System variable' + #13#10 + +'3308=Count invisible bands' + #13#10 + +'3309=Text' + #13#10 + +'3310=Running total' + #13#10 + +'' + #13#10 + +'agAggregate=Insert Aggregate' + #13#10 + +'vt1=[DATE]' + #13#10 + +'vt2=[TIME]' + #13#10 + +'vt3=[PAGE#]' + #13#10 + +'vt4=[TOTALPAGES#]' + #13#10 + +'vt5=[PAGE#] of [TOTALPAGES#]' + #13#10 + +'vt6=[LINE#]' + #13#10 + +'======== TfrxOleEditorForm ========' + #13#10 + +'3400=OLE object' + #13#10 + +'3401=Insert...' + #13#10 + +'3402=Edit...' + #13#10 + +'3403=Close' + #13#10 + +'' + #13#10 + +'olStretched=Stretched' + #13#10 + +'======== TfrxBarcodeEditorForm ========' + #13#10 + +'3500=Barcode Editor' + #13#10 + +'3501=Code' + #13#10 + +'3502=Type of Bar' + #13#10 + +'3503=Zoom:' + #13#10 + +'3504=Options' + #13#10 + +'3505=Rotation' + #13#10 + +'3506=Calc Checksum' + #13#10 + +'3507=Text' + #13#10 + +'3508=0°' + #13#10 + +'3509=90°' + #13#10 + +'3510=180°' + #13#10 + +'3511=270°' + #13#10 + +'' + #13#10 + +'bcCalcChecksum=Calc Checksum' + #13#10 + +'bcShowText=Show Text' + #13#10 + +'======== TfrxAliasesEditorForm ========' + #13#10 + +'3600=Edit Aliases' + #13#10 + +'3601=Press Enter to edit item' + #13#10 + +'3602=Dataset alias' + #13#10 + +'3603=Field aliases' + #13#10 + +'3604=Reset' + #13#10 + +'3605=Update' + #13#10 + +'' + #13#10 + +'alUserName=User name' + #13#10 + +'alOriginal=Original name' + #13#10 + +'======== TfrxParamsEditorForm ========' + #13#10 + +'3700=Parameters Editor' + #13#10 + +'' + #13#10 + +'qpName=Name' + #13#10 + +'qpDataType=Data Type' + #13#10 + +'qpValue=Value' + #13#10 + +'======== TfrxMDEditorForm ========' + #13#10 + +'3800=Master-Detail Link' + #13#10 + +'3801=Detail fields' + #13#10 + +'3802=Master fields' + #13#10 + +'3803=Linked fields' + #13#10 + +'3804=Add' + #13#10 + +'3805=Clear' + #13#10 + +'' + #13#10 + +'======== TfrxMemoEditorForm ========' + #13#10 + +'3900=Memo' + #13#10 + +'3901=Insert Expression' + #13#10 + +'3902=Insert Aggregate' + #13#10 + +'3903=Insert Formatting' + #13#10 + +'3904=Word Wrap' + #13#10 + +'3905=Text' + #13#10 + +'3906=Format' + #13#10 + +'3907=Highlight' + #13#10 + +'' + #13#10 + +'======== TfrxPictureEditorForm ========' + #13#10 + +'4000=Picture' + #13#10 + +'4001=Load' + #13#10 + +'4002=Copy' + #13#10 + +'4003=Paste' + #13#10 + +'4004=Clear' + #13#10 + +'' + #13#10 + +'piEmpty=Empty' + #13#10 + +'======== TfrxChartEditorForm ========' + #13#10 + +'4100=Chart Editor' + #13#10 + +'4101=Add Series' + #13#10 + +'4102=Delete Series' + #13#10 + +'4103=Edit Chart' + #13#10 + +'4104=Band source' + #13#10 + +'4105=Fixed data' + #13#10 + +'4106=DataSet' + #13#10 + +'4107=Data Source' + #13#10 + +'4108=Values' + #13#10 + +'4109=Select the chart series or add a new one.' + #13#10 + +'4114=Other options' + #13#10 + +'4115=TopN values' + #13#10 + +'4116=TopN caption' + #13#10 + +'4117=Sort order' + #13#10 + +'4126=X Axis' + #13#10 + +'' + #13#10 + +'ch3D=3D View' + #13#10 + +'chAxis=Show Axis' + #13#10 + +'chsoNone=None' + #13#10 + +'chsoAscending=Ascending' + #13#10 + +'chsoDescending=Descending' + #13#10 + +'chxtText=Text' + #13#10 + +'chxtNumber=Numeric' + #13#10 + +'chxtDate=Date' + #13#10 + +'======== TfrxRichEditorForm ========' + #13#10 + +'4200=Rich Editor' + #13#10 + +'4201=Open File' + #13#10 + +'4202=Save File' + #13#10 + +'4203=Undo' + #13#10 + +'4204=Font' + #13#10 + +'4205=Insert Expression' + #13#10 + +'4206=Bold' + #13#10 + +'4207=Italic' + #13#10 + +'4208=Underline' + #13#10 + +'4209=Left Align' + #13#10 + +'4210=Center Align' + #13#10 + +'4211=Right Align' + #13#10 + +'4212=Justify' + #13#10 + +'4213=Bullets' + #13#10 + +'' + #13#10 + +'======== TfrxCrossEditorForm ========' + #13#10 + +'4300=Cross-tab Editor' + #13#10 + +'4301=Source data' + #13#10 + +'4302=Dimensions' + #13#10 + +'4303=Rows' + #13#10 + +'4304=Columns' + #13#10 + +'4305=Cells' + #13#10 + +'4306=Cross-tab structure' + #13#10 + +'4307=Row header' + #13#10 + +'4308=Column header' + #13#10 + +'4309=Row grand total' + #13#10 + +'4310=Column grand total' + #13#10 + +'4311=Swap rows/columns' + #13#10 + +'4312=!Select style' + #13#10 + +'4313=!Save current style...' + #13#10 + +'4314=!Show title' + #13#10 + +'4315=!Show corner' + #13#10 + +'4316=!Reprint headers on new page' + #13#10 + +'4317=!Auto size' + #13#10 + +'4318=!Border around cells' + #13#10 + +'4319=!Print down then across' + #13#10 + +'4320=!Side-by-side cells' + #13#10 + +'4321=!Join equal cells' + #13#10 + +'4322=None' + #13#10 + +'4323=Sum' + #13#10 + +'4324=Min' + #13#10 + +'4325=Max' + #13#10 + +'4326=Average' + #13#10 + +'4327=Count' + #13#10 + +'4328=Ascending (A-Z)' + #13#10 + +'4329=Descending (Z-A)' + #13#10 + +'4330=No Sort' + #13#10 + +'' + #13#10 + +'crStName=!Enter the style name:' + #13#10 + +'crResize=!To resize a cross-tab, set its "AutoSize" property to False.' + #13#10 + +'crSubtotal=Subtotal' + #13#10 + +'crNone=None' + #13#10 + +'crSum=Sum' + #13#10 + +'crMin=Min' + #13#10 + +'crMax=Max' + #13#10 + +'crAvg=Avg' + #13#10 + +'crCount=Count' + #13#10 + +'crAsc=A-Z' + #13#10 + +'crDesc=Z-A' + #13#10 + +'======== TfrxExprEditorForm ========' + #13#10 + +'4400=Expression Editor' + #13#10 + +'4401=Expression:' + #13#10 + +'' + #13#10 + +'======== TfrxFormatEditorForm ========' + #13#10 + +'4500=Display Format' + #13#10 + +'4501=Category' + #13#10 + +'4502=Format' + #13#10 + +'4503=Format string:' + #13#10 + +'4504=Decimal separator:' + #13#10 + +'' + #13#10 + +'fkText=Text (no formatting)' + #13#10 + +'fkNumber=Number' + #13#10 + +'fkDateTime=Date/Time' + #13#10 + +'fkBoolean=Boolean' + #13#10 + +'fkNumber1=1234.5;%g' + #13#10 + +'fkNumber2=1234.50;%2.2f' + #13#10 + +'fkNumber3=1,234.50;%2.2n' + #13#10 + +'fkNumber4=$1,234.50;%2.2m' + #13#10 + +'fkDateTime1=11.28.2002;mm.dd.yyyy' + #13#10 + +'fkDateTime2=28 nov 2002;dd mmm yyyy' + #13#10 + +'fkDateTime3=November 28, 2002;mmmm dd, yyyy' + #13#10 + +'fkDateTime4=02:14;hh:mm' + #13#10 + +'fkDateTime5=02:14am;hh:mm am/pm' + #13#10 + +'fkDateTime6=02:14:00;hh:mm:ss' + #13#10 + +'fkDateTime7=02:14am, November 28, 2002;hh:mm am/pm, mmmm dd, yyyy' + #13#10 + +'fkBoolean1=0,1;0,1' + #13#10 + +'fkBoolean2=No,Yes;No,Yes' + #13#10 + +'fkBoolean3=_,x;_,x' + #13#10 + +'fkBoolean4=False,True;False,True' + #13#10 + +'======== TfrxHighlightEditorForm ========' + #13#10 + +'4600=Highlight' + #13#10 + +'4601=Color...' + #13#10 + +'4602=Color...' + #13#10 + +'4603=Condition' + #13#10 + +'4604=Font' + #13#10 + +'4605=Background' + #13#10 + +'4606=Bold' + #13#10 + +'4607=Italic' + #13#10 + +'4608=Underline' + #13#10 + +'4609=Transparent' + #13#10 + +'4610=Other' + #13#10 + +'' + #13#10 + +'======== TfrxReportEditorForm ========' + #13#10 + +'4700=Report Settings' + #13#10 + +'4701=General' + #13#10 + +'4702=Printer settings' + #13#10 + +'4703=Copies' + #13#10 + +'4704=General' + #13#10 + +'4705=Password' + #13#10 + +'4706=Collate copies' + #13#10 + +'4707=Double pass' + #13#10 + +'4708=Print if empty' + #13#10 + +'4709=Description' + #13#10 + +'4710=Name' + #13#10 + +'4711=Description' + #13#10 + +'4712=Picture' + #13#10 + +'4713=Author' + #13#10 + +'4714=Major' + #13#10 + +'4715=Minor' + #13#10 + +'4716=Release' + #13#10 + +'4717=Build' + #13#10 + +'4718=Created' + #13#10 + +'4719=Modified' + #13#10 + +'4720=Description' + #13#10 + +'4721=Version' + #13#10 + +'4722=Browse...' + #13#10 + +'4723=Inheritance settings' + #13#10 + +'4724=Select the option:' + #13#10 + +'4725=Don''t change' + #13#10 + +'4726=Detach the base report' + #13#10 + +'4727=Inherit from base report:' + #13#10 + +'4728=Inheritance' + #13#10 + +'' + #13#10 + +'rePrnOnPort=on' + #13#10 + +'riNotInherited=This report is not inherited.' + #13#10 + +'riInherited=This report is inherited from base report: %s' + #13#10 + +'======== TfrxStringsEditorForm ========' + #13#10 + +'4800=Lines' + #13#10 + +'' + #13#10 + +'======== TfrxSQLEditorForm ========' + #13#10 + +'4900=SQL' + #13#10 + +'4901=Query Builder' + #13#10 + +'' + #13#10 + +'======== TfrxPasswordForm ========' + #13#10 + +'5000=Password' + #13#10 + +'5001=Enter the password:' + #13#10 + +'' + #13#10 + +'======== TfrxStyleEditorForm ========' + #13#10 + +'5100=Style Editor' + #13#10 + +'5101=Color...' + #13#10 + +'5102=Font...' + #13#10 + +'5103=Frame...' + #13#10 + +'5104=Add' + #13#10 + +'5105=Delete' + #13#10 + +'5106=Edit' + #13#10 + +'5107=Load' + #13#10 + +'5108=Save' + #13#10 + +'' + #13#10 + +'======== TfrxFrameEditorForm ========' + #13#10 + +'5200=Frame Editor' + #13#10 + +'5201=Frame' + #13#10 + +'5202=Frame line' + #13#10 + +'5203=Shadow' + #13#10 + +'5204=Top Line' + #13#10 + +'5205=Bottom Line' + #13#10 + +'5206=Left Line' + #13#10 + +'5207=Right Line' + #13#10 + +'5208=All Frame Lines' + #13#10 + +'5209=No Frame' + #13#10 + +'5210=Frame Color' + #13#10 + +'5211=Frame Style' + #13#10 + +'5212=Frame Width' + #13#10 + +'5213=Shadow' + #13#10 + +'5214=Shadow Color' + #13#10 + +'5215=Shadow Width' + #13#10 + +'' + #13#10 + +'======== TfrxNewItemForm ========' + #13#10 + +'5300=New Item' + #13#10 + +'5301=Items' + #13#10 + +'5302=Templates' + #13#10 + +'5303=Inherit the report' + #13#10 + +'' + #13#10 + +'======== TfrxTabOrderEditorForm ========' + #13#10 + +'5400=Tab Order' + #13#10 + +'5401=Controls listed in tab order:' + #13#10 + +'5402=Move Up' + #13#10 + +'5403=Move Down' + #13#10 + +'' + #13#10 + +'======== TfrxEvaluateForm ========' + #13#10 + +'5500=Evaluate' + #13#10 + +'5501=Expression' + #13#10 + +'5502=Result' + #13#10 + +'' + #13#10 + +'======== TfrxStdWizardForm ========' + #13#10 + +'5600=Report Wizard' + #13#10 + +'5601=Data' + #13#10 + +'5602=Fields' + #13#10 + +'5603=Groups' + #13#10 + +'5604=Layout' + #13#10 + +'5605=Style' + #13#10 + +'5606=Step 1. Select the dataset.' + #13#10 + +'5607=Step 2. Select the fields to display.' + #13#10 + +'5608=Step 3. Create groups (optional).' + #13#10 + +'5609=Step 4. Define the page orientation and data layout.' + #13#10 + +'5610=Step 5. Choose the report style.' + #13#10 + +'5611=Add >' + #13#10 + +'5612=Add all >>' + #13#10 + +'5613=< Remove' + #13#10 + +'5614=<< Remove all' + #13#10 + +'5615=Add >' + #13#10 + +'5616=< Remove' + #13#10 + +'5617=Selected fields:' + #13#10 + +'5618=Available fields:' + #13#10 + +'5619=Groups:' + #13#10 + +'5620=Orientation' + #13#10 + +'5621=Layout' + #13#10 + +'5622=Portrait' + #13#10 + +'5623=Landscape' + #13#10 + +'5624=Tabular' + #13#10 + +'5625=Columnar' + #13#10 + +'5626=Fit fields to page width' + #13#10 + +'5627=<< Back' + #13#10 + +'5628=Next >>' + #13#10 + +'5629=Finish' + #13#10 + +'5630=New table...' + #13#10 + +'5631=New query...' + #13#10 + +'5632=Select database connection:' + #13#10 + +'5633=Select a table:' + #13#10 + +'5634=or' + #13#10 + +'5635=Create a query...' + #13#10 + +'5636=Configure connections' + #13#10 + +'' + #13#10 + +'wzStd=Standard Report Wizard' + #13#10 + +'wzDMP=Dot-Matrix Report Wizard' + #13#10 + +'wzStdEmpty=Standard Report' + #13#10 + +'wzDMPEmpty=Dot-Matrix Report' + #13#10 + +'======== TfrxConnectionWizardForm ========' + #13#10 + +'5700=Connection Wizard' + #13#10 + +'5701=Connection' + #13#10 + +'5702=Choose the connection type:' + #13#10 + +'5703=Choose the database:' + #13#10 + +'5704=Login' + #13#10 + +'5705=Password' + #13#10 + +'5706=Prompt login' + #13#10 + +'5707=Use login/password:' + #13#10 + +'5708=Table' + #13#10 + +'5709=Choose the table name:' + #13#10 + +'5710=Filter records:' + #13#10 + +'5711=Query' + #13#10 + +'5712=SQL statement:' + #13#10 + +'5713=Query Builder' + #13#10 + +'5714=Edit Query Parameters' + #13#10 + +'' + #13#10 + +'ftAllFiles=All Files' + #13#10 + +'ftPictures=Pictures' + #13#10 + +'ftDB=Databases' + #13#10 + +'ftRichFile=RichText file' + #13#10 + +'ftTextFile=Text file' + #13#10 + +'prNotAssigned=(Not assigned)' + #13#10 + +'prInvProp=Invalid property value' + #13#10 + +'prDupl=Duplicate name' + #13#10 + +'prPict=(Picture)' + #13#10 + +'mvExpr=Allow Expressions' + #13#10 + +'mvStretch=Stretch' + #13#10 + +'mvStretchToMax=Stretch to Max Height' + #13#10 + +'mvShift=Shift' + #13#10 + +'mvShiftOver=Shift When Overlapped' + #13#10 + +'mvVisible=Visible' + #13#10 + +'mvPrintable=Printable' + #13#10 + +'mvFont=Font...' + #13#10 + +'mvFormat=Display Format...' + #13#10 + +'mvClear=Clear Contents' + #13#10 + +'mvAutoWidth=Auto Width' + #13#10 + +'mvWWrap=Word Wrap' + #13#10 + +'mvSuppress=Suppress Repeated Values' + #13#10 + +'mvHideZ=Hide Zeros' + #13#10 + +'mvHTML=Allow HTML Tags' + #13#10 + +'lvDiagonal=Diagonal' + #13#10 + +'pvAutoSize=Auto Size' + #13#10 + +'pvCenter=Center' + #13#10 + +'pvAspect=Keep Aspect Ratio' + #13#10 + +'bvSplit=Allow Split' + #13#10 + +'bvKeepChild=Keep Child Together' + #13#10 + +'bvPrintChild=Print Child If Invisible' + #13#10 + +'bvStartPage=Start New Page' + #13#10 + +'bvPrintIfEmpty=Print If Detail Empty' + #13#10 + +'bvKeepDetail=Keep Detail Together' + #13#10 + +'bvKeepFooter=Keep Footer Together' + #13#10 + +'bvReprint=Reprint On New Page' + #13#10 + +'bvOnFirst=Print On First Page' + #13#10 + +'bvOnLast=Print On Last Page' + #13#10 + +'bvKeepGroup=Keep Together' + #13#10 + +'bvFooterAfterEach=Footer After Each Row' + #13#10 + +'bvDrillDown=Drill-Down' + #13#10 + +'bvResetPageNo=Reset Page Numbers' + #13#10 + +'srParent=Print On Parent' + #13#10 + +'bvKeepHeader=Keep Header Together' + #13#10 + +'obCatDraw=Draw' + #13#10 + +'obCatOther=Other objects' + #13#10 + +'obCatOtherControls=Other controls' + #13#10 + +'obDiagLine=Diagonal line' + #13#10 + +'obRect=Rectangle' + #13#10 + +'obRoundRect=Rounded rectangle' + #13#10 + +'obEllipse=Ellipse' + #13#10 + +'obTrian=Triangle' + #13#10 + +'obDiamond=Diamond' + #13#10 + +'obLabel=Label control' + #13#10 + +'obEdit=Edit control' + #13#10 + +'obMemoC=Memo control' + #13#10 + +'obButton=Button control' + #13#10 + +'obChBoxC=CheckBox control' + #13#10 + +'obRButton=RadioButton control' + #13#10 + +'obLBox=ListBox control' + #13#10 + +'obCBox=ComboBox control' + #13#10 + +'obDateEdit=DateEdit control' + #13#10 + +'obImageC=Image control' + #13#10 + +'obPanel=Panel control' + #13#10 + +'obGrBox=GroupBox control' + #13#10 + +'obBBtn=BitBtn control' + #13#10 + +'obSBtn=SpeedButton control' + #13#10 + +'obMEdit=MaskEdit control' + #13#10 + +'obChLB=CheckListBox control' + #13#10 + +'obDBLookup=DBLookupComboBox control' + #13#10 + +'obBevel=Bevel object' + #13#10 + +'obShape=Shape object' + #13#10 + +'obText=Text object' + #13#10 + +'obSysText=System text' + #13#10 + +'obLine=Line object' + #13#10 + +'obPicture=Picture object' + #13#10 + +'obBand=Band object' + #13#10 + +'obDataBand=Data band' + #13#10 + +'obSubRep=Subreport object' + #13#10 + +'obDlgPage=Dialog form' + #13#10 + +'obRepPage=Report page' + #13#10 + +'obReport=Report object' + #13#10 + +'obRich=RichText object' + #13#10 + +'obOLE=OLE object' + #13#10 + +'obChBox=CheckBox object' + #13#10 + +'obChart=Chart object' + #13#10 + +'obBarC=Barcode object' + #13#10 + +'obCross=Cross-tab object' + #13#10 + +'obDBCross=DB Cross-tab object' + #13#10 + +'obGrad=Gradient object' + #13#10 + +'obDMPText=Dot-matrix Text object' + #13#10 + +'obDMPLine=Dot-matrix Line object' + #13#10 + +'obDMPCmd=Dot-matrix Command object' + #13#10 + +'obBDEDB=BDE Database' + #13#10 + +'obBDETb=BDE Table' + #13#10 + +'obBDEQ=BDE Query' + #13#10 + +'obBDEComps=BDE components' + #13#10 + +'obIBXDB=IBX Database' + #13#10 + +'obIBXTb=IBX Table' + #13#10 + +'obIBXQ=IBX Query' + #13#10 + +'obIBXComps=IBX Components' + #13#10 + +'obADODB=ADO Database' + #13#10 + +'obADOTb=ADO Table' + #13#10 + +'obADOQ=ADO Query' + #13#10 + +'obADOComps=ADO Components' + #13#10 + +'obDBXDB=DBX Database' + #13#10 + +'obDBXTb=DBX Table' + #13#10 + +'obDBXQ=DBX Query' + #13#10 + +'obDBXComps=DBX Components' + #13#10 + +'obFIBDB=FIB Database' + #13#10 + +'obFIBTb=FIB Table' + #13#10 + +'obFIBQ=FIB Query' + #13#10 + +'obFIBComps=FIB Components' + #13#10 + +'ctString=String' + #13#10 + +'ctDate=Date and Time' + #13#10 + +'ctConv=Conversions' + #13#10 + +'ctFormat=Formatting' + #13#10 + +'ctMath=Mathematical' + #13#10 + +'ctOther=Other' + #13#10 + +'IntToStr=Converts an integer value to a string' + #13#10 + +'FloatToStr=Converts a float value to a string' + #13#10 + +'DateToStr=Converts a date to a string' + #13#10 + +'TimeToStr=Converts a time to a string' + #13#10 + +'DateTimeToStr=Converts a date-and-time value to a string' + #13#10 + +'VarToStr=Converts a variant value to a string' + #13#10 + +'StrToInt=Converts a string to an integer value' + #13#10 + +'StrToInt64=Converts a string to an Int64 value' + #13#10 + +'StrToFloat=Converts a string to a floating-point value' + #13#10 + +'StrToDate=Converts a string to a date format' + #13#10 + +'StrToTime=Converts a string to a time format' + #13#10 + +'StrToDateTime=Converts a string to a date-and-time format' + #13#10 + +'Format=Returns formatted string assembled from a series of array arguments' + #13#10 + +'FormatFloat=Formats a floating-point value' + #13#10 + +'FormatDateTime=Formats a date-and-time value' + #13#10 + +'FormatMaskText=Returns a string formatted using an edit mask' + #13#10 + +'EncodeDate=Returns a TDateTime type for a specified Year, Month, and Day' + #13#10 + +'DecodeDate=Breaks TDateTime into Year, Month, and Day values' + #13#10 + +'EncodeTime=Returns a TDateTime type for a specified Hour, Min, Sec, and MSec' + #13#10 + +'DecodeTime=Breaks TDateTime into hours, minutes, seconds, and milliseconds' + #13#10 + +'Date=Returns current date' + #13#10 + +'Time=Returns current time' + #13#10 + +'Now=Return current date and time' + #13#10 + +'DayOfWeek=Returns the day of the week for a specified date' + #13#10 + +'IsLeapYear=Indicates whether a specified year is a leap year' + #13#10 + +'DaysInMonth=Returns a number of days in a specified month' + #13#10 + +'Length=Returns a length of a string' + #13#10 + +'Copy=Returns a substring of a string' + #13#10 + +'Pos=Returns a position of a substring in a string' + #13#10 + +'Delete=Removes a substring from a string' + #13#10 + +'Insert=Inserts a substring into a string' + #13#10 + +'Uppercase=Converts all character in a string to upper case' + #13#10 + +'Lowercase=Converts all character in a string to lower case' + #13#10 + +'Trim=Trims all trailing and leading spaces in a string' + #13#10 + +'NameCase=Converts first character of a word to upper case' + #13#10 + +'CompareText=Compares two strings' + #13#10 + +'Chr=Converts an integer value to a char' + #13#10 + +'Ord=Converts a character value to an integer' + #13#10 + +'SetLength=Sets the length of a string' + #13#10 + +'Round=Rounds a floating-point value to the nearest whole number' + #13#10 + +'Trunc=Truncates a floating-point value to an integer' + #13#10 + +'Int=Returns the integer part of a real number' + #13#10 + +'Frac=Returns the fractional part of a real number' + #13#10 + +'Sqrt=Returns the square root of a specified number' + #13#10 + +'Abs=Returns an absolute value' + #13#10 + +'Sin=Returns the sine of an angle (in radians)' + #13#10 + +'Cos=Returns the cosine of an angle (in radians)' + #13#10 + +'ArcTan=Returns the arctangent' + #13#10 + +'Tan=Returns the tangent' + #13#10 + +'Exp=Returns the exponential' + #13#10 + +'Ln=Returns the natural log of a real expression' + #13#10 + +'Pi=Returns the 3.1415926... number' + #13#10 + +'Inc=Increments a value' + #13#10 + +'Dec=Decrements a value' + #13#10 + +'RaiseException=Raises an exception' + #13#10 + +'ShowMessage=Shows a message box' + #13#10 + +'Randomize=Starts the random numbers generator' + #13#10 + +'Random=Returns a random number' + #13#10 + +'ValidInt=Returns True if specified string contains a valid integer' + #13#10 + +'ValidFloat=Returns True if specified string contains a valid float' + #13#10 + +'ValidDate=Returns True if specified string contains a valid date' + #13#10 + +'IIF=Returns TrueValue if specified Expr is True, otherwise returns FalseValue' + #13#10 + +'Get=For internal use only' + #13#10 + +'Set=For internal use only' + #13#10 + +'InputBox=Displays an input dialog box that enables the user to enter a string' + #13#10 + +'InputQuery=Displays an input dialog box that enables the user to enter a string' + #13#10 + +'MessageDlg=Shows a message box' + #13#10 + +'CreateOleObject=Creates an OLE object' + #13#10 + +'VarArrayCreate=Creates a variant array' + #13#10 + +'VarType=Return a type of the variant value' + #13#10 + +'DayOf=Returns day number (1..31) of given Date' + #13#10 + +'MonthOf=Returns month number (1..12) of given Date' + #13#10 + +'YearOf=Returns year of given Date' + #13#10 + +'ctAggregate=Aggregate' + #13#10 + +'Sum=Calculates the sum of the Expr for the Band datarow' + #13#10 + +'Avg=Calculates the average of the Expr for the Band datarow' + #13#10 + +'Min=Calculates the minimum of the Expr for the Band datarow' + #13#10 + +'Max=Calculates the maximum of the Expr for the Band datarow' + #13#10 + +'Count=Calculates the number of datarows' + #13#10 + +'wzDBConn=New Connection Wizard' + #13#10 + +'wzDBTable=New Table Wizard' + #13#10 + +'wzDBQuery=New Query Wizard' + #13#10 + +'======== TfrxConnEditorForm ========' + #13#10 + +'5800=Connections' + #13#10 + +'5801=New' + #13#10 + +'5802=Delete' + #13#10 + +'' + #13#10 + +'cpName=Name' + #13#10 + +'cpConnStr=Connection string' + #13#10 + +'startCreateNew=Create new report' + #13#10 + +'startCreateBlank=Create blank report' + #13#10 + +'startOpenReport=Open report' + #13#10 + +'startOpenLast=Open last report' + #13#10 + +'startEditAliases=Edit connection aliases' + #13#10 + +'startHelp=Help' + #13#10 + +'' + #13#10 + +'======== TfrxWatchForm ========' + #13#10 + +'5900=Watches' + #13#10 + +'5901=Add Watch' + #13#10 + +'5902=Delete Watch' + #13#10 + +'5903=Edit Watch' + #13#10 + +'' + #13#10 + +'======== TfrxInheritErrorForm ========' + #13#10 + +'6000=Inherit error' + #13#10 + +'6001=Base and inherited reports have duplicate objects. What should we do?' + #13#10 + +'6002=Delete duplicates' + #13#10 + +'6003=Rename duplicates' + #13#10 + +''; + +initialization + frxResources.AddStrings(resStr); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/frxrcInsp.pas b/official/4.2/Source/frxrcInsp.pas new file mode 100644 index 0000000..a09a7d4 --- /dev/null +++ b/official/4.2/Source/frxrcInsp.pas @@ -0,0 +1,287 @@ +{******************************************} +{ } +{ FastReport v4.0 } +{ Language resource file } +{ } +{ Copyright (c) 1998-2007 } +{ by Alexander Tzyganenko, } +{ Fast Reports Inc. } +{ } +{******************************************} + +unit frxrcInsp; + +interface + +implementation + +uses frxRes; + +const resStr = +'propActive=Specifies if a dataset is open' + #13#10 + +'propActive.TfrxHighlight=Specifies if a highlight is active' + #13#10 + +'propAliasName=The name of the DB alias' + #13#10 + +'propAlign=Determines the alignment of the object relative to band or page' + #13#10 + +'propAlignment=The alignment of the object''s text' + #13#10 + +'propAllowAllUp=Specifies if all speed buttons in the group can be unselected at the same time' + #13#10 + +'propAllowEdit=Determines if the user may edit the prepared report pages' + #13#10 + +'propAllowExpressions=Determines if the text object may contain expressions inside the text' + #13#10 + +'propAllowGrayed=Allows grayed state of the control checkboxes' + #13#10 + +'propAllowHTMLTags=Determines if the text object may contain HTML tags inside the text' + #13#10 + +'propAllowSplit=Determines if the band may split its contents across pages' + #13#10 + +'propAuthor=The author of the report' + #13#10 + +'propAutoSize.TfrxPictureView=Determines if the picture should handle its size automatically' + #13#10 + +'propAutoWidth=Determines if the text object should handle its width automatically' + #13#10 + +'propBackPicture=The background page picture' + #13#10 + +'propBarType=The type of the barcode' + #13#10 + +'propBevelInner=The type of the inner bevel' + #13#10 + +'propBevelOuter=The type of the outer bevel' + #13#10 + +'propBevelWidth=The width of the bevel' + #13#10 + +'propBorder=Determines if outer border is shown' + #13#10 + +'propBorderStyle=The style of the window' + #13#10 + +'propBottomMargin=The size of the bottom page margin' + #13#10 + +'propBrushStyle=The style of the brush used for object''s background' + #13#10 + +'propCalcCheckSum=Determines if the barcode should calculate the checksum digit' + #13#10 + +'propCancel=Determines if the button should be activated when Esc key pressed' + #13#10 + +'propCaption=The caption of the control' + #13#10 + +'propCellFields=Names of DB fields represents the cross cells' + #13#10 + +'propCellLevels=Number of cell levels' + #13#10 + +'propCenter=Determines if the image should be centered inside the control' + #13#10 + +'propCharset=The font charset' + #13#10 + +'propCharSpacing=Amount of pixels between two characters' + #13#10 + +'propCheckColor=The color of the check mark' + #13#10 + +'propChecked=Indicates if the control is checked' + #13#10 + +'propCheckStyle=The style of the check mark' + #13#10 + +'propChild=Child band connected to this band' + #13#10 + +'propClipped=Determines if the text should be clipped inside the objects bounds' + #13#10 + +'propCollate=Default setting of collation' + #13#10 + +'propColor.TFont=The color of the text' + #13#10 + +'propColor=The color of the object' + #13#10 + +'propColor.TfrxFrame=The color of the frame' + #13#10 + +'propColor.TfrxHighlight=Determines the color of the object if highlight is active' + #13#10 + +'propColumnFields=Names of DB fields represents the cross columns' + #13#10 + +'propColumnGap=The gap between band columns' + #13#10 + +'propColumnLevels=Number of column levels' + #13#10 + +'propColumns=Number of columns in the band' + #13#10 + +'propColumnWidth=The width of the band column' + #13#10 + +'propCondition=The grouping condition. The group will break if value of this expression changed' + #13#10 + +'propCondition.TfrxHighlight=Expression string. If this expression is True, the highlight will be active' + #13#10 + +'propConnected=Indicates if the database connection is active' + #13#10 + +'propConvertNulls=Determines if null DB values will converted to 0, False or empty string' + #13#10 + +'propCopies=The default number of copies' + #13#10 + +'propCursor=The cursor of the object' + #13#10 + +'propDatabaseName=The name of the database' + #13#10 + +'propDataField=Specifies the field from which the object gets data' + #13#10 + +'propDataSet=Links the object to the dataset that contains the field it represents' + #13#10 + +'propDate=The date value of the control' + #13#10 + +'propDateFormat=Specifies format in which the date is presented' + #13#10 + +'propDecimalSeparator=The decimal separator' + #13#10 + +'propDefault=Determines if the button is the default button' + #13#10 + +'propDefHeight=Default height of the row' + #13#10 + +'propDescription.TfrxReportOptions=The report description' + #13#10 + +'propDescription=Object''s description' + #13#10 + +'propDiagonal=Indicates that the line is diagonal' + #13#10 + +'propDisplayFormat=The format of the displayed value' + #13#10 + +'propDoublePass=Determines if the report engine should perform the second pass' + #13#10 + +'propDown=Determines if the speed button is pressed or not' + #13#10 + +'propDownThenAcross=Determines how a large cross table will be split across pages' + #13#10 + +'propDriverName=The name of the BDE driver' + #13#10 + +'propDropShadow=Determines if the objects has a shadow' + #13#10 + +'propDuplex=Specifies the duplex mode for the page' + #13#10 + +'propEditMask=Specifies the mask that represents what text is valid for the masked edit control' + #13#10 + +'propEnabled=Determines if the control is enabled' + #13#10 + +'propEngineOptions=The engine options of the report' + #13#10 + +'propExpression=Value of this expression will be shown in the object' + #13#10 + +'propExpressionDelimiters=The characters that will be used for enclosing the expressions contained in the text' + #13#10 + +'propFieldAliases=The dataset field''s aliases' + #13#10 + +'propFilter=The filtering condition for the dataset' + #13#10 + +'propFiltered=Determines if the dataset should filter the records using the condition in the Filter property' + #13#10 + +'propFlowTo=The text object that will show the text that not fit in the object' + #13#10 + +'propFont=The font attributes of the object' + #13#10 + +'propFooterAfterEach=Determines if the footer band should be shown after each data row' + #13#10 + +'propFormatStr=The formatting string' + #13#10 + +'propFrame=The frame attributes of the object' + #13#10 + +'propGapX=The left indent of the text' + #13#10 + +'propGapY=The top indent of the text' + #13#10 + +'propGlyph=The image of the control' + #13#10 + +'propGroupIndex=Allows speed buttons to work together as a group' + #13#10 + +'propHAlign=The horizontal alignment of the text' + #13#10 + +'propHeight=The height of the object' + #13#10 + +'propHideZeros=Determines if the text object will hide the zero values' + #13#10 + +'propHighlight=The conditional highlight attributes' + #13#10 + +'propIndexName=The name of the index' + #13#10 + +'propInitString=Printer init string for dot-matrix reports' + #13#10 + +'propItems=List items of the object' + #13#10 + +'propKeepAspectRatio=Keep the original aspect ratio of the image' + #13#10 + +'propKeepChild=Determines if the band will be printed together with its child' + #13#10 + +'propKeepFooter=Determines if the band will be printed together with its footer' + #13#10 + +'propKeepHeader=Determines if the band will be printed together with its header' + #13#10 + +'propKeepTogether=Determines if the band will be printed together with all its subbands' + #13#10 + +'propKind.TfrxFormat=The kind of formatting' + #13#10 + +'propKind=The kind of the button' + #13#10 + +'propLargeDesignHeight=Determines if the page will have large height in the design mode' + #13#10 + +'propLayout=The layout of the button glyph' + #13#10 + +'propLeft=The left coordinate of the object' + #13#10 + +'propLeftMargin=The size of the left page margin' + #13#10 + +'propLines=The text of the object' + #13#10 + +'propLineSpacing=The amount of pixels between two lines of text' + #13#10 + +'propLoginPrompt=Determines if to show the login dialog' + #13#10 + +'propMargin=Determines the number of pixels between the edge of the image and the edge of the button' + #13#10 + +'propMaster=The master dataset' + #13#10 + +'propMasterFields=The fields linked by master-detail relationship' + #13#10 + +'propMaxLength=Max length of the text' + #13#10 + +'propMaxWidth=Max width of the column' + #13#10 + +'propMemo=The text of the object' + #13#10 + +'propMinWidth=Min width of the column' + #13#10 + +'propMirrorMargins=Mirror the page margins on the even pages' + #13#10 + +'propModalResult=Determines if and how the button closes its modal form' + #13#10 + +'propName.TFont=The name of the font' + #13#10 + +'propName.TfrxReportOptions=The name of the report' + #13#10 + +'propName=The name of the object' + #13#10 + +'propNumGlyphs=Indicates the number of images that are in the graphic specified in the Glyph property' + #13#10 + +'propOpenDataSource=Determines if to open datasource automatically or not' + #13#10 + +'propOrientation=The orientation of the page' + #13#10 + +'propOutlineText=The text that will be shown in the preview outline control' + #13#10 + +'propOutlineVisible=The visibility of the preview outline control' + #13#10 + +'propOutlineWidth=The width of the preview outline control' + #13#10 + +'propPageNumbers.TfrxPrintOptions=The numbers of the pages to be printed' + #13#10 + +'propPaperHeight=The height of the page' + #13#10 + +'propPaperWidth=The width of the page' + #13#10 + +'propParagraphGap=The indent of the first line of paragraph' + #13#10 + +'propParams.TfrxBDEDatabase=The parameters of the connection' + #13#10 + +'propParams=The parameters of the query' + #13#10 + +'propParentFont=Determines if the object will use parent''s font' + #13#10 + +'propPassword=The report password' + #13#10 + +'propPasswordChar=Indicates the character, if any, to display in place of the actual characters typed in the control' + #13#10 + +'propPicture=The picture' + #13#10 + +'propPicture.TfrxReportOptions=The description picture of the report' + #13#10 + +'propPosition=The initial position of the window' + #13#10 + +'propPreviewOptions=The preview options of the report' + #13#10 + +'propPrintable=Printability of the object. Objects with the Printable=False will be previewed, but not printed' + #13#10 + +'propPrintChildIfInvisible=Determines if the child band will be printed if its parent band is invisible' + #13#10 + +'propPrinter=The name of the printer that will be selected when open or run this report' + #13#10 + +'propPrintIfDetailEmpty=Determines if the databand will be printed if its subband is empty' + #13#10 + +'propPrintIfEmpty=Determines if the page will be printed if all its datasets are empty' + #13#10 + +'propPrintOnFirstPage=Determines if the band will be printed on the first page' + #13#10 + +'propPrintOnLastPage=Determines if the band will be printed on the last page' + #13#10 + +'propPrintOnParent=Determines if the subreport can print itself on parent band' + #13#10 + +'propPrintOnPreviousPage=Determines if the page can be generated on the free space of previously generated page' + #13#10 + +'propPrintOptions=Print options of the report' + #13#10 + +'propPrintPages=Determines if to print all, odd or even pages' + #13#10 + +'propRangeBegin=Determines the start point of dataset navigation' + #13#10 + +'propRangeEnd=Determines the end point of dataset navigation' + #13#10 + +'propRangeEndCount=Determines the number of records in the dataset if RangeEnd is reCount' + #13#10 + +'propReadOnly=Determines if the text object is read-only' + #13#10 + +'propRepeatHeaders=Determines if the column and row headers will be reprinted on new page' + #13#10 + +'propReportOptions=The options of the report' + #13#10 + +'propReprintOnNewPage=Determines if the band will be reprinted on new page' + #13#10 + +'propRestrictions=Set of restriction flags' + #13#10 + +'propRightMargin=The size of the right page margin' + #13#10 + +'propRotation.TfrxBarCodeView=The orientation of the barcode' + #13#10 + +'propRotation=The text rotation' + #13#10 + +'propRowCount=Number of virtual records in the databand' + #13#10 + +'propRowFields=Names of DB fields represents the cross rows' + #13#10 + +'propRowLevels=Number of row levels' + #13#10 + +'propRTLReading=Determines if the text object will show its text in right-to-left direction' + #13#10 + +'propSessionName=The name of the BDE session' + #13#10 + +'propShadowColor=The color of the shadow' + #13#10 + +'propShadowWidth=The width of the shadow' + #13#10 + +'propShape=The type of the shape' + #13#10 + +'propShiftMode=Shift behavior of the object' + #13#10 + +'propShowColumnHeader=Determines if the cross will show column headers' + #13#10 + +'propShowColumnTotal=Determines if the cross will show column grand total' + #13#10 + +'propShowRowHeader=Determines if the cross will show row headers' + #13#10 + +'propShowRowTotal=Determines if the cross will show row grand total' + #13#10 + +'propShowDialog=Determines if the print dialog will be shown in the preview window' + #13#10 + +'propShowText=Determines if the barcode object will show a readable text' + #13#10 + +'propSize=The size of the font' + #13#10 + +'propSorted=Determines if the items are sorted or not' + #13#10 + +'propSpacing=Determines the number of pixels between the image and the text' + #13#10 + +'propSQL=The SQL statement' + #13#10 + +'propStartNewPage=Starts a new page before printing a band' + #13#10 + +'propStretch=Stretches the picture to fit the object bounds' + #13#10 + +'propStretched=Determines if the object can be stretched' + #13#10 + +'propStretchMode=Stretch behavior of the object' + #13#10 + +'propStyle.TFont=The style of the font' + #13#10 + +'propStyle=The style of the control' + #13#10 + +'propStyle.TfrxFrame=The style of the object''s frame' + #13#10 + +'propSuppressRepeated=Suppresses repeated values' + #13#10 + +'propTableName=The name of the data table' + #13#10 + +'propTag=Tag number of the object' + #13#10 + +'propTagStr=Tag string of the object' + #13#10 + +'propText=The text of the object' + #13#10 + +'propTitleBeforeHeader=Determines if report title shown before page header' + #13#10 + +'propTop=The top coordinate of the object' + #13#10 + +'propTopMargin=The size of the top page margin' + #13#10 + +'propTyp=The type of the frame' + #13#10 + +'propUnderlines=Determines if the text object will show under lines after each text line' + #13#10 + +'propURL=The URL of the object' + #13#10 + +'propUserName=User name of the data object. This name will be shown in the data tree' + #13#10 + +'propVAlign=The vertical alignment of the text' + #13#10 + +'propVersionBuild=Version info, build' + #13#10 + +'propVersionMajor=Version info, major version' + #13#10 + +'propVersionMinor=Version info, minor version' + #13#10 + +'propVersionRelease=Version info, release' + #13#10 + +'propVisible=Visibility of the object' + #13#10 + +'propWidth=Width of the object' + #13#10 + +'propWidth.TfrxFrame=The width of the frame' + #13#10 + +'propWindowState=Initial state of the window' + #13#10 + +'propWordBreak=Break russian words' + #13#10 + +'propWordWrap=Determines if the text object inserts soft carriage returns so text wraps at the right margin' + #13#10 + +'propZoom.TfrxBarCodeView=Zooms the barcode' + #13#10 + +'propConnectionName=Name of the connection to the database used in the report' + #13#10 + +'propCurve=Curvature of the roundrectangle edges' + #13#10 + +'propDrillDown=Determines if the group can be drilled down' + #13#10 + +'propFontStyle=Dot-matrix font style' + #13#10 + +'propHideIfSingleDataRecord=Hide the footer if a group has only one data record' + #13#10 + +'propOutlineExpand=Determines if the report outline expands or not' + #13#10 + +'propPlainCells=Determines whether to print several cells side-by-side or stacked' + #13#10 + +'propPrintMode=Print mode: normal, split big pages to small one, or print several small pages on a big one' + #13#10 + +'propPrintOnSheet=Paper size to print report on. Used if PrintMode is not pmDefault' + #13#10 + +'propResetPageNumbers=Reset page number/total pages numbers when print a group. Should be used with StartNewPage option set to true' + #13#10 + +'propReverse=Determines if pages print in reverse order' + #13#10 + +'propShowFooterIfDrillDown=Determines if group footer is shown if group is drilldown' + #13#10 + +'propSizeMode=Display mode of the OLE object' + #13#10 + +'propVersion=Version of the FastReport' + #13#10 + +'propWideBarRatio=Relative with of wide bars of the barcode' + #13#10 + +'propWysiwyg=Determines if the object should use the printer canvas to format the text. A printer should be installed and ready.' + #13#10 + +'propArrowEnd=Determines if an arrow is shown at end of a line' + #13#10 + +'propArrowLength=Length of the arrow' + #13#10 + +'propArrowSolid=Determines if arrow has solid-fill' + #13#10 + +'propArrowStart=Determines if an arrow is shown at the start of a line' + #13#10 + +'propArrowWidth=Width of the arrow' + #13#10 + +'propCloseDataSource=Determines whether to close the dataset when report is finished' + #13#10 + +'propDatabase=Database connection' + #13#10 + +'propIndexFieldNames=Names of index fields' + #13#10 + +'propCommandTimeOut=Amount of time needed to execute a query' + #13#10 + +'propExpandDrillDown=Determines if all drill-down elements are expanded at first start of a report' + #13#10 + +'propWysiwyg.TfrxMemoView=Determines if text is displayed in WYSIWYG mode' + #13#10 + +'propLeftLine=Left line of a frame' + #13#10 + +'propTopLine=Top line of a frame' + #13#10 + +'propRightLine=Right line of a frame' + #13#10 + +'propBottomLine=Bottom line of a frame' + #13#10 + +'propColor.TfrxFrameLine=The color of the frame line' + #13#10 + +'propStyle.TfrxFrameLine=The style of the frame line' + #13#10 + +'propWidth.TfrxFrameLine=The width of the frame line' + #13#10 + +'propFileLink=Expression or name of the file containing a picture' + #13#10 + +'propEndlessWidth=Endless page mode. If true, page will grow depending on number of data records on it' + #13#10 + +'propEndlessHeight=Endless page mode. If true, page will grow depending on number of data records on it' + #13#10 + +'propAddHeight=Adds specified amount of space to the cell height' + #13#10 + +'propAddWidth=Adds specified amount of space to the cell width' + #13#10 + +'propAllowDuplicates=Determines if the cell can accept duplicate string values' + #13#10 + +'propJoinEqualCells=Determines if the crosstab should join cells with equal values' + #13#10 + +'propNextCross=Pointer to the next crosstab that will be displayed side-by-side' + #13#10 + +'propNextCrossGap=Gap between side-by-side crosstabs' + #13#10 + +'propShowCorner=Determines if the crosstab should display a left-top corner elements' + #13#10 + +'propSuppressNullRecords=!Determines if the crosstab should suppress records with all NULL values' + #13#10 + +'propShowTitle=!Determines if the crosstab should display a title' + #13#10 + +'propAutoSize=!Determines if the crosstab should handle its size automatically' + #13#10 + +''; + +initialization + frxResources.AddStrings(resStr); + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/infback.zobj b/official/4.2/Source/infback.zobj new file mode 100644 index 0000000..de48b33 Binary files /dev/null and b/official/4.2/Source/infback.zobj differ diff --git a/official/4.2/Source/inffast.zobj b/official/4.2/Source/inffast.zobj new file mode 100644 index 0000000..7deab05 Binary files /dev/null and b/official/4.2/Source/inffast.zobj differ diff --git a/official/4.2/Source/inflate.zobj b/official/4.2/Source/inflate.zobj new file mode 100644 index 0000000..6274e31 Binary files /dev/null and b/official/4.2/Source/inflate.zobj differ diff --git a/official/4.2/Source/inftrees.zobj b/official/4.2/Source/inftrees.zobj new file mode 100644 index 0000000..44a5708 Binary files /dev/null and b/official/4.2/Source/inftrees.zobj differ diff --git a/official/4.2/Source/pngimage.pas b/official/4.2/Source/pngimage.pas new file mode 100644 index 0000000..7261491 --- /dev/null +++ b/official/4.2/Source/pngimage.pas @@ -0,0 +1,5827 @@ +{Portable Network Graphics Delphi 1.564 (31 July 2006) } + +{This is a full, open sourced implementation of png in Delphi } +{It has native support for most of png features including the } +{partial transparency, gamma and more. } +{For the latest version, please be sure to check my website } +{http://pngdelphi.sourceforge.net } +{Gustavo Huffenbacher Daud (gustavo.daud@terra.com.br) } + + +{ + Version 1.564 + 2006-07-25 BUG 1 - There was one GDI Palette object leak + when assigning from other PNG (fixed) + BUG 2 - Loosing color information when assigning png + to bmp on lower screen depth system + BUG 3 - There was a bug in TStream.GetSize + (fixed thanks to Vladimir Panteleev) + IMPROVE 1 - When assigning png to bmp now alpha information + is drawn (simulated into a white background) + + Version 1.563 + 2006-07-25 BUG 1 - There was a memory bug in the main component + destructor (fixed thanks to Steven L Brenner) + BUG 2 - The packages name contained spaces which was + causing some strange bugs in Delphi + (fixed thanks to Martijn Saly) + BUG 3 - Lots of fixes when handling palettes + (bugs implemented in the last version) + Fixed thanks to Gabriel Corneanu!!! + BUG 4 - CreateAlpha was raising an error because it did + not resized the palette chunk it created; + Fixed thanks to Miha Sokolov + IMPROVE 1 - Renamed the pngzlib.pas unit to zlibpas.pas + as a tentative to all libraries use the same + shared zlib implementation and to avoid including + two or three times the same P-Code. + (Gabriel Corneanu idea) + + + + Version 1.561 + 2006-05-17 BUG 1 - There was a bug in the method that draws semi + transparent images (a memory leak). fixed. + + Version 1.56 + 2006-05-09 - IMPROVE 1 - Delphi standard TCanvas support is now implemented + IMPROVE 2 - The PNG files may now be resized and created from + scratch using CreateBlank, Resize, Width and Height + BUG 1 - Fixed some bugs on handling tRNS transparencies + BUG 2 - Fixed bugs related to palette handling + + Version 1.535 + 2006-04-21 - IMPROVE 1 - Now the library uses the latest ZLIB release (1.2.3) + (thanks to: Roberto Della Pasqua + http://www.dellapasqua.com/delphizlib/) + + Version 1.53 + 2006-04-14 - + BUG 1 - Remove transparency was not working for + RGB Alpha and Grayscale alpha. fixed + BUG 2 - There was a bug were compressed text chunks no keyword + name could not be read + IMPROVE 1 - Add classes and methods to work with the pHYs chunk + (including TPNGObject.DrawUsingPixelInformation) + IMPROVE 3 - Included a property Version to return the library + version + IMPROVE 4 - New polish translation (thanks to Piotr Domanski) + IMPROVE 5 - Now packages for delphi 5, 6, 7, 2005 and 2006 + + Also Martijn Saly (thany) made some improvements in the library: + IMPROVE 1 - SetPixel now works with grayscale + IMPROVE 2 - Palette property now can be written using a + windows handle + Thanks !! + + Version 1.5 + 2005-06-29 - Fixed a lot of bugs using tips from mails that Iґve + being receiving for some time + BUG 1 - Loosing palette when assigning to TBitmap. fixed + BUG 2 - SetPixels and GetPixels worked only with + parameters in range 0..255. fixed + BUG 3 - Force type address off using directive + BUG 4 - TChunkzTXt contained an error + BUG 5 - MaxIdatSize was not working correctly (fixed thanks + to Gabriel Corneanu + BUG 6 - Corrected german translation (thanks to Mael Horz) + And the following improvements: + IMPROVE 1 - Create ImageHandleValue properties as public in + TChunkIHDR to get access to this handle + IMPROVE 2 - Using SetStretchBltMode to improve stretch quality + IMPROVE 3 - Scale is now working for alpha transparent images + IMPROVE 4 - GammaTable propery is now public to support an + article in the help file + + Version 1.4361 + 2003-03-04 - Fixed important bug for simple transparency when using + RGB, Grayscale color modes + + Version 1.436 + 2003-03-04 - * NEW * Property Pixels for direct access to pixels + * IMPROVED * Palette property (TPngObject) (read only) + Slovenian traslation for the component (Miha Petelin) + Help file update (scanline article/png->jpg example) + + Version 1.435 + 2003-11-03 - * NEW * New chunk implementation zTXt (method AddzTXt) + * NEW * New compiler flags to store the extra 8 bits + from 16 bits samples (when saving it is ignored), the + extra data may be acessed using ExtraScanline property + * Fixed * a bug on tIMe chunk + French translation included (Thanks to IBE Software) + Bugs fixed + + Version 1.432 + 2002-08-24 - * NEW * A new method, CreateAlpha will transform the + current image into partial transparency. + Help file updated with a new article on how to handle + partial transparency. + + Version 1.431 + 2002-08-14 - Fixed and tested to work on: + C++ Builder 3 + C++ Builder 5 + Delphi 3 + There was an error when setting TransparentColor, fixed + New method, RemoveTransparency to remove image + BIT TRANSPARENCY + + Version 1.43 + 2002-08-01 - * NEW * Support for Delphi 3 and C++ Builder 3 + Implements mostly some things that were missing, + a few tweaks and fixes. + + Version 1.428 + 2002-07-24 - More minor fixes (thanks to Ian Boyd) + Bit transparency fixes + * NEW * Finally support to bit transparency + (palette / rgb / grayscale -> all) + + Version 1.427 + 2002-07-19 - Lots of bugs and leaks fixed + * NEW * method to easy adding text comments, AddtEXt + * NEW * property for setting bit transparency, + TransparentColor + + Version 1.426 + 2002-07-18 - Clipboard finally fixed and working + Changed UseDelphi trigger to UseDelphi + * NEW * Support for bit transparency bitmaps + when assigning from/to TBitmap objects + Altough it does not support drawing transparent + parts of bit transparency pngs (only partial) + it is closer than ever + + Version 1.425 + 2002-07-01 - Clipboard methods implemented + Lots of bugs fixed + + Version 1.424 + 2002-05-16 - Scanline and AlphaScanline are now working correctly. + New methods for handling the clipboard + + Version 1.423 + 2002-05-16 - * NEW * Partial transparency for 1, 2, 4 and 8 bits is + also supported using the tRNS chunk (for palette and + grayscaling). + New bug fixes (Peter Haas). + + Version 1.422 + 2002-05-14 - Fixed some critical leaks, thanks to Peter Haas tips. + New translation for German (Peter Haas). + + Version 1.421 + 2002-05-06 - Now uses new ZLIB version, 1.1.4 with some security + fixes. + LoadFromResourceID and LoadFromResourceName added and + help file updated for that. + The resources strings are now located in pnglang.pas. + New translation for Brazilian Portuguese. + Bugs fixed. + + IMPORTANT: As always Iґm looking for bugs on the library. If + anyone has found one, please send me an email and + I will fix asap. Thanks for all the help and ideas + I'm receiving so far.} + +{My email is : gustavo.daud@terra.com.br} +{Website link : http://pngdelphi.sourceforge.net} +{Gustavo Huffenbacher Daud} + +unit pngimage; + +interface + +{Triggers avaliable (edit the fields bellow)} +{$TYPEDADDRESS OFF} + +{$DEFINE UseDelphi} //Disable fat vcl units(perfect for small apps) +{$DEFINE ErrorOnUnknownCritical} //Error when finds an unknown critical chunk +{$DEFINE CheckCRC} //Enables CRC checking +{$DEFINE RegisterGraphic} //Registers TPNGObject to use with TPicture +{$DEFINE PartialTransparentDraw} //Draws partial transparent images +{$DEFINE Store16bits} //Stores the extra 8 bits from 16bits/sample +{$RANGECHECKS OFF} {$J+} + + + +uses + Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF}, + frxZlib, pnglang; + +const + LibraryVersion = '1.564'; + +{$IFNDEF UseDelphi} + const + soFromBeginning = 0; + soFromCurrent = 1; + soFromEnd = 2; +{$ENDIF} + +const + {ZLIB constants} + ZLIBErrors: Array[-6..2] of string = ('incompatible version (-6)', + 'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)', + 'stream error (-2)', 'file error (-1)', '(0)', 'stream end (1)', + 'need dictionary (2)'); + Z_NO_FLUSH = 0; + Z_FINISH = 4; + Z_STREAM_END = 1; + + {Avaliable PNG filters for mode 0} + FILTER_NONE = 0; + FILTER_SUB = 1; + FILTER_UP = 2; + FILTER_AVERAGE = 3; + FILTER_PAETH = 4; + + {Avaliable color modes for PNG} + COLOR_GRAYSCALE = 0; + COLOR_RGB = 2; + COLOR_PALETTE = 3; + COLOR_GRAYSCALEALPHA = 4; + COLOR_RGBALPHA = 6; + + +type + {$IFNDEF UseDelphi} + {Custom exception handler} + Exception = class(TObject) + constructor Create(Msg: String); + end; + ExceptClass = class of Exception; + TColor = ColorRef; + {$ENDIF} + + {Error types} + EPNGOutMemory = class(Exception); + EPngError = class(Exception); + EPngUnexpectedEnd = class(Exception); + EPngInvalidCRC = class(Exception); + EPngInvalidIHDR = class(Exception); + EPNGMissingMultipleIDAT = class(Exception); + EPNGZLIBError = class(Exception); + EPNGInvalidPalette = class(Exception); + EPNGInvalidFileHeader = class(Exception); + EPNGIHDRNotFirst = class(Exception); + EPNGNotExists = class(Exception); + EPNGSizeExceeds = class(Exception); + EPNGMissingPalette = class(Exception); + EPNGUnknownCriticalChunk = class(Exception); + EPNGUnknownCompression = class(Exception); + EPNGUnknownInterlace = class(Exception); + EPNGNoImageData = class(Exception); + EPNGCouldNotLoadResource = class(Exception); + EPNGCannotChangeTransparent = class(Exception); + EPNGHeaderNotPresent = class(Exception); + EPNGInvalidNewSize = class(Exception); + EPNGInvalidSpec = class(Exception); + +type + {Direct access to pixels using R,G,B} + TRGBLine = array[word] of TRGBTriple; + pRGBLine = ^TRGBLine; + + {Same as TBitmapInfo but with allocated space for} + {palette entries} + TMAXBITMAPINFO = packed record + bmiHeader: TBitmapInfoHeader; + bmiColors: packed array[0..255] of TRGBQuad; + end; + + {Transparency mode for pngs} + TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial); + {Pointer to a cardinal type} + pCardinal = ^Cardinal; + {Access to a rgb pixel} + pRGBPixel = ^TRGBPixel; + TRGBPixel = packed record + B, G, R: Byte; + end; + + {Pointer to an array of bytes type} + TByteArray = Array[Word] of Byte; + pByteArray = ^TByteArray; + + {Forward} + TPNGObject = class; + pPointerArray = ^TPointerArray; + TPointerArray = Array[Word] of Pointer; + + {Contains a list of objects} + TPNGPointerList = class + private + fOwner: TPNGObject; + fCount : Cardinal; + fMemory: pPointerArray; + function GetItem(Index: Cardinal): Pointer; + procedure SetItem(Index: Cardinal; const Value: Pointer); + protected + {Removes an item} + function Remove(Value: Pointer): Pointer; virtual; + {Inserts an item} + procedure Insert(Value: Pointer; Position: Cardinal); + {Add a new item} + procedure Add(Value: Pointer); + {Returns an item} + property Item[Index: Cardinal]: Pointer read GetItem write SetItem; + {Set the size of the list} + procedure SetSize(const Size: Cardinal); + {Returns owner} + property Owner: TPNGObject read fOwner; + public + {Returns number of items} + property Count: Cardinal read fCount write SetSize; + {Object being either created or destroyed} + constructor Create(AOwner: TPNGObject); + destructor Destroy; override; + end; + + {Forward declaration} + TChunk = class; + TChunkClass = class of TChunk; + + {Same as TPNGPointerList but providing typecasted values} + TPNGList = class(TPNGPointerList) + private + {Used with property Item} + function GetItem(Index: Cardinal): TChunk; + public + {Finds the first item with this class} + function FindChunk(ChunkClass: TChunkClass): TChunk; + {Removes an item} + procedure RemoveChunk(Chunk: TChunk); overload; + {Add a new chunk using the class from the parameter} + function Add(ChunkClass: TChunkClass): TChunk; + {Returns pointer to the first chunk of class} + function ItemFromClass(ChunkClass: TChunkClass): TChunk; + {Returns a chunk item from the list} + property Item[Index: Cardinal]: TChunk read GetItem; + end; + + {$IFNDEF UseDelphi} + {The STREAMs bellow are only needed in case delphi provided ones is not} + {avaliable (UseDelphi trigger not set)} + {Object becomes handles} + TCanvas = THandle; + TBitmap = HBitmap; + {Trick to work} + TPersistent = TObject; + + {Base class for all streams} + TStream = class + protected + {Returning/setting size} + function GetSize: Longint; virtual; + procedure SetSize(const Value: Longint); virtual; abstract; + {Returns/set position} + function GetPosition: Longint; virtual; + procedure SetPosition(const Value: Longint); virtual; + public + {Returns/sets current position} + property Position: Longint read GetPosition write SetPosition; + {Property returns/sets size} + property Size: Longint read GetSize write SetSize; + {Allows reading/writing data} + function Read(var Buffer; Count: Longint): Cardinal; virtual; abstract; + function Write(const Buffer; Count: Longint): Cardinal; virtual; abstract; + {Copies from another Stream} + function CopyFrom(Source: TStream; + Count: Cardinal): Cardinal; virtual; + {Seeks a stream position} + function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract; + end; + + {File stream modes} + TFileStreamMode = (fsmRead, fsmWrite, fsmCreate); + TFileStreamModeSet = set of TFileStreamMode; + + {File stream for reading from files} + TFileStream = class(TStream) + private + {Opened mode} + Filemode: TFileStreamModeSet; + {Handle} + fHandle: THandle; + protected + {Set the size of the file} + procedure SetSize(const Value: Longint); override; + public + {Seeks a file position} + function Seek(Offset: Longint; Origin: Word): Longint; override; + {Reads/writes data from/to the file} + function Read(var Buffer; Count: Longint): Cardinal; override; + function Write(const Buffer; Count: Longint): Cardinal; override; + {Stream being created and destroy} + constructor Create(Filename: String; Mode: TFileStreamModeSet); + destructor Destroy; override; + end; + + {Stream for reading from resources} + TResourceStream = class(TStream) + constructor Create(Instance: HInst; const ResName: String; ResType:PChar); + private + {Variables for reading} + Size: Integer; + Memory: Pointer; + Position: Integer; + protected + {Set the size of the file} + procedure SetSize(const Value: Longint); override; + public + {Stream processing} + function Read(var Buffer; Count: Integer): Cardinal; override; + function Seek(Offset: Integer; Origin: Word): Longint; override; + function Write(const Buffer; Count: Longint): Cardinal; override; + end; + {$ENDIF} + + {Forward} + TChunkIHDR = class; + TChunkpHYs = class; + {Interlace method} + TInterlaceMethod = (imNone, imAdam7); + {Compression level type} + TCompressionLevel = 0..9; + {Filters type} + TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth); + TFilters = set of TFilter; + + {Png implementation object} + TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF} + protected + {Inverse gamma table values} + InverseGamma: Array[Byte] of Byte; + procedure InitializeGamma; + private + {Canvas} + {$IFDEF UseDelphi}fCanvas: TCanvas;{$ENDIF} + {Filters to test to encode} + fFilters: TFilters; + {Compression level for ZLIB} + fCompressionLevel: TCompressionLevel; + {Maximum size for IDAT chunks} + fMaxIdatSize: Integer; + {Returns if image is interlaced} + fInterlaceMethod: TInterlaceMethod; + {Chunks object} + fChunkList: TPngList; + {Clear all chunks in the list} + procedure ClearChunks; + {Returns if header is present} + function HeaderPresent: Boolean; + procedure GetPixelInfo(var LineSize, Offset: Cardinal); + {Returns linesize and byte offset for pixels} + procedure SetMaxIdatSize(const Value: Integer); + function GetAlphaScanline(const LineIndex: Integer): pByteArray; + function GetScanline(const LineIndex: Integer): Pointer; + {$IFDEF Store16bits} + function GetExtraScanline(const LineIndex: Integer): Pointer; + {$ENDIF} + function GetPixelInformation: TChunkpHYs; + function GetTransparencyMode: TPNGTransparencyMode; + function GetTransparentColor: TColor; + procedure SetTransparentColor(const Value: TColor); + {Returns the version} + function GetLibraryVersion: String; + protected + {Being created} + BeingCreated: Boolean; + {Returns / set the image palette} + function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF} + procedure SetPalette(Value: HPALETTE); {$IFDEF UseDelphi}override;{$ENDIF} + procedure DoSetPalette(Value: HPALETTE; const UpdateColors: Boolean); + {Returns/sets image width and height} + function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF} + function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF} + procedure SetWidth(Value: Integer); {$IFDEF UseDelphi}override; {$ENDIF} + procedure SetHeight(Value: Integer); {$IFDEF UseDelphi}override;{$ENDIF} + {Assigns from another TPNGObject} + procedure AssignPNG(Source: TPNGObject); + {Returns if the image is empty} + function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF} + {Used with property Header} + function GetHeader: TChunkIHDR; + {Draws using partial transparency} + procedure DrawPartialTrans(DC: HDC; Rect: TRect); + {$IFDEF UseDelphi} + {Returns if the image is transparent} + function GetTransparent: Boolean; override; + {$ENDIF} + {Returns a pixel} + function GetPixels(const X, Y: Integer): TColor; virtual; + procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual; + public + {Gamma table array} + GammaTable: Array[Byte] of Byte; + {Resizes the PNG image} + procedure Resize(const CX, CY: Integer); + {Generates alpha information} + procedure CreateAlpha; + {Removes the image transparency} + procedure RemoveTransparency; + {Transparent color} + property TransparentColor: TColor read GetTransparentColor write + SetTransparentColor; + {Add text chunk, TChunkTEXT, TChunkzTXT} + procedure AddtEXt(const Keyword, Text: String); + procedure AddzTXt(const Keyword, Text: String); + {$IFDEF UseDelphi} + {Saves to clipboard format (thanks to Antoine Pottern)} + procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; + var APalette: HPalette); override; + procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; + APalette: HPalette); override; + {$ENDIF} + {Calling errors} + procedure RaiseError(ExceptionClass: ExceptClass; Text: String); + {Returns a scanline from png} + property Scanline[const Index: Integer]: Pointer read GetScanline; + {$IFDEF Store16bits} + property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline; + {$ENDIF} + {Used to return pixel information} + function HasPixelInformation: Boolean; + property PixelInformation: TChunkpHYs read GetPixelInformation; + property AlphaScanline[const Index: Integer]: pByteArray read + GetAlphaScanline; + procedure DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint); + + {Canvas} + {$IFDEF UseDelphi}property Canvas: TCanvas read fCanvas;{$ENDIF} + {Returns pointer to the header} + property Header: TChunkIHDR read GetHeader; + {Returns the transparency mode used by this png} + property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode; + {Assigns from another object} + procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF} + {Assigns to another object} + procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF} + {Assigns from a windows bitmap handle} + procedure AssignHandle(Handle: HBitmap; Transparent: Boolean; + TransparentColor: ColorRef); + {Draws the image into a canvas} + procedure Draw(ACanvas: TCanvas; const Rect: TRect); + {$IFDEF UseDelphi}override;{$ENDIF} + {Width and height properties} + property Width: Integer read GetWidth; + property Height: Integer read GetHeight; + {Returns if the image is interlaced} + property InterlaceMethod: TInterlaceMethod read fInterlaceMethod + write fInterlaceMethod; + {Filters to test to encode} + property Filters: TFilters read fFilters write fFilters; + {Maximum size for IDAT chunks, default and minimum is 65536} + property MaxIdatSize: Integer read fMaxIdatSize write SetMaxIdatSize; + {Property to return if the image is empty or not} + property Empty: Boolean read GetEmpty; + {Compression level} + property CompressionLevel: TCompressionLevel read fCompressionLevel + write fCompressionLevel; + {Access to the chunk list} + property Chunks: TPngList read fChunkList; + {Object being created and destroyed} + constructor Create; {$IFDEF UseDelphi}override;{$ENDIF} + constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer); + destructor Destroy; override; + {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF} + {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF} + procedure LoadFromStream(Stream: TStream); + {$IFDEF UseDelphi}override;{$ENDIF} + procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF} + {Loading the image from resources} + procedure LoadFromResourceName(Instance: HInst; const Name: String); + procedure LoadFromResourceID(Instance: HInst; ResID: Integer); + {Access to the png pixels} + property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels; + {Palette property} + {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette write + SetPalette;{$ENDIF} + {Returns the version} + property Version: String read GetLibraryVersion; + end; + + {Chunk name object} + TChunkName = Array[0..3] of Char; + + {Global chunk object} + TChunk = class + private + {Contains data} + fData: Pointer; + fDataSize: Cardinal; + {Stores owner} + fOwner: TPngObject; + {Stores the chunk name} + fName: TChunkName; + {Returns pointer to the TChunkIHDR} + function GetHeader: TChunkIHDR; + {Used with property index} + function GetIndex: Integer; + {Should return chunk class/name} + class function GetName: String; virtual; + {Returns the chunk name} + function GetChunkName: String; + public + {Returns index from list} + property Index: Integer read GetIndex; + {Returns pointer to the TChunkIHDR} + property Header: TChunkIHDR read GetHeader; + {Resize the data} + procedure ResizeData(const NewSize: Cardinal); + {Returns data and size} + property Data: Pointer read fData; + property DataSize: Cardinal read fDataSize; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); virtual; + {Returns owner} + property Owner: TPngObject read fOwner; + {Being destroyed/created} + constructor Create(Owner: TPngObject); virtual; + destructor Destroy; override; + {Returns chunk class/name} + property Name: String read GetChunkName; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; virtual; + {Saves the chunk to a stream} + function SaveData(Stream: TStream): Boolean; + function SaveToStream(Stream: TStream): Boolean; virtual; + end; + + {Chunk classes} + TChunkIEND = class(TChunk); {End chunk} + + {IHDR data} + pIHDRData = ^TIHDRData; + TIHDRData = packed record + Width, Height: Cardinal; + BitDepth, + ColorType, + CompressionMethod, + FilterMethod, + InterlaceMethod: Byte; + end; + + {Information header chunk} + TChunkIHDR = class(TChunk) + private + {Current image} + ImageHandle: HBitmap; + ImageDC: HDC; + ImagePalette: HPalette; + {Output windows bitmap} + HasPalette: Boolean; + BitmapInfo: TMaxBitmapInfo; + {Stores the image bytes} + {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF} + ImageData: pointer; + ImageAlpha: Pointer; + + {Contains all the ihdr data} + IHDRData: TIHDRData; + protected + BytesPerRow: Integer; + {Creates a grayscale palette} + function CreateGrayscalePalette(Bitdepth: Integer): HPalette; + {Copies the palette to the Device Independent bitmap header} + procedure PaletteToDIB(Palette: HPalette); + {Resizes the image data to fill the color type, bit depth, } + {width and height parameters} + procedure PrepareImageData; + {Release allocated ImageData memory} + procedure FreeImageData; + public + {Access to ImageHandle} + property ImageHandleValue: HBitmap read ImageHandle; + {Properties} + property Width: Cardinal read IHDRData.Width write IHDRData.Width; + property Height: Cardinal read IHDRData.Height write IHDRData.Height; + property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth; + property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType; + property CompressionMethod: Byte read IHDRData.CompressionMethod + write IHDRData.CompressionMethod; + property FilterMethod: Byte read IHDRData.FilterMethod + write IHDRData.FilterMethod; + property InterlaceMethod: Byte read IHDRData.InterlaceMethod + write IHDRData.InterlaceMethod; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + {Destructor/constructor} + constructor Create(Owner: TPngObject); override; + destructor Destroy; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {pHYs chunk} + pUnitType = ^TUnitType; + TUnitType = (utUnknown, utMeter); + TChunkpHYs = class(TChunk) + private + fPPUnitX, fPPUnitY: Cardinal; + fUnit: TUnitType; + public + {Returns the properties} + property PPUnitX: Cardinal read fPPUnitX write fPPUnitX; + property PPUnitY: Cardinal read fPPUnitY write fPPUnitY; + property UnitType: TUnitType read fUnit write fUnit; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {Gamma chunk} + TChunkgAMA = class(TChunk) + private + {Returns/sets the value for the gamma chunk} + function GetValue: Cardinal; + procedure SetValue(const Value: Cardinal); + public + {Returns/sets gamma value} + property Gamma: Cardinal read GetValue write SetValue; + {Loading the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Being created} + constructor Create(Owner: TPngObject); override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {ZLIB Decompression extra information} + TZStreamRec2 = packed record + {From ZLIB} + ZLIB: TZStreamRec; + {Additional info} + Data: Pointer; + fStream : TStream; + end; + + {Palette chunk} + TChunkPLTE = class(TChunk) + protected + {Number of items in the palette} + fCount: Integer; + private + {Contains the palette handle} + function GetPaletteItem(Index: Byte): TRGBQuad; + public + {Returns the color for each item in the palette} + property Item[Index: Byte]: TRGBQuad read GetPaletteItem; + {Returns the number of items in the palette} + property Count: Integer read fCount; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {Transparency information} + TChunktRNS = class(TChunk) + private + fBitTransparency: Boolean; + function GetTransparentColor: ColorRef; + {Returns the transparent color} + procedure SetTransparentColor(const Value: ColorRef); + public + {Palette values for transparency} + PaletteValues: Array[Byte] of Byte; + {Returns if it uses bit transparency} + property BitTransparency: Boolean read fBitTransparency; + {Returns the transparent color} + property TransparentColor: ColorRef read GetTransparentColor write + SetTransparentColor; + {Loads/saves the chunk from/to a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + function SaveToStream(Stream: TStream): Boolean; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {Actual image information} + TChunkIDAT = class(TChunk) + private + {Holds another pointer to the TChunkIHDR} + Header: TChunkIHDR; + {Stores temporary image width and height} + ImageWidth, ImageHeight: Integer; + {Size in bytes of each line and offset} + Row_Bytes, Offset : Cardinal; + {Contains data for the lines} + Encode_Buffer: Array[0..5] of pByteArray; + Row_Buffer: Array[Boolean] of pByteArray; + {Variable to invert the Row_Buffer used} + RowUsed: Boolean; + {Ending position for the current IDAT chunk} + EndPos: Integer; + {Filter the current line} + procedure FilterRow; + {Filter to encode and returns the best filter} + function FilterToEncode: Byte; + {Reads ZLIB compressed data} + function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer; + Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer; + {Compress and writes IDAT data} + procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer; + const Length: Cardinal); + procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2); + {Prepares the palette} + procedure PreparePalette; + protected + {Decode interlaced image} + procedure DecodeInterlacedAdam7(Stream: TStream; + var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal); + {Decode non interlaced imaged} + procedure DecodeNonInterlaced(Stream: TStream; + var ZLIBStream: TZStreamRec2; const Size: Integer; + var crcfile: Cardinal); + protected + {Encode non interlaced images} + procedure EncodeNonInterlaced(Stream: TStream; + var ZLIBStream: TZStreamRec2); + {Encode interlaced images} + procedure EncodeInterlacedAdam7(Stream: TStream; + var ZLIBStream: TZStreamRec2); + protected + {Memory copy methods to decode} + procedure CopyNonInterlacedRGB8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedRGB16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedPalette148( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedPalette2( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedGray2( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedGrayscale16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedRGBAlpha8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedRGBAlpha16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedGrayscaleAlpha8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyNonInterlacedGrayscaleAlpha16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedRGB8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedRGB16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedPalette148(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedPalette2(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedGray2(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedGrayscale16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedRGBAlpha8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedRGBAlpha16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); + protected + {Memory copy methods to encode} + procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar); + procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar); + procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar); + procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar); + procedure EncodeInterlacedPalette148(const Pass: Byte; + Src, Dest, Trans: pChar); + procedure EncodeInterlacedGrayscale16(const Pass: Byte; + Src, Dest, Trans: pChar); + procedure EncodeInterlacedRGBAlpha8(const Pass: Byte; + Src, Dest, Trans: pChar); + procedure EncodeInterlacedRGBAlpha16(const Pass: Byte; + Src, Dest, Trans: pChar); + procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte; + Src, Dest, Trans: pChar); + procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte; + Src, Dest, Trans: pChar); + public + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + end; + + {Image last modification chunk} + TChunktIME = class(TChunk) + private + {Holds the variables} + fYear: Word; + fMonth, fDay, fHour, fMinute, fSecond: Byte; + public + {Returns/sets variables} + property Year: Word read fYear write fYear; + property Month: Byte read fMonth write fMonth; + property Day: Byte read fDay write fDay; + property Hour: Byte read fHour write fHour; + property Minute: Byte read fMinute write fMinute; + property Second: Byte read fSecond write fSecond; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {Textual data} + TChunktEXt = class(TChunk) + private + fKeyword, fText: String; + public + {Keyword and text} + property Keyword: String read fKeyword write fKeyword; + property Text: String read fText write fText; + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + {Assigns from another TChunk} + procedure Assign(Source: TChunk); override; + end; + + {zTXT chunk} + TChunkzTXt = class(TChunktEXt) + {Loads the chunk from a stream} + function LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; override; + {Saves the chunk to a stream} + function SaveToStream(Stream: TStream): Boolean; override; + end; + +{Here we test if it's c++ builder or delphi version 3 or less} +{$IFDEF VER110}{$DEFINE DelphiBuilder3Less}{$ENDIF} +{$IFDEF VER100}{$DEFINE DelphiBuilder3Less}{$ENDIF} +{$IFDEF VER93}{$DEFINE DelphiBuilder3Less}{$ENDIF} +{$IFDEF VER90}{$DEFINE DelphiBuilder3Less}{$ENDIF} +{$IFDEF VER80}{$DEFINE DelphiBuilder3Less}{$ENDIF} + + +{Registers a new chunk class} +procedure RegisterChunk(ChunkClass: TChunkClass); +{Calculates crc} +function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer + {$ENDIF}; buf: pByteArray; len: Integer): Cardinal; +{Invert bytes using assembly} +function ByteSwap(const a: integer): integer; + +implementation + +var + ChunkClasses: TPngPointerList; + {Table of CRCs of all 8-bit messages} + crc_table: Array[0..255] of Cardinal; + {Flag: has the table been computed? Initially false} + crc_table_computed: Boolean; + +{Draw transparent image using transparent color} +procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer; + var srcHeader: TBitmapInfoHeader; + srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF); +var + cColor: COLORREF; + bmAndBack, bmAndObject, bmAndMem: HBITMAP; + bmBackOld, bmObjectOld, bmMemOld: HBITMAP; + hdcMem, hdcBack, hdcObject, hdcTemp: HDC; + ptSize, orgSize: TPOINT; + OldBitmap, DrawBitmap: HBITMAP; +begin + hdcTemp := CreateCompatibleDC(dc); + {Select the bitmap} + DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^, + DIB_RGB_COLORS); + OldBitmap := SelectObject(hdcTemp, DrawBitmap); + + {Get sizes} + OrgSize.x := abs(srcHeader.biWidth); + OrgSize.y := abs(srcHeader.biHeight); + ptSize.x := Rect.Right - Rect.Left; // Get width of bitmap + ptSize.y := Rect.Bottom - Rect.Top; // Get height of bitmap + + {Create some DCs to hold temporary data} + hdcBack := CreateCompatibleDC(dc); + hdcObject := CreateCompatibleDC(dc); + hdcMem := CreateCompatibleDC(dc); + + // Create a bitmap for each DC. DCs are required for a number of + // GDI functions. + + // Monochrome DCs + bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil); + bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil); + + bmAndMem := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y); + + // Each DC must select a bitmap object to store pixel data. + bmBackOld := SelectObject(hdcBack, bmAndBack); + bmObjectOld := SelectObject(hdcObject, bmAndObject); + bmMemOld := SelectObject(hdcMem, bmAndMem); + + // Set the background color of the source DC to the color. + // contained in the parts of the bitmap that should be transparent + cColor := SetBkColor(hdcTemp, cTransparentColor); + + // Create the object mask for the bitmap by performing a BitBlt + // from the source bitmap to a monochrome bitmap. + StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, + orgSize.x, orgSize.y, SRCCOPY); + + // Set the background color of the source DC back to the original + // color. + SetBkColor(hdcTemp, cColor); + + // Create the inverse of the object mask. + BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, + NOTSRCCOPY); + + // Copy the background of the main DC to the destination. + BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top, + SRCCOPY); + + // Mask out the places where the bitmap will be placed. + BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND); + + // Mask out the transparent colored pixels on the bitmap. +// BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND); + StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 0, 0, + PtSize.x, PtSize.y, SRCAND); + + // XOR the bitmap with the background on the destination DC. + StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, + OrgSize.x, OrgSize.y, SRCPAINT); + + // Copy the destination to the screen. + BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0, + SRCCOPY); + + // Delete the memory bitmaps. + DeleteObject(SelectObject(hdcBack, bmBackOld)); + DeleteObject(SelectObject(hdcObject, bmObjectOld)); + DeleteObject(SelectObject(hdcMem, bmMemOld)); + DeleteObject(SelectObject(hdcTemp, OldBitmap)); + + // Delete the memory DCs. + DeleteDC(hdcMem); + DeleteDC(hdcBack); + DeleteDC(hdcObject); + DeleteDC(hdcTemp); +end; + +{Make the table for a fast CRC.} +procedure make_crc_table; +var + c: Cardinal; + n, k: Integer; +begin + + {fill the crc table} + for n := 0 to 255 do + begin + c := Cardinal(n); + for k := 0 to 7 do + begin + if Boolean(c and 1) then + c := $edb88320 xor (c shr 1) + else + c := c shr 1; + end; + crc_table[n] := c; + end; + + {The table has already being computated} + crc_table_computed := true; +end; + +{Update a running CRC with the bytes buf[0..len-1]--the CRC + should be initialized to all 1's, and the transmitted value + is the 1's complement of the final running CRC (see the + crc() routine below)).} +function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer + {$ENDIF}; buf: pByteArray; len: Integer): Cardinal; +var + c: Cardinal; + n: Integer; +begin + c := crc; + + {Create the crc table in case it has not being computed yet} + if not crc_table_computed then make_crc_table; + + {Update} + for n := 0 to len - 1 do + c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8); + + {Returns} + Result := c; +end; + +{$IFNDEF UseDelphi} + function FileExists(Filename: String): Boolean; + var + FindFile: THandle; + FindData: TWin32FindData; + begin + FindFile := FindFirstFile(PChar(Filename), FindData); + Result := FindFile <> INVALID_HANDLE_VALUE; + if Result then Windows.FindClose(FindFile); + end; + + +{$ENDIF} + +{$IFNDEF UseDelphi} + {Exception implementation} + constructor Exception.Create(Msg: String); + begin + end; +{$ENDIF} + +{Calculates the paeth predictor} +function PaethPredictor(a, b, c: Byte): Byte; +var + pa, pb, pc: Integer; +begin + { a = left, b = above, c = upper left } + pa := abs(b - c); { distances to a, b, c } + pb := abs(a - c); + pc := abs(a + b - c * 2); + + { return nearest of a, b, c, breaking ties in order a, b, c } + if (pa <= pb) and (pa <= pc) then + Result := a + else + if pb <= pc then + Result := b + else + Result := c; +end; + +{Invert bytes using assembly} +function ByteSwap(const a: integer): integer; +asm + bswap eax +end; +function ByteSwap16(inp:word): word; +asm + bswap eax + shr eax, 16 +end; + +{Calculates number of bytes for the number of pixels using the} +{color mode in the paramenter} +function BytesForPixels(const Pixels: Integer; const ColorType, + BitDepth: Byte): Integer; +begin + case ColorType of + {Palette and grayscale contains a single value, for palette} + {an value of size 2^bitdepth pointing to the palette index} + {and grayscale the value from 0 to 2^bitdepth with color intesity} + COLOR_GRAYSCALE, COLOR_PALETTE: + Result := (Pixels * BitDepth + 7) div 8; + {RGB contains 3 values R, G, B with size 2^bitdepth each} + COLOR_RGB: + Result := (Pixels * BitDepth * 3) div 8; + {Contains one value followed by alpha value booth size 2^bitdepth} + COLOR_GRAYSCALEALPHA: + Result := (Pixels * BitDepth * 2) div 8; + {Contains four values size 2^bitdepth, Red, Green, Blue and alpha} + COLOR_RGBALPHA: + Result := (Pixels * BitDepth * 4) div 8; + else + Result := 0; + end {case ColorType} +end; + +type + pChunkClassInfo = ^TChunkClassInfo; + TChunkClassInfo = record + ClassName: TChunkClass; + end; + +{Register a chunk type} +procedure RegisterChunk(ChunkClass: TChunkClass); +var + NewClass: pChunkClassInfo; +begin + {In case the list object has not being created yet} + if ChunkClasses = nil then ChunkClasses := TPngPointerList.Create(nil); + + {Add this new class} + new(NewClass); + NewClass^.ClassName := ChunkClass; + ChunkClasses.Add(NewClass); +end; + +{Free chunk class list} +procedure FreeChunkClassList; +var + i: Integer; +begin + if (ChunkClasses <> nil) then + begin + FOR i := 0 TO ChunkClasses.Count - 1 do + Dispose(pChunkClassInfo(ChunkClasses.Item[i])); + ChunkClasses.Free; + end; +end; + +{Registering of common chunk classes} +procedure RegisterCommonChunks; +begin + {Important chunks} + RegisterChunk(TChunkIEND); + RegisterChunk(TChunkIHDR); + RegisterChunk(TChunkIDAT); + RegisterChunk(TChunkPLTE); + RegisterChunk(TChunkgAMA); + RegisterChunk(TChunktRNS); + + {Not so important chunks} + RegisterChunk(TChunkpHYs); + RegisterChunk(TChunktIME); + RegisterChunk(TChunktEXt); + RegisterChunk(TChunkzTXt); +end; + +{Creates a new chunk of this class} +function CreateClassChunk(Owner: TPngObject; Name: TChunkName): TChunk; +var + i : Integer; + NewChunk: TChunkClass; +begin + {Looks for this chunk} + NewChunk := TChunk; {In case there is no registered class for this} + + {Looks for this class in all registered chunks} + if Assigned(ChunkClasses) then + FOR i := 0 TO ChunkClasses.Count - 1 DO + begin + if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName = Name then + begin + NewChunk := pChunkClassInfo(ChunkClasses.Item[i])^.ClassName; + break; + end; + end; + + {Returns chunk class} + Result := NewChunk.Create(Owner); + Result.fName := Name; +end; + +{ZLIB support} + +const + ZLIBAllocate = High(Word); + +{Initializes ZLIB for decompression} +function ZLIBInitInflate(Stream: TStream): TZStreamRec2; +begin + {Fill record} + Fillchar(Result, SIZEOF(TZStreamRec2), #0); + + {Set internal record information} + with Result do + begin + GetMem(Data, ZLIBAllocate); + fStream := Stream; + end; + + {Init decompression} + InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec)); +end; + +{Initializes ZLIB for compression} +function ZLIBInitDeflate(Stream: TStream; + Level: TCompressionlevel; Size: Cardinal): TZStreamRec2; +begin + {Fill record} + Fillchar(Result, SIZEOF(TZStreamRec2), #0); + + {Set internal record information} + with Result, ZLIB do + begin + GetMem(Data, Size); + fStream := Stream; + next_out := Data; + avail_out := Size; + end; + + {Inits compression} + deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec)); +end; + +{Terminates ZLIB for compression} +procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2); +begin + {Terminates decompression} + DeflateEnd(ZLIBStream.zlib); + {Free internal record} + FreeMem(ZLIBStream.Data, ZLIBAllocate); +end; + +{Terminates ZLIB for decompression} +procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2); +begin + {Terminates decompression} + InflateEnd(ZLIBStream.zlib); + {Free internal record} + FreeMem(ZLIBStream.Data, ZLIBAllocate); +end; + +{Decompresses ZLIB into a memory address} +function DecompressZLIB(const Input: Pointer; InputSize: Integer; + var Output: Pointer; var OutputSize: Integer; + var ErrorOutput: String): Boolean; +var + StreamRec : TZStreamRec; + Buffer : Array[Byte] of Byte; + InflateRet: Integer; +begin + with StreamRec do + begin + {Initializes} + Result := True; + OutputSize := 0; + + {Prepares the data to decompress} + FillChar(StreamRec, SizeOf(TZStreamRec), #0); + InflateInit_(StreamRec, zlib_version, SIZEOF(TZStreamRec)); + next_in := Input; + avail_in := InputSize; + + {Decodes data} + repeat + {In case it needs an output buffer} + if (avail_out = 0) then + begin + next_out := @Buffer; + avail_out := SizeOf(Buffer); + end {if (avail_out = 0)}; + + {Decompress and put in output} + InflateRet := inflate(StreamRec, 0); + if (InflateRet = Z_STREAM_END) or (InflateRet = 0) then + begin + {Reallocates output buffer} + inc(OutputSize, total_out); + if Output = nil then + GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize); + {Copies the new data} + CopyMemory(Ptr(Longint(Output) + OutputSize - total_out), + @Buffer, total_out); + end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)} + {Now tests for errors} + else if InflateRet < 0 then + begin + Result := False; + ErrorOutput := StreamRec.msg; + InflateEnd(StreamRec); + Exit; + end {if InflateRet < 0} + until InflateRet = Z_STREAM_END; + + {Terminates decompression} + InflateEnd(StreamRec); + end {with StreamRec} + +end; + +{Compresses ZLIB into a memory address} +function CompressZLIB(Input: Pointer; InputSize, CompressionLevel: Integer; + var Output: Pointer; var OutputSize: Integer; + var ErrorOutput: String): Boolean; +var + StreamRec : TZStreamRec; + Buffer : Array[Byte] of Byte; + DeflateRet: Integer; +begin + with StreamRec do + begin + Result := True; {By default returns TRUE as everything might have gone ok} + OutputSize := 0; {Initialize} + {Prepares the data to compress} + FillChar(StreamRec, SizeOf(TZStreamRec), #0); + DeflateInit_(StreamRec, CompressionLevel,zlib_version, SIZEOF(TZStreamRec)); + + next_in := Input; + avail_in := InputSize; + + while avail_in > 0 do + begin + {When it needs new buffer to stores the compressed data} + if avail_out = 0 then + begin + {Restore buffer} + next_out := @Buffer; + avail_out := SizeOf(Buffer); + end {if avail_out = 0}; + + {Compresses} + DeflateRet := deflate(StreamRec, Z_FINISH); + + if (DeflateRet = Z_STREAM_END) or (DeflateRet = 0) then + begin + {Updates the output memory} + inc(OutputSize, total_out); + if Output = nil then + GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize); + + {Copies the new data} + CopyMemory(Ptr(Longint(Output) + OutputSize - total_out), + @Buffer, total_out); + end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)} + {Now tests for errors} + else if DeflateRet < 0 then + begin + Result := False; + ErrorOutput := StreamRec.msg; + DeflateEnd(StreamRec); + Exit; + end {if InflateRet < 0} + + end {while avail_in > 0}; + + {Finishes compressing} + DeflateEnd(StreamRec); + end {with StreamRec} + +end; + +{TPngPointerList implementation} + +{Object being created} +constructor TPngPointerList.Create(AOwner: TPNGObject); +begin + inherited Create; {Let ancestor work} + {Holds owner} + fOwner := AOwner; + {Memory pointer not being used yet} + fMemory := nil; + {No items yet} + fCount := 0; +end; + +{Removes value from the list} +function TPngPointerList.Remove(Value: Pointer): Pointer; +var + I, Position: Integer; +begin + {Gets item position} + Position := -1; + FOR I := 0 TO Count - 1 DO + if Value = Item[I] then Position := I; + {In case a match was found} + if Position >= 0 then + begin + Result := Item[Position]; {Returns pointer} + {Remove item and move memory} + Dec(fCount); + if Position < Integer(FCount) then + System.Move(fMemory^[Position + 1], fMemory^[Position], + (Integer(fCount) - Position) * SizeOf(Pointer)); + end {if Position >= 0} else Result := nil +end; + +{Add a new value in the list} +procedure TPngPointerList.Add(Value: Pointer); +begin + Count := Count + 1; + Item[Count - 1] := Value; +end; + + +{Object being destroyed} +destructor TPngPointerList.Destroy; +begin + {Release memory if needed} + if fMemory <> nil then + FreeMem(fMemory, fCount * sizeof(Pointer)); + + {Free things} + inherited Destroy; +end; + +{Returns one item from the list} +function TPngPointerList.GetItem(Index: Cardinal): Pointer; +begin + if (Index <= Count - 1) then + Result := fMemory[Index] + else + {In case it's out of bounds} + Result := nil; +end; + +{Inserts a new item in the list} +procedure TPngPointerList.Insert(Value: Pointer; Position: Cardinal); +begin + if (Position < Count) or (Count = 0) then + begin + {Increase item count} + SetSize(Count + 1); + {Move other pointers} + if Position < Count then + System.Move(fMemory^[Position], fMemory^[Position + 1], + (Count - Position - 1) * SizeOf(Pointer)); + {Sets item} + Item[Position] := Value; + end; +end; + +{Sets one item from the list} +procedure TPngPointerList.SetItem(Index: Cardinal; const Value: Pointer); +begin + {If index is in bounds, set value} + if (Index <= Count - 1) then + fMemory[Index] := Value +end; + +{This method resizes the list} +procedure TPngPointerList.SetSize(const Size: Cardinal); +begin + {Sets the size} + if (fMemory = nil) and (Size > 0) then + GetMem(fMemory, Size * SIZEOF(Pointer)) + else + if Size > 0 then {Only realloc if the new size is greater than 0} + ReallocMem(fMemory, Size * SIZEOF(Pointer)) + else + {In case user is resize to 0 items} + begin + FreeMem(fMemory); + fMemory := nil; + end; + {Update count} + fCount := Size; +end; + +{TPNGList implementation} + +{Finds the first chunk of this class} +function TPNGList.FindChunk(ChunkClass: TChunkClass): TChunk; +var + i: Integer; +begin + Result := nil; + for i := 0 to Count - 1 do + if Item[i] is ChunkClass then + begin + Result := Item[i]; + Break + end +end; + + +{Removes an item} +procedure TPNGList.RemoveChunk(Chunk: TChunk); +begin + Remove(Chunk); + Chunk.Free +end; + +{Add a new item} +function TPNGList.Add(ChunkClass: TChunkClass): TChunk; +var + IHDR: TChunkIHDR; + IEND: TChunkIEND; + + IDAT: TChunkIDAT; + PLTE: TChunkPLTE; +begin + Result := nil; {Default result} + {Adding these is not allowed} + if ((ChunkClass = TChunkIHDR) or (ChunkClass = TChunkIDAT) or + (ChunkClass = TChunkPLTE) or (ChunkClass = TChunkIEND)) and not + (Owner.BeingCreated) then + fOwner.RaiseError(EPngError, EPNGCannotAddChunkText) + {Two of these is not allowed} + else if ((ChunkClass = TChunkgAMA) and (ItemFromClass(TChunkgAMA) <> nil)) or + ((ChunkClass = TChunktRNS) and (ItemFromClass(TChunktRNS) <> nil)) or + ((ChunkClass = TChunkpHYs) and (ItemFromClass(TChunkpHYs) <> nil)) then + fOwner.RaiseError(EPngError, EPNGCannotAddChunkText) + {There must have an IEND and IHDR chunk} + else if ((ItemFromClass(TChunkIEND) = nil) or + (ItemFromClass(TChunkIHDR) = nil)) and not Owner.BeingCreated then + fOwner.RaiseError(EPngError, EPNGCannotAddInvalidImageText) + else + begin + {Get common chunks} + IHDR := ItemFromClass(TChunkIHDR) as TChunkIHDR; + IEND := ItemFromClass(TChunkIEND) as TChunkIEND; + {Create new chunk} + Result := ChunkClass.Create(Owner); + {Add to the list} + if (ChunkClass = TChunkgAMA) or (ChunkClass = TChunkpHYs) or + (ChunkClass = TChunkPLTE) then + Insert(Result, IHDR.Index + 1) + {Header and end} + else if (ChunkClass = TChunkIEND) then + Insert(Result, Count) + else if (ChunkClass = TChunkIHDR) then + Insert(Result, 0) + {Transparency chunk (fix by Ian Boyd)} + else if (ChunkClass = TChunktRNS) then + begin + {Transparecy chunk must be after PLTE; before IDAT} + IDAT := ItemFromClass(TChunkIDAT) as TChunkIDAT; + PLTE := ItemFromClass(TChunkPLTE) as TChunkPLTE; + + if Assigned(PLTE) then + Insert(Result, PLTE.Index + 1) + else if Assigned(IDAT) then + Insert(Result, IDAT.Index) + else + Insert(Result, IHDR.Index + 1) + end + else {All other chunks} + Insert(Result, IEND.Index); + end {if} +end; + +{Returns item from the list} +function TPNGList.GetItem(Index: Cardinal): TChunk; +begin + Result := inherited GetItem(Index); +end; + +{Returns first item from the list using the class from parameter} +function TPNGList.ItemFromClass(ChunkClass: TChunkClass): TChunk; +var + i: Integer; +begin + Result := nil; {Initial result} + FOR i := 0 TO Count - 1 DO + {Test if this item has the same class} + if Item[i] is ChunkClass then + begin + {Returns this item and exit} + Result := Item[i]; + break; + end {if} +end; + +{$IFNDEF UseDelphi} + + {TStream implementation} + + {Copies all from another stream} + function TStream.CopyFrom(Source: TStream; Count: Cardinal): Cardinal; + const + MaxBytes = $f000; + var + Buffer: PChar; + BufSize, N: Cardinal; + begin + {If count is zero, copy everything from Source} + if Count = 0 then + begin + Source.Seek(0, soFromBeginning); + Count := Source.Size; + end; + + Result := Count; {Returns the number of bytes readed} + {Allocates memory} + if Count > MaxBytes then BufSize := MaxBytes else BufSize := Count; + GetMem(Buffer, BufSize); + + {Copy memory} + while Count > 0 do + begin + if Count > BufSize then N := BufSize else N := Count; + Source.Read(Buffer^, N); + Write(Buffer^, N); + dec(Count, N); + end; + + {Deallocates memory} + FreeMem(Buffer, BufSize); + end; + +{Set current stream position} +procedure TStream.SetPosition(const Value: Longint); +begin + Seek(Value, soFromBeginning); +end; + +{Returns position} +function TStream.GetPosition: Longint; +begin + Result := Seek(0, soFromCurrent); +end; + + {Returns stream size} +function TStream.GetSize: Longint; + var + Pos: Cardinal; + begin + Pos := Seek(0, soFromCurrent); + Result := Seek(0, soFromEnd); + Seek(Pos, soFromBeginning); + end; + + {TFileStream implementation} + + {Filestream object being created} + constructor TFileStream.Create(Filename: String; Mode: TFileStreamModeSet); + {Makes file mode} + function OpenMode: DWORD; + begin + Result := 0; + if fsmRead in Mode then Result := GENERIC_READ; + if (fsmWrite in Mode) or (fsmCreate in Mode) then + Result := Result OR GENERIC_WRITE; + end; + const + IsCreate: Array[Boolean] of Integer = (OPEN_ALWAYS, CREATE_ALWAYS); + begin + {Call ancestor} + inherited Create; + + {Create handle} + fHandle := CreateFile(PChar(Filename), OpenMode, FILE_SHARE_READ or + FILE_SHARE_WRITE, nil, IsCreate[fsmCreate in Mode], 0, 0); + {Store mode} + FileMode := Mode; + end; + + {Filestream object being destroyed} + destructor TFileStream.Destroy; + begin + {Terminates file and close} + if FileMode = [fsmWrite] then + SetEndOfFile(fHandle); + CloseHandle(fHandle); + + {Call ancestor} + inherited Destroy; + end; + + {Writes data to the file} + function TFileStream.Write(const Buffer; Count: Longint): Cardinal; + begin + if not WriteFile(fHandle, Buffer, Count, Result, nil) then + Result := 0; + end; + + {Reads data from the file} + function TFileStream.Read(var Buffer; Count: Longint): Cardinal; + begin + if not ReadFile(fHandle, Buffer, Count, Result, nil) then + Result := 0; + end; + + {Seeks the file position} + function TFileStream.Seek(Offset: Integer; Origin: Word): Longint; + begin + Result := SetFilePointer(fHandle, Offset, nil, Origin); + end; + + {Sets the size of the file} + procedure TFileStream.SetSize(const Value: Longint); + begin + Seek(Value, soFromBeginning); + SetEndOfFile(fHandle); + end; + + {TResourceStream implementation} + + {Creates the resource stream} + constructor TResourceStream.Create(Instance: HInst; const ResName: String; + ResType: PChar); + var + ResID: HRSRC; + ResGlobal: HGlobal; + begin + {Obtains the resource ID} + ResID := FindResource(hInstance, PChar(ResName), RT_RCDATA); + if ResID = 0 then raise EPNGError.Create(''); + {Obtains memory and size} + ResGlobal := LoadResource(hInstance, ResID); + Size := SizeOfResource(hInstance, ResID); + Memory := LockResource(ResGlobal); + if (ResGlobal = 0) or (Memory = nil) then EPNGError.Create(''); + end; + + + {Setting resource stream size is not supported} + procedure TResourceStream.SetSize(const Value: Integer); + begin + end; + + {Writing into a resource stream is not supported} + function TResourceStream.Write(const Buffer; Count: Integer): Cardinal; + begin + Result := 0; + end; + + {Reads data from the stream} + function TResourceStream.Read(var Buffer; Count: Integer): Cardinal; + begin + //Returns data + CopyMemory(@Buffer, Ptr(Longint(Memory) + Position), Count); + //Update position + inc(Position, Count); + //Returns + Result := Count; + end; + + {Seeks data} + function TResourceStream.Seek(Offset: Integer; Origin: Word): Longint; + begin + {Move depending on the origin} + case Origin of + soFromBeginning: Position := Offset; + soFromCurrent: inc(Position, Offset); + soFromEnd: Position := Size + Offset; + end; + + {Returns the current position} + Result := Position; + end; + +{$ENDIF} + +{TChunk implementation} + +{Resizes the data} +procedure TChunk.ResizeData(const NewSize: Cardinal); +begin + fDataSize := NewSize; + ReallocMem(fData, NewSize + 1); +end; + +{Returns index from list} +function TChunk.GetIndex: Integer; +var + i: Integer; +begin + Result := -1; {Avoiding warnings} + {Searches in the list} + FOR i := 0 TO Owner.Chunks.Count - 1 DO + if Owner.Chunks.Item[i] = Self then + begin + {Found match} + Result := i; + exit; + end {for i} +end; + +{Returns pointer to the TChunkIHDR} +function TChunk.GetHeader: TChunkIHDR; +begin + Result := Owner.Chunks.Item[0] as TChunkIHDR; +end; + +{Assigns from another TChunk} +procedure TChunk.Assign(Source: TChunk); +begin + {Copy properties} + fName := Source.fName; + {Set data size and realloc} + ResizeData(Source.fDataSize); + + {Copy data (if there's any)} + if fDataSize > 0 then CopyMemory(fData, Source.fData, fDataSize); +end; + +{Chunk being created} +constructor TChunk.Create(Owner: TPngObject); +var + ChunkName: String; +begin + {Ancestor create} + inherited Create; + + {If it's a registered class, set the chunk name based on the class} + {name. For instance, if the class name is TChunkgAMA, the GAMA part} + {will become the chunk name} + ChunkName := Copy(ClassName, Length('TChunk') + 1, Length(ClassName)); + if Length(ChunkName) = 4 then CopyMemory(@fName[0], @ChunkName[1], 4); + + {Initialize data holder} + GetMem(fData, 1); + fDataSize := 0; + {Record owner} + fOwner := Owner; +end; + +{Chunk being destroyed} +destructor TChunk.Destroy; +begin + {Free data holder} + FreeMem(fData, fDataSize + 1); + {Let ancestor destroy} + inherited Destroy; +end; + +{Returns the chunk name 1} +function TChunk.GetChunkName: String; +begin + Result := fName +end; + +{Returns the chunk name 2} +class function TChunk.GetName: String; +begin + {For avoid writing GetName for each TChunk descendent, by default for} + {classes which don't declare GetName, it will look for the class name} + {to extract the chunk kind. Example, if the class name is TChunkIEND } + {this method extracts and returns IEND} + Result := Copy(ClassName, Length('TChunk') + 1, Length(ClassName)); +end; + +{Saves the data to the stream} +function TChunk.SaveData(Stream: TStream): Boolean; +var + ChunkSize, ChunkCRC: Cardinal; +begin + {First, write the size for the following data in the chunk} + ChunkSize := ByteSwap(DataSize); + Stream.Write(ChunkSize, 4); + {The chunk name} + Stream.Write(fName, 4); + {If there is data for the chunk, write it} + if DataSize > 0 then Stream.Write(Data^, DataSize); + {Calculates and write CRC} + ChunkCRC := update_crc($ffffffff, @fName[0], 4); + ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff); + Stream.Write(ChunkCRC, 4); + + {Returns that everything went ok} + Result := TRUE; +end; + +{Saves the chunk to the stream} +function TChunk.SaveToStream(Stream: TStream): Boolean; +begin + Result := SaveData(Stream) +end; + + +{Loads the chunk from a stream} +function TChunk.LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; +var + CheckCRC: Cardinal; + {$IFDEF CheckCRC}RightCRC: Cardinal;{$ENDIF} +begin + {Copies data from source} + ResizeData(Size); + if Size > 0 then Stream.Read(fData^, Size); + {Reads CRC} + Stream.Read(CheckCRC, 4); + CheckCrc := ByteSwap(CheckCRC); + + {Check if crc readed is valid} + {$IFDEF CheckCRC} + RightCRC := update_crc($ffffffff, @ChunkName[0], 4); + RightCRC := update_crc(RightCRC, fData, Size) xor $ffffffff; + Result := RightCRC = CheckCrc; + + {Handle CRC error} + if not Result then + begin + {In case it coult not load chunk} + Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText); + exit; + end + {$ELSE}Result := TRUE; {$ENDIF} + +end; + +{TChunktIME implementation} + +{Chunk being loaded from a stream} +function TChunktIME.LoadFromStream(Stream: TStream; + const ChunkName: TChunkName; Size: Integer): Boolean; +begin + {Let ancestor load the data} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result or (Size <> 7) then exit; {Size must be 7} + + {Reads data} + fYear := ((pByte(Longint(Data) )^) * 256)+ (pByte(Longint(Data) + 1)^); + fMonth := pByte(Longint(Data) + 2)^; + fDay := pByte(Longint(Data) + 3)^; + fHour := pByte(Longint(Data) + 4)^; + fMinute := pByte(Longint(Data) + 5)^; + fSecond := pByte(Longint(Data) + 6)^; +end; + +{Assigns from another TChunk} +procedure TChunktIME.Assign(Source: TChunk); +begin + fYear := TChunktIME(Source).fYear; + fMonth := TChunktIME(Source).fMonth; + fDay := TChunktIME(Source).fDay; + fHour := TChunktIME(Source).fHour; + fMinute := TChunktIME(Source).fMinute; + fSecond := TChunktIME(Source).fSecond; +end; + +{Saving the chunk to a stream} +function TChunktIME.SaveToStream(Stream: TStream): Boolean; +begin + {Update data} + ResizeData(7); {Make sure the size is 7} + pWord(Data)^ := ByteSwap16(Year); + pByte(Longint(Data) + 2)^ := Month; + pByte(Longint(Data) + 3)^ := Day; + pByte(Longint(Data) + 4)^ := Hour; + pByte(Longint(Data) + 5)^ := Minute; + pByte(Longint(Data) + 6)^ := Second; + + {Let inherited save data} + Result := inherited SaveToStream(Stream); +end; + +{TChunkztXt implementation} + +{Loading the chunk from a stream} +function TChunkzTXt.LoadFromStream(Stream: TStream; + const ChunkName: TChunkName; Size: Integer): Boolean; +var + ErrorOutput: String; + CompressionMethod: Byte; + Output: Pointer; + OutputSize: Integer; +begin + {Load data from stream and validate} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result or (Size < 4) then exit; + fKeyword := PChar(Data); {Get keyword and compression method bellow} + if Longint(fKeyword) = 0 then + CompressionMethod := pByte(Data)^ + else + CompressionMethod := pByte(Longint(fKeyword) + Length(fKeyword))^; + fText := ''; + + {In case the compression is 0 (only one accepted by specs), reads it} + if CompressionMethod = 0 then + begin + Output := nil; + if DecompressZLIB(PChar(Longint(Data) + Length(fKeyword) + 2), + Size - Length(fKeyword) - 2, Output, OutputSize, ErrorOutput) then + begin + SetLength(fText, OutputSize); + CopyMemory(@fText[1], Output, OutputSize); + end {if DecompressZLIB(...}; + FreeMem(Output); + end {if CompressionMethod = 0} + +end; + +{Saving the chunk to a stream} +function TChunkztXt.SaveToStream(Stream: TStream): Boolean; +var + Output: Pointer; + OutputSize: Integer; + ErrorOutput: String; +begin + Output := nil; {Initializes output} + if fText = '' then fText := ' '; + + {Compresses the data} + if CompressZLIB(@fText[1], Length(fText), Owner.CompressionLevel, Output, + OutputSize, ErrorOutput) then + begin + {Size is length from keyword, plus a null character to divide} + {plus the compression method, plus the length of the text (zlib compressed)} + ResizeData(Length(fKeyword) + 2 + OutputSize); + + Fillchar(Data^, DataSize, #0); + {Copies the keyword data} + if Keyword <> '' then + CopyMemory(Data, @fKeyword[1], Length(Keyword)); + {Compression method 0 (inflate/deflate)} + pByte(Ptr(Longint(Data) + Length(Keyword) + 1))^ := 0; + if OutputSize > 0 then + CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 2), Output, OutputSize); + + {Let ancestor calculate crc and save} + Result := SaveData(Stream); + end {if CompressZLIB(...} else Result := False; + + {Frees output} + if Output <> nil then FreeMem(Output) +end; + +{TChunktEXt implementation} + +{Assigns from another text chunk} +procedure TChunktEXt.Assign(Source: TChunk); +begin + fKeyword := TChunktEXt(Source).fKeyword; + fText := TChunktEXt(Source).fText; +end; + +{Loading the chunk from a stream} +function TChunktEXt.LoadFromStream(Stream: TStream; + const ChunkName: TChunkName; Size: Integer): Boolean; +begin + {Load data from stream and validate} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result or (Size < 3) then exit; + {Get text} + fKeyword := PChar(Data); + SetLength(fText, Size - Length(fKeyword) - 1); + CopyMemory(@fText[1], Ptr(Longint(Data) + Length(fKeyword) + 1), + Length(fText)); +end; + +{Saving the chunk to a stream} +function TChunktEXt.SaveToStream(Stream: TStream): Boolean; +begin + {Size is length from keyword, plus a null character to divide} + {plus the length of the text} + ResizeData(Length(fKeyword) + 1 + Length(fText)); + Fillchar(Data^, DataSize, #0); + {Copy data} + if Keyword <> '' then + CopyMemory(Data, @fKeyword[1], Length(Keyword)); + if Text <> '' then + CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 1), @fText[1], + Length(Text)); + {Let ancestor calculate crc and save} + Result := inherited SaveToStream(Stream); +end; + + +{TChunkIHDR implementation} + +{Chunk being created} +constructor TChunkIHDR.Create(Owner: TPngObject); +begin + {Prepare pointers} + ImageHandle := 0; + ImagePalette := 0; + ImageDC := 0; + + {Call inherited} + inherited Create(Owner); +end; + +{Chunk being destroyed} +destructor TChunkIHDR.Destroy; +begin + {Free memory} + FreeImageData(); + + {Calls TChunk destroy} + inherited Destroy; +end; + +{Copies the palette} +procedure CopyPalette(Source: HPALETTE; Destination: HPALETTE); +var + PaletteSize: Integer; + Entries: Array[Byte] of TPaletteEntry; +begin + PaletteSize := 0; + if GetObject(Source, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit; + if PaletteSize = 0 then Exit; + ResizePalette(Destination, PaletteSize); + GetPaletteEntries(Source, 0, PaletteSize, Entries); + SetPaletteEntries(Destination, 0, PaletteSize, Entries); +end; + +{Assigns from another IHDR chunk} +procedure TChunkIHDR.Assign(Source: TChunk); +begin + {Copy the IHDR data} + if Source is TChunkIHDR then + begin + {Copy IHDR values} + IHDRData := TChunkIHDR(Source).IHDRData; + + {Prepare to hold data by filling BitmapInfo structure and} + {resizing ImageData and ImageAlpha memory allocations} + PrepareImageData(); + + {Copy image data} + CopyMemory(ImageData, TChunkIHDR(Source).ImageData, + BytesPerRow * Integer(Height)); + CopyMemory(ImageAlpha, TChunkIHDR(Source).ImageAlpha, + Integer(Width) * Integer(Height)); + + {Copy palette colors} + BitmapInfo.bmiColors := TChunkIHDR(Source).BitmapInfo.bmiColors; + {Copy palette also} + CopyPalette(TChunkIHDR(Source).ImagePalette, ImagePalette); + end + else + Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText); +end; + +{Release allocated image data} +procedure TChunkIHDR.FreeImageData; +begin + {Free old image data} + if ImageHandle <> 0 then DeleteObject(ImageHandle); + if ImageDC <> 0 then DeleteDC(ImageDC); + if ImageAlpha <> nil then FreeMem(ImageAlpha); + if ImagePalette <> 0 then DeleteObject(ImagePalette); + {$IFDEF Store16bits} + if ExtraImageData <> nil then FreeMem(ExtraImageData); + {$ENDIF} + ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := nil; + ImagePalette := 0; ExtraImageData := nil; +end; + +{Chunk being loaded from a stream} +function TChunkIHDR.LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; +begin + {Let TChunk load it} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result then Exit; + + {Now check values} + {Note: It's recommended by png specification to make sure that the size} + {must be 13 bytes to be valid, but some images with 14 bytes were found} + {which could be loaded by internet explorer and other tools} + if (fDataSize < SIZEOF(TIHdrData)) then + begin + {Ihdr must always have at least 13 bytes} + Result := False; + Owner.RaiseError(EPNGInvalidIHDR, EPNGInvalidIHDRText); + exit; + end; + + {Everything ok, reads IHDR} + IHDRData := pIHDRData(fData)^; + IHDRData.Width := ByteSwap(IHDRData.Width); + IHDRData.Height := ByteSwap(IHDRData.Height); + + {The width and height must not be larger than 65535 pixels} + if (IHDRData.Width > High(Word)) or (IHDRData.Height > High(Word)) then + begin + Result := False; + Owner.RaiseError(EPNGSizeExceeds, EPNGSizeExceedsText); + exit; + end {if IHDRData.Width > High(Word)}; + {Compression method must be 0 (inflate/deflate)} + if (IHDRData.CompressionMethod <> 0) then + begin + Result := False; + Owner.RaiseError(EPNGUnknownCompression, EPNGUnknownCompressionText); + exit; + end; + {Interlace must be either 0 (none) or 7 (adam7)} + if (IHDRData.InterlaceMethod <> 0) and (IHDRData.InterlaceMethod <> 1) then + begin + Result := False; + Owner.RaiseError(EPNGUnknownInterlace, EPNGUnknownInterlaceText); + exit; + end; + + {Updates owner properties} + Owner.InterlaceMethod := TInterlaceMethod(IHDRData.InterlaceMethod); + + {Prepares data to hold image} + PrepareImageData(); +end; + +{Saving the IHDR chunk to a stream} +function TChunkIHDR.SaveToStream(Stream: TStream): Boolean; +begin + {Ignore 2 bits images} + if BitDepth = 2 then BitDepth := 4; + + {It needs to do is update the data with the IHDR data} + {structure containing the write values} + ResizeData(SizeOf(TIHDRData)); + pIHDRData(fData)^ := IHDRData; + {..byteswap 4 byte types} + pIHDRData(fData)^.Width := ByteSwap(pIHDRData(fData)^.Width); + pIHDRData(fData)^.Height := ByteSwap(pIHDRData(fData)^.Height); + {..update interlace method} + pIHDRData(fData)^.InterlaceMethod := Byte(Owner.InterlaceMethod); + {..and then let the ancestor SaveToStream do the hard work} + Result := inherited SaveToStream(Stream); +end; + +{Creates a grayscale palette} +function TChunkIHDR.CreateGrayscalePalette(Bitdepth: Integer): HPalette; +var + j: Integer; + palEntries: TMaxLogPalette; +begin + {Prepares and fills the strucutre} + if Bitdepth = 16 then Bitdepth := 8; + fillchar(palEntries, sizeof(palEntries), 0); + palEntries.palVersion := $300; + palEntries.palNumEntries := 1 shl Bitdepth; + {Fill it with grayscale colors} + for j := 0 to palEntries.palNumEntries - 1 do + begin + palEntries.palPalEntry[j].peRed := + fOwner.GammaTable[MulDiv(j, 255, palEntries.palNumEntries - 1)]; + palEntries.palPalEntry[j].peGreen := palEntries.palPalEntry[j].peRed; + palEntries.palPalEntry[j].peBlue := palEntries.palPalEntry[j].peRed; + end; + {Creates and returns the palette} + Result := CreatePalette(pLogPalette(@palEntries)^); +end; + +{Copies the palette to the Device Independent bitmap header} +procedure TChunkIHDR.PaletteToDIB(Palette: HPalette); +var + j: Integer; + palEntries: TMaxLogPalette; +begin + {Copy colors} + Fillchar(palEntries, sizeof(palEntries), #0); + BitmapInfo.bmiHeader.biClrUsed := GetPaletteEntries(Palette, 0, 256, palEntries.palPalEntry[0]); + for j := 0 to BitmapInfo.bmiHeader.biClrUsed - 1 do + begin + BitmapInfo.bmiColors[j].rgbBlue := palEntries.palPalEntry[j].peBlue; + BitmapInfo.bmiColors[j].rgbRed := palEntries.palPalEntry[j].peRed; + BitmapInfo.bmiColors[j].rgbGreen := palEntries.palPalEntry[j].peGreen; + end; +end; + +{Resizes the image data to fill the color type, bit depth, } +{width and height parameters} +procedure TChunkIHDR.PrepareImageData(); + {Set the bitmap info} + procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean); + begin + + {Copy if the bitmap contain palette entries} + HasPalette := Palette; + {Fill the strucutre} + with BitmapInfo.bmiHeader do + begin + biSize := sizeof(TBitmapInfoHeader); + biHeight := Height; + biWidth := Width; + biPlanes := 1; + biBitCount := BitDepth; + biCompression := BI_RGB; + end {with BitmapInfo.bmiHeader} + end; +begin + {Prepare bitmap info header} + Fillchar(BitmapInfo, sizeof(TMaxBitmapInfo), #0); + {Release old image data} + FreeImageData(); + + {Obtain number of bits for each pixel} + case ColorType of + COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA: + case BitDepth of + {These are supported by windows} + 1, 4, 8: SetInfo(BitDepth, TRUE); + {2 bits for each pixel is not supported by windows bitmap} + 2 : SetInfo(4, TRUE); + {Also 16 bits (2 bytes) for each pixel is not supported} + {and should be transormed into a 8 bit grayscale} + 16 : SetInfo(8, TRUE); + end; + {Only 1 byte (8 bits) is supported} + COLOR_RGB, COLOR_RGBALPHA: SetInfo(24, FALSE); + end {case ColorType}; + {Number of bytes for each scanline} + BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31) + and not 31) div 8; + + {Build array for alpha information, if necessary} + if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then + begin + GetMem(ImageAlpha, Integer(Width) * Integer(Height)); + FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #0); + end; + + {Build array for extra byte information} + {$IFDEF Store16bits} + if (BitDepth = 16) then + begin + GetMem(ExtraImageData, BytesPerRow * Integer(Height)); + FillChar(ExtraImageData^, BytesPerRow * Integer(Height), #0); + end; + {$ENDIF} + + {Creates the image to hold the data, CreateDIBSection does a better} + {work in allocating necessary memory} + ImageDC := CreateCompatibleDC(0); + {$IFDEF UseDelphi}Self.Owner.Canvas.Handle := ImageDC;{$ENDIF} + + {In case it is a palette image, create the palette} + if HasPalette then + begin + {Create a standard palette} + if ColorType = COLOR_PALETTE then + ImagePalette := CreateHalfTonePalette(ImageDC) + else + ImagePalette := CreateGrayscalePalette(Bitdepth); + ResizePalette(ImagePalette, 1 shl BitmapInfo.bmiHeader.biBitCount); + BitmapInfo.bmiHeader.biClrUsed := 1 shl BitmapInfo.bmiHeader.biBitCount; + SelectPalette(ImageDC, ImagePalette, False); + RealizePalette(ImageDC); + PaletteTODIB(ImagePalette); + end; + + {Create the device independent bitmap} + ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^, + DIB_RGB_COLORS, ImageData, 0, 0); + SelectObject(ImageDC, ImageHandle); + + {Build array and allocate bytes for each row} + fillchar(ImageData^, BytesPerRow * Integer(Height), 0); +end; + +{TChunktRNS implementation} + +{$IFNDEF UseDelphi} +function CompareMem(P1, P2: pByte; const Size: Integer): Boolean; +var i: Integer; +begin + Result := True; + for i := 1 to Size do + begin + if P1^ <> P2^ then Result := False; + inc(P1); inc(P2); + end {for i} +end; +{$ENDIF} + +{Sets the transpararent color} +procedure TChunktRNS.SetTransparentColor(const Value: ColorRef); +var + i: Byte; + LookColor: TRGBQuad; +begin + {Clears the palette values} + Fillchar(PaletteValues, SizeOf(PaletteValues), #0); + {Sets that it uses bit transparency} + fBitTransparency := True; + + + {Depends on the color type} + with Header do + case ColorType of + COLOR_GRAYSCALE: + begin + Self.ResizeData(2); + pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value)); + end; + COLOR_RGB: + begin + Self.ResizeData(6); + pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value)); + pWord(@PaletteValues[2])^ := ByteSwap16(GetGValue(Value)); + pWord(@PaletteValues[4])^ := ByteSwap16(GetBValue(Value)); + end; + COLOR_PALETTE: + begin + {Creates a RGBQuad to search for the color} + LookColor.rgbRed := GetRValue(Value); + LookColor.rgbGreen := GetGValue(Value); + LookColor.rgbBlue := GetBValue(Value); + {Look in the table for the entry} + for i := 0 to BitmapInfo.bmiHeader.biClrUsed - 1 do + if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then + Break; + {Fill the transparency table} + Fillchar(PaletteValues, i, 255); + Self.ResizeData(i + 1) + + end + end {case / with}; + +end; + +{Returns the transparent color for the image} +function TChunktRNS.GetTransparentColor: ColorRef; +var + PaletteChunk: TChunkPLTE; + i: Integer; + Value: Byte; +begin + Result := 0; {Default: Unknown transparent color} + + {Depends on the color type} + with Header do + case ColorType of + COLOR_GRAYSCALE: + begin + Value := BitmapInfo.bmiColors[PaletteValues[1]].rgbRed; + Result := RGB(Value, Value, Value); + end; + COLOR_RGB: + Result := RGB(fOwner.GammaTable[PaletteValues[1]], + fOwner.GammaTable[PaletteValues[3]], + fOwner.GammaTable[PaletteValues[5]]); + COLOR_PALETTE: + begin + {Obtains the palette chunk} + PaletteChunk := Owner.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE; + + {Looks for an entry with 0 transparency meaning that it is the} + {full transparent entry} + for i := 0 to Self.DataSize - 1 do + if PaletteValues[i] = 0 then + with PaletteChunk.GetPaletteItem(i) do + begin + Result := RGB(rgbRed, rgbGreen, rgbBlue); + break + end + end {COLOR_PALETTE} + end {case Header.ColorType}; +end; + +{Saving the chunk to a stream} +function TChunktRNS.SaveToStream(Stream: TStream): Boolean; +begin + {Copy palette into data buffer} + if DataSize <= 256 then + CopyMemory(fData, @PaletteValues[0], DataSize); + + Result := inherited SaveToStream(Stream); +end; + +{Assigns from another chunk} +procedure TChunktRNS.Assign(Source: TChunk); +begin + CopyMemory(@PaletteValues[0], @TChunkTrns(Source).PaletteValues[0], 256); + fBitTransparency := TChunkTrns(Source).fBitTransparency; + inherited Assign(Source); +end; + +{Loads the chunk from a stream} +function TChunktRNS.LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; +var + i, Differ255: Integer; +begin + {Let inherited load} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + + if not Result then Exit; + + {Make sure size is correct} + if Size > 256 then Owner.RaiseError(EPNGInvalidPalette, + EPNGInvalidPaletteText); + + {The unset items should have value 255} + Fillchar(PaletteValues[0], 256, 255); + {Copy the other values} + CopyMemory(@PaletteValues[0], fData, Size); + + {Create the mask if needed} + case Header.ColorType of + {Mask for grayscale and RGB} + COLOR_RGB, COLOR_GRAYSCALE: fBitTransparency := True; + COLOR_PALETTE: + begin + Differ255 := 0; {Count the entries with a value different from 255} + {Tests if it uses bit transparency} + for i := 0 to Size - 1 do + if PaletteValues[i] <> 255 then inc(Differ255); + + {If it has one value different from 255 it is a bit transparency} + fBitTransparency := (Differ255 = 1); + end {COLOR_PALETTE} + end {case Header.ColorType}; + +end; + +{Prepares the image palette} +procedure TChunkIDAT.PreparePalette; +var + Entries: Word; + j : Integer; + palEntries: TMaxLogPalette; +begin + {In case the image uses grayscale, build a grayscale palette} + with Header do + if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then + begin + {Calculate total number of palette entries} + Entries := (1 shl Byte(BitmapInfo.bmiHeader.biBitCount)); + Fillchar(palEntries, sizeof(palEntries), #0); + palEntries.palVersion := $300; + palEntries.palNumEntries := Entries; + + FOR j := 0 TO Entries - 1 DO + with palEntries.palPalEntry[j] do + begin + + {Calculate each palette entry} + peRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)]; + peGreen := peRed; + peBlue := peRed; + end {with BitmapInfo.bmiColors[j]}; + Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^)); + end {if ColorType = COLOR_GRAYSCALE..., with Header} +end; + +{Reads from ZLIB} +function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2; + Buffer: Pointer; Count: Integer; var EndPos: Integer; + var crcfile: Cardinal): Integer; +var + ProcResult : Integer; + IDATHeader : Array[0..3] of char; + IDATCRC : Cardinal; +begin + {Uses internal record pointed by ZLIBStream to gather information} + with ZLIBStream, ZLIBStream.zlib do + begin + {Set the buffer the zlib will read into} + next_out := Buffer; + avail_out := Count; + + {Decode until it reach the Count variable} + while avail_out > 0 do + begin + {In case it needs more data and it's in the end of a IDAT chunk,} + {it means that there are more IDAT chunks} + if (fStream.Position = EndPos) and (avail_out > 0) and + (avail_in = 0) then + begin + {End this chunk by reading and testing the crc value} + fStream.Read(IDATCRC, 4); + + {$IFDEF CheckCRC} + if crcfile xor $ffffffff <> Cardinal(ByteSwap(IDATCRC)) then + begin + Result := -1; + Owner.RaiseError(EPNGInvalidCRC, EPNGInvalidCRCText); + exit; + end; + {$ENDIF} + + {Start reading the next chunk} + fStream.Read(EndPos, 4); {Reads next chunk size} + fStream.Read(IDATHeader[0], 4); {Next chunk header} + {It must be a IDAT chunk since image data is required and PNG} + {specification says that multiple IDAT chunks must be consecutive} + if IDATHeader <> 'IDAT' then + begin + Owner.RaiseError(EPNGMissingMultipleIDAT, EPNGMissingMultipleIDATText); + result := -1; + exit; + end; + + {Calculate chunk name part of the crc} + {$IFDEF CheckCRC} + crcfile := update_crc($ffffffff, @IDATHeader[0], 4); + {$ENDIF} + EndPos := fStream.Position + ByteSwap(EndPos); + end; + + + {In case it needs compressed data to read from} + if avail_in = 0 then + begin + {In case it's trying to read more than it is avaliable} + if fStream.Position + ZLIBAllocate > EndPos then + avail_in := fStream.Read(Data^, EndPos - fStream.Position) + else + avail_in := fStream.Read(Data^, ZLIBAllocate); + {Update crc} + {$IFDEF CheckCRC} + crcfile := update_crc(crcfile, Data, avail_in); + {$ENDIF} + + {In case there is no more compressed data to read from} + if avail_in = 0 then + begin + Result := Count - avail_out; + Exit; + end; + + {Set next buffer to read and record current position} + next_in := Data; + + end {if avail_in = 0}; + + ProcResult := inflate(zlib, 0); + + {In case the result was not sucessfull} + if (ProcResult < 0) then + begin + Result := -1; + Owner.RaiseError(EPNGZLIBError, + EPNGZLIBErrorText + zliberrors[procresult]); + exit; + end; + + end {while avail_out > 0}; + + end {with}; + + {If everything gone ok, it returns the count bytes} + Result := Count; +end; + +{TChunkIDAT implementation} + +const + {Adam 7 interlacing values} + RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1); + ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0); + RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2); + ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1); + +{Copy interlaced images with 1 byte for R, G, B} +procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col * 3); + repeat + {Copy this row} + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + + {Move to next column} + inc(Src, 3); + inc(Dest, ColumnIncrement[Pass] * 3 - 3); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy interlaced images with 2 bytes for R, G, B} +procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col * 3); + repeat + {Copy this row} + Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest); + Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {$IFDEF Store16bits} + {Copy extra pixel values} + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra); + {$ENDIF} + + {Move to next column} + inc(Src, 6); + inc(Dest, ColumnIncrement[Pass] * 3 - 3); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy нmages with palette using bit depths 1, 4 or 8} +procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +const + BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF); + StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0); +var + CurBit, Col: Integer; + Dest2: PChar; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + repeat + {Copy data} + CurBit := StartBit[Header.BitDepth]; + repeat + {Adjust pointer to pixel byte bounds} + Dest2 := pChar(Longint(Dest) + (Header.BitDepth * Col) div 8); + {Copy data} + Byte(Dest2^) := Byte(Dest2^) or + ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth]) + shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8))); + + {Move to next column} + inc(Col, ColumnIncrement[Pass]); + {Will read next bits} + dec(CurBit, Header.BitDepth); + until CurBit < 0; + + {Move to next byte in source} + inc(Src); + until Col >= ImageWidth; +end; + +{Copy нmages with palette using bit depth 2} +procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest, + Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + CurBit, Col: Integer; + Dest2: PChar; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + repeat + {Copy data} + CurBit := 6; + repeat + {Adjust pointer to pixel byte bounds} + Dest2 := pChar(Longint(Dest) + Col div 2); + {Copy data} + Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3) + shl (4 - (4 * Col) mod 8)); + {Move to next column} + inc(Col, ColumnIncrement[Pass]); + {Will read next bits} + dec(CurBit, 2); + until CurBit < 0; + + {Move to next byte in source} + inc(Src); + until Col >= ImageWidth; +end; + +{Copy нmages with grayscale using bit depth 2} +procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + CurBit, Col: Integer; + Dest2: PChar; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + repeat + {Copy data} + CurBit := 6; + repeat + {Adjust pointer to pixel byte bounds} + Dest2 := pChar(Longint(Dest) + Col div 2); + {Copy data} + Byte(Dest2^) := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F) + shl (4 - (Col*4) mod 8)); + {Move to next column} + inc(Col, ColumnIncrement[Pass]); + {Will read next bits} + dec(CurBit, 2); + until CurBit < 0; + + {Move to next byte in source} + inc(Src); + until Col >= ImageWidth; +end; + +{Copy нmages with palette using 2 bytes for each pixel} +procedure TChunkIDAT.CopyInterlacedGrayscale16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col); + repeat + {Copy this row} + Dest^ := Src^; inc(Dest); + {$IFDEF Store16bits} + Extra^ := pChar(Longint(Src) + 1)^; inc(Extra); + {$ENDIF} + + {Move to next column} + inc(Src, 2); + inc(Dest, ColumnIncrement[Pass] - 1); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Decodes interlaced RGB alpha with 1 byte for each sample} +procedure TChunkIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col * 3); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row and alpha value} + Trans^ := pChar(Longint(Src) + 3)^; + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + + {Move to next column} + inc(Src, 4); + inc(Dest, ColumnIncrement[Pass] * 3 - 3); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Decodes interlaced RGB alpha with 2 bytes for each sample} +procedure TChunkIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col * 3); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row and alpha value} + Trans^ := pChar(Longint(Src) + 6)^; + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {$IFDEF Store16bits} + {Copy extra pixel values} + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra); + {$ENDIF} + + {Move to next column} + inc(Src, 8); + inc(Dest, ColumnIncrement[Pass] * 3 - 3); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Decodes 8 bit grayscale image followed by an alpha sample} +procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column, pointers to the data and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this grayscale value and alpha} + Dest^ := Src^; inc(Src); + Trans^ := Src^; inc(Src); + + {Move to next column} + inc(Dest, ColumnIncrement[Pass]); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Decodes 16 bit grayscale image followed by an alpha sample} +procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte; + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + Col: Integer; +begin + {Get first column, pointers to the data and enter in loop} + Col := ColumnStart[Pass]; + Dest := pChar(Longint(Dest) + Col); + Trans := pChar(Longint(Trans) + Col); + repeat + {$IFDEF Store16bits} + Extra^ := pChar(Longint(Src) + 1)^; inc(Extra); + {$ENDIF} + {Copy this grayscale value and alpha, transforming 16 bits into 8} + Dest^ := Src^; inc(Src, 2); + Trans^ := Src^; inc(Src, 2); + + {Move to next column} + inc(Dest, ColumnIncrement[Pass]); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Decodes an interlaced image} +procedure TChunkIDAT.DecodeInterlacedAdam7(Stream: TStream; + var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal); +var + CurrentPass: Byte; + PixelsThisRow: Integer; + CurrentRow: Integer; + Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar; + CopyProc: procedure(const Pass: Byte; Src, Dest, + Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object; +begin + + CopyProc := nil; {Initialize} + {Determine method to copy the image data} + case Header.ColorType of + {R, G, B values for each pixel} + COLOR_RGB: + case Header.BitDepth of + 8: CopyProc := CopyInterlacedRGB8; + 16: CopyProc := CopyInterlacedRGB16; + end {case Header.BitDepth}; + {Palette} + COLOR_PALETTE, COLOR_GRAYSCALE: + case Header.BitDepth of + 1, 4, 8: CopyProc := CopyInterlacedPalette148; + 2 : if Header.ColorType = COLOR_PALETTE then + CopyProc := CopyInterlacedPalette2 + else + CopyProc := CopyInterlacedGray2; + 16 : CopyProc := CopyInterlacedGrayscale16; + end; + {RGB followed by alpha} + COLOR_RGBALPHA: + case Header.BitDepth of + 8: CopyProc := CopyInterlacedRGBAlpha8; + 16: CopyProc := CopyInterlacedRGBAlpha16; + end; + {Grayscale followed by alpha} + COLOR_GRAYSCALEALPHA: + case Header.BitDepth of + 8: CopyProc := CopyInterlacedGrayscaleAlpha8; + 16: CopyProc := CopyInterlacedGrayscaleAlpha16; + end; + end {case Header.ColorType}; + + {Adam7 method has 7 passes to make the final image} + FOR CurrentPass := 0 TO 6 DO + begin + {Calculates the number of pixels and bytes for this pass row} + PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] + + ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass]; + Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType, + Header.BitDepth); + {Clear buffer for this pass} + ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes); + + {Get current row index} + CurrentRow := RowStart[CurrentPass]; + {Get a pointer to the current row image data} + Data := Ptr(Longint(Header.ImageData) + Header.BytesPerRow * + (ImageHeight - 1 - CurrentRow)); + Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow); + {$IFDEF Store16bits} + Extra := Ptr(Longint(Header.ExtraImageData) + Header.BytesPerRow * + (ImageHeight - 1 - CurrentRow)); + {$ENDIF} + + if Row_Bytes > 0 then {There must have bytes for this interlaced pass} + while CurrentRow < ImageHeight do + begin + {Reads this line and filter} + if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, + EndPos, CRCFile) = 0 then break; + + FilterRow; + {Copy image data} + + CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Data, Trans + {$IFDEF Store16bits}, Extra{$ENDIF}); + + {Use the other RowBuffer item} + RowUsed := not RowUsed; + + {Move to the next row} + inc(CurrentRow, RowIncrement[CurrentPass]); + {Move pointer to the next line} + dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow); + inc(Trans, RowIncrement[CurrentPass] * ImageWidth); + {$IFDEF Store16bits} + dec(Extra, RowIncrement[CurrentPass] * Header.BytesPerRow); + {$ENDIF} + end {while CurrentRow < ImageHeight}; + + end {FOR CurrentPass}; + +end; + +{Copy 8 bits RGB image} +procedure TChunkIDAT.CopyNonInterlacedRGB8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Copy pixel values} + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {Move to next pixel} + inc(Src, 3); + end {for I} +end; + +{Copy 16 bits RGB image} +procedure TChunkIDAT.CopyNonInterlacedRGB16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + //Since windows does not supports 2 bytes for + //each R, G, B value, the method will read only 1 byte from it + {Copy pixel values} + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {$IFDEF Store16bits} + {Copy extra pixel values} + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra); + {$ENDIF} + + {Move to next pixel} + inc(Src, 6); + end {for I} +end; + +{Copy types using palettes (1, 4 or 8 bits per pixel)} +procedure TChunkIDAT.CopyNonInterlacedPalette148( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +begin + {It's simple as copying the data} + CopyMemory(Dest, Src, Row_Bytes); +end; + +{Copy grayscale types using 2 bits for each pixel} +procedure TChunkIDAT.CopyNonInterlacedGray2( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + i: Integer; +begin + {2 bits is not supported, this routine will converted into 4 bits} + FOR i := 1 TO Row_Bytes do + begin + Byte(Dest^) := ((Byte(Src^) shr 2) and $F) or ((Byte(Src^)) and $F0); + inc(Dest); + Byte(Dest^) := ((Byte(Src^) shl 2) and $F) or ((Byte(Src^) shl 4) and $F0); + inc(Dest); + inc(Src); + end {FOR i} +end; + +{Copy types using palette with 2 bits for each pixel} +procedure TChunkIDAT.CopyNonInterlacedPalette2( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + i: Integer; +begin + {2 bits is not supported, this routine will converted into 4 bits} + FOR i := 1 TO Row_Bytes do + begin + Byte(Dest^) := ((Byte(Src^) shr 4) and $3) or ((Byte(Src^) shr 2) and $30); + inc(Dest); + Byte(Dest^) := (Byte(Src^) and $3) or ((Byte(Src^) shl 2) and $30); + inc(Dest); + inc(Src); + end {FOR i} +end; + +{Copy grayscale images with 16 bits} +procedure TChunkIDAT.CopyNonInterlacedGrayscale16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Windows does not supports 16 bits for each pixel in grayscale} + {mode, so reduce to 8} + Dest^ := Src^; inc(Dest); + {$IFDEF Store16bits} + Extra^ := pChar(Longint(Src) + 1)^; inc(Extra); + {$ENDIF} + + {Move to next pixel} + inc(Src, 2); + end {for I} +end; + +{Copy 8 bits per sample RGB images followed by an alpha byte} +procedure TChunkIDAT.CopyNonInterlacedRGBAlpha8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + i: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Copy pixel values and transparency} + Trans^ := pChar(Longint(Src) + 3)^; + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {Move to next pixel} + inc(Src, 4); inc(Trans); + end {for I} +end; + +{Copy 16 bits RGB image with alpha using 2 bytes for each sample} +procedure TChunkIDAT.CopyNonInterlacedRGBAlpha16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + //Copy rgb and alpha values (transforming from 16 bits to 8 bits) + {Copy pixel values} + Trans^ := pChar(Longint(Src) + 6)^; + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest); + {$IFDEF Store16bits} + {Copy extra pixel values} + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra); + Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra); + {$ENDIF} + {Move to next pixel} + inc(Src, 8); inc(Trans); + end {for I} +end; + +{Copy 8 bits per sample grayscale followed by alpha} +procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha8( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Copy alpha value and then gray value} + Dest^ := Src^; inc(Src); + Trans^ := Src^; inc(Src); + inc(Dest); inc(Trans); + end; +end; + +{Copy 16 bits per sample grayscale followed by alpha} +procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha16( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Copy alpha value and then gray value} + {$IFDEF Store16bits} + Extra^ := pChar(Longint(Src) + 1)^; inc(Extra); + {$ENDIF} + Dest^ := Src^; inc(Src, 2); + Trans^ := Src^; inc(Src, 2); + inc(Dest); inc(Trans); + end; +end; + +{Decode non interlaced image} +procedure TChunkIDAT.DecodeNonInterlaced(Stream: TStream; + var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal); +var + j: Cardinal; + Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar; + CopyProc: procedure( + Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object; +begin + CopyProc := nil; {Initialize} + {Determines the method to copy the image data} + case Header.ColorType of + {R, G, B values} + COLOR_RGB: + case Header.BitDepth of + 8: CopyProc := CopyNonInterlacedRGB8; + 16: CopyProc := CopyNonInterlacedRGB16; + end; + {Types using palettes} + COLOR_PALETTE, COLOR_GRAYSCALE: + case Header.BitDepth of + 1, 4, 8: CopyProc := CopyNonInterlacedPalette148; + 2 : if Header.ColorType = COLOR_PALETTE then + CopyProc := CopyNonInterlacedPalette2 + else + CopyProc := CopyNonInterlacedGray2; + 16 : CopyProc := CopyNonInterlacedGrayscale16; + end; + {R, G, B followed by alpha} + COLOR_RGBALPHA: + case Header.BitDepth of + 8 : CopyProc := CopyNonInterlacedRGBAlpha8; + 16 : CopyProc := CopyNonInterlacedRGBAlpha16; + end; + {Grayscale followed by alpha} + COLOR_GRAYSCALEALPHA: + case Header.BitDepth of + 8 : CopyProc := CopyNonInterlacedGrayscaleAlpha8; + 16 : CopyProc := CopyNonInterlacedGrayscaleAlpha16; + end; + end; + + {Get the image data pointer} + Longint(Data) := Longint(Header.ImageData) + + Header.BytesPerRow * (ImageHeight - 1); + Trans := Header.ImageAlpha; + {$IFDEF Store16bits} + Longint(Extra) := Longint(Header.ExtraImageData) + + Header.BytesPerRow * (ImageHeight - 1); + {$ENDIF} + {Reads each line} + FOR j := 0 to ImageHeight - 1 do + begin + {Read this line Row_Buffer[RowUsed][0] if the filter type for this line} + if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, EndPos, + CRCFile) = 0 then break; + + {Filter the current row} + FilterRow; + {Copies non interlaced row to image} + CopyProc(@Row_Buffer[RowUsed][1], Data, Trans{$IFDEF Store16bits}, Extra + {$ENDIF}); + + {Invert line used} + RowUsed := not RowUsed; + dec(Data, Header.BytesPerRow); + {$IFDEF Store16bits}dec(Extra, Header.BytesPerRow);{$ENDIF} + inc(Trans, ImageWidth); + end {for I}; + + +end; + +{Filter the current line} +procedure TChunkIDAT.FilterRow; +var + pp: Byte; + vv, left, above, aboveleft: Integer; + Col: Cardinal; +begin + {Test the filter} + case Row_Buffer[RowUsed]^[0] of + {No filtering for this line} + FILTER_NONE: begin end; + {AND 255 serves only to never let the result be larger than one byte} + {Sub filter} + FILTER_SUB: + FOR Col := Offset + 1 to Row_Bytes DO + Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] + + Row_Buffer[RowUsed][Col - Offset]) and 255; + {Up filter} + FILTER_UP: + FOR Col := 1 to Row_Bytes DO + Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] + + Row_Buffer[not RowUsed][Col]) and 255; + {Average filter} + FILTER_AVERAGE: + FOR Col := 1 to Row_Bytes DO + begin + {Obtains up and left pixels} + above := Row_Buffer[not RowUsed][Col]; + if col - 1 < Offset then + left := 0 + else + Left := Row_Buffer[RowUsed][Col - Offset]; + + {Calculates} + Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] + + (left + above) div 2) and 255; + end; + {Paeth filter} + FILTER_PAETH: + begin + {Initialize} + left := 0; + aboveleft := 0; + {Test each byte} + FOR Col := 1 to Row_Bytes DO + begin + {Obtains above pixel} + above := Row_Buffer[not RowUsed][Col]; + {Obtains left and top-left pixels} + if (col - 1 >= offset) Then + begin + left := row_buffer[RowUsed][col - offset]; + aboveleft := row_buffer[not RowUsed][col - offset]; + end; + + {Obtains current pixel and paeth predictor} + vv := row_buffer[RowUsed][Col]; + pp := PaethPredictor(left, above, aboveleft); + + {Calculates} + Row_Buffer[RowUsed][Col] := (pp + vv) and $FF; + end {for}; + end; + + end {case}; +end; + +{Reads the image data from the stream} +function TChunkIDAT.LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; +var + ZLIBStream: TZStreamRec2; + CRCCheck, + CRCFile : Cardinal; +begin + {Get pointer to the header chunk} + Header := Owner.Chunks.Item[0] as TChunkIHDR; + {Build palette if necessary} + if Header.HasPalette then PreparePalette(); + + {Copy image width and height} + ImageWidth := Header.Width; + ImageHeight := Header.Height; + + {Initialize to calculate CRC} + {$IFDEF CheckCRC} + CRCFile := update_crc($ffffffff, @ChunkName[0], 4); + {$ENDIF} + + Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information} + ZLIBStream := ZLIBInitInflate(Stream); {Initializes decompression} + + {Calculate ending position for the current IDAT chunk} + EndPos := Stream.Position + Size; + + {Allocate memory} + GetMem(Row_Buffer[false], Row_Bytes + 1); + GetMem(Row_Buffer[true], Row_Bytes + 1); + ZeroMemory(Row_Buffer[false], Row_bytes + 1); + {Set the variable to alternate the Row_Buffer item to use} + RowUsed := TRUE; + + {Call special methods for the different interlace methods} + case Owner.InterlaceMethod of + imNone: DecodeNonInterlaced(stream, ZLIBStream, Size, crcfile); + imAdam7: DecodeInterlacedAdam7(stream, ZLIBStream, size, crcfile); + end; + + {Free memory} + ZLIBTerminateInflate(ZLIBStream); {Terminates decompression} + FreeMem(Row_Buffer[False], Row_Bytes + 1); + FreeMem(Row_Buffer[True], Row_Bytes + 1); + + {Now checks CRC} + Stream.Read(CRCCheck, 4); + {$IFDEF CheckCRC} + CRCFile := CRCFile xor $ffffffff; + CRCCheck := ByteSwap(CRCCheck); + Result := CRCCheck = CRCFile; + + {Handle CRC error} + if not Result then + begin + {In case it coult not load chunk} + Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText); + exit; + end; + {$ELSE}Result := TRUE; {$ENDIF} +end; + +const + IDATHeader: Array[0..3] of char = ('I', 'D', 'A', 'T'); + BUFFER = 5; + +{Saves the IDAT chunk to a stream} +function TChunkIDAT.SaveToStream(Stream: TStream): Boolean; +var + ZLIBStream : TZStreamRec2; +begin + {Get pointer to the header chunk} + Header := Owner.Chunks.Item[0] as TChunkIHDR; + {Copy image width and height} + ImageWidth := Header.Width; + ImageHeight := Header.Height; + Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information} + + {Allocate memory} + GetMem(Encode_Buffer[BUFFER], Row_Bytes); + ZeroMemory(Encode_Buffer[BUFFER], Row_Bytes); + {Allocate buffers for the filters selected} + {Filter none will always be calculated to the other filters to work} + GetMem(Encode_Buffer[FILTER_NONE], Row_Bytes); + ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes); + if pfSub in Owner.Filters then + GetMem(Encode_Buffer[FILTER_SUB], Row_Bytes); + if pfUp in Owner.Filters then + GetMem(Encode_Buffer[FILTER_UP], Row_Bytes); + if pfAverage in Owner.Filters then + GetMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes); + if pfPaeth in Owner.Filters then + GetMem(Encode_Buffer[FILTER_PAETH], Row_Bytes); + + {Initialize ZLIB} + ZLIBStream := ZLIBInitDeflate(Stream, Owner.fCompressionLevel, + Owner.MaxIdatSize); + {Write data depending on the interlace method} + case Owner.InterlaceMethod of + imNone: EncodeNonInterlaced(stream, ZLIBStream); + imAdam7: EncodeInterlacedAdam7(stream, ZLIBStream); + end; + {Terminates ZLIB} + ZLIBTerminateDeflate(ZLIBStream); + + {Release allocated memory} + FreeMem(Encode_Buffer[BUFFER], Row_Bytes); + FreeMem(Encode_Buffer[FILTER_NONE], Row_Bytes); + if pfSub in Owner.Filters then + FreeMem(Encode_Buffer[FILTER_SUB], Row_Bytes); + if pfUp in Owner.Filters then + FreeMem(Encode_Buffer[FILTER_UP], Row_Bytes); + if pfAverage in Owner.Filters then + FreeMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes); + if pfPaeth in Owner.Filters then + FreeMem(Encode_Buffer[FILTER_PAETH], Row_Bytes); + + {Everything went ok} + Result := True; +end; + +{Writes the IDAT using the settings} +procedure WriteIDAT(Stream: TStream; Data: Pointer; const Length: Cardinal); +var + ChunkLen, CRC: Cardinal; +begin + {Writes IDAT header} + ChunkLen := ByteSwap(Length); + Stream.Write(ChunkLen, 4); {Chunk length} + Stream.Write(IDATHeader[0], 4); {Idat header} + CRC := update_crc($ffffffff, @IDATHeader[0], 4); {Crc part for header} + + {Writes IDAT data and calculates CRC for data} + Stream.Write(Data^, Length); + CRC := Byteswap(update_crc(CRC, Data, Length) xor $ffffffff); + {Writes final CRC} + Stream.Write(CRC, 4); +end; + +{Compress and writes IDAT chunk data} +procedure TChunkIDAT.IDATZlibWrite(var ZLIBStream: TZStreamRec2; + Buffer: Pointer; const Length: Cardinal); +begin + with ZLIBStream, ZLIBStream.ZLIB do + begin + {Set data to be compressed} + next_in := Buffer; + avail_in := Length; + + {Compress all the data avaliable to compress} + while avail_in > 0 do + begin + deflate(ZLIB, Z_NO_FLUSH); + + {The whole buffer was used, save data to stream and restore buffer} + if avail_out = 0 then + begin + {Writes this IDAT chunk} + WriteIDAT(fStream, Data, Owner.MaxIdatSize); + + {Restore buffer} + next_out := Data; + avail_out := Owner.MaxIdatSize; + end {if avail_out = 0}; + + end {while avail_in}; + + end {with ZLIBStream, ZLIBStream.ZLIB} +end; + +{Finishes compressing data to write IDAT chunk} +procedure TChunkIDAT.FinishIDATZlib(var ZLIBStream: TZStreamRec2); +begin + with ZLIBStream, ZLIBStream.ZLIB do + begin + {Set data to be compressed} + next_in := nil; + avail_in := 0; + + while deflate(ZLIB,Z_FINISH) <> Z_STREAM_END do + begin + {Writes this IDAT chunk} + WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out); + {Re-update buffer} + next_out := Data; + avail_out := Owner.MaxIdatSize; + end; + + if avail_out < Owner.MaxIdatSize then + {Writes final IDAT} + WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out); + + end {with ZLIBStream, ZLIBStream.ZLIB}; +end; + +{Copy memory to encode RGB image with 1 byte for each color sample} +procedure TChunkIDAT.EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + {Copy pixel values} + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest); + {Move to next pixel} + inc(Src, 3); + end {for I} +end; + +{Copy memory to encode RGB images with 16 bits for each color sample} +procedure TChunkIDAT.EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word) + //for sample + {Copy pixel values} + pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2); + pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2); + pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2); + {Move to next pixel} + inc(Src, 3); + end {for I} + +end; + +{Copy memory to encode types using palettes (1, 4 or 8 bits per pixel)} +procedure TChunkIDAT.EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar); +begin + {It's simple as copying the data} + CopyMemory(Dest, Src, Row_Bytes); +end; + +{Copy memory to encode grayscale images with 2 bytes for each sample} +procedure TChunkIDAT.EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar); +var + I: Integer; +begin + FOR I := 1 TO ImageWidth DO + begin + //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word) + //for sample + pWORD(Dest)^ := pByte(Longint(Src))^; inc(Dest, 2); + {Move to next pixel} + inc(Src); + end {for I} +end; + +{Encode images using RGB followed by an alpha value using 1 byte for each} +procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar); +var + i: Integer; +begin + {Copy the data to the destination, including data from Trans pointer} + FOR i := 1 TO ImageWidth do + begin + Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest); + Dest^ := Trans^; inc(Dest); + inc(Src, 3); inc(Trans); + end {for i}; +end; + +{Encode images using RGB followed by an alpha value using 2 byte for each} +procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar); +var + i: Integer; +begin + {Copy the data to the destination, including data from Trans pointer} + FOR i := 1 TO ImageWidth do + begin + pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest, 2); + pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest, 2); + pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest, 2); + pWord(Dest)^ := PByte(Longint(Trans) )^; inc(Dest, 2); + inc(Src, 3); inc(Trans); + end {for i}; +end; + +{Encode grayscale images followed by an alpha value using 1 byte for each} +procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha8( + Src, Dest, Trans: pChar); +var + i: Integer; +begin + {Copy the data to the destination, including data from Trans pointer} + FOR i := 1 TO ImageWidth do + begin + Dest^ := Src^; inc(Dest); + Dest^ := Trans^; inc(Dest); + inc(Src); inc(Trans); + end {for i}; +end; + +{Encode grayscale images followed by an alpha value using 2 byte for each} +procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha16( + Src, Dest, Trans: pChar); +var + i: Integer; +begin + {Copy the data to the destination, including data from Trans pointer} + FOR i := 1 TO ImageWidth do + begin + pWord(Dest)^ := pByte(Src)^; inc(Dest, 2); + pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2); + inc(Src); inc(Trans); + end {for i}; +end; + +{Encode non interlaced images} +procedure TChunkIDAT.EncodeNonInterlaced(Stream: TStream; + var ZLIBStream: TZStreamRec2); +var + {Current line} + j: Cardinal; + {Pointers to image data} + Data, Trans: PChar; + {Filter used for this line} + Filter: Byte; + {Method which will copy the data into the buffer} + CopyProc: procedure(Src, Dest, Trans: pChar) of object; +begin + CopyProc := nil; {Initialize to avoid warnings} + {Defines the method to copy the data to the buffer depending on} + {the image parameters} + case Header.ColorType of + {R, G, B values} + COLOR_RGB: + case Header.BitDepth of + 8: CopyProc := EncodeNonInterlacedRGB8; + 16: CopyProc := EncodeNonInterlacedRGB16; + end; + {Palette and grayscale values} + COLOR_GRAYSCALE, COLOR_PALETTE: + case Header.BitDepth of + 1, 4, 8: CopyProc := EncodeNonInterlacedPalette148; + 16: CopyProc := EncodeNonInterlacedGrayscale16; + end; + {RGB with a following alpha value} + COLOR_RGBALPHA: + case Header.BitDepth of + 8: CopyProc := EncodeNonInterlacedRGBAlpha8; + 16: CopyProc := EncodeNonInterlacedRGBAlpha16; + end; + {Grayscale images followed by an alpha} + COLOR_GRAYSCALEALPHA: + case Header.BitDepth of + 8: CopyProc := EncodeNonInterlacedGrayscaleAlpha8; + 16: CopyProc := EncodeNonInterlacedGrayscaleAlpha16; + end; + end {case Header.ColorType}; + + {Get the image data pointer} + Longint(Data) := Longint(Header.ImageData) + + Header.BytesPerRow * (ImageHeight - 1); + Trans := Header.ImageAlpha; + + {Writes each line} + FOR j := 0 to ImageHeight - 1 do + begin + {Copy data into buffer} + CopyProc(Data, @Encode_Buffer[BUFFER][0], Trans); + {Filter data} + Filter := FilterToEncode; + + {Compress data} + IDATZlibWrite(ZLIBStream, @Filter, 1); + IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes); + + {Adjust pointers to the actual image data} + dec(Data, Header.BytesPerRow); + inc(Trans, ImageWidth); + end; + + {Compress and finishes copying the remaining data} + FinishIDATZlib(ZLIBStream); +end; + +{Copy memory to encode interlaced images using RGB value with 1 byte for} +{each color sample} +procedure TChunkIDAT.EncodeInterlacedRGB8(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col * 3); + repeat + {Copy this row} + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest); + + {Move to next column} + inc(Src, ColumnIncrement[Pass] * 3); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy memory to encode interlaced RGB images with 2 bytes each color sample} +procedure TChunkIDAT.EncodeInterlacedRGB16(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col * 3); + repeat + {Copy this row} + pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2); + pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2); + pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2); + + {Move to next column} + inc(Src, ColumnIncrement[Pass] * 3); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy memory to encode interlaced images using palettes using bit depths} +{1, 4, 8 (each pixel in the image)} +procedure TChunkIDAT.EncodeInterlacedPalette148(const Pass: Byte; + Src, Dest, Trans: pChar); +const + BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF); + StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0); +var + CurBit, Col: Integer; + Src2: PChar; +begin + {Clean the line} + fillchar(Dest^, Row_Bytes, #0); + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + with Header.BitmapInfo.bmiHeader do + repeat + {Copy data} + CurBit := StartBit[biBitCount]; + repeat + {Adjust pointer to pixel byte bounds} + Src2 := pChar(Longint(Src) + (biBitCount * Col) div 8); + {Copy data} + Byte(Dest^) := Byte(Dest^) or + (((Byte(Src2^) shr (StartBit[Header.BitDepth] - (biBitCount * Col) + mod 8))) and (BitTable[biBitCount])) shl CurBit; + + {Move to next column} + inc(Col, ColumnIncrement[Pass]); + {Will read next bits} + dec(CurBit, biBitCount); + until CurBit < 0; + + {Move to next byte in source} + inc(Dest); + until Col >= ImageWidth; +end; + +{Copy to encode interlaced grayscale images using 16 bits for each sample} +procedure TChunkIDAT.EncodeInterlacedGrayscale16(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col); + repeat + {Copy this row} + pWord(Dest)^ := Byte(Src^); inc(Dest, 2); + + {Move to next column} + inc(Src, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy to encode interlaced rgb images followed by an alpha value, all using} +{one byte for each sample} +procedure TChunkIDAT.EncodeInterlacedRGBAlpha8(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col * 3); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row} + Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest); + Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest); + Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest); + Dest^ := Trans^; inc(Dest); + + {Move to next column} + inc(Src, ColumnIncrement[Pass] * 3); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy to encode interlaced rgb images followed by an alpha value, all using} +{two byte for each sample} +procedure TChunkIDAT.EncodeInterlacedRGBAlpha16(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col * 3); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row} + pWord(Dest)^ := pByte(Longint(Src) + 2)^; inc(Dest, 2); + pWord(Dest)^ := pByte(Longint(Src) + 1)^; inc(Dest, 2); + pWord(Dest)^ := pByte(Longint(Src) )^; inc(Dest, 2); + pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2); + + {Move to next column} + inc(Src, ColumnIncrement[Pass] * 3); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy to encode grayscale interlaced images followed by an alpha value, all} +{using 1 byte for each sample} +procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha8(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row} + Dest^ := Src^; inc(Dest); + Dest^ := Trans^; inc(Dest); + + {Move to next column} + inc(Src, ColumnIncrement[Pass]); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Copy to encode grayscale interlaced images followed by an alpha value, all} +{using 2 bytes for each sample} +procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha16(const Pass: Byte; + Src, Dest, Trans: pChar); +var + Col: Integer; +begin + {Get first column and enter in loop} + Col := ColumnStart[Pass]; + Src := pChar(Longint(Src) + Col); + Trans := pChar(Longint(Trans) + Col); + repeat + {Copy this row} + pWord(Dest)^ := pByte(Src)^; inc(Dest, 2); + pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2); + + {Move to next column} + inc(Src, ColumnIncrement[Pass]); + inc(Trans, ColumnIncrement[Pass]); + inc(Col, ColumnIncrement[Pass]); + until Col >= ImageWidth; +end; + +{Encode interlaced images} +procedure TChunkIDAT.EncodeInterlacedAdam7(Stream: TStream; + var ZLIBStream: TZStreamRec2); +var + CurrentPass, Filter: Byte; + PixelsThisRow: Integer; + CurrentRow : Integer; + Trans, Data: pChar; + CopyProc: procedure(const Pass: Byte; + Src, Dest, Trans: pChar) of object; +begin + CopyProc := nil; {Initialize to avoid warnings} + {Defines the method to copy the data to the buffer depending on} + {the image parameters} + case Header.ColorType of + {R, G, B values} + COLOR_RGB: + case Header.BitDepth of + 8: CopyProc := EncodeInterlacedRGB8; + 16: CopyProc := EncodeInterlacedRGB16; + end; + {Grayscale and palette} + COLOR_PALETTE, COLOR_GRAYSCALE: + case Header.BitDepth of + 1, 4, 8: CopyProc := EncodeInterlacedPalette148; + 16: CopyProc := EncodeInterlacedGrayscale16; + end; + {RGB followed by alpha} + COLOR_RGBALPHA: + case Header.BitDepth of + 8: CopyProc := EncodeInterlacedRGBAlpha8; + 16: CopyProc := EncodeInterlacedRGBAlpha16; + end; + COLOR_GRAYSCALEALPHA: + {Grayscale followed by alpha} + case Header.BitDepth of + 8: CopyProc := EncodeInterlacedGrayscaleAlpha8; + 16: CopyProc := EncodeInterlacedGrayscaleAlpha16; + end; + end {case Header.ColorType}; + + {Compress the image using the seven passes for ADAM 7} + FOR CurrentPass := 0 TO 6 DO + begin + {Calculates the number of pixels and bytes for this pass row} + PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] + + ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass]; + Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType, + Header.BitDepth); + ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes); + + {Get current row index} + CurrentRow := RowStart[CurrentPass]; + {Get a pointer to the current row image data} + Data := Ptr(Longint(Header.ImageData) + Header.BytesPerRow * + (ImageHeight - 1 - CurrentRow)); + Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow); + + {Process all the image rows} + if Row_Bytes > 0 then + while CurrentRow < ImageHeight do + begin + {Copy data into buffer} + CopyProc(CurrentPass, Data, @Encode_Buffer[BUFFER][0], Trans); + {Filter data} + Filter := FilterToEncode; + + {Compress data} + IDATZlibWrite(ZLIBStream, @Filter, 1); + IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes); + + {Move to the next row} + inc(CurrentRow, RowIncrement[CurrentPass]); + {Move pointer to the next line} + dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow); + inc(Trans, RowIncrement[CurrentPass] * ImageWidth); + end {while CurrentRow < ImageHeight} + + end {CurrentPass}; + + {Compress and finishes copying the remaining data} + FinishIDATZlib(ZLIBStream); +end; + +{Filters the row to be encoded and returns the best filter} +function TChunkIDAT.FilterToEncode: Byte; +var + Run, LongestRun, ii, jj: Cardinal; + Last, Above, LastAbove: Byte; +begin + {Selecting more filters using the Filters property from TPngObject} + {increases the chances to the file be much smaller, but decreases} + {the performace} + + {This method will creates the same line data using the different} + {filter methods and select the best} + + {Sub-filter} + if pfSub in Owner.Filters then + for ii := 0 to Row_Bytes - 1 do + begin + {There is no previous pixel when it's on the first pixel, so} + {set last as zero when in the first} + if (ii >= Offset) then + last := Encode_Buffer[BUFFER]^[ii - Offset] + else + last := 0; + Encode_Buffer[FILTER_SUB]^[ii] := Encode_Buffer[BUFFER]^[ii] - last; + end; + + {Up filter} + if pfUp in Owner.Filters then + for ii := 0 to Row_Bytes - 1 do + Encode_Buffer[FILTER_UP]^[ii] := Encode_Buffer[BUFFER]^[ii] - + Encode_Buffer[FILTER_NONE]^[ii]; + + {Average filter} + if pfAverage in Owner.Filters then + for ii := 0 to Row_Bytes - 1 do + begin + {Get the previous pixel, if the current pixel is the first, the} + {previous is considered to be 0} + if (ii >= Offset) then + last := Encode_Buffer[BUFFER]^[ii - Offset] + else + last := 0; + {Get the pixel above} + above := Encode_Buffer[FILTER_NONE]^[ii]; + + {Calculates formula to the average pixel} + Encode_Buffer[FILTER_AVERAGE]^[ii] := Encode_Buffer[BUFFER]^[ii] - + (above + last) div 2 ; + end; + + {Paeth filter (the slower)} + if pfPaeth in Owner.Filters then + begin + {Initialize} + last := 0; + lastabove := 0; + for ii := 0 to Row_Bytes - 1 do + begin + {In case this pixel is not the first in the line obtains the} + {previous one and the one above the previous} + if (ii >= Offset) then + begin + last := Encode_Buffer[BUFFER]^[ii - Offset]; + lastabove := Encode_Buffer[FILTER_NONE]^[ii - Offset]; + end; + {Obtains the pixel above} + above := Encode_Buffer[FILTER_NONE]^[ii]; + {Calculate paeth filter for this byte} + Encode_Buffer[FILTER_PAETH]^[ii] := Encode_Buffer[BUFFER]^[ii] - + PaethPredictor(last, above, lastabove); + end; + end; + + {Now calculates the same line using no filter, which is necessary} + {in order to have data to the filters when the next line comes} + CopyMemory(@Encode_Buffer[FILTER_NONE]^[0], + @Encode_Buffer[BUFFER]^[0], Row_Bytes); + + {If only filter none is selected in the filter list, we don't need} + {to proceed and further} + if (Owner.Filters = [pfNone]) or (Owner.Filters = []) then + begin + Result := FILTER_NONE; + exit; + end {if (Owner.Filters = [pfNone...}; + + {Check which filter is the best by checking which has the larger} + {sequence of the same byte, since they are best compressed} + LongestRun := 0; Result := FILTER_NONE; + for ii := FILTER_NONE TO FILTER_PAETH do + {Check if this filter was selected} + if TFilter(ii) in Owner.Filters then + begin + Run := 0; + {Check if it's the only filter} + if Owner.Filters = [TFilter(ii)] then + begin + Result := ii; + exit; + end; + + {Check using a sequence of four bytes} + for jj := 2 to Row_Bytes - 1 do + if (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-1]) or + (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-2]) then + inc(Run); {Count the number of sequences} + + {Check if this one is the best so far} + if (Run > LongestRun) then + begin + Result := ii; + LongestRun := Run; + end {if (Run > LongestRun)}; + + end {if TFilter(ii) in Owner.Filters}; +end; + +{TChunkPLTE implementation} + +{Returns an item in the palette} +function TChunkPLTE.GetPaletteItem(Index: Byte): TRGBQuad; +begin + {Test if item is valid, if not raise error} + if Index > Count - 1 then + Owner.RaiseError(EPNGError, EPNGUnknownPalEntryText) + else + {Returns the item} + Result := Header.BitmapInfo.bmiColors[Index]; +end; + +{Loads the palette chunk from a stream} +function TChunkPLTE.LoadFromStream(Stream: TStream; + const ChunkName: TChunkName; Size: Integer): Boolean; +type + pPalEntry = ^PalEntry; + PalEntry = record + r, g, b: Byte; + end; +var + j : Integer; {For the FOR} + PalColor : pPalEntry; + palEntries: TMaxLogPalette; +begin + {Let ancestor load data and check CRC} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result then exit; + + {This chunk must be divisible by 3 in order to be valid} + if (Size mod 3 <> 0) or (Size div 3 > 256) then + begin + {Raise error} + Result := FALSE; + Owner.RaiseError(EPNGInvalidPalette, EPNGInvalidPaletteText); + exit; + end {if Size mod 3 <> 0}; + + {Fill array with the palette entries} + fCount := Size div 3; + Fillchar(palEntries, sizeof(palEntries), #0); + palEntries.palVersion := $300; + palEntries.palNumEntries := fCount; + PalColor := Data; + FOR j := 0 TO fCount - 1 DO + with palEntries.palPalEntry[j] do + begin + peRed := Owner.GammaTable[PalColor.r]; + peGreen := Owner.GammaTable[PalColor.g]; + peBlue := Owner.GammaTable[PalColor.b]; + peFlags := 0; + {Move to next palette entry} + inc(PalColor); + end; + Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^)); +end; + +{Saves the PLTE chunk to a stream} +function TChunkPLTE.SaveToStream(Stream: TStream): Boolean; +var + J: Integer; + DataPtr: pByte; + BitmapInfo: TMAXBITMAPINFO; + palEntries: TMaxLogPalette; +begin + {Adjust size to hold all the palette items} + if fCount = 0 then fCount := Header.BitmapInfo.bmiHeader.biClrUsed; + ResizeData(fCount * 3); + {Get all the palette entries} + fillchar(palEntries, sizeof(palEntries), #0); + GetPaletteEntries(Header.ImagePalette, 0, 256, palEntries.palPalEntry[0]); + {Copy pointer to data} + DataPtr := fData; + + {Copy palette items} + BitmapInfo := Header.BitmapInfo; + FOR j := 0 TO fCount - 1 DO + with palEntries.palPalEntry[j] do + begin + DataPtr^ := Owner.InverseGamma[peRed]; inc(DataPtr); + DataPtr^ := Owner.InverseGamma[peGreen]; inc(DataPtr); + DataPtr^ := Owner.InverseGamma[peBlue]; inc(DataPtr); + end {with BitmapInfo}; + + {Let ancestor do the rest of the work} + Result := inherited SaveToStream(Stream); +end; + +{Assigns from another PLTE chunk} +procedure TChunkPLTE.Assign(Source: TChunk); +begin + {Copy the number of palette items} + if Source is TChunkPLTE then + fCount := TChunkPLTE(Source).fCount + else + Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText); +end; + +{TChunkgAMA implementation} + +{Assigns from another chunk} +procedure TChunkgAMA.Assign(Source: TChunk); +begin + {Copy the gamma value} + if Source is TChunkgAMA then + Gamma := TChunkgAMA(Source).Gamma + else + Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText); +end; + +{Gamma chunk being created} +constructor TChunkgAMA.Create(Owner: TPngObject); +begin + {Call ancestor} + inherited Create(Owner); + Gamma := 1; {Initial value} +end; + +{Returns gamma value} +function TChunkgAMA.GetValue: Cardinal; +begin + {Make sure that the size is four bytes} + if DataSize <> 4 then + begin + {Adjust size and returns 1} + ResizeData(4); + Result := 1; + end + {If it's right, read the value} + else Result := Cardinal(ByteSwap(pCardinal(Data)^)) +end; + +function Power(Base, Exponent: Extended): Extended; +begin + if Exponent = 0.0 then + Result := 1.0 {Math rule} + else if (Base = 0) or (Exponent = 0) then Result := 0 + else + Result := Exp(Exponent * Ln(Base)); +end; + +{Loading the chunk from a stream} +function TChunkgAMA.LoadFromStream(Stream: TStream; + const ChunkName: TChunkName; Size: Integer): Boolean; +var + i: Integer; + Value: Cardinal; +begin + {Call ancestor and test if it went ok} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result then exit; + Value := Gamma; + {Build gamma table and inverse table for saving} + if Value <> 0 then + with Owner do + FOR i := 0 TO 255 DO + begin + GammaTable[I] := Round(Power((I / 255), 1 / + (Value / 100000 * 2.2)) * 255); + InverseGamma[Round(Power((I / 255), 1 / + (Value / 100000 * 2.2)) * 255)] := I; + end +end; + +{Sets the gamma value} +procedure TChunkgAMA.SetValue(const Value: Cardinal); +begin + {Make sure that the size is four bytes} + if DataSize <> 4 then ResizeData(4); + {If it's right, set the value} + pCardinal(Data)^ := ByteSwap(Value); +end; + +{TPngObject implementation} + +{Assigns from another object} +procedure TPngObject.Assign(Source: TPersistent); +begin + {Being cleared} + if Source = nil then + ClearChunks + {Assigns contents from another TPNGObject} + else if Source is TPNGObject then + AssignPNG(Source as TPNGObject) + {Copy contents from a TBitmap} + {$IFDEF UseDelphi}else if Source is TBitmap then + with Source as TBitmap do + AssignHandle(Handle, Transparent, + ColorToRGB(TransparentColor)){$ENDIF} + {Unknown source, let ancestor deal with it} + else + inherited; +end; + +{Clear all the chunks in the list} +procedure TPngObject.ClearChunks; +var + i: Integer; +begin + {Initialize gamma} + InitializeGamma(); + {Free all the objects and memory (0 chunks Bug fixed by Noel Sharpe)} + for i := 0 TO Integer(Chunks.Count) - 1 do + TChunk(Chunks.Item[i]).Free; + Chunks.Count := 0; +end; + +{Portable Network Graphics object being created as a blank image} +constructor TPNGObject.CreateBlank(ColorType, BitDepth: Cardinal; + cx, cy: Integer); +var NewIHDR: TChunkIHDR; +begin + {Calls creator} + Create; + {Checks if the parameters are ok} + if not (ColorType in [COLOR_GRAYSCALE, COLOR_RGB, COLOR_PALETTE, + COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA]) or not (BitDepth in + [1,2,4,8, 16]) or ((ColorType = COLOR_PALETTE) and (BitDepth = 16)) or + ((ColorType = COLOR_RGB) and (BitDepth < 8)) then + begin + RaiseError(EPNGInvalidSpec, EInvalidSpec); + exit; + end; + if Bitdepth = 2 then Bitdepth := 4; + + {Add the basis chunks} + InitializeGamma; + BeingCreated := True; + Chunks.Add(TChunkIEND); + NewIHDR := Chunks.Add(TChunkIHDR) as TChunkIHDR; + NewIHDR.IHDRData.ColorType := ColorType; + NewIHDR.IHDRData.BitDepth := BitDepth; + NewIHDR.IHDRData.Width := cx; + NewIHDR.IHDRData.Height := cy; + NewIHDR.PrepareImageData; + if NewIHDR.HasPalette then + TChunkPLTE(Chunks.Add(TChunkPLTE)).fCount := 1 shl BitDepth; + Chunks.Add(TChunkIDAT); + BeingCreated := False; +end; + +{Portable Network Graphics object being created} +constructor TPngObject.Create; +begin + {Let it be created} + inherited Create; + + {Initial properties} + {$IFDEF UseDelphi}fCanvas := TCanvas.Create;{$ENDIF} + fFilters := [pfSub]; + fCompressionLevel := 7; + fInterlaceMethod := imNone; + fMaxIdatSize := High(Word); + {Create chunklist object} + fChunkList := TPngList.Create(Self); + +end; + +{Portable Network Graphics object being destroyed} +destructor TPngObject.Destroy; +begin + {Free object list} + ClearChunks; + fChunkList.Free; + {$IFDEF UseDelphi}if fCanvas <> nil then + fCanvas.Free;{$ENDIF} + + {Call ancestor destroy} + inherited Destroy; +end; + +{Returns linesize and byte offset for pixels} +procedure TPngObject.GetPixelInfo(var LineSize, Offset: Cardinal); +begin + {There must be an Header chunk to calculate size} + if HeaderPresent then + begin + {Calculate number of bytes for each line} + LineSize := BytesForPixels(Header.Width, Header.ColorType, Header.BitDepth); + + {Calculates byte offset} + Case Header.ColorType of + {Grayscale} + COLOR_GRAYSCALE: + If Header.BitDepth = 16 Then + Offset := 2 + Else + Offset := 1 ; + {It always smaller or equal one byte, so it occupes one byte} + COLOR_PALETTE: + offset := 1; + {It might be 3 or 6 bytes} + COLOR_RGB: + offset := 3 * Header.BitDepth Div 8; + {It might be 2 or 4 bytes} + COLOR_GRAYSCALEALPHA: + offset := 2 * Header.BitDepth Div 8; + {4 or 8 bytes} + COLOR_RGBALPHA: + offset := 4 * Header.BitDepth Div 8; + else + Offset := 0; + End ; + + end + else + begin + {In case if there isn't any Header chunk} + Offset := 0; + LineSize := 0; + end; + +end; + +{Returns image height} +function TPngObject.GetHeight: Integer; +begin + {There must be a Header chunk to get the size, otherwise returns 0} + if HeaderPresent then + Result := TChunkIHDR(Chunks.Item[0]).Height + else Result := 0; +end; + +{Returns image width} +function TPngObject.GetWidth: Integer; +begin + {There must be a Header chunk to get the size, otherwise returns 0} + if HeaderPresent then + Result := Header.Width + else Result := 0; +end; + +{Returns if the image is empty} +function TPngObject.GetEmpty: Boolean; +begin + Result := (Chunks.Count = 0); +end; + +{Raises an error} +procedure TPngObject.RaiseError(ExceptionClass: ExceptClass; Text: String); +begin + raise ExceptionClass.Create(Text); +end; + +{Set the maximum size for IDAT chunk} +procedure TPngObject.SetMaxIdatSize(const Value: Integer); +begin + {Make sure the size is at least 65535} + if Value < High(Word) then + fMaxIdatSize := High(Word) else fMaxIdatSize := Value; +end; + +{Draws the image using pixel information from TChunkpHYs} +procedure TPNGObject.DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint); + function Rect(Left, Top, Right, Bottom: Integer): TRect; + begin + Result.Left := Left; + Result.Top := Top; + Result.Right := Right; + Result.Bottom := Bottom; + end; +var + PPMeterY, PPMeterX: Double; + NewSizeX, NewSizeY: Integer; + DC: HDC; +begin + {Get system information} + DC := GetDC(0); + PPMeterY := GetDeviceCaps(DC, LOGPIXELSY) / 0.0254; + PPMeterX := GetDeviceCaps(DC, LOGPIXELSX) / 0.0254; + ReleaseDC(0, DC); + + {In case it does not has pixel information} + if not HasPixelInformation then + Draw(Canvas, Rect(Point.X, Point.Y, Point.X + Width, + Point.Y + Height)) + else + with PixelInformation do + begin + NewSizeX := Trunc(Self.Width / (PPUnitX / PPMeterX)); + NewSizeY := Trunc(Self.Height / (PPUnitY / PPMeterY)); + Draw(Canvas, Rect(Point.X, Point.Y, Point.X + NewSizeX, + Point.Y + NewSizeY)); + end; +end; + +{$IFNDEF UseDelphi} + {Creates a file stream reading from the filename in the parameter and load} + procedure TPngObject.LoadFromFile(const Filename: String); + var + FileStream: TFileStream; + begin + {Test if the file exists} + if not FileExists(Filename) then + begin + {In case it does not exists, raise error} + RaiseError(EPNGNotExists, EPNGNotExistsText); + exit; + end; + + {Creates the file stream to read} + FileStream := TFileStream.Create(Filename, [fsmRead]); + LoadFromStream(FileStream); {Loads the data} + FileStream.Free; {Free file stream} + end; + + {Saves the current png image to a file} + procedure TPngObject.SaveToFile(const Filename: String); + var + FileStream: TFileStream; + begin + {Creates the file stream to write} + FileStream := TFileStream.Create(Filename, [fsmWrite]); + SaveToStream(FileStream); {Saves the data} + FileStream.Free; {Free file stream} + end; + +{$ENDIF} + +{Returns if it has the pixel information chunk} +function TPngObject.HasPixelInformation: Boolean; +begin + Result := (Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs) <> nil; +end; + +{Returns the pixel information chunk} +function TPngObject.GetPixelInformation: TChunkpHYs; +begin + Result := Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs; + if not Assigned(Result) then + begin + Result := Chunks.Add(tChunkpHYs) as tChunkpHYs; + Result.fUnit := utMeter; + end; +end; + +{Returns pointer to the chunk TChunkIHDR which should be the first} +function TPngObject.GetHeader: TChunkIHDR; +begin + {If there is a TChunkIHDR returns it, otherwise returns nil} + if (Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR) then + Result := Chunks.Item[0] as TChunkIHDR + else + begin + {No header, throw error message} + RaiseError(EPNGHeaderNotPresent, EPNGHeaderNotPresentText); + Result := nil + end +end; + +{Draws using partial transparency} +procedure TPngObject.DrawPartialTrans(DC: HDC; Rect: TRect); + {Adjust the rectangle structure} + procedure AdjustRect(var Rect: TRect); + var + t: Integer; + begin + if Rect.Right < Rect.Left then + begin + t := Rect.Right; + Rect.Right := Rect.Left; + Rect.Left := t; + end; + if Rect.Bottom < Rect.Top then + begin + t := Rect.Bottom; + Rect.Bottom := Rect.Top; + Rect.Top := t; + end + end; + +type + {Access to pixels} + TPixelLine = Array[Word] of TRGBQuad; + pPixelLine = ^TPixelLine; +const + {Structure used to create the bitmap} + BitmapInfoHeader: TBitmapInfoHeader = + (biSize: sizeof(TBitmapInfoHeader); + biWidth: 100; + biHeight: 100; + biPlanes: 1; + biBitCount: 32; + biCompression: BI_RGB; + biSizeImage: 0; + biXPelsPerMeter: 0; + biYPelsPerMeter: 0; + biClrUsed: 0; + biClrImportant: 0); +var + {Buffer bitmap creation} + BitmapInfo : TBitmapInfo; + BufferDC : HDC; + BufferBits : Pointer; + OldBitmap, + BufferBitmap: HBitmap; + Header: TChunkIHDR; + + {Transparency/palette chunks} + TransparencyChunk: TChunktRNS; + PaletteChunk: TChunkPLTE; + TransValue, PaletteIndex: Byte; + CurBit: Integer; + Data: PByte; + + {Buffer bitmap modification} + BytesPerRowDest, + BytesPerRowSrc, + BytesPerRowAlpha: Integer; + ImageSource, ImageSourceOrg, + AlphaSource : pByteArray; + ImageData : pPixelLine; + i, j, i2, j2 : Integer; + + {For bitmap stretching} + W, H : Cardinal; + Stretch : Boolean; + FactorX, FactorY: Double; +begin + {Prepares the rectangle structure to stretch draw} + if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then exit; + AdjustRect(Rect); + {Gets the width and height} + W := Rect.Right - Rect.Left; + H := Rect.Bottom - Rect.Top; + Header := Self.Header; {Fast access to header} + Stretch := (W <> Header.Width) or (H <> Header.Height); + if Stretch then FactorX := W / Header.Width else FactorX := 1; + if Stretch then FactorY := H / Header.Height else FactorY := 1; + + {Prepare to create the bitmap} + Fillchar(BitmapInfo, sizeof(BitmapInfo), #0); + BitmapInfoHeader.biWidth := W; + BitmapInfoHeader.biHeight := -Integer(H); + BitmapInfo.bmiHeader := BitmapInfoHeader; + + {Create the bitmap which will receive the background, the applied} + {alpha blending and then will be painted on the background} + BufferDC := CreateCompatibleDC(0); + {In case BufferDC could not be created} + if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText); + BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS, + BufferBits, 0, 0); + {In case buffer bitmap could not be created} + if (BufferBitmap = 0) or (BufferBits = Nil) then + begin + if BufferBitmap <> 0 then DeleteObject(BufferBitmap); + DeleteDC(BufferDC); + RaiseError(EPNGOutMemory, EPNGOutMemoryText); + end; + + {Selects new bitmap and release old bitmap} + OldBitmap := SelectObject(BufferDC, BufferBitmap); + + {Draws the background on the buffer image} + BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY); + + {Obtain number of bytes for each row} + BytesPerRowAlpha := Header.Width; + BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * W) + 31) + and not 31) div 8; {Number of bytes for each image row in destination} + BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) + + 31) and not 31) div 8; {Number of bytes for each image row in source} + + {Obtains image pointers} + ImageData := BufferBits; + AlphaSource := Header.ImageAlpha; + Longint(ImageSource) := Longint(Header.ImageData) + + Header.BytesPerRow * Longint(Header.Height - 1); + ImageSourceOrg := ImageSource; + + case Header.BitmapInfo.bmiHeader.biBitCount of + {R, G, B images} + 24: + FOR j := 1 TO H DO + begin + {Process all the pixels in this line} + FOR i := 0 TO W - 1 DO + begin + if Stretch then i2 := trunc(i / FactorX) else i2 := i; + {Optmize when we donґt have transparency} + if (AlphaSource[i2] <> 0) then + if (AlphaSource[i2] = 255) then + ImageData[i] := pRGBQuad(@ImageSource[i2 * 3])^ + else + with ImageData[i] do + begin + rgbRed := (255+ImageSource[2+i2*3] * AlphaSource[i2] + rgbRed * + (not AlphaSource[i2])) shr 8; + rgbGreen := (255+ImageSource[1+i2*3] * AlphaSource[i2] + + rgbGreen * (not AlphaSource[i2])) shr 8; + rgbBlue := (255+ImageSource[i2*3] * AlphaSource[i2] + rgbBlue * + (not AlphaSource[i2])) shr 8; + end; + end; + + {Move pointers} + inc(Longint(ImageData), BytesPerRowDest); + if Stretch then j2 := trunc(j / FactorY) else j2 := j; + Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2; + Longint(AlphaSource) := Longint(Header.ImageAlpha) + + BytesPerRowAlpha * j2; + end; + {Palette images with 1 byte for each pixel} + 1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then + FOR j := 1 TO H DO + begin + {Process all the pixels in this line} + FOR i := 0 TO W - 1 DO + with ImageData[i], Header.BitmapInfo do begin + if Stretch then i2 := trunc(i / FactorX) else i2 := i; + rgbRed := (255 + ImageSource[i2] * AlphaSource[i2] + + rgbRed * (255 - AlphaSource[i2])) shr 8; + rgbGreen := (255 + ImageSource[i2] * AlphaSource[i2] + + rgbGreen * (255 - AlphaSource[i2])) shr 8; + rgbBlue := (255 + ImageSource[i2] * AlphaSource[i2] + + rgbBlue * (255 - AlphaSource[i2])) shr 8; + end; + + {Move pointers} + Longint(ImageData) := Longint(ImageData) + BytesPerRowDest; + if Stretch then j2 := trunc(j / FactorY) else j2 := j; + Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2; + Longint(AlphaSource) := Longint(Header.ImageAlpha) + + BytesPerRowAlpha * j2; + end + else {Palette images} + begin + {Obtain pointer to the transparency chunk} + TransparencyChunk := TChunktRNS(Chunks.ItemFromClass(TChunktRNS)); + PaletteChunk := TChunkPLTE(Chunks.ItemFromClass(TChunkPLTE)); + + FOR j := 1 TO H DO + begin + {Process all the pixels in this line} + i := 0; + repeat + CurBit := 0; + if Stretch then i2 := trunc(i / FactorX) else i2 := i; + Data := @ImageSource[i2]; + + repeat + {Obtains the palette index} + case Header.BitDepth of + 1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1; + 2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F; + else PaletteIndex := Data^; + end; + + {Updates the image with the new pixel} + with ImageData[i] do + begin + TransValue := TransparencyChunk.PaletteValues[PaletteIndex]; + rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed * + TransValue + rgbRed * (255 - TransValue)) shr 8; + rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen * + TransValue + rgbGreen * (255 - TransValue)) shr 8; + rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue * + TransValue + rgbBlue * (255 - TransValue)) shr 8; + end; + + {Move to next data} + inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount); + until CurBit >= 8; + {Move to next source data} + //inc(Data); + until i >= Integer(W); + + {Move pointers} + Longint(ImageData) := Longint(ImageData) + BytesPerRowDest; + if Stretch then j2 := trunc(j / FactorY) else j2 := j; + Longint(ImageSource) := Longint(ImageSourceOrg) - BytesPerRowSrc * j2; + end + end {Palette images} + end {case Header.BitmapInfo.bmiHeader.biBitCount}; + + {Draws the new bitmap on the foreground} + BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY); + + {Free bitmap} + SelectObject(BufferDC, OldBitmap); + DeleteObject(BufferBitmap); + DeleteDC(BufferDC); +end; + +{Draws the image into a canvas} +procedure TPngObject.Draw(ACanvas: TCanvas; const Rect: TRect); +var + Header: TChunkIHDR; +begin + {Quit in case there is no header, otherwise obtain it} + if Empty then Exit; + Header := Chunks.GetItem(0) as TChunkIHDR; + + {Copy the data to the canvas} + case Self.TransparencyMode of + {$IFDEF PartialTransparentDraw} + ptmPartial: + DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect); + {$ENDIF} + ptmBit: DrawTransparentBitmap(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, + Header.ImageData, Header.BitmapInfo.bmiHeader, + pBitmapInfo(@Header.BitmapInfo), Rect, + {$IFDEF UseDelphi}ColorToRGB({$ENDIF}TransparentColor) + {$IFDEF UseDelphi}){$ENDIF} + else + begin + SetStretchBltMode(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, COLORONCOLOR); + StretchDiBits(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect.Left, + Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0, + Header.Width, Header.Height, Header.ImageData, + pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY) + end + end {case} +end; + +{Characters for the header} +const + PngHeader: Array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10); + +{Loads the image from a stream of data} +procedure TPngObject.LoadFromStream(Stream: TStream); +var + Header : Array[0..7] of Char; + HasIDAT : Boolean; + + {Chunks reading} + ChunkCount : Cardinal; + ChunkLength: Cardinal; + ChunkName : TChunkName; +begin + {Initialize before start loading chunks} + ChunkCount := 0; + ClearChunks(); + {Reads the header} + Stream.Read(Header[0], 8); + + {Test if the header matches} + if Header <> PngHeader then + begin + RaiseError(EPNGInvalidFileHeader, EPNGInvalidFileHeaderText); + Exit; + end; + + + HasIDAT := FALSE; + Chunks.Count := 10; + + {Load chunks} + repeat + inc(ChunkCount); {Increment number of chunks} + if Chunks.Count < ChunkCount then {Resize the chunks list if needed} + Chunks.Count := Chunks.Count + 10; + + {Reads chunk length and invert since it is in network order} + {also checks the Read method return, if it returns 0, it} + {means that no bytes was readed, probably because it reached} + {the end of the file} + if Stream.Read(ChunkLength, 4) = 0 then + begin + {In case it found the end of the file here} + Chunks.Count := ChunkCount - 1; + RaiseError(EPNGUnexpectedEnd, EPNGUnexpectedEndText); + end; + + ChunkLength := ByteSwap(ChunkLength); + {Reads chunk name} + Stream.Read(Chunkname, 4); + + {Here we check if the first chunk is the Header which is necessary} + {to the file in order to be a valid Portable Network Graphics image} + if (ChunkCount = 1) and (ChunkName <> 'IHDR') then + begin + Chunks.Count := ChunkCount - 1; + RaiseError(EPNGIHDRNotFirst, EPNGIHDRNotFirstText); + exit; + end; + + {Has a previous IDAT} + if (HasIDAT and (ChunkName = 'IDAT')) or (ChunkName = 'cHRM') then + begin + dec(ChunkCount); + Stream.Seek(ChunkLength + 4, soFromCurrent); + Continue; + end; + {Tell it has an IDAT chunk} + if ChunkName = 'IDAT' then HasIDAT := TRUE; + + {Creates object for this chunk} + Chunks.SetItem(ChunkCount - 1, CreateClassChunk(Self, ChunkName)); + + {Check if the chunk is critical and unknown} + {$IFDEF ErrorOnUnknownCritical} + if (TChunk(Chunks.Item[ChunkCount - 1]).ClassType = TChunk) and + ((Byte(ChunkName[0]) AND $20) = 0) and (ChunkName <> '') then + begin + Chunks.Count := ChunkCount; + RaiseError(EPNGUnknownCriticalChunk, EPNGUnknownCriticalChunkText); + end; + {$ENDIF} + + {Loads it} + try if not TChunk(Chunks.Item[ChunkCount - 1]).LoadFromStream(Stream, + ChunkName, ChunkLength) then break; + except + Chunks.Count := ChunkCount; + raise; + end; + + {Terminates when it reaches the IEND chunk} + until (ChunkName = 'IEND'); + + {Resize the list to the appropriate size} + Chunks.Count := ChunkCount; + + {Check if there is data} + if not HasIDAT then + RaiseError(EPNGNoImageData, EPNGNoImageDataText); +end; + +{Changing height is not supported} +procedure TPngObject.SetHeight(Value: Integer); +begin + Resize(Width, Value) +end; + +{Changing width is not supported} +procedure TPngObject.SetWidth(Value: Integer); +begin + Resize(Value, Height) +end; + +{$IFDEF UseDelphi} +{Saves to clipboard format (thanks to Antoine Pottern)} +procedure TPNGObject.SaveToClipboardFormat(var AFormat: Word; + var AData: THandle; var APalette: HPalette); +begin + with TBitmap.Create do + try + Width := Self.Width; + Height := Self.Height; + Self.Draw(Canvas, Rect(0, 0, Width, Height)); + SaveToClipboardFormat(AFormat, AData, APalette); + finally + Free; + end {try} +end; + +{Loads data from clipboard} +procedure TPngObject.LoadFromClipboardFormat(AFormat: Word; + AData: THandle; APalette: HPalette); +begin + with TBitmap.Create do + try + LoadFromClipboardFormat(AFormat, AData, APalette); + Self.AssignHandle(Handle, False, 0); + finally + Free; + end {try} +end; + +{Returns if the image is transparent} +function TPngObject.GetTransparent: Boolean; +begin + Result := (TransparencyMode <> ptmNone); +end; + +{$ENDIF} + +{Saving the PNG image to a stream of data} +procedure TPngObject.SaveToStream(Stream: TStream); +var + j: Integer; +begin + {Reads the header} + Stream.Write(PNGHeader[0], 8); + {Write each chunk} + FOR j := 0 TO Chunks.Count - 1 DO + Chunks.Item[j].SaveToStream(Stream) +end; + +{Prepares the Header chunk} +procedure BuildHeader(Header: TChunkIHDR; Handle: HBitmap; Info: pBitmap); +var + DC: HDC; +begin + {Set width and height} + Header.Width := Info.bmWidth; + Header.Height := abs(Info.bmHeight); + {Set bit depth} + if Info.bmBitsPixel >= 16 then + Header.BitDepth := 8 else Header.BitDepth := Info.bmBitsPixel; + {Set color type} + if Info.bmBitsPixel >= 16 then + Header.ColorType := COLOR_RGB else Header.ColorType := COLOR_PALETTE; + {Set other info} + Header.CompressionMethod := 0; {deflate/inflate} + Header.InterlaceMethod := 0; {no interlace} + + {Prepares bitmap headers to hold data} + Header.PrepareImageData(); + {Copy image data} + DC := CreateCompatibleDC(0); + GetDIBits(DC, Handle, 0, Header.Height, Header.ImageData, + pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS); + + DeleteDC(DC); +end; + +{Loads the image from a resource} +procedure TPngObject.LoadFromResourceName(Instance: HInst; + const Name: String); +var + ResStream: TResourceStream; +begin + {Creates an especial stream to load from the resource} + try ResStream := TResourceStream.Create(Instance, Name, RT_RCDATA); + except RaiseError(EPNGCouldNotLoadResource, EPNGCouldNotLoadResourceText); + exit; end; + + {Loads the png image from the resource} + try + LoadFromStream(ResStream); + finally + ResStream.Free; + end; +end; + +{Loads the png from a resource ID} +procedure TPngObject.LoadFromResourceID(Instance: HInst; ResID: Integer); +begin + LoadFromResourceName(Instance, String(ResID)); +end; + +{Assigns this tpngobject to another object} +procedure TPngObject.AssignTo(Dest: TPersistent); +{$IFDEF UseDelphi} + function DetectPixelFormat: TPixelFormat; + begin + with Header do + begin + {Always use 24bits for partial transparency} + if TransparencyMode = ptmPartial then + DetectPixelFormat := pf24bit + else + case BitDepth of + {Only supported by COLOR_PALETTE} + 1: DetectPixelFormat := pf1bit; + 2, 4: DetectPixelFormat := pf4bit; + {8 may be palette or r, g, b values} + 8, 16: + case ColorType of + COLOR_RGB, COLOR_GRAYSCALE: DetectPixelFormat := pf24bit; + COLOR_PALETTE: DetectPixelFormat := pf8bit; + else raise Exception.Create(''); + end {case ColorFormat of} + else raise Exception.Create(''); + end {case BitDepth of} + end {with Header} + end; +var + TRNS: TChunkTRNS; +{$ENDIF} +begin + {If the destination is also a TPNGObject make it assign} + {this one} + if Dest is TPNGObject then + TPNGObject(Dest).AssignPNG(Self) + {$IFDEF UseDelphi} + {In case the destination is a bitmap} + else if (Dest is TBitmap) and HeaderPresent then + begin + {Copies the handle using CopyImage API} + TBitmap(Dest).PixelFormat := DetectPixelFormat; + TBitmap(Dest).Width := Width; + TBitmap(Dest).Height := Height; + TBitmap(Dest).Canvas.Draw(0, 0, Self); + + {Copy transparency mode} + if (TransparencyMode = ptmBit) then + begin + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + TBitmap(Dest).TransparentColor := TRNS.TransparentColor; + TBitmap(Dest).Transparent := True + end {if (TransparencyMode = ptmBit)} + + end + else + {Unknown destination kind} + inherited AssignTo(Dest); + {$ENDIF} +end; + +{Assigns from a bitmap object} +procedure TPngObject.AssignHandle(Handle: HBitmap; Transparent: Boolean; + TransparentColor: ColorRef); +var + BitmapInfo: Windows.TBitmap; + {Chunks} + Header: TChunkIHDR; + PLTE: TChunkPLTE; + IDAT: TChunkIDAT; + IEND: TChunkIEND; + TRNS: TChunkTRNS; + i: Integer; + palEntries : TMaxLogPalette; +begin + {Obtain bitmap info} + GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo); + + {Clear old chunks and prepare} + ClearChunks(); + + {Create the chunks} + Header := TChunkIHDR.Create(Self); + + {This method will fill the Header chunk with bitmap information} + {and copy the image data} + BuildHeader(Header, Handle, @BitmapInfo); + + if Header.HasPalette then PLTE := TChunkPLTE.Create(Self) else PLTE := nil; + if Transparent then TRNS := TChunkTRNS.Create(Self) else TRNS := nil; + IDAT := TChunkIDAT.Create(Self); + IEND := TChunkIEND.Create(Self); + + {Add chunks} + TPNGPointerList(Chunks).Add(Header); + if Header.HasPalette then TPNGPointerList(Chunks).Add(PLTE); + if Transparent then TPNGPointerList(Chunks).Add(TRNS); + TPNGPointerList(Chunks).Add(IDAT); + TPNGPointerList(Chunks).Add(IEND); + + {In case there is a image data, set the PLTE chunk fCount variable} + {to the actual number of palette colors which is 2^(Bits for each pixel)} + if Header.HasPalette then + begin + PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel; + + {Create and set palette} + fillchar(palEntries, sizeof(palEntries), 0); + palEntries.palVersion := $300; + palEntries.palNumEntries := 1 shl BitmapInfo.bmBitsPixel; + for i := 0 to palEntries.palNumEntries - 1 do + begin + palEntries.palPalEntry[i].peRed := Header.BitmapInfo.bmiColors[i].rgbRed; + palEntries.palPalEntry[i].peGreen := Header.BitmapInfo.bmiColors[i].rgbGreen; + palEntries.palPalEntry[i].peBlue := Header.BitmapInfo.bmiColors[i].rgbBlue; + end; + DoSetPalette(CreatePalette(pLogPalette(@palEntries)^), false); + end; + + {In case it is a transparent bitmap, prepares it} + if Transparent then TRNS.TransparentColor := TransparentColor; +end; + +{Assigns from another PNG} +procedure TPngObject.AssignPNG(Source: TPNGObject); +var + J: Integer; +begin + {Copy properties} + InterlaceMethod := Source.InterlaceMethod; + MaxIdatSize := Source.MaxIdatSize; + CompressionLevel := Source.CompressionLevel; + Filters := Source.Filters; + + {Clear old chunks and prepare} + ClearChunks(); + Chunks.Count := Source.Chunks.Count; + {Create chunks and makes a copy from the source} + FOR J := 0 TO Chunks.Count - 1 DO + with Source.Chunks do + begin + Chunks.SetItem(J, TChunkClass(TChunk(Item[J]).ClassType).Create(Self)); + TChunk(Chunks.Item[J]).Assign(TChunk(Item[J])); + end {with}; +end; + +{Returns a alpha data scanline} +function TPngObject.GetAlphaScanline(const LineIndex: Integer): pByteArray; +begin + with Header do + if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then + Longint(Result) := Longint(ImageAlpha) + (LineIndex * Longint(Width)) + else Result := nil; {In case the image does not use alpha information} +end; + +{$IFDEF Store16bits} +{Returns a png data extra scanline} +function TPngObject.GetExtraScanline(const LineIndex: Integer): Pointer; +begin + with Header do + Longint(Result) := (Longint(ExtraImageData) + ((Longint(Height) - 1) * + BytesPerRow)) - (LineIndex * BytesPerRow); +end; +{$ENDIF} + +{Returns a png data scanline} +function TPngObject.GetScanline(const LineIndex: Integer): Pointer; +begin + with Header do + Longint(Result) := (Longint(ImageData) + ((Longint(Height) - 1) * + BytesPerRow)) - (LineIndex * BytesPerRow); +end; + +{Initialize gamma table} +procedure TPngObject.InitializeGamma; +var + i: Integer; +begin + {Build gamma table as if there was no gamma} + FOR i := 0 to 255 do + begin + GammaTable[i] := i; + InverseGamma[i] := i; + end {for i} +end; + +{Returns the transparency mode used by this png} +function TPngObject.GetTransparencyMode: TPNGTransparencyMode; +var + TRNS: TChunkTRNS; +begin + with Header do + begin + Result := ptmNone; {Default result} + {Gets the TRNS chunk pointer} + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + + {Test depending on the color type} + case ColorType of + {This modes are always partial} + COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Result := ptmPartial; + {This modes support bit transparency} + COLOR_RGB, COLOR_GRAYSCALE: if TRNS <> nil then Result := ptmBit; + {Supports booth translucid and bit} + COLOR_PALETTE: + {A TRNS chunk must be present, otherwise it won't support transparency} + if TRNS <> nil then + if TRNS.BitTransparency then + Result := ptmBit else Result := ptmPartial + end {case} + + end {with Header} +end; + +{Add a text chunk} +procedure TPngObject.AddtEXt(const Keyword, Text: String); +var + TextChunk: TChunkTEXT; +begin + TextChunk := Chunks.Add(TChunkText) as TChunkTEXT; + TextChunk.Keyword := Keyword; + TextChunk.Text := Text; +end; + +{Add a text chunk} +procedure TPngObject.AddzTXt(const Keyword, Text: String); +var + TextChunk: TChunkzTXt; +begin + TextChunk := Chunks.Add(TChunkzTXt) as TChunkzTXt; + TextChunk.Keyword := Keyword; + TextChunk.Text := Text; +end; + +{Removes the image transparency} +procedure TPngObject.RemoveTransparency; +var + TRNS: TChunkTRNS; +begin + {Removes depending on the color type} + with Header do + case ColorType of + {Palette uses the TChunktRNS to store alpha} + COLOR_PALETTE: + begin + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + if TRNS <> nil then Chunks.RemoveChunk(TRNS) + end; + {Png allocates different memory space to hold alpha information} + {for these types} + COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA: + begin + {Transform into the appropriate color type} + if ColorType = COLOR_GRAYSCALEALPHA then + ColorType := COLOR_GRAYSCALE + else ColorType := COLOR_RGB; + {Free the pointer data} + if ImageAlpha <> nil then FreeMem(ImageAlpha); + ImageAlpha := nil + end + end +end; + +{Generates alpha information} +procedure TPngObject.CreateAlpha; +var + TRNS: TChunkTRNS; +begin + {Generates depending on the color type} + with Header do + case ColorType of + {Png allocates different memory space to hold alpha information} + {for these types} + COLOR_GRAYSCALE, COLOR_RGB: + begin + {Transform into the appropriate color type} + if ColorType = COLOR_GRAYSCALE then + ColorType := COLOR_GRAYSCALEALPHA + else ColorType := COLOR_RGBALPHA; + {Allocates memory to hold alpha information} + GetMem(ImageAlpha, Integer(Width) * Integer(Height)); + FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #255); + end; + {Palette uses the TChunktRNS to store alpha} + COLOR_PALETTE: + begin + {Gets/creates TRNS chunk} + if Chunks.ItemFromClass(TChunkTRNS) = nil then + TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS + else + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + + {Prepares the TRNS chunk} + with TRNS do + begin + ResizeData(256); + Fillchar(PaletteValues[0], 256, 255); + fDataSize := 1 shl Header.BitDepth; + fBitTransparency := False + end {with Chunks.Add}; + end; + end {case Header.ColorType} + +end; + +{Returns transparent color} +function TPngObject.GetTransparentColor: TColor; +var + TRNS: TChunkTRNS; +begin + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + {Reads the transparency chunk to get this info} + if Assigned(TRNS) then Result := TRNS.TransparentColor + else Result := 0 +end; + +{$OPTIMIZATION OFF} +procedure TPngObject.SetTransparentColor(const Value: TColor); +var + TRNS: TChunkTRNS; +begin + if HeaderPresent then + {Tests the ColorType} + case Header.ColorType of + {Not allowed for this modes} + COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Self.RaiseError( + EPNGCannotChangeTransparent, EPNGCannotChangeTransparentText); + {Allowed} + COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE: + begin + TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS; + if not Assigned(TRNS) then TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS; + + {Sets the transparency value from TRNS chunk} + TRNS.TransparentColor := {$IFDEF UseDelphi}ColorToRGB({$ENDIF}Value + {$IFDEF UseDelphi}){$ENDIF} + end {COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE)} + end {case} +end; + +{Returns if header is present} +function TPngObject.HeaderPresent: Boolean; +begin + Result := ((Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR)) +end; + +{Returns pixel for png using palette and grayscale} +function GetByteArrayPixel(const png: TPngObject; const X, Y: Integer): TColor; +var + ByteData: Byte; + DataDepth: Byte; +begin + with png, Header do + begin + {Make sure the bitdepth is not greater than 8} + DataDepth := BitDepth; + if DataDepth > 8 then DataDepth := 8; + {Obtains the byte containing this pixel} + ByteData := pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)]; + {Moves the bits we need to the right} + ByteData := (ByteData shr ((8 - DataDepth) - + (X mod (8 div DataDepth)) * DataDepth)); + {Discard the unwanted pixels} + ByteData:= ByteData and ($FF shr (8 - DataDepth)); + + {For palette mode map the palette entry and for grayscale convert and + returns the intensity} + case ColorType of + COLOR_PALETTE: + with TChunkPLTE(png.Chunks.ItemFromClass(TChunkPLTE)).Item[ByteData] do + Result := rgb(GammaTable[rgbRed], GammaTable[rgbGreen], + GammaTable[rgbBlue]); + COLOR_GRAYSCALE: + begin + if BitDepth = 1 + then ByteData := GammaTable[Byte(ByteData * 255)] + else ByteData := GammaTable[Byte(ByteData * ((1 shl DataDepth) + 1))]; + Result := rgb(ByteData, ByteData, ByteData); + end; + else Result := 0; + end {case}; + end {with} +end; + +{In case vcl units are not being used} +{$IFNDEF UseDelphi} +function ColorToRGB(const Color: TColor): COLORREF; +begin + Result := Color +end; +{$ENDIF} + +{Sets a pixel for grayscale and palette pngs} +procedure SetByteArrayPixel(const png: TPngObject; const X, Y: Integer; + const Value: TColor); +const + ClearFlag: Array[1..8] of Integer = (1, 3, 0, 15, 0, 0, 0, $FF); +var + ByteData: pByte; + DataDepth: Byte; + ValEntry: Byte; +begin + with png.Header do + begin + {Map into a palette entry} + ValEntry := GetNearestPaletteIndex(Png.Palette, ColorToRGB(Value)); + + {16 bits grayscale extra bits are discarted} + DataDepth := BitDepth; + if DataDepth > 8 then DataDepth := 8; + {Gets a pointer to the byte we intend to change} + ByteData := @pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)]; + {Clears the old pixel data} + ByteData^ := ByteData^ and not (ClearFlag[DataDepth] shl ((8 - DataDepth) - + (X mod (8 div DataDepth)) * DataDepth)); + + {Setting the new pixel} + ByteData^ := ByteData^ or (ValEntry shl ((8 - DataDepth) - + (X mod (8 div DataDepth)) * DataDepth)); + end {with png.Header} +end; + +{Returns pixel when png uses RGB} +function GetRGBLinePixel(const png: TPngObject; + const X, Y: Integer): TColor; +begin + with pRGBLine(png.Scanline[Y])^[X] do + Result := RGB(rgbtRed, rgbtGreen, rgbtBlue) +end; + +{Sets pixel when png uses RGB} +procedure SetRGBLinePixel(const png: TPngObject; + const X, Y: Integer; Value: TColor); +begin + with pRGBLine(png.Scanline[Y])^[X] do + begin + rgbtRed := GetRValue(Value); + rgbtGreen := GetGValue(Value); + rgbtBlue := GetBValue(Value) + end +end; + +{Returns pixel when png uses grayscale} +function GetGrayLinePixel(const png: TPngObject; + const X, Y: Integer): TColor; +var + B: Byte; +begin + B := PByteArray(png.Scanline[Y])^[X]; + Result := RGB(B, B, B); +end; + +{Sets pixel when png uses grayscale} +procedure SetGrayLinePixel(const png: TPngObject; + const X, Y: Integer; Value: TColor); +begin + PByteArray(png.Scanline[Y])^[X] := GetRValue(Value); +end; + +{Resizes the PNG image} +procedure TPngObject.Resize(const CX, CY: Integer); + function Min(const A, B: Integer): Integer; + begin + if A < B then Result := A else Result := B; + end; +var + Header: TChunkIHDR; + Line, NewBytesPerRow: Integer; + NewHandle: HBitmap; + NewDC: HDC; + NewImageData: Pointer; + NewImageAlpha: Pointer; + NewImageExtra: Pointer; +begin + if (CX > 0) and (CY > 0) then + begin + {Gets some actual information} + Header := Self.Header; + + {Creates the new image} + NewDC := CreateCompatibleDC(Header.ImageDC); + Header.BitmapInfo.bmiHeader.biWidth := cx; + Header.BitmapInfo.bmiHeader.biHeight := cy; + NewHandle := CreateDIBSection(NewDC, pBitmapInfo(@Header.BitmapInfo)^, + DIB_RGB_COLORS, NewImageData, 0, 0); + SelectObject(NewDC, NewHandle); + {$IFDEF UseDelphi}Canvas.Handle := NewDC;{$ENDIF} + NewBytesPerRow := (((Header.BitmapInfo.bmiHeader.biBitCount * cx) + 31) + and not 31) div 8; + + {Copies the image data} + for Line := 0 to Min(CY - 1, Height - 1) do + CopyMemory(Ptr(Longint(NewImageData) + (Longint(CY) - 1) * + NewBytesPerRow - (Line * NewBytesPerRow)), Scanline[Line], + Min(NewBytesPerRow, Header.BytesPerRow)); + + {Build array for alpha information, if necessary} + if (Header.ColorType = COLOR_RGBALPHA) or + (Header.ColorType = COLOR_GRAYSCALEALPHA) then + begin + GetMem(NewImageAlpha, CX * CY); + Fillchar(NewImageAlpha^, CX * CY, 255); + for Line := 0 to Min(CY - 1, Height - 1) do + CopyMemory(Ptr(Longint(NewImageAlpha) + (Line * CX)), + AlphaScanline[Line], Min(CX, Width)); + FreeMem(Header.ImageAlpha); + Header.ImageAlpha := NewImageAlpha; + end; + + {$IFDEF Store16bits} + if (Header.BitDepth = 16) then + begin + GetMem(NewImageExtra, CX * CY); + Fillchar(NewImageExtra^, CX * CY, 0); + for Line := 0 to Min(CY - 1, Height - 1) do + CopyMemory(Ptr(Longint(NewImageExtra) + (Line * CX)), + ExtraScanline[Line], Min(CX, Width)); + FreeMem(Header.ExtraImageData); + Header.ExtraImageData := NewImageExtra; + end; + {$ENDIF} + + {Deletes the old image} + DeleteObject(Header.ImageHandle); + DeleteDC(Header.ImageDC); + + {Prepares the header to get the new image} + Header.BytesPerRow := NewBytesPerRow; + Header.IHDRData.Width := CX; + Header.IHDRData.Height := CY; + Header.ImageData := NewImageData; + + {Replaces with the new image} + Header.ImageHandle := NewHandle; + Header.ImageDC := NewDC; + end + else + {The new size provided is invalid} + RaiseError(EPNGInvalidNewSize, EInvalidNewSize) + +end; + +{Sets a pixel} +procedure TPngObject.SetPixels(const X, Y: Integer; const Value: TColor); +begin + if ((X >= 0) and (X <= Width - 1)) and + ((Y >= 0) and (Y <= Height - 1)) then + with Header do + begin + if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then + SetByteArrayPixel(Self, X, Y, Value) + else if ColorType in [COLOR_GRAYSCALEALPHA] then + SetGrayLinePixel(Self, X, Y, Value) + else + SetRGBLinePixel(Self, X, Y, Value) + end {with} +end; + + +{Returns a pixel} +function TPngObject.GetPixels(const X, Y: Integer): TColor; +begin + if ((X >= 0) and (X <= Width - 1)) and + ((Y >= 0) and (Y <= Height - 1)) then + with Header do + begin + if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then + Result := GetByteArrayPixel(Self, X, Y) + else if ColorType in [COLOR_GRAYSCALEALPHA] then + Result := GetGrayLinePixel(Self, X, Y) + else + Result := GetRGBLinePixel(Self, X, Y) + end {with} + else Result := 0 +end; + +{Returns the image palette} +function TPngObject.GetPalette: HPALETTE; +begin + Result := Header.ImagePalette; +end; + +{Assigns from another TChunk} +procedure TChunkpHYs.Assign(Source: TChunk); +begin + fPPUnitY := TChunkpHYs(Source).fPPUnitY; + fPPUnitX := TChunkpHYs(Source).fPPUnitX; + fUnit := TChunkpHYs(Source).fUnit; +end; + +{Loads the chunk from a stream} +function TChunkpHYs.LoadFromStream(Stream: TStream; const ChunkName: TChunkName; + Size: Integer): Boolean; +begin + {Let ancestor load the data} + Result := inherited LoadFromStream(Stream, ChunkName, Size); + if not Result or (Size <> 9) then exit; {Size must be 9} + + {Reads data} + fPPUnitX := ByteSwap(pCardinal(Longint(Data))^); + fPPUnitY := ByteSwap(pCardinal(Longint(Data) + 4)^); + fUnit := pUnitType(Longint(Data) + 8)^; +end; + +{Saves the chunk to a stream} +function TChunkpHYs.SaveToStream(Stream: TStream): Boolean; +begin + {Update data} + ResizeData(9); {Make sure the size is 9} + pCardinal(Data)^ := ByteSwap(fPPUnitX); + pCardinal(Longint(Data) + 4)^ := ByteSwap(fPPUnitY); + pUnitType(Longint(Data) + 8)^ := fUnit; + + {Let inherited save data} + Result := inherited SaveToStream(Stream); +end; + +procedure TPngObject.DoSetPalette(Value: HPALETTE; const UpdateColors: boolean); +begin + if (Header.HasPalette) then + begin + {Update the palette entries} + if UpdateColors then + Header.PaletteToDIB(Value); + + {Resize the new palette} + SelectPalette(Header.ImageDC, Value, False); + RealizePalette(Header.ImageDC); + + {Replaces} + DeleteObject(Header.ImagePalette); + Header.ImagePalette := Value; + end +end; + +{Set palette based on a windows palette handle} +procedure TPngObject.SetPalette(Value: HPALETTE); +begin + DoSetPalette(Value, true); +end; + +{Returns the library version} +function TPNGObject.GetLibraryVersion: String; +begin + Result := LibraryVersion +end; + +initialization + {Initialize} + ChunkClasses := nil; + {crc table has not being computed yet} + crc_table_computed := FALSE; + {Register the necessary chunks for png} + RegisterCommonChunks; + {Registers TPNGObject to use with TPicture} + {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} + TPicture.RegisterFileFormat('PNG', 'Portable Network Graphics', TPNGObject); + {$ENDIF}{$ENDIF} +finalization + {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} + TPicture.UnregisterGraphicClass(TPNGObject); + {$ENDIF}{$ENDIF} + {Free chunk classes} + FreeChunkClassList; +end. + + + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/pnglang.pas b/official/4.2/Source/pnglang.pas new file mode 100644 index 0000000..7042c20 --- /dev/null +++ b/official/4.2/Source/pnglang.pas @@ -0,0 +1,358 @@ +{Portable Network Graphics Delphi Language Info (24 July 2002)} + +{Feel free to change the text bellow to adapt to your language} +{Also if you have a translation to other languages and want to} +{share it, send me: gubadaud@terra.com.br } +unit pnglang; + +interface + +{$DEFINE English} +{.$DEFINE Polish} +{.$DEFINE Portuguese} +{.$DEFINE German} +{.$DEFINE French} +{.$DEFINE Slovenian} + +{Language strings for english} +resourcestring + {$IFDEF Polish} + EPngInvalidCRCText = 'Ten obraz "Portable Network Graphics" jest nieprawidіowy ' + + 'poniewaї zawiera on nieprawidіowe czкњci danych (bі№d crc)'; + EPNGInvalidIHDRText = 'Obraz "Portable Network Graphics" nie moїe zostaж ' + + 'wgrany poniewaї jedna z czкњci danych (ihdr) moїe byж uszkodzona'; + EPNGMissingMultipleIDATText = 'Obraz "Portable Network Graphics" jest ' + + 'nieprawidіowy poniewaї brakuje w nim czкњci obrazu.'; + EPNGZLIBErrorText = 'Nie moїna zdekompresowaж obrazu poniewaї zawiera ' + + 'bікdnie zkompresowane dane.'#13#10 + ' Opis bікdu: '; + EPNGInvalidPaletteText = 'Obraz "Portable Network Graphics" zawiera ' + + 'niewіaњciw№ paletк.'; + EPNGInvalidFileHeaderText = 'Plik ktуry jest odczytywany jest nieprawidіowym '+ + 'obrazem "Portable Network Graphics" poniewaї zawiera nieprawidіowy nagіуwek.' + + ' Plik moїк byж uszkodzony, sprуbuj pobraж go ponownie.'; + EPNGIHDRNotFirstText = 'Obraz "Portable Network Graphics" nie jest ' + + 'obsіugiwany lub moїe byж niewіaњciwy.'#13#10 + '(stopka IHDR nie jest pierwsza)'; + EPNGNotExistsText = 'Plik png nie moїe zostaж wgrany poniewaї nie ' + + 'istnieje.'; + EPNGSizeExceedsText = 'Obraz "Portable Network Graphics" nie jest ' + + 'obsіugiwany poniewaї jego szerokoњж lub wysokoњж przekracza maksimum ' + + 'rozmiaru, ktуry wynosi 65535 pikseli dіugoњci.'; + EPNGUnknownPalEntryText = 'Nie znaleziono wpisуw palety.'; + EPNGMissingPaletteText = 'Obraz "Portable Network Graphics" nie moїe zostaж ' + + 'wgrany poniewaї uїywa tabeli kolorуw ktуrej brakuje.'; + EPNGUnknownCriticalChunkText = 'Obraz "Portable Network Graphics" ' + + 'zawiera nieznan№ krytyczn№ czкњж ktуra nie moїe zostaж odkodowana.'; + EPNGUnknownCompressionText = 'Obraz "Portable Network Graphics" jest ' + + 'skompresowany nieznanym schemat ktуry nie moїe zostaж odszyfrowany.'; + EPNGUnknownInterlaceText = 'Obraz "Portable Network Graphics" uїywa ' + + 'nie znany schamat przeplatania ktуry nie moїe zostaж odszyfrowany.'; + EPNGCannotAssignChunkText = 'Stopka mysi byж kompatybilna aby zostaіa wyznaczona.'; + EPNGUnexpectedEndText = 'Obraz "Portable Network Graphics" jest nieprawidіowy ' + + 'poniewaї dekoder znalazі niespodziewanie koniec pliku.'; + EPNGNoImageDataText = 'Obraz "Portable Network Graphics" nie zawiera' + + 'danych.'; + EPNGCannotAddChunkText = 'Program prуbuje dodaж krytyczn№ ' + + 'stopkк do aktualnego obrazu co jest niedozwolone.'; + EPNGCannotAddInvalidImageText = 'Nie moїna dodaж nowej stopki ' + + 'poniewaї aktualny obraz jest nieprawidіowy.'; + EPNGCouldNotLoadResourceText = 'Obraz png nie moїe zostaж zaіadowany z' + + 'zasobуw o podanym ID.'; + EPNGOutMemoryText = 'Niektуre operacje nie mog№ zostaж zrealizowane poniewaї ' + + 'systemowi brakuje zasobуw. Zamknij kilka okien i sprуbuj ponownie.'; + EPNGCannotChangeTransparentText = 'Ustawienie bitu przezroczystego koloru jest ' + + 'zabronione dla obrazуw png zawieraj№cych wartoњж alpha dla kaїdego piksela ' + + '(COLOR_RGBALPHA i COLOR_GRAYSCALEALPHA)'; + EPNGHeaderNotPresentText = 'Ta operacja jest niedozwolona poniewaї ' + + 'aktualny obraz zawiera niewіaњciwy nagіуwek.'; + EInvalidNewSize = 'The new size provided for image resizing is invalid.'; + EInvalidSpec = 'The "Portable Network Graphics" could not be created ' + + 'because invalid image type parameters have being provided.'; + {$ENDIF} + + {$IFDEF English} + EPngInvalidCRCText = 'This "Portable Network Graphics" image is not valid ' + + 'because it contains invalid pieces of data (crc error)'; + EPNGInvalidIHDRText = 'The "Portable Network Graphics" image could not be ' + + 'loaded because one of its main piece of data (ihdr) might be corrupted'; + EPNGMissingMultipleIDATText = 'This "Portable Network Graphics" image is ' + + 'invalid because it has missing image parts.'; + EPNGZLIBErrorText = 'Could not decompress the image because it contains ' + + 'invalid compressed data.'#13#10 + ' Description: '; + EPNGInvalidPaletteText = 'The "Portable Network Graphics" image contains ' + + 'an invalid palette.'; + EPNGInvalidFileHeaderText = 'The file being readed is not a valid '+ + '"Portable Network Graphics" image because it contains an invalid header.' + + ' This file may be corruped, try obtaining it again.'; + EPNGIHDRNotFirstText = 'This "Portable Network Graphics" image is not ' + + 'supported or it might be invalid.'#13#10 + '(IHDR chunk is not the first)'; + EPNGNotExistsText = 'The png file could not be loaded because it does not ' + + 'exists.'; + EPNGSizeExceedsText = 'This "Portable Network Graphics" image is not ' + + 'supported because either it''s width or height exceeds the maximum ' + + 'size, which is 65535 pixels length.'; + EPNGUnknownPalEntryText = 'There is no such palette entry.'; + EPNGMissingPaletteText = 'This "Portable Network Graphics" could not be ' + + 'loaded because it uses a color table which is missing.'; + EPNGUnknownCriticalChunkText = 'This "Portable Network Graphics" image ' + + 'contains an unknown critical part which could not be decoded.'; + EPNGUnknownCompressionText = 'This "Portable Network Graphics" image is ' + + 'encoded with an unknown compression scheme which could not be decoded.'; + EPNGUnknownInterlaceText = 'This "Portable Network Graphics" image uses ' + + 'an unknown interlace scheme which could not be decoded.'; + EPNGCannotAssignChunkText = 'The chunks must be compatible to be assigned.'; + EPNGUnexpectedEndText = 'This "Portable Network Graphics" image is invalid ' + + 'because the decoder found an unexpected end of the file.'; + EPNGNoImageDataText = 'This "Portable Network Graphics" image contains no ' + + 'data.'; + EPNGCannotAddChunkText = 'The program tried to add a existent critical ' + + 'chunk to the current image which is not allowed.'; + EPNGCannotAddInvalidImageText = 'It''s not allowed to add a new chunk ' + + 'because the current image is invalid.'; + EPNGCouldNotLoadResourceText = 'The png image could not be loaded from the ' + + 'resource ID.'; + EPNGOutMemoryText = 'Some operation could not be performed because the ' + + 'system is out of resources. Close some windows and try again.'; + EPNGCannotChangeTransparentText = 'Setting bit transparency color is not ' + + 'allowed for png images containing alpha value for each pixel ' + + '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)'; + EPNGHeaderNotPresentText = 'This operation is not valid because the ' + + 'current image contains no valid header.'; + EInvalidNewSize = 'The new size provided for image resizing is invalid.'; + EInvalidSpec = 'The "Portable Network Graphics" could not be created ' + + 'because invalid image type parameters have being provided.'; + {$ENDIF} + {$IFDEF Portuguese} + EPngInvalidCRCText = 'Essa imagem "Portable Network Graphics" nгo й vбlida ' + + 'porque contйm chunks invбlidos de dados (erro crc)'; + EPNGInvalidIHDRText = 'A imagem "Portable Network Graphics" nгo pode ser ' + + 'carregada porque um dos seus chunks importantes (ihdr) pode estar '+ + 'invбlido'; + EPNGMissingMultipleIDATText = 'Essa imagem "Portable Network Graphics" й ' + + 'invбlida porque tem chunks de dados faltando.'; + EPNGZLIBErrorText = 'Nгo foi possнvel descomprimir os dados da imagem ' + + 'porque ela contйm dados invбlidos.'#13#10 + ' Descriзгo: '; + EPNGInvalidPaletteText = 'A imagem "Portable Network Graphics" contйm ' + + 'uma paleta invбlida.'; + EPNGInvalidFileHeaderText = 'O arquivo sendo lido nгo й uma imagem '+ + '"Portable Network Graphics" vбlida porque contйm um cabeзalho invбlido.' + + ' O arquivo pode estar corrompida, tente obter ela novamente.'; + EPNGIHDRNotFirstText = 'Essa imagem "Portable Network Graphics" nгo й ' + + 'suportada ou pode ser invбlida.'#13#10 + '(O chunk IHDR nгo й o ' + + 'primeiro)'; + EPNGNotExistsText = 'A imagem png nгo pode ser carregada porque ela nгo ' + + 'existe.'; + EPNGSizeExceedsText = 'Essa imagem "Portable Network Graphics" nгo й ' + + 'suportada porque a largura ou a altura ultrapassam o tamanho mбximo, ' + + 'que й de 65535 pixels de diвmetro.'; + EPNGUnknownPalEntryText = 'Nгo existe essa entrada de paleta.'; + EPNGMissingPaletteText = 'Essa imagem "Portable Network Graphics" nгo pode ' + + 'ser carregada porque usa uma paleta que estб faltando.'; + EPNGUnknownCriticalChunkText = 'Essa imagem "Portable Network Graphics" ' + + 'contйm um chunk crнtico desconheзido que nгo pode ser decodificado.'; + EPNGUnknownCompressionText = 'Essa imagem "Portable Network Graphics" estб ' + + 'codificada com um esquema de compressгo desconheзido e nгo pode ser ' + + 'decodificada.'; + EPNGUnknownInterlaceText = 'Essa imagem "Portable Network Graphics" usa um ' + + 'um esquema de interlace que nгo pode ser decodificado.'; + EPNGCannotAssignChunkText = 'Os chunk devem ser compatнveis para serem ' + + 'copiados.'; + EPNGUnexpectedEndText = 'Essa imagem "Portable Network Graphics" й ' + + 'invбlida porque o decodificador encontrou um fim inesperado.'; + EPNGNoImageDataText = 'Essa imagem "Portable Network Graphics" nгo contйm ' + + 'dados.'; + EPNGCannotAddChunkText = 'O programa tentou adicionar um chunk crнtico ' + + 'jб existente para a imagem atual, oque nгo й permitido.'; + EPNGCannotAddInvalidImageText = 'Nгo й permitido adicionar um chunk novo ' + + 'porque a imagem atual й invбlida.'; + EPNGCouldNotLoadResourceText = 'A imagem png nгo pode ser carregada apartir' + + ' do resource.'; + EPNGOutMemoryText = 'Uma operaзгo nгo pode ser completada porque o sistema ' + + 'estб sem recursos. Fecha algumas janelas e tente novamente.'; + EPNGCannotChangeTransparentText = 'Definir transparкncia booleana nгo й ' + + 'permitido para imagens png contendo informaзгo alpha para cada pixel ' + + '(COLOR_RGBALPHA e COLOR_GRAYSCALEALPHA)'; + EPNGHeaderNotPresentText = 'Essa operaзгo nгo й vбlida porque a ' + + 'imagem atual nгo contйm um cabeзalho vбlido.'; + EInvalidNewSize = 'O novo tamanho fornecido para o redimensionamento de ' + + 'imagem й invбlido.'; + EInvalidSpec = 'A imagem "Portable Network Graphics" nгo pode ser criada ' + + 'porque parвmetros de tipo de imagem invбlidos foram usados.'; + {$ENDIF} + {Language strings for German} + {$IFDEF German} + EPngInvalidCRCText = 'Dieses "Portable Network Graphics" Bild ist ' + + 'ungьltig, weil Teile der Daten fehlerhaft sind (CRC-Fehler)'; + EPNGInvalidIHDRText = 'Dieses "Portable Network Graphics" Bild konnte ' + + 'nicht geladen werden, weil wahrscheinlich einer der Hauptdatenbreiche ' + + '(IHDR) beschдdigt ist'; + EPNGMissingMultipleIDATText = 'Dieses "Portable Network Graphics" Bild ' + + 'ist ungьltig, weil Grafikdaten fehlen.'; + EPNGZLIBErrorText = 'Die Grafik konnte nicht entpackt werden, weil Teile der ' + + 'komprimierten Daten fehlerhaft sind.'#13#10 + ' Beschreibung: '; + EPNGInvalidPaletteText = 'Das "Portable Network Graphics" Bild enthдlt ' + + 'eine ungьltige Palette.'; + EPNGInvalidFileHeaderText = 'Die Datei, die gelesen wird, ist kein ' + + 'gьltiges "Portable Network Graphics" Bild, da es keinen gьltigen ' + + 'Header enthдlt. Die Datei kцnnte beschдdigt sein, versuchen Sie, ' + + 'eine neue Kopie zu bekommen.'; + EPNGIHDRNotFirstText = 'Dieses "Portable Network Graphics" Bild wird ' + + 'nicht unterstьtzt oder ist ungьltig.'#13#10 + + '(Der IHDR-Abschnitt ist nicht der erste Abschnitt in der Datei).'; + EPNGNotExistsText = 'Die PNG Datei konnte nicht geladen werden, da sie ' + + 'nicht existiert.'; + EPNGSizeExceedsText = 'Dieses "Portable Network Graphics" Bild wird nicht ' + + 'unterstьtzt, weil entweder seine Breite oder seine Hцhe das Maximum von ' + + '65535 Pixeln ьberschreitet.'; + EPNGUnknownPalEntryText = 'Es gibt keinen solchen Palettenwert.'; + EPNGMissingPaletteText = 'Dieses "Portable Network Graphics" Bild konnte ' + + 'nicht geladen werden, weil die benцtigte Farbtabelle fehlt.'; + EPNGUnknownCriticalChunkText = 'Dieses "Portable Network Graphics" Bild ' + + 'enhдlt einen unbekannten aber notwendigen Teil, welcher nicht entschlьsselt ' + + 'werden kann.'; + EPNGUnknownCompressionText = 'Dieses "Portable Network Graphics" Bild ' + + 'wurde mit einem unbekannten Komprimierungsalgorithmus kodiert, welcher ' + + 'nicht entschlьsselt werden kann.'; + EPNGUnknownInterlaceText = 'Dieses "Portable Network Graphics" Bild ' + + 'benutzt ein unbekanntes Interlace-Schema, welches nicht entschlьsselt ' + + 'werden kann.'; + EPNGCannotAssignChunkText = 'Die Abschnitte mьssen kompatibel sein, damit ' + + 'sie zugewiesen werden kцnnen.'; + EPNGUnexpectedEndText = 'Dieses "Portable Network Graphics" Bild ist ' + + 'ungьltig: Der Dekoder ist unerwartete auf das Ende der Datei gestoЯen.'; + EPNGNoImageDataText = 'Dieses "Portable Network Graphics" Bild enthдlt ' + + 'keine Daten.'; + EPNGCannotAddChunkText = 'Das Programm versucht einen existierenden und ' + + 'notwendigen Abschnitt zum aktuellen Bild hinzuzufьgen. Dies ist nicht ' + + 'zulдssig.'; + EPNGCannotAddInvalidImageText = 'Es ist nicht zulдssig, einem ungьltigen ' + + 'Bild einen neuen Abschnitt hinzuzufьgen.'; + EPNGCouldNotLoadResourceText = 'Das PNG Bild konnte nicht aus den ' + + 'Resourcendaten geladen werden.'; + EPNGOutMemoryText = 'Es stehen nicht genьgend Resourcen im System zur ' + + 'Verfьgung, um die Operation auszufьhren. SchlieЯen Sie einige Fenster '+ + 'und versuchen Sie es erneut.'; + EPNGCannotChangeTransparentText = 'Das Setzen der Bit-' + + 'Transparent-Farbe ist fьr PNG-Images die Alpha-Werte fьr jedes ' + + 'Pixel enthalten (COLOR_RGBALPHA und COLOR_GRAYSCALEALPHA) nicht ' + + 'zulдssig'; + EPNGHeaderNotPresentText = 'Die Datei, die gelesen wird, ist kein ' + + 'gьltiges "Portable Network Graphics" Bild, da es keinen gьltigen ' + + 'Header enthдlt.'; + EInvalidNewSize = 'The new size provided for image resizing is invalid.'; + EInvalidSpec = 'The "Portable Network Graphics" could not be created ' + + 'because invalid image type parameters have being provided.'; + {$ENDIF} + {Language strings for French} + {$IFDEF French} + EPngInvalidCRCText = 'Cette image "Portable Network Graphics" n''est pas valide ' + + 'car elle contient des donnйes invalides (erreur crc)'; + EPNGInvalidIHDRText = 'Cette image "Portable Network Graphics" n''a pu кtre ' + + 'chargйe car l''une de ses principale donnйe (ihdr) doit кtre corrompue'; + EPNGMissingMultipleIDATText = 'Cette image "Portable Network Graphics" est ' + + 'invalide car elle contient des parties d''image manquantes.'; + EPNGZLIBErrorText = 'Impossible de dйcompresser l''image car elle contient ' + + 'des donnйes compressйes invalides.'#13#10 + ' Description: '; + EPNGInvalidPaletteText = 'L''image "Portable Network Graphics" contient ' + + 'une palette invalide.'; + EPNGInvalidFileHeaderText = 'Le fichier actuellement lu est une image '+ + '"Portable Network Graphics" invalide car elle contient un en-tкte invalide.' + + ' Ce fichier doit кtre corrompu, essayer de l''obtenir а nouveau.'; + EPNGIHDRNotFirstText = 'Cette image "Portable Network Graphics" n''est pas ' + + 'supportйe ou doit кtre invalide.'#13#10 + '(la partie IHDR n''est pas la premiиre)'; + EPNGNotExistsText = 'Le fichier png n''a pu кtre chargй car il n''йxiste pas.'; + EPNGSizeExceedsText = 'Cette image "Portable Network Graphics" n''est pas supportйe ' + + 'car sa longueur ou sa largeur excиde la taille maximale, qui est de 65535 pixels.'; + EPNGUnknownPalEntryText = 'Il n''y a aucune entrйe pour cette palette.'; + EPNGMissingPaletteText = 'Cette image "Portable Network Graphics" n''a pu кtre ' + + 'chargйe car elle utilise une table de couleur manquante.'; + EPNGUnknownCriticalChunkText = 'Cette image "Portable Network Graphics" ' + + 'contient une partie critique inconnue qui n'' pu кtre dйcodйe.'; + EPNGUnknownCompressionText = 'Cette image "Portable Network Graphics" est ' + + 'encodйe а l''aide d''un schйmas de compression inconnu qui ne peut кtre dйcodй.'; + EPNGUnknownInterlaceText = 'Cette image "Portable Network Graphics" utilise ' + + 'un schйmas d''entrelacement inconnu qui ne peut кtre dйcodй.'; + EPNGCannotAssignChunkText = 'Ce morceau doit кtre compatible pour кtre assignй.'; + EPNGUnexpectedEndText = 'Cette image "Portable Network Graphics" est invalide ' + + 'car le decodeur est arrivй а une fin de fichier non attendue.'; + EPNGNoImageDataText = 'Cette image "Portable Network Graphics" ne contient pas de ' + + 'donnйes.'; + EPNGCannotAddChunkText = 'Le programme a essayй d''ajouter un morceau critique existant ' + + 'а l''image actuelle, ce qui n''est pas autorisй.'; + EPNGCannotAddInvalidImageText = 'Il n''est pas permis d''ajouter un nouveau morceau ' + + 'car l''image actuelle est invalide.'; + EPNGCouldNotLoadResourceText = 'L''image png n''a pu кtre chargйe depuis ' + + 'l''ID ressource.'; + EPNGOutMemoryText = 'Certaines opйrations n''ont pu кtre effectuйe car le ' + + 'systиme n''a plus de ressources. Fermez quelques fenкtres et essayez а nouveau.'; + EPNGCannotChangeTransparentText = 'Dйfinir le bit de transparence n''est pas ' + + 'permis pour des images png qui contiennent une valeur alpha pour chaque pixel ' + + '(COLOR_RGBALPHA et COLOR_GRAYSCALEALPHA)'; + EPNGHeaderNotPresentText = 'Cette opйration n''est pas valide car l''image ' + + 'actuelle ne contient pas de header valide.'; + EPNGAlphaNotSupportedText = 'Le type de couleur de l''image "Portable Network Graphics" actuelle ' + + 'contient dйjа des informations alpha ou il ne peut кtre converti.'; + EInvalidNewSize = 'The new size provided for image resizing is invalid.'; + EInvalidSpec = 'The "Portable Network Graphics" could not be created ' + + 'because invalid image type parameters have being provided.'; + {$ENDIF} + {Language strings for slovenian} + {$IFDEF Slovenian} + EPngInvalidCRCText = 'Ta "Portable Network Graphics" slika je neveljavna, ' + + 'ker vsebuje neveljavne dele podatkov (CRC napaka).'; + EPNGInvalidIHDRText = 'Slike "Portable Network Graphics" ni bilo moћno ' + + 'naloћiti, ker je eden od glavnih delov podatkov (IHDR) verjetno pokvarjen.'; + EPNGMissingMultipleIDATText = 'Ta "Portable Network Graphics" slika je ' + + 'naveljavna, ker manjkajo deli slike.'; + EPNGZLIBErrorText = 'Ne morem raztegniti slike, ker vsebuje ' + + 'neveljavne stisnjene podatke.'#13#10 + ' Opis: '; + EPNGInvalidPaletteText = 'Slika "Portable Network Graphics" vsebuje ' + + 'neveljavno barvno paleto.'; + EPNGInvalidFileHeaderText = 'Datoteka za branje ni veljavna '+ + '"Portable Network Graphics" slika, ker vsebuje neveljavno glavo.' + + ' Datoteka je verjetno pokvarjena, poskusite jo ponovno naloћiti.'; + EPNGIHDRNotFirstText = 'Ta "Portable Network Graphics" slika ni ' + + 'podprta ali pa je neveljavna.'#13#10 + '(IHDR del datoteke ni prvi).'; + EPNGNotExistsText = 'Ne morem naloћiti png datoteke, ker ta ne ' + + 'obstaja.'; + EPNGSizeExceedsText = 'Ta "Portable Network Graphics" slika ni ' + + 'podprta, ker ali njena љirina ali viљina presega najvecjo moћno vrednost ' + + '65535 pik.'; + EPNGUnknownPalEntryText = 'Slika nima vneљene take barvne palete.'; + EPNGMissingPaletteText = 'Te "Portable Network Graphics" ne morem ' + + 'naloћiti, ker uporablja manjkajoco barvno paleto.'; + EPNGUnknownCriticalChunkText = 'Ta "Portable Network Graphics" slika ' + + 'vsebuje neznan kriticni del podatkov, ki ga ne morem prebrati.'; + EPNGUnknownCompressionText = 'Ta "Portable Network Graphics" slika je ' + + 'kodirana z neznano kompresijsko shemo, ki je ne morem prebrati.'; + EPNGUnknownInterlaceText = 'Ta "Portable Network Graphics" slika uporablja ' + + 'neznano shemo za preliv, ki je ne morem prebrati.'; + EPNGCannotAssignChunkText = Koљcki morajo biti med seboj kompatibilni za prireditev vrednosti.'; + EPNGUnexpectedEndText = 'Ta "Portable Network Graphics" slika je neveljavna, ' + + 'ker je bralnik priљel do nepricakovanega konca datoteke.'; + EPNGNoImageDataText = 'Ta "Portable Network Graphics" ne vsebuje nobenih ' + + 'podatkov.'; + EPNGCannotAddChunkText = 'Program je poskusil dodati obstojeci kriticni ' + + 'kos podatkov k trenutni sliki, kar ni dovoljeno.'; + EPNGCannotAddInvalidImageText = 'Ni dovoljeno dodati nov kos podatkov, ' + + 'ker trenutna slika ni veljavna.'; + EPNGCouldNotLoadResourceText = 'Ne morem naloћiti png slike iz ' + + 'skladiљca.'; + EPNGOutMemoryText = 'Ne morem izvesti operacije, ker je ' + + 'sistem ostal brez resorjev. Zaprite nekaj oken in poskusite znova.'; + EPNGCannotChangeTransparentText = 'Ni dovoljeno nastaviti prosojnosti posamezne barve ' + + 'za png slike, ki vsebujejo alfa prosojno vrednost za vsako piko ' + + '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)'; + EPNGHeaderNotPresentText = 'Ta operacija ni veljavna, ker ' + + 'izbrana slika ne vsebuje veljavne glave.'; + EInvalidNewSize = 'The new size provided for image resizing is invalid.'; + EInvalidSpec = 'The "Portable Network Graphics" could not be created ' + + 'because invalid image type parameters have being provided.'; + {$ENDIF} + + +implementation + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/printers.xml b/official/4.2/Source/printers.xml new file mode 100644 index 0000000..30e07c0 --- /dev/null +++ b/official/4.2/Source/printers.xml @@ -0,0 +1,20 @@ + + + + + + + + diff --git a/official/4.2/Source/rc_AlgRef.pas b/official/4.2/Source/rc_AlgRef.pas new file mode 100644 index 0000000..08dfd98 --- /dev/null +++ b/official/4.2/Source/rc_AlgRef.pas @@ -0,0 +1,573 @@ +{* rijndael-alg-ref.c v2.0 August '99 *} +(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * --------------------------------- * + * DELPHI * + * Rijndael algorithm implementation * + * --------------------------------- * + * December 2000 * + * * + * Authors: Paulo Barreto * + * Vincent Rijmen * + * * + * Delphi translation by Sergey Kirichenko (ksv@cheerful.com) * + * Home Page: http://rcolonel.tripod.com * + * Adapted to FastReport: Alexander Tzyganenko * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *) + +unit rc_AlgRef; + +{$I frx.inc} + +interface + +const + MAXBC = (256 div 32); + MAXKC = (256 div 32); + MAXROUNDS = 14; + +type + word8 = byte; // unsigned 8-bit + word16 = word; // unsigned 16-bit + word32 = longword; // unsigned 32-bit + + TArrayK = array [0..4-1, 0..MAXKC-1] of word8; + PArrayK = ^TArrayK; + TArrayRK = array [0..MAXROUNDS+1-1, 0..4-1, 0..MAXBC-1] of word8; + TArrayBox= array [0..256-1] of word8; + + +{ Calculate the necessary round keys + The number of calculations depends on keyBits and blockBits } +function rijndaelKeySched(k: TArrayK; keyBits, blockBits: integer; + var W: TArrayRK): integer; + +{ Encryption of one block. } +function rijndaelEncrypt(var a: TArrayK; keyBits, blockBits: integer; rk: TArrayRK): integer; + +{ Encrypt only a certain number of rounds. + Only used in the Intermediate Value Known Answer Test. } +function rijndaelEncryptRound(var a: TArrayK; keyBits, blockBits: integer; + rk: TArrayRK; var irounds: integer): integer; + +{ Decryption of one block. } +function rijndaelDecrypt(var a: TArrayK; keyBits, blockBits: integer; rk: TArrayRK): integer; + +{ Decrypt only a certain number of rounds. + Only used in the Intermediate Value Known Answer Test. + Operations rearranged such that the intermediate values + of decryption correspond with the intermediate values + of encryption. } +function rijndaelDecryptRound(var a: TArrayK; keyBits, blockBits: integer; + rk: TArrayRK; var irounds: integer): integer; + + +implementation + + +{ + Tables that are needed by the reference implementation. + The tables implement the S-box and its inverse, and also + some temporary tables needed for multiplying in the finite field GF(2^8) +} + +const + Logtable: array [0..256-1] of word8 = ( + 0, 0, 25, 1, 50, 2, 26, 198, 75, 199, 27, 104, 51, 238, 223, 3, + 100, 4, 224, 14, 52, 141, 129, 239, 76, 113, 8, 200, 248, 105, 28, 193, + 125, 194, 29, 181, 249, 185, 39, 106, 77, 228, 166, 114, 154, 201, 9, 120, + 101, 47, 138, 5, 33, 15, 225, 36, 18, 240, 130, 69, 53, 147, 218, 142, + 150, 143, 219, 189, 54, 208, 206, 148, 19, 92, 210, 241, 64, 70, 131, 56, + 102, 221, 253, 48, 191, 6, 139, 98, 179, 37, 226, 152, 34, 136, 145, 16, + 126, 110, 72, 195, 163, 182, 30, 66, 58, 107, 40, 84, 250, 133, 61, 186, + 43, 121, 10, 21, 155, 159, 94, 202, 78, 212, 172, 229, 243, 115, 167, 87, + 175, 88, 168, 80, 244, 234, 214, 116, 79, 174, 233, 213, 231, 230, 173, 232, + 44, 215, 117, 122, 235, 22, 11, 245, 89, 203, 95, 176, 156, 169, 81, 160, + 127, 12, 246, 111, 23, 196, 73, 236, 216, 67, 31, 45, 164, 118, 123, 183, + 204, 187, 62, 90, 251, 96, 177, 134, 59, 82, 161, 108, 170, 85, 41, 157, + 151, 178, 135, 144, 97, 190, 220, 252, 188, 149, 207, 205, 55, 63, 91, 209, + 83, 57, 132, 60, 65, 162, 109, 71, 20, 42, 158, 93, 86, 242, 211, 171, + 68, 17, 146, 217, 35, 32, 46, 137, 180, 124, 184, 38, 119, 153, 227, 165, + 103, 74, 237, 222, 197, 49, 254, 24, 13, 99, 140, 128, 192, 247, 112, 7 ); + + Alogtable: array [0..256-1] of word8 = ( + 1, 3, 5, 15, 17, 51, 85, 255, 26, 46, 114, 150, 161, 248, 19, 53, + 95, 225, 56, 72, 216, 115, 149, 164, 247, 2, 6, 10, 30, 34, 102, 170, + 229, 52, 92, 228, 55, 89, 235, 38, 106, 190, 217, 112, 144, 171, 230, 49, + 83, 245, 4, 12, 20, 60, 68, 204, 79, 209, 104, 184, 211, 110, 178, 205, + 76, 212, 103, 169, 224, 59, 77, 215, 98, 166, 241, 8, 24, 40, 120, 136, + 131, 158, 185, 208, 107, 189, 220, 127, 129, 152, 179, 206, 73, 219, 118, 154, + 181, 196, 87, 249, 16, 48, 80, 240, 11, 29, 39, 105, 187, 214, 97, 163, + 254, 25, 43, 125, 135, 146, 173, 236, 47, 113, 147, 174, 233, 32, 96, 160, + 251, 22, 58, 78, 210, 109, 183, 194, 93, 231, 50, 86, 250, 21, 63, 65, + 195, 94, 226, 61, 71, 201, 64, 192, 91, 237, 44, 116, 156, 191, 218, 117, + 159, 186, 213, 100, 172, 239, 42, 126, 130, 157, 188, 223, 122, 142, 137, 128, + 155, 182, 193, 88, 232, 35, 101, 175, 234, 37, 111, 177, 200, 67, 197, 84, + 252, 31, 33, 99, 165, 244, 7, 9, 27, 45, 119, 153, 176, 203, 70, 202, + 69, 207, 74, 222, 121, 139, 134, 145, 168, 227, 62, 66, 198, 81, 243, 14, + 18, 54, 90, 238, 41, 123, 141, 140, 143, 138, 133, 148, 167, 242, 13, 23, + 57, 75, 221, 124, 132, 151, 162, 253, 28, 36, 108, 180, 199, 82, 246, 1 ); + + S: TArrayBox{array [0..256-1] of word8} = ( + 99, 124, 119, 123, 242, 107, 111, 197, 48, 1, 103, 43, 254, 215, 171, 118, + 202, 130, 201, 125, 250, 89, 71, 240, 173, 212, 162, 175, 156, 164, 114, 192, + 183, 253, 147, 38, 54, 63, 247, 204, 52, 165, 229, 241, 113, 216, 49, 21, + 4, 199, 35, 195, 24, 150, 5, 154, 7, 18, 128, 226, 235, 39, 178, 117, + 9, 131, 44, 26, 27, 110, 90, 160, 82, 59, 214, 179, 41, 227, 47, 132, + 83, 209, 0, 237, 32, 252, 177, 91, 106, 203, 190, 57, 74, 76, 88, 207, + 208, 239, 170, 251, 67, 77, 51, 133, 69, 249, 2, 127, 80, 60, 159, 168, + 81, 163, 64, 143, 146, 157, 56, 245, 188, 182, 218, 33, 16, 255, 243, 210, + 205, 12, 19, 236, 95, 151, 68, 23, 196, 167, 126, 61, 100, 93, 25, 115, + 96, 129, 79, 220, 34, 42, 144, 136, 70, 238, 184, 20, 222, 94, 11, 219, + 224, 50, 58, 10, 73, 6, 36, 92, 194, 211, 172, 98, 145, 149, 228, 121, + 231, 200, 55, 109, 141, 213, 78, 169, 108, 86, 244, 234, 101, 122, 174, 8, + 186, 120, 37, 46, 28, 166, 180, 198, 232, 221, 116, 31, 75, 189, 139, 138, + 112, 62, 181, 102, 72, 3, 246, 14, 97, 53, 87, 185, 134, 193, 29, 158, + 225, 248, 152, 17, 105, 217, 142, 148, 155, 30, 135, 233, 206, 85, 40, 223, + 140, 161, 137, 13, 191, 230, 66, 104, 65, 153, 45, 15, 176, 84, 187, 22 ); + + Si: TArrayBox{array [0..256-1] of word8} = ( + 82, 9, 106, 213, 48, 54, 165, 56, 191, 64, 163, 158, 129, 243, 215, 251, + 124, 227, 57, 130, 155, 47, 255, 135, 52, 142, 67, 68, 196, 222, 233, 203, + 84, 123, 148, 50, 166, 194, 35, 61, 238, 76, 149, 11, 66, 250, 195, 78, + 8, 46, 161, 102, 40, 217, 36, 178, 118, 91, 162, 73, 109, 139, 209, 37, + 114, 248, 246, 100, 134, 104, 152, 22, 212, 164, 92, 204, 93, 101, 182, 146, + 108, 112, 72, 80, 253, 237, 185, 218, 94, 21, 70, 87, 167, 141, 157, 132, + 144, 216, 171, 0, 140, 188, 211, 10, 247, 228, 88, 5, 184, 179, 69, 6, + 208, 44, 30, 143, 202, 63, 15, 2, 193, 175, 189, 3, 1, 19, 138, 107, + 58, 145, 17, 65, 79, 103, 220, 234, 151, 242, 207, 206, 240, 180, 230, 115, + 150, 172, 116, 34, 231, 173, 53, 133, 226, 249, 55, 232, 28, 117, 223, 110, + 71, 241, 26, 113, 29, 41, 197, 137, 111, 183, 98, 14, 170, 24, 190, 27, + 252, 86, 62, 75, 198, 210, 121, 32, 154, 219, 192, 254, 120, 205, 90, 244, + 31, 221, 168, 51, 136, 7, 199, 49, 177, 18, 16, 89, 39, 128, 236, 95, + 96, 81, 127, 169, 25, 181, 74, 13, 45, 229, 122, 159, 147, 201, 156, 239, + 160, 224, 59, 77, 174, 42, 245, 176, 200, 235, 187, 60, 131, 83, 153, 97, + 23, 43, 4, 126, 186, 119, 214, 38, 225, 105, 20, 99, 85, 33, 12, 125 ); + + rcon: array [0..30-1] of word32 = ( + $01,$02, $04, $08, $10, $20, $40, $80, $1b, $36, $6c, + $d8, $ab, $4d, $9a, $2f, $5e, $bc, $63, $c6, $97, $35, + $6a, $d4, $b3, $7d, $fa, $ef, $c5, $91 ); + + shifts: array [0..3-1, 0..4-1, 0..2-1] of word8 = ( + ((0, 0),(1, 3),(2, 2),(3, 1)), + ((0, 0),(1, 5),(2, 4),(3, 3)), + ((0, 0),(1, 7),(3, 5),(4, 4))); + +function iif(bExpression: boolean; iResTrue,iResFalse: integer): integer; +begin + if bExpression then + result:= iResTrue + else + result:= iResFalse; +end; + +function mul(a, b: word8): word8; +{ multiply two elements of GF(2^m) + needed for MixColumn and InvMixColumn } +begin + if (a<>0) and (b<>0) then + result:= Alogtable[(Logtable[a] + Logtable[b]) mod 255] + else + result:= 0; +end; + +procedure KeyAddition(var a: TArrayK; rk: PArrayK; BC:word8); +{ Exor corresponding text input and round key input bytes } +var + i, j: integer; +begin + for i:= 0 to 4-1 do + for j:= 0 to BC-1 do + a[i][j]:= a[i][j] xor rk[i][j]; +end; + +procedure ShiftRow(var a: TArrayK; d, BC: word8); +{ Row 0 remains unchanged + The other three rows are shifted a variable amount } +var + tmp: array [0..MAXBC-1] of word8; + i, j: integer; +begin + for i:= 1 to 4-1 do + begin + for j:= 0 to BC-1 do + tmp[j]:= a[i][(j + shifts[((BC - 4) shr 1)][i][d]) mod BC]; + for j:= 0 to BC-1 do + a[i][j]:= tmp[j]; + end; +end; + +procedure Substitution(var a: TArrayK; const box: TArrayBox; BC: word8); +{ Replace every byte of the input by the byte at that place + in the nonlinear S-box } +var + i, j: integer; +begin + for i:= 0 to 4-1 do + for j:= 0 to BC-1 do + a[i][j]:= box[a[i][j]]; +end; + +procedure MixColumn(var a: TArrayK; BC: word8); +{ Mix the four bytes of every column in a linear way } +var + b: TArrayK; + i, j: integer; +begin + for j:= 0 to BC-1 do + for i:= 0 to 4-1 do + b[i][j]:= mul(2,a[i][j]) + xor mul(3,a[(i + 1) mod 4][j]) + xor a[(i + 2) mod 4][j] + xor a[(i + 3) mod 4][j]; + for i:= 0 to 4-1 do + for j:= 0 to BC-1 do + a[i][j]:= b[i][j]; +end; + +procedure InvMixColumn(var a: TArrayK; BC: word8); +{ Mix the four bytes of every column in a linear way + This is the opposite operation of Mixcolumn } +var + b: TArrayK; + i, j: integer; +begin + for j:= 0 to BC-1 do + for i:= 0 to 4-1 do + b[i][j]:= mul($e,a[i][j]) + xor mul($b,a[(i + 1) mod 4][j]) + xor mul($d,a[(i + 2) mod 4][j]) + xor mul($9,a[(i + 3) mod 4][j]); + for i:= 0 to 4-1 do + for j:= 0 to BC-1 do + a[i][j]:= b[i][j]; +end; + +function rijndaelKeySched(k: TArrayK; keyBits, blockBits: integer; + var W: TArrayRK): integer; +{ Calculate the necessary round keys + The number of calculations depends on keyBits and blockBits } +var + KC, BC, ROUNDS: integer; + i, j, t, rconpointer: integer; + tk: array [0..4-1, 0..MAXKC-1] of word8; +begin + rconpointer:= 0; + case (keyBits) of + 128: KC:= 4; + 192: KC:= 6; + 256: KC:= 8; + else + begin + result:= -1; + exit; + end; + end; + + case (blockBits) of + 128: BC:= 4; + 192: BC:= 6; + 256: BC:= 8; + else + begin + result:= -2; + exit; + end; + end; + + case iif(keyBits >= blockBits, keyBits, blockBits) of + 128: ROUNDS:= 10; + 192: ROUNDS:= 12; + 256: ROUNDS:= 14; + else + begin + result:= -3; {* this cannot happen *} + exit; + end; + end; + + for j:= 0 to KC-1 do + for i:= 0 to 4-1 do + tk[i][j]:= k[i][j]; + + { copy values into round key array } + t:= 0; + j:= 0; + while ((j < KC) and (t < (ROUNDS+1)*BC)) do + begin + for i:= 0 to 4-1 do + W[t div BC][i][t mod BC]:= tk[i][j]; + inc(j); + inc(t); + end; + + while (t < (ROUNDS+1)*BC) do { while not enough round key material calculated } + begin + { calculate new values } + for i:= 0 to 4-1 do + tk[i][0]:= tk[i][0] xor S[tk[(i+1) mod 4][KC-1]]; + tk[0][0]:= tk[0][0] xor rcon[rconpointer]; + inc(rconpointer); + if (KC <> 8) then + begin + for j:= 1 to KC-1 do + for i:= 0 to 4-1 do + tk[i][j]:= tk[i][j] xor tk[i][j-1]; + end + else + begin + j:= 1; + while j < KC/2 do + begin + for i:= 0 to 4-1 do + tk[i][j]:= tk[i][j] xor tk[i][j-1]; + inc(j); + end; + for i:= 0 to 4-1 do + tk[i][KC div 2]:= tk[i][KC div 2] xor S[tk[i][(KC div 2) - 1]]; + j:= (KC div 2) + 1; + while j < KC do + begin + for i:= 0 to 4-1 do + tk[i][j]:= tk[i][j] xor tk[i][j-1]; + inc(j); + end; + end; + + { copy values into round key array } + j:= 0; + while ((j < KC) and (t < (ROUNDS+1)*BC)) do + begin + for i:= 0 to 4-1 do + W[t div BC][i][t mod BC]:= tk[i][j]; + inc(j); + inc(t); + end; + end; + result:= 0; +end; + +function rijndaelEncrypt(var a: TArrayK; keyBits, blockBits: integer; rk: TArrayRK): integer; +{ Encryption of one block. } +var + r, BC, ROUNDS: integer; +begin + case (blockBits) of + 128: BC:= 4; + 192: BC:= 6; + 256: BC:= 8; + else + begin + result:= -2; + exit; + end; + end; + + case iif(keyBits >= blockBits, keyBits, blockBits) of + 128: ROUNDS:= 10; + 192: ROUNDS:= 12; + 256: ROUNDS:= 14; + else + begin + result:= -3; { this cannot happen } + exit; + end; + end; + + { begin with a key addition } + KeyAddition(a,addr(rk[0]),BC); + + { ROUNDS-1 ordinary rounds } + for r:= 1 to ROUNDS-1 do + begin + Substitution(a,S,BC); + ShiftRow(a,0,BC); + MixColumn(a,BC); + KeyAddition(a,addr(rk[r]),BC); + end; + + { Last round is special: there is no MixColumn } + Substitution(a,S,BC); + ShiftRow(a,0,BC); + KeyAddition(a,addr(rk[ROUNDS]),BC); + result:= 0; +end; + +function rijndaelEncryptRound(var a: TArrayK; keyBits, blockBits: integer; + rk: TArrayRK; var irounds: integer): integer; +{ Encrypt only a certain number of rounds. + Only used in the Intermediate Value Known Answer Test. } +var + r, BC, ROUNDS: integer; +begin + case (blockBits) of + 128: BC:= 4; + 192: BC:= 6; + 256: BC:= 8; + else + begin + result:= -2; + exit; + end; + end; + + case iif(keyBits >= blockBits, keyBits, blockBits) of + 128: ROUNDS:= 10; + 192: ROUNDS:= 12; + 256: ROUNDS:= 14; + else + begin + result:= -3; { this cannot happen } + exit; + end; + end; + + { make number of rounds sane } + if (irounds > ROUNDS) then + irounds:= ROUNDS; + + { begin with a key addition } + KeyAddition(a,addr(rk[0]),BC); + + { at most ROUNDS-1 ordinary rounds } + r:= 1; + while (r <= irounds) and (r < ROUNDS) do + begin + Substitution(a,S,BC); + ShiftRow(a,0,BC); + MixColumn(a,BC); + KeyAddition(a,addr(rk[r]),BC); + inc(r); + end; + + { if necessary, do the last, special, round: } + if (irounds = ROUNDS) then + begin + Substitution(a,S,BC); + ShiftRow(a,0,BC); + KeyAddition(a,addr(rk[ROUNDS]),BC); + end; + + result:= 0; +end; + +function rijndaelDecrypt(var a: TArrayK; keyBits, blockBits: integer; rk: TArrayRK): integer; +var + r, BC, ROUNDS: integer; +begin + + case (blockBits) of + 128: BC:= 4; + 192: BC:= 6; + 256: BC:= 8; + else + begin + result:= -2; + exit; + end; + end; + + case iif(keyBits >= blockBits, keyBits, blockBits) of + 128: ROUNDS:= 10; + 192: ROUNDS:= 12; + 256: ROUNDS:= 14; + else + begin + result:= -3; { this cannot happen } + exit; + end; + end; + + { To decrypt: apply the inverse operations of the encrypt routine, + in opposite order + + (KeyAddition is an involution: it 's equal to its inverse) + (the inverse of Substitution with table S is Substitution with the inverse table of S) + (the inverse of Shiftrow is Shiftrow over a suitable distance) } + + { First the special round: + without InvMixColumn + with extra KeyAddition } + KeyAddition(a,addr(rk[ROUNDS]),BC); + Substitution(a,Si,BC); + ShiftRow(a,1,BC); + + { ROUNDS-1 ordinary rounds } + for r:= ROUNDS-1 downto 0+1 do + begin + KeyAddition(a,addr(rk[r]),BC); + InvMixColumn(a,BC); + Substitution(a,Si,BC); + ShiftRow(a,1,BC); + end; + + { End with the extra key addition } + + KeyAddition(a,addr(rk[0]),BC); + result:= 0; +end; + +function rijndaelDecryptRound(var a: TArrayK; keyBits, blockBits: integer; + rk: TArrayRK; var irounds: integer): integer; +{ Decrypt only a certain number of rounds. + Only used in the Intermediate Value Known Answer Test. + Operations rearranged such that the intermediate values + of decryption correspond with the intermediate values + of encryption. } +var + r, BC, ROUNDS: integer; +begin + case (blockBits) of + 128: BC:= 4; + 192: BC:= 6; + 256: BC:= 8; + else + begin + result:= -2; + exit; + end; + end; + + case iif(keyBits >= blockBits, keyBits, blockBits) of + 128: ROUNDS:= 10; + 192: ROUNDS:= 12; + 256: ROUNDS:= 14; + else + begin + result:= -3; { this cannot happen } + exit; + end; + end; + + { make number of rounds sane } + if (irounds > ROUNDS) then + irounds:= ROUNDS; + + { First the special round: + without InvMixColumn + with extra KeyAddition } + + KeyAddition(a,addr(rk[ROUNDS]),BC); + Substitution(a,Si,BC); + ShiftRow(a,1,BC); + + { ROUNDS-1 ordinary rounds } + for r:= ROUNDS-1 downto irounds+1 do + begin + KeyAddition(a,addr(rk[r]),BC); + InvMixColumn(a,BC); + Substitution(a,Si,BC); + ShiftRow(a,1,BC); + end; + + if (irounds = 0) then + { End with the extra key addition } + KeyAddition(a,addr(rk[0]),BC); + + result:= 0; +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/rc_ApiRef.pas b/official/4.2/Source/rc_ApiRef.pas new file mode 100644 index 0000000..6e9361d --- /dev/null +++ b/official/4.2/Source/rc_ApiRef.pas @@ -0,0 +1,459 @@ +{* rijndael-api-ref.c v2.0 August '99 *} +(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * --------------------------------- * + * DELPHI * + * Rijndael API * + * --------------------------------- * + * December 2000 * + * * + * Authors: Paulo Barreto * + * Vincent Rijmen * + * * + * Delphi translation by Sergey Kirichenko (ksv@cheerful.com) * + * Home Page: http://rcolonel.tripod.com * + * Adapted to FastReport: Alexander Tzyganenko * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *) + +unit rc_ApiRef; + +{$I frx.inc} + +interface + +uses rc_AlgRef; + +const + MAXBC = (256 div 32); + MAXKC = (256 div 32); + MAXROUNDS = 14; + + DIR_ENCRYPT = 0; { Are we encrpyting? } + DIR_DECRYPT = 1; { Are we decrpyting? } + MODE_ECB = 1; { Are we ciphering in ECB mode? } + MODE_CBC = 2; { Are we ciphering in CBC mode? } + MODE_CFB1 = 3; { Are we ciphering in 1-bit CFB mode? } + rTRUE = 1; { integer(true) } + rFALSE = 0; { integer(false) } + BITSPERBLOCK = 128; { Default number of bits in a cipher block } + +{ Error Codes - CHANGE POSSIBLE: inclusion of additional error codes } + BAD_KEY_DIR = -1; { Key direction is invalid, e.g., unknown value } + BAD_KEY_MAT = -2; { Key material not of correct length } + BAD_KEY_INSTANCE = -3; { Key passed is not valid } + BAD_CIPHER_MODE = -4; { Params struct passed to cipherInit invalid } + BAD_CIPHER_STATE = -5; { Cipher in wrong state (e.g., not initialized) } + BAD_CIPHER_INSTANCE = -7; + +{ CHANGE POSSIBLE: inclusion of algorithm specific defines } + MAX_KEY_SIZE = 64; { # of ASCII char's needed to represent a key } + MAX_IV_SIZE = (BITSPERBLOCK div 8); { # bytes needed to represent an IV } + +type +{ Typedef'ed data storage elements. Add any algorithm specific + parameters at the bottom of the structs as appropriate. } + + word8 = byte; // unsigned 8-bit + word16 = word; // unsigned 16-bit + word32 = longword; // unsigned 32-bit + TByteArray = array [0..MaxInt div sizeof(Byte)-1] of Byte; + PByte = ^TByteArray; + +{ The structure for key information } + PkeyInstance = ^keyInstance; + keyInstance = packed record + direction: Byte; { Key used for encrypting or decrypting? } + keyLen: integer; { Length of the key } + keyMaterial: array [0..MAX_KEY_SIZE+1-1] of char; { Raw key data in ASCII, e.g., user input or KAT values } + { The following parameters are algorithm dependent, replace or add as necessary } + blockLen: integer; { block length } + keySched: TArrayRK; { key schedule } + end; {* keyInstance *} + TkeyInstance = keyInstance; + +{ The structure for cipher information } + PcipherInstance = ^cipherInstance; + cipherInstance = packed record + mode: Byte; // MODE_ECB, MODE_CBC, or MODE_CFB1 + IV: array [0..MAX_IV_SIZE-1] of Byte; // A possible Initialization Vector for ciphering + { Add any algorithm specific parameters needed here } + blockLen: integer; // Sample: Handles non-128 bit block sizes (if available) + end; {* cipherInstance *} + TcipherInstance = cipherInstance; + +{ Function prototypes } +function makeKey(key: PkeyInstance; direction: Byte; keyLen: integer; keyMaterial: pchar): integer; +function cipherInit(cipher: PcipherInstance; mode: Byte; IV: pchar): integer; +{sergey has corrected it} +function blocksEnCrypt(cipher: PcipherInstance; key: PkeyInstance; input: PByte; + inputLen: integer; outBuffer: PByte): integer; +{sergey has corrected it} +function blocksDeCrypt(cipher: PcipherInstance; key: PkeyInstance; input: PByte; + inputLen: integer; outBuffer: PByte): integer; +{ cipherUpdateRounds: + + Encrypts/Decrypts exactly one full block a specified number of rounds. + Only used in the Intermediate Value Known Answer Test. + + Returns: + TRUE - on success + BAD_CIPHER_STATE - cipher in bad state (e.g., not initialized) } +function cipherUpdateRounds(cipher: PcipherInstance; key: PkeyInstance; input: PByte; + inputLen: integer; outBuffer: PByte; iRounds: integer): integer; + +implementation + +{ StrLCopy copies at most MaxLen characters from Source to Dest and returns Dest. } +function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler; +asm + PUSH EDI + PUSH ESI + PUSH EBX + MOV ESI,EAX + MOV EDI,EDX + MOV EBX,ECX + XOR AL,AL + TEST ECX,ECX + JZ @@1 + REPNE SCASB + JNE @@1 + INC ECX +@@1: SUB EBX,ECX + MOV EDI,ESI + MOV ESI,EDX + MOV EDX,EDI + MOV ECX,EBX + SHR ECX,2 + REP MOVSD + MOV ECX,EBX + AND ECX,3 + REP MOVSB + STOSB + MOV EAX,EDX + POP EBX + POP ESI + POP EDI +end; + +function makeKey(key: PkeyInstance; direction: Byte; keyLen: integer; keyMaterial: pchar): integer; +var + k: TArrayK; + i, j, t: integer; +begin + if not assigned(key) then + begin + result:= BAD_KEY_INSTANCE; + exit; + end; + + if ((direction = DIR_ENCRYPT) or (direction = DIR_DECRYPT)) then + key.direction:= direction + else + begin + result:= BAD_KEY_DIR; + exit; + end; + + if ((keyLen = 128) or (keyLen = 192) or (keyLen = 256)) then + key.keyLen:= keyLen + else + begin + result:= BAD_KEY_MAT; + exit; + end; + + if (keyMaterial^ <> #0) then + StrLCopy(key.keyMaterial, keyMaterial, keyLen div 4); // strncpy + + j := 0; + { initialize key schedule: } + for i:= 0 to (key.keyLen div 8)-1 do + begin + t:= integer(key.keyMaterial[2*i]); + if ((t >= ord('0')) and (t <= ord('9'))) then + j:= (t - ord('0')) shl 4 + else + if ((t >= ord('a')) and (t <= ord('f'))) then + j:= (t - ord('a') + 10) shl 4 + else + if ((t >= ord('A')) and (t <= ord('F'))) then + j:= (t - ord('A') + 10) shl 4 + else + begin + result:= BAD_KEY_MAT; + exit; + end; + + t:= integer(key.keyMaterial[2*i+1]); + if ((t >= ord('0')) and (t <= ord('9'))) then + j:= j xor (t - ord('0')) + else + if ((t >= ord('a')) and (t <= ord('f'))) then + j:= j xor (t - ord('a') + 10) + else + if ((t >= ord('A')) and (t <= ord('F'))) then + j:= j xor (t - ord('A') + 10) + else + begin + result:= BAD_KEY_MAT; + exit; + end; + + k[i mod 4][i div 4]:= word8(j); + end; + rijndaelKeySched(k, key.keyLen, key.blockLen, key.keySched); + result:= rTRUE; +end; + +function cipherInit(cipher: PcipherInstance; mode: Byte; IV: pchar): integer; +var + i, j, t: integer; +begin + if ((mode = MODE_ECB) or (mode = MODE_CBC) or (mode = MODE_CFB1)) then + cipher.mode:= mode + else + begin + result:= BAD_CIPHER_MODE; + exit; + end; + + j := 0; + + if assigned(IV) then + for i:= 0 to (cipher.blockLen div 8)-1 do + begin + t:= integer(IV[2*i]); + if ((t >= ord('0')) and (t <= ord('9'))) then + j:= (t - ord('0')) shl 4 + else + if ((t >= ord('a')) and (t <= ord('f'))) then + j:= (t - ord('a') + 10) shl 4 + else + if ((t >= ord('A')) and (t <= ord('F'))) then + j:= (t - ord('A') + 10) shl 4 + else + begin + result:= BAD_CIPHER_INSTANCE; + exit; + end; + + t:= integer(IV[2*i+1]); + if ((t >= ord('0')) and (t <= ord('9'))) then + j:= j xor (t - ord('0')) + else + if ((t >= ord('a')) and (t <= ord('f'))) then + j:= j xor (t - ord('a') + 10) + else + if ((t >= ord('A')) and (t <= ord('F'))) then + j:= j xor (t - ord('A') + 10) + else + begin + result:= BAD_CIPHER_INSTANCE; + exit; + end; + cipher.IV[i]:= Byte(j); + end; + result:= rTRUE; +end; + +function blocksEnCrypt(cipher: PcipherInstance; key: PkeyInstance; + input: PByte; inputLen: integer; outBuffer: PByte): integer; +var + i, j, t, numBlocks: integer; + block: TArrayK; +begin + { check parameter consistency: } + if (not assigned(key)) or + (key.direction <> DIR_ENCRYPT) or + ((key.keyLen <> 128) and (key.keyLen <> 192) and (key.keyLen <> 256)) then + begin + result:= BAD_KEY_MAT; + exit; + end; + + if (not assigned(cipher)) or + ((cipher.mode <> MODE_ECB) and (cipher.mode <> MODE_CBC) and (cipher.mode <> MODE_CFB1)) or + ((cipher.blockLen <> 128) and (cipher.blockLen <> 192) and (cipher.blockLen <> 256)) then + begin + result:= BAD_CIPHER_STATE; + exit; + end; + + numBlocks:= inputLen div cipher.blockLen; + case (cipher.mode) of + MODE_ECB: + for i:= 0 to numBlocks-1 do + begin + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array } + block[t][j]:= input[4*j+t] and $FF; + rijndaelEncrypt(block, key.keyLen, cipher.blockLen, key.keySched); + for j:= 0 to (cipher.blockLen div 32)-1 do + { parse rectangular array into output ciphertext bytes } + for t:= 0 to 4-1 do + outBuffer[4*j+t]:= Byte(block[t][j]); + end; + MODE_CBC: + begin + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse initial value into rectangular array } + block[t][j]:= cipher.IV[t+4*j] and $FF; + for i:= 0 to numBlocks-1 do + begin + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array and exor with + IV or the previous ciphertext } +// block[t][j]:= block[t][j] xor (input[4*j+t] and $FF); {!original!} + block[t][j]:= block[t][j] xor (input[(i*(cipher.blockLen div 8))+4*j+t] and $FF); {!sergey made it!} + rijndaelEncrypt(block, key.keyLen, cipher.blockLen, key.keySched); + for j:= 0 to (cipher.blockLen div 32)-1 do + { parse rectangular array into output ciphertext bytes } + for t:= 0 to 4-1 do +// outBuffer[4*j+t]:= Byte(block[t][j]); {!original!} + outBuffer[(i*(cipher.blockLen div 8))+4*j+t]:= Byte(block[t][j]); {!sergey made it!} + end; + end; + else + begin + result:= BAD_CIPHER_STATE; + exit + end; + end; + result:= numBlocks*cipher.blockLen; +end; + +function blocksDeCrypt(cipher: PcipherInstance; key: PkeyInstance; input: PByte; + inputLen: integer; outBuffer: PByte): integer; +var + i, j, t, numBlocks: integer; + block: TArrayK; +begin + if (not assigned(cipher)) or + (not assigned(key)) or + (key.direction = DIR_ENCRYPT) or + (cipher.blockLen <> key.blockLen) then + begin + result:= BAD_CIPHER_STATE; + exit; + end; + + { check parameter consistency: } + if (not assigned(key)) or + (key.direction <> DIR_DECRYPT) or + ((key.keyLen <> 128) and (key.keyLen <> 192) and (key.keyLen <> 256)) then + begin + result:= BAD_KEY_MAT; + exit; + end; + + if (not assigned(cipher)) or + ((cipher.mode <> MODE_ECB) and (cipher.mode <> MODE_CBC) and (cipher.mode <> MODE_CFB1)) or + ((cipher.blockLen <> 128) and (cipher.blockLen <> 192) and (cipher.blockLen <> 256)) then + begin + result:= BAD_CIPHER_STATE; + exit; + end; + + numBlocks:= inputLen div cipher.blockLen; + case (cipher.mode) of + MODE_ECB: + for i:= 0 to numBlocks-1 do + begin + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array } + block[t][j]:= input[4*j+t] and $FF; + rijndaelDecrypt (block, key.keyLen, cipher.blockLen, key.keySched); + for j:= 0 to (cipher.blockLen div 32)-1 do + { parse rectangular array into output ciphertext bytes } + for t:= 0 to 4-1 do + outBuffer[4*j+t]:= Byte(block[t][j]); + end; + MODE_CBC: + {! sergey has rearranged processing blocks and + corrected exclusive-ORing operation !} + + begin + { blocks after first } + for i:= numBlocks-1 downto 1 do + begin + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array } + block[t][j]:= input[(i*(cipher.blockLen div 8))+ 4*j+ t] and $FF; + rijndaelDecrypt(block, key.keyLen, cipher.blockLen, key.keySched); + + for j:= 0 to (cipher.blockLen div 32)-1 do + { exor previous ciphertext block and parse rectangular array + into output ciphertext bytes } + for t:= 0 to 4-1 do + outBuffer[(i*(cipher.blockLen div 8))+ 4*j+t]:= Byte(block[t][j] xor + input[(i-1)*(cipher.blockLen div 8)+ 4*j+ t]); + end; + + { first block } + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array } + block[t][j]:= input[4*j+t] and $FF; + rijndaelDecrypt(block, key.keyLen, cipher.blockLen, key.keySched); + + for j:= 0 to (cipher.blockLen div 32)-1 do + { exor the IV and parse rectangular array into output ciphertext bytes } + for t:= 0 to 4-1 do + outBuffer[4*j+t]:= Byte(block[t][j] xor cipher.IV[t+4*j]); + end; + else + begin + result:= BAD_CIPHER_STATE; + exit; + end; + end; + result:= numBlocks*cipher.blockLen; +end; + +function cipherUpdateRounds(cipher: PcipherInstance; key: PkeyInstance; input: PByte; + inputLen: integer; outBuffer: PByte; iRounds: integer): integer; +var + j, t: integer; + block: TArrayK; +begin + if (not assigned(cipher)) or + (not assigned(key)) or + (cipher.blockLen <> key.blockLen) then + begin + result:= BAD_CIPHER_STATE; + exit; + end; + + for j:= 0 to (cipher.blockLen div 32)-1 do + for t:= 0 to 4-1 do + { parse input stream into rectangular array } + block[t][j]:= input[4*j+t] and $FF; + + case (key.direction) of + DIR_ENCRYPT: + rijndaelEncryptRound(block, key.keyLen, cipher.blockLen, key.keySched, irounds); + DIR_DECRYPT: + rijndaelDecryptRound(block, key.keyLen, cipher.blockLen, key.keySched, irounds); + else + begin + result:= BAD_KEY_DIR; + exit; + end; + end; + + for j:= 0 to (cipher.blockLen div 32)-1 do + { parse rectangular array into output ciphertext bytes } + for t:= 0 to 4-1 do + outBuffer[4*j+t]:= Byte(block[t][j]); + result:= rTRUE; +end; + + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/rc_Crypt.pas b/official/4.2/Source/rc_Crypt.pas new file mode 100644 index 0000000..9e78d9d --- /dev/null +++ b/official/4.2/Source/rc_Crypt.pas @@ -0,0 +1,116 @@ +(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * --------------------------------- * + * DELPHI * + * Rijndael Extended API * + * version 1.0 * + * --------------------------------- * + * December 2000 * + * * + * Author: Sergey Kirichenko (ksv@cheerful.com) * + * Home Page: http://rcolonel.tripod.com * + * Adapted to FastReport: Alexander Tzyganenko * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *) + +unit rc_Crypt; + +{$I frx.inc} + +interface + +uses sysutils, + rc_ApiRef; + +const + _KEYLength = 128; + +function ExpandKey(sKey: string; iLength: integer): string; +{encode string} +function EnCryptString(const sMessage: string; sKeyMaterial: string): string; +{decode string} +function DeCryptString(const sMessage: string; sKeyMaterial: string): string; + + +implementation + +function ExpandKey(sKey: string; iLength: integer): string; +var + ikey: array [0..(_KEYLength div 8)-1] of byte; + i,t: integer; + sr: string; +begin + sr:= sKey; + FillChar(ikey,sizeof(ikey),0); + try + if (length(sr) mod 2)<> 0 then + sr:= sr+ '0'; + t:= length(sr) div 2; + if t> (iLength div 8) then + t:= (iLength div 8); + for i:= 0 to t-1 do + ikey[i]:= strtoint('$'+sr[i*2+1]+sr[i*2+2]); + except + end; + sr:= ''; + for i:= 0 to (iLength div 8)-1 do + sr:= sr+IntToHex(ikey[i],2); + result:= sr; +end; + +function EnCryptString(const sMessage: string; sKeyMaterial: string): string; +var + sres: string; + blockLength,i: integer; + keyInst: TkeyInstance; + cipherInst: TcipherInstance; +begin + keyInst.blockLen:= BITSPERBLOCK; + sres:= ExpandKey(sKeyMaterial,_KEYLength); + if makeKey(addr(keyInst), DIR_ENCRYPT, _KEYLength, pchar(sres))<> rTRUE then + raise Exception.CreateFmt('Key error.',[-1]); + cipherInst.blockLen:= BITSPERBLOCK; + cipherInst.mode:= MODE_CBC; + FillChar(cipherInst.IV,sizeof(cipherInst.IV),0); + + sres:= sMessage; + blockLength:= length(sres)*8; + if (blockLength mod BITSPERBLOCK)<> 0 then + begin + for i:= 1 to ((BITSPERBLOCK-(blockLength-(BITSPERBLOCK*(blockLength div BITSPERBLOCK)))) div 8) do + sres:= sres+ ' '; + blockLength:= length(sres)*8; + end; + + if blocksEnCrypt(addr(cipherInst), addr(keyInst), addr(sres[1]), blockLength, addr(sres[1]))<> blockLength then + raise Exception.CreateFmt('EnCrypt error.',[-2]); + result:= sres; +end; + +function DeCryptString(const sMessage: string; sKeyMaterial: string): string; +var + sres: string; + blockLength: integer; + keyInst: TkeyInstance; + cipherInst: TcipherInstance; +begin + keyInst.blockLen:= BITSPERBLOCK; + sres:= ExpandKey(sKeyMaterial,_KEYLength); + if makeKey(addr(keyInst), DIR_DECRYPT, _KEYLength, pchar(sres))<> rTRUE then + raise Exception.CreateFmt('Key error.',[-1]); + cipherInst.blockLen:= BITSPERBLOCK; + cipherInst.mode:= MODE_CBC; + FillChar(cipherInst.IV,sizeof(cipherInst.IV),0); + + sres:= sMessage; + blockLength:= length(sres)*8; + if (blockLength= 0) or ((blockLength mod BITSPERBLOCK)<> 0) then + raise Exception.CreateFmt('Wrong message length.',[-4]); + + if blocksDeCrypt(addr(cipherInst), addr(keyInst), addr(sres[1]), blockLength, addr(sres[1]))<> blockLength then + raise Exception.CreateFmt('DeCrypt error.',[-3]); + result:= trim(sres); +end; + +end. + + +//862fd5d6aa1a637203d9b08a3c0bcfb0 \ No newline at end of file diff --git a/official/4.2/Source/tee.inc b/official/4.2/Source/tee.inc new file mode 100644 index 0000000..4911849 --- /dev/null +++ b/official/4.2/Source/tee.inc @@ -0,0 +1,49 @@ +//------------------- TeeChart component ---------------------------- +{$DEFINE TeeChartStd} + +//------------------- TeeChart Std 7 component ---------------------- +// If you have TeeChart Std 7, uncomment the following line: +//{$DEFINE TeeChartStd7} + +//------------------- TeeChart Pro 4 component -------------------- +// If you have TeeChart Pro 4, uncomment the following line: +//{$DEFINE TeeChart4} + +//------------------- TeeChart Pro 5 component -------------------- +// If you have TeeChart Pro 5, uncomment the following line: +//{$DEFINE TeeChart5} + +//------------------- TeeChart Pro 6 component ---------------------- +// If you have TeeChart Pro 6, uncomment the following line: +//{$DEFINE TeeChart6} + +//------------------- TeeChart Pro 7 component ---------------------- +// If you have TeeChart Pro 7, uncomment the following line: +//{$DEFINE TeeChart7} + + + +// Don't change here ------------------------------------------------ +{$IFDEF TeeChartStd7} + {$UNDEF TeeChartStd} +{$ENDIF} + +{$IFDEF TeeChart4} + {$UNDEF TeeChartStd} + {$DEFINE TeeChartPro} +{$ENDIF} + +{$IFDEF TeeChart5} + {$UNDEF TeeChartStd} + {$DEFINE TeeChartPro} +{$ENDIF} + +{$IFDEF TeeChart6} + {$UNDEF TeeChartStd} + {$DEFINE TeeChartPro} +{$ENDIF} + +{$IFDEF TeeChart7} + {$UNDEF TeeChartStd} + {$DEFINE TeeChartPro} +{$ENDIF} diff --git a/official/4.2/Source/trees.zobj b/official/4.2/Source/trees.zobj new file mode 100644 index 0000000..8406014 Binary files /dev/null and b/official/4.2/Source/trees.zobj differ diff --git a/official/4.2/Source/wizstyle.xml b/official/4.2/Source/wizstyle.xml new file mode 100644 index 0000000..799535e --- /dev/null +++ b/official/4.2/Source/wizstyle.xml @@ -0,0 +1,35 @@ + + + + + + + diff --git a/official/4.2/changes.txt b/official/4.2/changes.txt new file mode 100644 index 0000000..476424a --- /dev/null +++ b/official/4.2/changes.txt @@ -0,0 +1,114 @@ +version 4.02 +--------------- ++ added support for CodeGear Delphi 2007 ++ added export of html tags in RTF format ++ improved split of the rich object ++ improved split of the memo object ++ added TfrxReportPage.ResetPageNumbers property ++ added support of underlines property in PDF export +* export of the memos formatted as fkNumeric to float in ODS export +- fixed bug keeptogether with aggregates +- fixed bug with double-line draw in RTF export +- fix multi-thread problem in PDF export +- fixed bug with the shading of the paragraph in RTF export when external rich-text was inserted +- fixed bug with unicode in xml/xls export +- fixed bug in the crop of page in BMP, TIFF, Jpeg, Gif +- "scale" printmode fixed +- group & userdataset bugfix +- fixed cross-tab pagination error +- fixed bug with round brackets in PDF export +- fixed bug with gray to black colors in RTF export +- fixed outline with page.endlessheight +- fixed SuppressRepeated & new page +- fixed bug with long time export in text format +- fixed bug with page range and outline in PDF export +- fixed undo in code window +- fixed error when call DesignReport twice +- fixed unicode in the cross object +- fixed designreportinpanel with dialog forms +- fixed paste of DMPCommand object +- fixed bug with the export of null images +- fixed code completion bug +- fixed column footer & report summary problem + + + +version 4.01 +--------------- ++ added ability to show designer inside panel (TfrxReport.DesignReportInPanel method). See new demo Demos\EmbedDesigner ++ added TeeChart7 Std support ++ [server] added "User" parameter in TfrxReportServer.OnGetReport, TfrxReportServer.OnGetVariables and TfrxReportServer.OnAfterBuildReport events ++ added Cross.KeepTogether property ++ added TfrxReport.PreviewOptions.PagesInCache property +- barcode fix (export w/o preview bug) +- fixed bug in preview (AV with zoommode = zmWholePage) +- fixed bug with outline + drilldown +- fixed datasets in inherited report +- [install] fixed bug with library path set up in BDS/Turbo C++ Builder installation +- fixed pagefooter position if page.EndlessWidth is true +- fixed shift bug +- fixed design-time inheritance (folder issues) +- fixed chm help file path +- fixed embedded fonts in PDF +- fixed preview buttons +- fixed bug with syntax highlight +- fixed bug with print scale mode +- fixed bug with control.Hint +- fixed edit preview page +- fixed memory leak in cross-tab + + + +version 4.0 initial release +--------------------- +Report Designer: +- new XP-style interface +- the "Data" tab with all report datasets +- ability to draw diagrams in the "Data" tab +- code completion (Ctrl+Space) +- breakpoints +- watches +- report templates +- local guidelines (appears when you move or resize an object) +- ability to work in non-modal mode, mdi child mode + +Report Preview: +- thumbnails + +Print: +- split a big page to several small pages +- print several small pages on one big +- print a page on a specified sheet (with scale) +- duplex handling from print dialogue +- print copy name on each printed copy (for example, "First copy", "Second copy") + +Report Core: +- "endless page" mode +- images handling, increased speed +- the "Reset page numbers" mode for groups +- reports crypting (Rijndael algorithm) +- report inheritance (both file-based and dfm-based) +- drill-down groups +- frxGlobalVariables object +- "cross-tab" object enhancements: + - improved cells appearance + - cross elements visible in the designer + - fill corner (ShowCorner property) + - side-by-side crosstabs (NextCross property) + - join cells with the same value (JoinEqualCells property) + - join the same string values in a cell (AllowDuplicates property) + - ability to put an external object inside cross-tab + - AddWidth, AddHeight properties to increase width&height of the cell + - AutoSize property, ability to resize cells manually +- line object can have arrows +- added TfrxPictureView.FileLink property (can contain variable or a file name) +- separate settings for each frame line (properties Frame.LeftLine, +TopLine, RightLine, BottomLine can be set in the object inspector) +- PNG images support (uncomment {$DEFINE PNG} in the frx.inc file) +- Open Document Format for Office Applications (OASIS) exports, spreadsheet (ods) and text (odt) + +Enterprise components: +- Users/Groups security support (see a demo application Demos\ClientServer\UserManager) +- Templates support +- Dynamically refresh of configuration, users/groups + diff --git a/official/4.2/changes_rus.txt b/official/4.2/changes_rus.txt new file mode 100644 index 0000000..634cb0a --- /dev/null +++ b/official/4.2/changes_rus.txt @@ -0,0 +1,114 @@ +Версия 4.02 +-------------- ++ добавлена поддержка CodeGear Delphi 2007 ++ добавлен экспорт html тегов в формат RTF ++ улучшено разбиение объекта "Rich" на страницы ++ улучшено разбиение объекта "Текст" на страницы ++ добавлено свойство TfrxReportPage.ResetPageNumbers ++ добавлена поддержка экспорта underlines в формат PDF +* экспорт текстовых полей с форматом fkNumeric как чисел в ODS экспорт +- исправлена ошибка keeptogether с агрегатными ф-ями +- исправлена ошибка с экспортом двойных линий в RTF +- исправлена ошибка с мультипоточностью в PDF экспорте +- исправлена ошибка с цветом фона абзаца в RTF экспорте +- исправлена ошибка с юникодом в xml/xls экспорте +- исправлена ошибка с обрезанием страниц в экспортах BMP, TIFF, Jpeg, Gif +- исправлена ошибка режима печати "масштабирование" +- исправлена ошибка группы с userdataset +- исправлена ошибка разбиения cross-tab на страницы +- исправлена ошибка с круглыми скобками в PDF экспорте +- исправлена ошибка с изменением серого цвета в черный в RTF экспорте +- исправлена ошибка outline с page.endlessheight +- исправлена ошибка с зависанием при экспорте в текстовый формат некоторых отчетов +- исправлена ошибка с диапазоном страниц и outline в PDF экспорте +- исправлена ошибка с вызовом DesignReport дважды +- исправлена ошибка undo в окне кода +- исправлена поддержка unicode в cross объекте +- исправлен метод designreportinpanel с диалоговыми формами +- исправлена ошибка копирования DMPCommand в буфер обмена +- исправлена ошибка с экспортом null изображений +- исправлена ошибка code completion +- исправлена ошибка column footer & report summary + + +Версия 4.01 +-------------- ++ добавлена возможность показа дизайнера в панели (метод TfrxReport.DesignReportInPanel). См. демо Demos\EmbedDesigner ++ добавлена поддержка TeeChart7 Std ++ [server] добавлен параметр "User" в события TfrxReportServer.OnGetReport, TfrxReportServer.OnGetVariables и TfrxReportServer.OnAfterBuildReport ++ добавлено свойство Cross.KeepTogether ++ добавлено свойство TfrxReport.PreviewOptions.PagesInCache +- исправлена ошибка в штрихкоде (при экспорте без превью) +- исправлена ошибка в preview (AV при zoommode = zmWholePage) +- исправлена ошибка с outline + drilldown +- исправлена ошибка с датасетами в наследованном отчете +- [install] исправлена ошибка с настройкой library path при установке в BDS/Turbo C++ Builder +- исправлена позиция pagefooter если page.EndlessWidth = true +- исправлена ошибка сдвига объектов +- исправлено наследование в design-time (ошибка с путями) +- исправлена ошибка с chm help в дизайнере +- исправлена ошибка в PDF (встраивание шрифтов) +- исправлены кнопки превью +- исправлена ошибка с подсветкой синтаксиса +- исправлена ошибка в режиме print scale +- исправлена ошибка с control.Hint +- исправлена ошибка редактирования в режиме превью +- исправлена утечка в cross-tab + + +Версия 4.0 релиз +----------- + +Дизайнер: +- оформление интерфейса в стиле XP +- закладка "Data" со всеми источниками данных отчета +- рисование диаграмм в закладке "Data" +- code completion (Ctrl+Space) +- точки останова +- watches +- шаблоны отчетов +- локальные выносные линии (появляются при перемещении или изменении +размеров объекта) +- возможность немодальной работы, mdi child + +Предварительный просмотр: +- эскизы страниц + +Печать: +- разрезание страниц при печати на меньший размер бумаги +- печать нескольких страниц на одной большой +- печать с масштабированием +- управление дуплексом из диалога печати +- печать имени копии на каждой копии документа (например, "Первая копия", "Вторая копия") + +Ядро: +- режим "бесконечная страница" +- увеличена скорость работы с изображениями +- режим "reset page numbers" для групп +- шифрация файлов отчета (Rijndael алгоритм) +- наследование отчетов (в файлах и формах dfm) +- drill-down отчеты +- объект frxGlobalVariables +- улучшения в объекте "cross-tab" + - улучшенное управление ячейками + - элементы показываются в дизайнере + - заполнение угла таблицы (св-во ShowCorner) + - несколько кроссов в ширину (св-во NextCross) + - объединение одинаковых ячеек (св-во JoinEqualCells) + - объединение одинаковых строковых значений внутри ячейки (св-во AllowDuplicates) + - возможность вывода посторонних объектов внутри кросс-таблицы + - свойства AddWidth, AddHeight для увеличения ширины и высоты ячейки + - свойство AutoSize, возможность менять размеры ячеек вручную +- объект "Линия" может иметь стрелки +- добавлено св-во TfrxPictureView.FileLink (может содержать переменную или +имя файла) +- индивидуальное оформление каждой линии рамки (свойства Frame.LeftLine, +TopLine, RightLine, BottomLine - настраиваются в инспекторе) +- поддержка PNG изображений (раскомментируйте {$DEFINE PNG} в файле frx.inc) +- поддержка экспорта в формат Open Document Format for Office Applications (OASIS), таблиц (ods) и текстовых документов (odt) + +Enterprise компоненты: +- Поддержка разграничения доступа на основе политики Пользователей/Групп (добавлено новое demo) +- Поддержка шаблонов +- Динамическое обновление конфигурации, списка пользователей/групп + diff --git a/official/4.2/comp_developers.txt b/official/4.2/comp_developers.txt new file mode 100644 index 0000000..fc83632 --- /dev/null +++ b/official/4.2/comp_developers.txt @@ -0,0 +1,15 @@ +This file describes changes in FastReport 4 related to custom components +development. + +- The component icon size is 16x16 pixels. + +- There is no toolbar categories (frxObjects.RegisterCategory) in FastReport 4. +However you may still use it. + +- You don't need to use FImageIndex or Bitmap in non-visual components +(TfrxDialogComponent ancestors). It's enough to setup an icon when registering +the component (frxObjects.Register). This icon will be used to draw a component. + +- The wizard's icon size is 16x16 pixels for toolbar wizard and 32x32 pixels +for File|New... wizard. + diff --git a/official/4.2/comp_developers_rus.txt b/official/4.2/comp_developers_rus.txt new file mode 100644 index 0000000..137b8ad --- /dev/null +++ b/official/4.2/comp_developers_rus.txt @@ -0,0 +1,16 @@ +‡¤Ґбм ®ЇЁб ­л Ё§¬Ґ­Ґ­Ёп ў FastReport 4, Є б ойЁҐбп а §а Ў®вЄЁ б®Ўб⢥­­ле +Є®¬Ї®­Ґ­в. + +- ђ §¬Ґа ЁЄ®­ЄЁ Є®¬Ї®­Ґ­в  16x16 ЇЁЄбҐ«Ґ©. + +- ‚ FastReport 4 ­Ґв Є вҐЈ®аЁ© ў Ї ­Ґ«пе Ё­бва㬥­в®ў +(frxObjects.RegisterCategory). ’Ґ¬ ­Ґ ¬Ґ­ҐҐ, ўл ¬®¦ҐвҐ Їа®¤®«¦ вм Ёе +ЁбЇ®«м§®ў вм. + +- ‚ ¬ ­Ґ ­г¦­® ЁбЇ®«м§®ў вм FImageIndex Ё«Ё Bitmap ў ­ҐўЁ§г «м­ле Є®¬Ї®­Ґ­в е +(­ б«Ґ¤­ЁЄ е TfrxDialogComponent). „®бв в®з­® § ¤ вм ЁЄ®­Єг Є®¬Ї®­Ґ­в  ЇаЁ ҐЈ® +ॣЁбва жЁЁ (frxObjects.Register). ќв  ЁЄ®­Є  Ўг¤Ґв ЁбЇ®«м§®ў ­  ЇаЁ ®ваЁб®ўЄҐ +Є®¬Ї®­Ґ­в . + +- ђ §¬Ґа ЁЄ®­ЄЁ ўЁ§ а¤  16x16 ЇЁЄбҐ«Ґ© ¤«п ўЁ§ а¤®ў, а §¬Ґй Ґ¬ле ­  Ї ­Ґ«Ё +гЇа ў«Ґ­Ёп, Ё 32x32 ЇЁЄбҐ«  ¤«п ўЁ§ а¤®ў ў ¬Ґ­о "” ©«|Ќ®ўл©...". diff --git a/official/4.2/compatibility.txt b/official/4.2/compatibility.txt new file mode 100644 index 0000000..ed4bbd2 --- /dev/null +++ b/official/4.2/compatibility.txt @@ -0,0 +1,32 @@ +Compatibility issues between FastReport 3 and FastReport 4: + +- v4 uses the same file/package names as v3. You have to uninstall v3 before +installing v4. + +- v4 uses the same file format, .fr3 and can open v3 files without any problems. +Most of new report files also can be opened by v3, but not all. + +- v4 can read v3 .fp3 files. + +- New kind of page, "Data" page is introduced in v4. This page contains all +internal datasets of your report. When opening old v3 files, v4 automatically +adds the "Data" page and moves all datasets on it. + +- Since all v4 reports contain a "Data" page, you should check your Delphi +code where you access a report page by index. The "Data" page is always the +first one. So code like Page := frxReport1.Pages[0] will return a data page. +You should correct that code (either use [1] or access a page by its name). + +- Check your reports that contain the Cross-tab object! +a) In v4, this object draws cross-tab elements in design-time +and is bigger than in v3. So you have to correct bands that contain +such object. +b) New behavior introduced in v4 - table can have corner, title, cell headers. +All these properties are on by default. You may turn off corner and title +(ShowCorner, ShowTitle properties) if not needed, and fill in the cell +headers elements. +c) In v4, table has several cell elements. Each cell element has its own +font/color/frame/... settings. In v3 you were able to setup only one cell +element. You should set the fonts and colors for each new element, if needed. + +- frxHiButtons unit is no longer used - remove it from your "uses" list diff --git a/official/4.2/compatibility_rus.txt b/official/4.2/compatibility_rus.txt new file mode 100644 index 0000000..7f1afe0 --- /dev/null +++ b/official/4.2/compatibility_rus.txt @@ -0,0 +1,32 @@ +Совместимость между FastReport 3 и FastReport 4: + +- v4 имеет те же имена пакетов и классов, что и v3. Перед установкой v4 +удалите v3. + +- v4 использует тот же самый формат файлов .fr3 и может открывать файлы v3 +без проблем. Большинство файлов V4 могут быть также открыты в v3, но не все. + +- v4 может открывать файлы v3 .fp3. + +- В v4 появился новый вид страницы, "Данные". Эта страница содержит все +внутренние источники данных отчета. При открытии старых v3 файлов, v4 +автоматически добавляет в отчет эту страницу и переносит все данные на нее. + +- Т.к. все v4 отчеты содержат страницу "Данные", вам нужно проверить ваш +Delphi код, где идет обращение к странице отчета по индексу. Страница +"Данные" имеет индекс 0, и код типа Page := frxReport1.Pages[0] вернет +страницу "Данные". Вы должны исправить индекс на [1] или обращаться к странице +по имени. + +- Проверьте отчеты, содержащие объект Cross-tab! +а) в v4 объект рисует элементы таблицы в дизайнере и поэтому имеет больший +размер. Вам нужно поправить высоту бэндов, содержащих этот объект. +б) в v4 появились новые возможности - таблица может содержать элементы +в левом верхнем углу, заголовок, заголовки ячеек. Вы можете отключить угол и +заголовок таблицы (свойства ShowCorner, ShowTitles), если они не нужны, +а также заполнить элементы заголовков ячеек. +в) в v4 таблица содержит много ячеек. Это сделано для индивидуальной настройки +каждой ячейки. Вы должны проверить настройки (цвет, шрифт, рамка) каждой +ячейки и при необходимости исправить. + +- Модуль frxHiButtons больше не используется - удалите его из списка "uses". diff --git a/official/4.2/file_id.diz b/official/4.2/file_id.diz new file mode 100644 index 0000000..8d6949e --- /dev/null +++ b/official/4.2/file_id.diz @@ -0,0 +1,9 @@ +----------------------------------------- + FastReport v4 + Report generator + for Delphi 4-7,2005, BDS 2006,2007 + and C++Builder 4-6,2006 + + (c) 1998-2007 by Alexander Tzyganenko, + Fast Reports Inc. +----------------------------------------- diff --git a/official/4.2/frx_icon.ico b/official/4.2/frx_icon.ico new file mode 100644 index 0000000..3838d05 Binary files /dev/null and b/official/4.2/frx_icon.ico differ diff --git a/official/4.2/install.txt b/official/4.2/install.txt new file mode 100644 index 0000000..5842e68 --- /dev/null +++ b/official/4.2/install.txt @@ -0,0 +1,262 @@ +TABLE OF CONTENTS + +I. Introduction +II. Manual installing of the FastReport packages +III. Recompiling FastReport Basic Edition and Standard Edition packages +IV. Recompiling FastReport Pro Edition and Enterprise Edition packages + +------------------------------------------------------------------------ +I. Introduction + +FastReport comes with precompiled *.dcu, *.bpl, *.dcp files. Installation +program puts the runtime packages to the system folder and installs other +packages into the Delphi. You don't need to install anything manually. +However, if you change FR sources, change the language resources, or have +another version of TeeChart, IBX or any standard Delphi components, you'll +need to recompile FR packages. + +FastReport includes several packages, divided into runtime and design-time +parts. Design-time packages have 'dcl' prefix in the package name. Each +package has a number, corresponding to the Delphi version. For example, +dclfrx4.dpk is a design-time package for Delphi4. Here is a list of +runtime packages used by FastReport ('*' denotes a Delphi version): + +fs*.dpk - FastScript, main package +fsDB*.dpk - FastScript, DB classes and controls +fsBDE*.dpk - FastScript, BDE components +fsADO*.dpk - FastScript, ADO components +fsIBX*.dpk - FastScript, IBX components +fsTee*.dpk - FastScript, TeeChart components +frx*.dpk - FastReport, main package +frxDB*.dpk - FastReport, TDataSet wrapper (TfrxDBDataSet) +frxIBO*.dpk - FastReport, IB_Objects wrapper (TfrxIBODataSet) +frxBDE*.dpk - FastReport, end-user BDE components +frxADO*.dpk - FastReport, end-user ADO components +frxIBX*.dpk - FastReport, end-user IBX components +frxDBX*.dpk - FastReport, end-user DBX components +frxTee*.dpk - FastReport, TeeChart components +frxe*.dpk - FastReport, export filters + +Design-time packages are: + +dclfs*.dpk +dclfsDB*.dpk +dclfsBDE*.dpk +dclfsADO*.dpk +dclfsIBX*.dpk +dclfsTee*.dpk +dclfrx*.dpk +dclfrxDB*.dpk +dclfrxIBO*.dpk +dclfrxBDE*.dpk +dclfrxADO*.dpk +dclfrxIBX*.dpk +dclfrxDBX*.dpk +dclfrxTee*.dpk +dclfrxe*.dpk + +------------------------------------------------------------------------ +II. Manual installing of the FastReport packages + +Perform the following steps if you want to install FastReport packages +manually. + +Step 1. Copy runtime packages to System folder +- close Delphi +- copy \Lib\fs*.bpl file (* = your Delphi version) to Windows\System32 + (Windows\System for Windows 95/98/ME) +- copy \Lib\fsDB*.bpl file to Windows\System32 +- copy \Lib\fsBDE*.bpl file to Windows\System32 +- copy \Lib\fsADO*.bpl file to Windows\System32 +- copy \Lib\fsIBX*.bpl file to Windows\System32 +- copy \Lib\fsTee*.bpl file to Windows\System32 +- copy \Lib\frx*.bpl file to Windows\System32 +- copy \Lib\frxDB*.bpl file to Windows\System32 +- copy \Lib\frxBDE*.bpl file to Windows\System32 +- copy \Lib\frxADO*.bpl file to Windows\System32 +- copy \Lib\frxIBX*.bpl file to Windows\System32 +- copy \Lib\frxDBX*.bpl file to Windows\System32 +- copy \Lib\frxTee*.bpl file to Windows\System32 +- copy \Lib\frxe*.bpl file to Windows\System32 + +Step 2. Install packages +- in the Delphi IDE, select "Component|Install Packages..." menu item +- press "Add..." button and select \Lib\dclfs*.bpl file (* = your Delphi version) +- press "Add..." button and select \Lib\dclfsDB*.bpl file +- press "Add..." button and select \Lib\dclfsBDE*.bpl file +- press "Add..." button and select \Lib\dclfsADO*.bpl file (D5+) +- press "Add..." button and select \Lib\dclfsIBX*.bpl file (D5+) +- press "Add..." button and select \Lib\dclfsTee*.bpl file +- press "Add..." button and select \Lib\dclfrx*.bpl file +- press "Add..." button and select \Lib\dclfrxDB*.bpl file +- press "Add..." button and select \Lib\dclfrxBDE*.bpl file +- press "Add..." button and select \Lib\dclfrxADO*.bpl file (D5+) +- press "Add..." button and select \Lib\dclfrxIBX*.bpl file (D5+) +- press "Add..." button and select \Lib\dclfrxDBX*.bpl file (D6+) +- press "Add..." button and select \Lib\dclfrxTee*.bpl file +- press "Add..." button and select \Lib\dclfrxe*.bpl file + +Step 3. Add paths to library path +- in the Delphi IDE, select "Tools|Environmet options..." menu item +- go "Library" tab, "Library path" edit box +- add path to "FastReport 4\Lib" folder + +------------------------------------------------------------------------ +III. Recompiling FastReport Basic Edition and Standard Edition packages + +Perform the following steps if you want to recompile FastReport packages. + +Step 0 (for FastReport Basic Edition only) +- open the FastReport 4\Lib\frxReg.inc file and uncomment the following line: +{$DEFINE FR_VER_BASIC} + +Step 1. Add paths to library path +1.1. in the Delphi IDE, select "Tools|Environmet options..." menu +1.2. go "Library" tab, "Library path" edit box +1.3. add path to FastReport 4\Lib folder + +Step 2. Compile runtime packages +2.1. repeat the 2.2-2.4 steps for the following packages: +- FastReport 4\Lib\fs*.dpk (* = your delphi version) +- FastReport 4\Lib\fsDB*.dpk +- FastReport 4\Lib\fsBDE*.dpk +- FastReport 4\Lib\fsADO*.dpk +- FastReport 4\Lib\fsIBX*.dpk +- FastReport 4\Lib\fsTee*.dpk +- FastReport 4\Lib\frx*.dpk +- FastReport 4\Lib\frxDB*.dpk +- FastReport 4\Lib\frxADO*.dpk (FR3 Std only) +- FastReport 4\Lib\frxBDE*.dpk (FR3 Std only) +- FastReport 4\Lib\frxIBX*.dpk (FR3 Std only) +- FastReport 4\Lib\frxDBX*.dpk (FR3 Std only) +- FastReport 4\Lib\frxTee*.dpk +- FastReport 4\Lib\frxe*.dpk +2.2. open the package (by "File|Open project..." menu, select "Delphi + package (*.dpk)" as a file type) +2.3. press the "Compile" button +2.4. close the "Package" dialog + +Step 3. Copy runtime packages to system folder +3.1. copy the following files from the Delphi_dir\Projects\Bpl folder + to the Windows\System32 folder (or Windows\System for Win9x/Me): +- fs*.bpl (* = your delphi version) +- fsDB*.bpl +- fsBDE*.bpl +- fsADO*.bpl +- fsIBX*.bpl +- fsTee*.bpl +- frx*.bpl +- frxDB*.bpl +- frxADO*.bpl (FR3 Std only) +- frxBDE*.bpl (FR3 Std only) +- frxIBX*.bpl (FR3 Std only) +- frxDBX*.bpl (FR3 Std only) +- frxTee*.bpl +- frxe*.bpl +3.2. note for Delphi4 users: *.bpl files are sitting in the FastReport 4\Lib + folder, not in the Delphi_dir\Projects\Bpl folder + +Step 4. Compile and install design-time packages +4.1. repeat the 4.2-4.5 steps for the following packages: +- FastReport 4\Lib\dclfs*.dpk (* = your delphi version) +- FastReport 4\Lib\dclfsDB*.dpk +- FastReport 4\Lib\dclfsBDE*.dpk +- FastReport 4\Lib\dclfsADO*.dpk +- FastReport 4\Lib\dclfsIBX*.dpk +- FastReport 4\Lib\dclfsTee*.dpk +- FastReport 4\Lib\dclfrx*.dpk +- FastReport 4\Lib\dclfrxDB*.dpk +- FastReport 4\Lib\dclfrxADO*.dpk (FR3 Std only) +- FastReport 4\Lib\dclfrxBDE*.dpk (FR3 Std only) +- FastReport 4\Lib\dclfrxIBX*.dpk (FR3 Std only) +- FastReport 4\Lib\dclfrxDBX*.dpk (FR3 Std only) +- FastReport 4\Lib\dclfrxTee*.dpk +- FastReport 4\Lib\dclfrxe*.dpk +4.2. open the package (by "File|Open project..." menu, select "Delphi + package (*.dpk)" as a file type) +4.3. press the "Compile" button +4.4. press the "Install" button +4.5. close the "Package" dialog, answer "NO" when Delphi asks to save changes! + +------------------------------------------------------------------------ +IV. Recompiling FastReport Pro Edition and Enterprise Edition packages + +Perform the following steps if you have changed FastReport sources +and want to recompile them. + +Step 1. Remove old binary files +1.1. in the Delphi IDE, select "Tools|Environmet options..." menu +1.2. go "Library" tab, "Library path" edit box +1.3. remove path to FastReport 4\Lib folder + +Step 2. Add paths to library path +2.1. in the Delphi IDE, select "Tools|Environmet options..." menu +2.2. go "Library" tab, "Library path" edit box +2.3. add path to FastReport 4\FastScript, FastReport 4\Source, + FastReport 4\Source\BDE,ADO,IBX,DBX, FastReport 4\Source\ExportPack + +Step 3. Compile runtime packages +3.1. repeat the 3.2-3.4 steps for the following packages: +- FastReport 4\FastScript\fs*.dpk (* = your delphi version) +- FastReport 4\FastScript\fsDB*.dpk +- FastReport 4\FastScript\fsBDE*.dpk +- FastReport 4\FastScript\fsADO*.dpk +- FastReport 4\FastScript\fsIBX*.dpk +- FastReport 4\FastScript\fsTee*.dpk +- FastReport 4\Source\frx*.dpk +- FastReport 4\Source\frxDB*.dpk +- FastReport 4\Source\ADO\frxADO*.dpk +- FastReport 4\Source\BDE\frxBDE*.dpk +- FastReport 4\Source\IBX\frxIBX*.dpk +- FastReport 4\Source\DBX\frxDBX*.dpk +- FastReport 4\Source\frxTee*.dpk +- FastReport 4\Source\ExportPack\frxe*.dpk +3.2. open the package (by "File|Open project..." menu, select "Delphi + package (*.dpk)" as a file type) +3.3. press the "Compile" button +3.4. close the "Package" dialog + +Step 4. Copy runtime packages to system folder +4.1. copy the following files from the Delphi_dir\Projects\Bpl folder + to the Windows\System32 folder (or Windows\System for Win9x/Me): +- fs*.bpl (* = your delphi version) +- fsDB*.bpl +- fsBDE*.bpl +- fsADO*.bpl +- fsIBX*.bpl +- fsTee*.bpl +- frx*.bpl +- frxDB*.bpl +- frxADO*.bpl +- frxBDE*.bpl +- frxIBX*.bpl +- frxDBX*.bpl +- frxTee*.bpl +- frxe*.bpl +4.2. note for Delphi4 users: *.bpl files are sitting in the source folders, + not in the Delphi_dir\Projects\Bpl folder: + FastReport 4\FastScript, FastReport 4\Source, + FastReport 4\Source\BDE,ADO,IBX,DBX, FastReport 4\Source\ExportPack + +Step 5. Compile and install design-time packages +5.1. repeat the 5.2-5.5 steps for the following packages: +- FastReport 4\FastScript\dclfs*.dpk (* = your delphi version) +- FastReport 4\FastScript\dclfsDB*.dpk +- FastReport 4\FastScript\dclfsBDE*.dpk +- FastReport 4\FastScript\dclfsADO*.dpk +- FastReport 4\FastScript\dclfsIBX*.dpk +- FastReport 4\FastScript\dclfsTee*.dpk +- FastReport 4\Source\dclfrx*.dpk +- FastReport 4\Source\dclfrxDB*.dpk +- FastReport 4\Source\ADO\dclfrxADO*.dpk +- FastReport 4\Source\BDE\dclfrxBDE*.dpk +- FastReport 4\Source\IBX\dclfrxIBX*.dpk +- FastReport 4\Source\DBX\dclfrxDBX*.dpk +- FastReport 4\Source\dclfrxTee*.dpk +- FastReport 4\Source\ExportPack\dclfrxe*.dpk +5.2. open the package (by "File|Open project..." menu, select "Delphi + package (*.dpk)" as a file type) +5.3. press the "Compile" button +5.4. press the "Install" button +5.5. close the "Package" dialog, answer "NO" when Delphi asks to save changes! + diff --git a/official/4.2/install_rus.txt b/official/4.2/install_rus.txt new file mode 100644 index 0000000..28c8e87 --- /dev/null +++ b/official/4.2/install_rus.txt @@ -0,0 +1,265 @@ +СОДЕРЖАНИЕ + +I. Введение +II. Ручная установка пакетов FastReport +III. Компиляция пакетов FastReport Basic Edition и Standard Edition +IV. Компиляция пакетов FastReport Professional Edition и Enterprise Edition + +------------------------------------------------------------------------ +I. Введение + +FastReport поставляется с откомпилированными файлами *.dcu, *.bpl, *.dcp. +Программа установки копирует runtime пакеты в системную папку и устанавливает +остальные пакеты в Delphi. Вам ничего не нужно устанавливать вручную. +Тем не менее, если вы изменили исходники FR, поменяли языковые ресурсы, +или имеете другую версию TeeChart, IBX или прочих компонент Delphi, вы должны +перекомпилировать пакеты FR. + +FastReport состоит из нескольких пакетов, разделенных на runtime и design-time +части. Design-time пакеты имеют префикс 'dcl' в имени пакета. Каждый пакет +имеет номер, соответствующий версии Delphi. Например, пакет dclfrx4.dpk - это +design-time пакет для Delphi4. Ниже приведен список run-time пакетов, +используемых FastReport ('*' означает версию Delphi): + +fs*.dpk - FastScript, основной пакет +fsDB*.dpk - FastScript, DB классы и контролы +fsBDE*.dpk - FastScript, BDE компоненты +fsADO*.dpk - FastScript, ADO компоненты +fsIBX*.dpk - FastScript, IBX компоненты +fsTee*.dpk - FastScript, Tee компоненты +frx*.dpk - FastReport, основной пакет +frxDB*.dpk - FastReport, обертка над TDataSet (TfrxDBDataSet) +frxIBO*.dpk - FastReport, обертка над IB_Objects (TfrxIBODataSet) +frxBDE*.dpk - FastReport, BDE компоненты +frxADO*.dpk - FastReport, ADO компоненты +frxIBX*.dpk - FastReport, IBX компоненты +frxDBX*.dpk - FastReport, DBX компоненты +frxTee*.dpk - FastReport, Tee компоненты +frxe*.dpk - FastReport, фильтры экспорта + +Design-time пакеты: + +dclfs*.dpk +dclfsDB*.dpk +dclfsBDE*.dpk +dclfsADO*.dpk +dclfsIBX*.dpk +dclfsTee*.dpk +dclfrx*.dpk +dclfrxDB*.dpk +dclfrxIBO*.dpk +dclfrxBDE*.dpk +dclfrxADO*.dpk +dclfrxIBX*.dpk +dclfrxDBX*.dpk +dclfrxTee*.dpk +dclfrxe*.dpk + +------------------------------------------------------------------------ +II. Ручная установка пакетов FastReport + +Выполните следующие действия для ручной установки пакетов FastReport, +входящих в стандартную поставку. + +Шаг 1. Копирование run-time пакетов в системную папку +- закройте Delphi +- скопируйте \Lib\fs*.bpl файл (* = версия Delphi) в Windows\System32 + (Windows\System для Windows 95/98/ME) +- скопируйте \Lib\fsDB*.bpl файл в Windows\System32 +- скопируйте \Lib\fsBDE*.bpl файл в Windows\System32 +- скопируйте \Lib\fsADO*.bpl файл в Windows\System32 +- скопируйте \Lib\fsIBX*.bpl файл в Windows\System32 +- скопируйте \Lib\fsTee*.bpl файл в Windows\System32 +- скопируйте \Lib\frx*.bpl файл в Windows\System32 +- скопируйте \Lib\frxDB*.bpl файл в Windows\System32 +- скопируйте \Lib\frxBDE*.bpl файл в Windows\System32 +- скопируйте \Lib\frxADO*.bpl файл в Windows\System32 +- скопируйте \Lib\frxIBX*.bpl файл в Windows\System32 +- скопируйте \Lib\frxDBX*.bpl файл в Windows\System32 +- скопируйте \Lib\frxTee*.bpl файл в Windows\System32 +- скопируйте \Lib\frxe*.bpl файл в Windows\System32 + +Шаг 2. Установка design-time пакетов +- в Delphi IDE, выберите "Component|Install Packages..." +- нажмите кнопку "Add..." и выберите файл \Lib\dclfs*.bpl (* = версия Delphi) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfsDB*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfsBDE*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfsADO*.bpl (D5+) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfsIBX*.bpl (D5+) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfsTee*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrx*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxDB*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxBDE*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxADO*.bpl (D5+) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxIBX*.bpl (D5+) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxDBX*.bpl (D6+) +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxTee*.bpl +- нажмите кнопку "Add..." и выберите файл \Lib\dclfrxe*.bpl + +Шаг 3. Добавление путей +- в Delphi IDE, выберите "Tools|Environmet options..." +- переключитесь на закладку "Library", строка ввода "Library path" +- добавьте путь к папке "FastReport 4\Lib" + +------------------------------------------------------------------------ +III. Компиляция пакетов FastReport Basic Edition и Standard Edition + +Выполните следующие действия для компиляции пакетов FastReport +(при внесении изменений в исходный код и др.) + +Шаг 0 (только для FastReport Basic Edition) +- откройте файл FastReport 4\Lib\frxReg.inc и раскомментируйте строку: +{$DEFINE FR_VER_BASIC} + +Шаг 1. Добавление путей +1.1. в Delphi IDE, выберите "Tools|Environmet options..." +1.2. переключитесь на закладку "Library", строка ввода "Library path" +1.3. добавьте путь к папке FastReport 4\Lib + +Шаг 2. Компиляция run-time пакетов +2.1. повторите шаги 2.2-2.4 для следующих пакетов: +- FastReport 4\Lib\fs*.dpk (* = версия Delphi) +- FastReport 4\Lib\fsDB*.dpk +- FastReport 4\Lib\fsBDE*.dpk +- FastReport 4\Lib\fsADO*.dpk +- FastReport 4\Lib\fsIBX*.dpk +- FastReport 4\Lib\fsTee*.dpk +- FastReport 4\Lib\frx*.dpk +- FastReport 4\Lib\frxDB*.dpk +- FastReport 4\Lib\frxADO*.dpk (FR3 Std) +- FastReport 4\Lib\frxBDE*.dpk (FR3 Std) +- FastReport 4\Lib\frxIBX*.dpk (FR3 Std) +- FastReport 4\Lib\frxDBX*.dpk (FR3 Std) +- FastReport 4\Lib\frxTee*.dpk +- FastReport 4\Lib\frxe*.dpk +2.2. откройте пакет (с помощью команды меню "File|Open project...", выберите + "Delphi package (*.dpk)" в качестве типа файла) +2.3. нажмите кнопку "Compile" +2.4. закройте диалог "Package" + +Шаг 3. Копирование run-time пакетов в системную папку +3.1. скопируйте следующие файлы из папки Delphi_dir\Projects\Bpl + в папку Windows\System32 (Windows\System для Win9x/Me): +- fs*.bpl (* = версия Delphi) +- fsDB*.bpl +- fsBDE*.bpl +- fsADO*.bpl +- fsIBX*.bpl +- fsTee*.bpl +- frx*.bpl +- frxDB*.bpl +- frxADO*.bpl (FR3 Std) +- frxBDE*.bpl (FR3 Std) +- frxIBX*.bpl (FR3 Std) +- frxDBX*.bpl (FR3 Std) +- frxTee*.bpl +- frxe*.bpl +3.2. замечание для пользователей Delphi4: файлы *.bpl находятся в папке + FastReport 4\Lib, а не в Delphi_dir\Projects\Bpl + +Шаг 4. Компиляция и установка design-time пакетов +4.1. повторите шаги 4.2-4.5 для следующих пакетов: +- FastReport 4\Lib\dclfs*.dpk (* = версия Delphi) +- FastReport 4\Lib\dclfsDB*.dpk +- FastReport 4\Lib\dclfsBDE*.dpk +- FastReport 4\Lib\dclfsADO*.dpk +- FastReport 4\Lib\dclfsIBX*.dpk +- FastReport 4\Lib\dclfsTee*.dpk +- FastReport 4\Lib\dclfrx*.dpk +- FastReport 4\Lib\dclfrxDB*.dpk +- FastReport 4\Lib\dclfrxADO*.dpk (FR3 Std) +- FastReport 4\Lib\dclfrxBDE*.dpk (FR3 Std) +- FastReport 4\Lib\dclfrxIBX*.dpk (FR3 Std) +- FastReport 4\Lib\dclfrxDBX*.dpk (FR3 Std) +- FastReport 4\Lib\dclfrxTee*.dpk +- FastReport 4\Lib\dclfrxe*.dpk +4.2. откройте пакет (с помощью команды меню "File|Open project...", выберите + "Delphi package (*.dpk)" в качестве типа файла) +4.3. нажмите кнопку "Compile" +4.4. нажмите кнопку "Install" +4.5. закройте диалог "Package", ответьте "NO" когда Delphi попросит + сохранить изменения! + +------------------------------------------------------------------------ +IV. Компиляция пакетов FastReport Professional Edition и Enterprise Edition + +Выполните следующие действия для компиляции исходного кода FastReport +(при внесении изменений в исходный код и др.) + +Шаг 1. Удаление путей к старым файлам +1.1. в Delphi IDE, выберите "Tools|Environmet options..." +1.2. переключитесь на закладку "Library", строка ввода "Library path" +1.3. удалите путь к папке FastReport 4\Lib + +Шаг 2. Добавление путей +2.1. в Delphi IDE, выберите "Tools|Environmet options..." +2.2. переключитесь на закладку "Library", строка ввода "Library path" +2.3. добавьте путь к папкам FastReport 4\FastScript, FastReport 4\Source, + FastReport 4\Source\BDE,ADO,IBX,DBX, FastReport 4\Source\ExportPack + +Шаг 3. Компиляция run-time пакетов +3.1. повторите шаги 3.2-3.4 для следующих пакетов: +- FastReport 4\FastScript\fs*.dpk (* = версия Delphi) +- FastReport 4\FastScript\fsDB*.dpk +- FastReport 4\FastScript\fsBDE*.dpk +- FastReport 4\FastScript\fsADO*.dpk +- FastReport 4\FastScript\fsIBX*.dpk +- FastReport 4\FastScript\fsTee*.dpk +- FastReport 4\Source\frx*.dpk +- FastReport 4\Source\frxDB*.dpk +- FastReport 4\Source\ADO\frxADO*.dpk +- FastReport 4\Source\BDE\frxBDE*.dpk +- FastReport 4\Source\IBX\frxIBX*.dpk +- FastReport 4\Source\DBX\frxDBX*.dpk +- FastReport 4\Source\frxTee*.dpk +- FastReport 4\Source\ExportPack\frxe*.dpk +3.2. откройте пакет (с помощью команды меню "File|Open project...", выберите + "Delphi package (*.dpk)" в качестве типа файла) +3.3. нажмите кнопку "Compile" +3.4. закройте диалог "Package" + +Шаг 4. Копирование run-time пакетов в системную папку +4.1. скопируйте следующие файлы из папки Delphi_dir\Projects\Bpl + в папку Windows\System32 (Windows\System для Win9x/Me): +- fs*.bpl (* = версия Delphi) +- fsDB*.bpl +- fsBDE*.bpl +- fsADO*.bpl +- fsIBX*.bpl +- fsTee*.bpl +- frx*.bpl +- frxDB*.bpl +- frxADO*.bpl +- frxBDE*.bpl +- frxIBX*.bpl +- frxDBX*.bpl +- frxTee*.bpl +- frxe*.bpl +4.2. замечание для пользователей Delphi4: файлы *.bpl находятся в папках с + исходниками, а не в Delphi_dir\Projects\Bpl: + FastReport 4\FastScript, FastReport 4\Source, + FastReport 4\Source\BDE,ADO,IBX,DBX, FastReport 4\Source\ExportPack + +Шаг 5. Компиляция и установка design-time пакетов +5.1. повторите шаги 5.2-5.5 для следующих пакетов: +- FastReport 4\FastScript\dclfs*.dpk (* = версия Delphi) +- FastReport 4\FastScript\dclfsDB*.dpk +- FastReport 4\FastScript\dclfsBDE*.dpk +- FastReport 4\FastScript\dclfsADO*.dpk +- FastReport 4\FastScript\dclfsIBX*.dpk +- FastReport 4\FastScript\dclfsTee*.dpk +- FastReport 4\Source\dclfrx*.dpk +- FastReport 4\Source\dclfrxDB*.dpk +- FastReport 4\Source\ADO\dclfrxADO*.dpk +- FastReport 4\Source\BDE\dclfrxBDE*.dpk +- FastReport 4\Source\IBX\dclfrxIBX*.dpk +- FastReport 4\Source\DBX\dclfrxDBX*.dpk +- FastReport 4\Source\dclfrxTee*.dpk +- FastReport 4\Source\ExportPack\dclfrxe*.dpk +5.2. откройте пакет (с помощью команды меню "File|Open project...", выберите + "Delphi package (*.dpk)" в качестве типа файла) +5.3. нажмите кнопку "Compile" +5.4. нажмите кнопку "Install" +5.5. закройте диалог "Package", ответьте "NO" когда Delphi попросит + сохранить изменения! + diff --git a/official/4.2/license.rtf b/official/4.2/license.rtf new file mode 100644 index 0000000..2a4e9df --- /dev/null +++ b/official/4.2/license.rtf @@ -0,0 +1,117 @@ +{\rtf1\ansi\ansicpg1251\deff0\deflang1049\deflangfe1049{\fonttbl{\f0\fswiss\fprq2\fcharset204{\*\fname Arial;}Arial CYR;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\froman\fprq2\fcharset0 Times New Roman;}{\f3\fswiss\fprq2\fcharset204 Tahoma;}{\f4\froman\fprq2\fcharset204{\*\fname Times New Roman;}Times New Roman CYR;}} +{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\nowidctlpar\ri3452\tx5812\tx6096\b\f0\fs16 FastReport \lang1033\f1 4\lang1049\f0\par +\lang1033\b0\f2\par +\lang1049\b\f0 SINGLE USER SOFTWARE LICENSE AND LIMITED WARRANTY\par +\lang1033\b0\f2\par +\lang1049\f0 PLEASE READ THIS SOFTWARE LICENSE AGREEMENT CAREFULLY BEFORE \line DOWNLOADING OR USING THE SOFTWARE. BY CLICKING ON THE "ACCEPT" \line BUTTON, OPENING THE PACKAGE, DOWNLOADING THE PRODUCT, OR USING \line THE EQUIPMENT THAT CONTAINS THIS PRODUCT, YOU ARE CONSENTING TO \line BE BOUND BY THIS AGREEMENT. IF YOU DO NOT AGREE TO ALL OF THE TERMS \line OF THIS AGREEMENT, CLICK THE "DO NOT ACCEPT" BUTTON AND THE \line INSTALLATION PROCESS WILL NOT CONTINUE, RETURN THE PRODUCT TO THE \line PLACE OF PURCHASE FOR A FULL REFUND, OR DO NOT DOWNLOAD THE \line PRODUCT.\par +\par +\pard\nowidctlpar\ri3452\sb100\sa100\tx5812\tx6096 This license agreement covers your use of the FastReport \lang1033\f1 4\lang1049\f0 , its source code, \line documentation, and executable files, hereinafter referred to as \i "Product"\i0 . \par +\pard\nowidctlpar\ri3452\tx5812\tx6096 The Product is Copyright \'a9 1998-200\lang1033\f1 7\lang1049\f0 Fast Reports Inc. You may use it and distribute it \line according to this following License Agreement. If you do not agree with these terms, \line please remove the Product from your system. By incorporating the Product in your work \line or distributing the Product to others you implicitly agree to these license terms.\par +\pard\nowidctlpar\ri3452\sb100\sa100\tx5812\tx6096 The Product is, and remains, Copyright \'a9 1998-200\lang1033\f1 7\lang1049\f0 Fast Reports Inc., with exception of \line specific copyrights as noted in the individual source files. \par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\lang1049\b\f0 The Product is distributed as try-before-you-buy product. This means:\par +\lang1033\b0\f2\par +\lang1049\f0 All copyrights to Product are exclusively owned by the author - Fast Reports Inc. Product \line is protected by copyright laws. At all times Fast Reports Inc. retains full title to the \line software. Subject to your acceptance of and accordance with the terms and conditions \line stated in this agreement, you shall be granted a single-user software license. Any \line previous agreement with FastReports Inc. is superseded by this agreement.\par +\par +Anyone may use trial version of Product as long as you want. You can try trial version of \line Product, which prints only five page of report. Full version of Product not contain such \line restrictions and shipped with compiled modules (Basic Edition and Standard Edition) or \line with full source code (Professional Edition and Enterprise Edition). To use full version of \line Product, you MUST register.\par +\par +The Product unregistered trial version, may be freely distributed, with exceptions noted \line below, provided the distribution package is not modified. No person or company may \line charge a fee for the distribution of Product without written permission from the copyright \line holder. The Product unregistered trial version may not be bundled or distributed with any \line other package without written permission of the copyright holder.\par +\par +Kinds of register is listed in README.TXT.\par +\par +\b REGISTER THIS SOFTWARE LICENSE GIVES YOU THE RIGHT TO:\par +\lang1033\b0\f2\par +\lang1049\f0 1. Install and use the Product for the sole purposes of designing, developing, testing, and \line deploying application programs which you create. You may install a copy of the Product \line on a computer and freely move the Product from one computer to another, provided that \line you are the only individual using the Product. If you are an entity, you must designate one \line individual within your organization ("Named User") to have the right to use the Product. \par +\par +2. Write and compile your own application programs using the Product contained in this \line package. All copies of the Product you so write and distribute must include a Fast Reports \line Inc. copyright notice, or a valid copyright notice of your own.\par +\par +3. Make one copy of the Product for backup or archival purposes or copy the Product to a \line single permanent storage medium provided you keep the original solely for backup or \line archival purposes.\par +\par +4. Technical support and notifications on those new versions Product, which can upgrade \line with no additional payment. \par +\par +5. The registered Product may not be rented or leased, but may be permanently \line transferred, if the person receiving it agrees to terms of this license. If the software is an \line update, the transfer must include the update and all previous versions. \par +\par +6. It is not provided any additional license deductions, except for cost of the registration, \line connected with creation and distribution of reports and forms of Product. The registered \line users, can use Product as "Royalty free". It means, that they freely may distribute the \line programs using Product if it does not contradict conditions of this license agreement. Any \line sanctions to that on from the author is not required.\par +\par +\b ENGAGING IN ANY OF THE ACTIVITIES LISTED BELOW WILL TERMINATE THE \line SOFTWARE LICENSE. IN ADDITION TO SOFTWARE LICENSE TERMINATION, \line FAST REPORTS INC. MAY PURSUE CRIMINAL, CIVIL, OR ANY OTHER \line AVAILABLE REMEDIES.\par +\lang1033\b0\f2\par +\lang1049\f0 1. Distribution of any files contained in this software package, other than the runtime \par +packages explicitly listed above, including but not limited to .PAS, .DFM, .DCU files, .DCP \line files, and design-time packages.\par +\par +2. Modification, decompilation, disassembly, reverse engineering or translation of the Product.\par +\par +3. Removal of proprietary notices, labels or marks from the Product or Product \line Documentation.\par +\par +4. Inclusion of the Product in a development environment, CRM or ERP systems. \line\par +5. Creation of an application that does not differ materially from the Product.\line\par +6. Development and/or distribution of a stand-alone reporting application based on the \line Product.\par +\par +7. Creation of an application (whether it be freeware, shareware or a commercial product) \par +which competes directly or indirectly with the Product. \par +\f3\par +In these cases you need other type of license.\f0\par +\par +\b AGREEMENT PERTAINING TO THE RELEASE OF SOURCE CODE by Fast Reports, \line Inc. to Recipient:\par +\lang1033\b0\f2\par +\lang1049\i\f0 USE OF SOURCE CODE\par +\i0 Recipient will not utilize the source for the creation of Product (whether it be freeware, \line shareware or a commercial product) which competes directly or indirectly with Product. In \line addition, Recipient will not disclose the source itself, nor the implementations discovered \line therein, to any party involved in the creation of software which competes directly or \line indirectly with Product.\par +\par +\i DISTRIBUTION OF SOURCE CODE\par +\i0 Recipient will not distribute the Product. Specifically this includes all .dcu, .dfm, and .pas \line files which Fast Reports has provided.\par +\par +\i CHANGES TO SOURCE CODE\par +\i0 Fast Reports reserves the right to change any part of the source in future versions of the \line Product. These changes may include the removal of classes, properties and methods or \line the creation of new classes, properties and methods.\par +\par +\i TECHNICAL SUPPORT FOR SOURCE CODE\par +\i0 Fast Reports will not provide support for changes Recipient makes to the source. \line Recipient assumes full responsibility for supporting any code or application which results \line from such modification. Recipient will not hold Fast Reports liable, directly or indirectly, \line for any changes made to the source, including changes which Recipient has made based \line on advice or suggestions provided by Fast Reports.\par +\pard\nowidctlpar\ri3452\sb100\sa100\tx5812\tx6096 You must clearly indicate any modifications at the start of each source file. The user of \line any modified Product code must know that the source file is not original. \par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\lang1049\i\f0 SOURCE IS PROVIDED AS IS\par +\i0 PRODUCT IS DISTRIBUTED "AS IS". NO WARRANTY OF ANY KIND IS EXPRESSED \line OR IMPLIED. YOU USE AT YOUR OWN RISK. FAST REPORTS WILL NOT BE LIABLE \line FOR DATA LOSS, DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS \line WHILE USING OR MISUSING THIS PRODUCT\par +\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\i TERM AND TERMINATION. \par +\i0 The license granted under this Agreement will continue in force until terminated, as set \line forth herein. If Licensee fails to pay any monies or provide any services due in connection \line with the Product, or violates any term or condition of this Agreement, Fast Reports or its \line agent may terminate this License immediately by giving notice of termination to Licensee. \line Licensee is responsible for providing valid contact information to Fast Reports. If no valid \line contact information is available for Licensee in Fast Reports' records, Fast Reports is not \line required to give notice of termination to Licensee. Licensee also may terminate this \line License voluntarily by giving notice of termination to Fast Reports and destroying or \line returning to Fast Reports all copies of all or any part of the Product and related user \line documentation in Licensee's possession or under Licensee's control.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 EFFECT OF TERMINATION. \par +\i0 Immediately upon termination, Licensee will destroy or return to Fast Reports all copies of \line all or any part of the Product in Licensee's possession or under Licensee's control. \line Licensee will have no right to keep or use any copy of the Product and related user \line documentation for any purpose after termination of this Agreement.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 TRANSFER OF PRODUCT\par +\i0 Licensee shall not have the right to transfer this Product license, without the prior written \line consent of Fast Reports.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 CONFIDENTIALITY. \par +\i0 The parties to this Agreement will take all reasonable steps to ensure that any material or \line information identified by either party to be confidential ("Confidential Information"), which \line the other party has possession or knowledge of in connection with this Agreement, will \line not be disclosed to others, in whole or in part, without the prior written permission of the \line other party. Neither party will have the obligation to maintain the confidentiality of any \line data or information which (i) was in the receiving party's lawful possession prior to receipt \line from the other party, (ii) is later lawfully obtained by the receiving party from a third party \line having no obligation of secrecy to the other party, (iii) is available to the public through no \line act or failure of the receiving party, (iv) is readily available in the public domain, or (v) is \line independently developed by the receiving party. The receiving party will immediately \line return or destroy any or all Confidential Information that has been provided to it by the \line other party, upon the other party's request. \par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 PRODUCT WARRANTY\par +\i0 Fast Reports warrants the Product to conform to the description of its function and \line performance. In the event that the Software does not perform in accordance with this \line warranty, Fast Reports agrees to repair or fix any non-conformity free of charge, or to \line refund any amount paid by Licensee for the Product. Product that does not perform in \line accordance with its description due to one or more of the following causes will not be \line covered by this warranty: (i) The code or related files are changed by anyone other than \line Fast Reports, or (ii) if the Product is custom Product developed for Licensee, the custom \line Product is installed by anyone other than Fast Reports.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 REFUNDS\par +\i0 In the event that Fast Reports refunds any amounts paid by Licensee for the Product, \line pursuant to Paragraph above, Licensee understands and agrees that this Agreement and \line the Product license are terminated, and Fast Reports will withdraw Product, code and \line related documentation provided under this Agreement. Upon receipt of such refund, \line Licensee agrees that it will no longer use, display or otherwise control the Product, code \line or related documentation for which the refund was issued.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\b\f0 DISCLAIMER OF WARRANTY FOR PRODUCT\par +\b0 EXCEPT FOR THE EXPRESS WARRANTIES SET FORTH IN THIS AGREEMENT, \line FAST REPORTS DISCLAIMS ALL IMPLIED WARRANTIES FOR THE PRODUCT, \line INCLUDING WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A \line PARTICULAR PURPOSE. FAST REPORTS MAKES NO REPRESENTATIONS \line CONCERNING THE QUALITY OF THE PRODUCT AND DOES NOT PROMISE THAT \line THE PRODUCT WILL BE ERROR FREE OR WILL OPERATE WITHOUT \line INTERRUPTION. \par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\b\f0 LIMITATION OF LIABILITY\par +\b0 IN NO EVENT WILL FAST REPORTS BE LIABLE FOR ANY DIRECT, INDIRECT, \line INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT OF \line THE USE OF THE PRODUCT BY ANY PERSON, REGARDLESS OF WHETHER FAST \line REPORTS IS INFORMED OF THE POSSIBILITY OF DAMAGES IN ADVANCE. THESE \line LIMITATIONS APPLY TO ALL CAUSES OF ACTION, INCLUDING BREACH OF \line CONTRACT, BREACH OF WARRANTY, FAST REPORTS' NEGLIGENCE, STRICT \line LIABILITY, MISREPRESENTATION AND OTHER TORTS.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 OWNERSHIP OF PRODUCT\par +\i0 Fast Reports has and will retain all ownership rights in the Product, including all patent \line rights, copyrights, trade secrets, trademarks, service marks, related goodwill and \line confidential and proprietary information. Licensee will have no rights in the Product \line except as explicitly stated in this Agreement.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 ASSIGNMENT AND DELEGATION\par +\i0 Licensee may not assign this Agreement or any rights under it and may not delegate any \line duties under this Agreement without Fast Reports' prior written consent. Any attempt to \line assign or delegate without that consent will be void.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\lang1049\i\f0 GENERAL\par +\i0 This Agreement constitutes the entire understanding between Fast Reports and Licensee \line with respect to subject matter hereof. Any change to this Agreement must be in writing, \line signed by Fast Reports and Licensee. Terms and conditions set forth in any purchase \line order which differ from, conflict with, or are not included in this Agreement, shall not \line become part of this Agreement unless specifically accepted by Fast Reports in writing. \line Licensee shall be responsible for and shall pay, and shall reimburse Fast Reports on \line request if Fast Reports is required to pay, any sales, use, value added (VAT), \line consumption or other tax (excluding any tax that is based on Fast Reports' net income), \line assessment, duty, tariff, or other fee or charge of any kind or nature that is levied or \line imposed by any governmental authority on the Product. \par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\lang1049\b\f0 All rights not expressly granted here are reserved by Fast Reports Inc.\par +\par +\pard\nowidctlpar\ri3452\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx5812\tx6096\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656 LICENSEE HAS READ THIS AGREEMENT AND UNDERSTANDS AND\par +\pard\nowidctlpar\ri3452\sb100\sa100\tx5812\tx6096 AGREES TO ALL OF ITS TERMS AND CONDITIONS.\par +\pard\nowidctlpar\ri3452\tx5812\tx6096\lang1033\f2\par +\lang1049\f0 Thank you for using FastReport!\par +\par +\b0 Alexander Tzyganenko\par +\pard\nowidctlpar\ri3452\sb100\sa100\tx5812\tx6096 (CTO of Fast Reports Inc.)\par +\par +\pard\nowidctlpar\f4\fs20\par +} + \ No newline at end of file diff --git a/official/4.2/license_rus.rtf b/official/4.2/license_rus.rtf new file mode 100644 index 0000000..fb6f352 --- /dev/null +++ b/official/4.2/license_rus.rtf @@ -0,0 +1,425 @@ +{\rtf1\adeflang1037\ansi\ansicpg1251\uc1\adeff0\deff0\stshfdbch13\stshfloch0\stshfhich0\stshfbi0\deflang1049\deflangfe2052{\fonttbl{\f0\froman\fcharset204\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fswiss\fcharset204\fprq2{\*\panose 020b0604020202020204}Arial;} +{\f13\fnil\fcharset134\fprq2{\*\panose 02010600030101010101}SimSun{\*\falt \'cb\'ce\'cc\'e5};}{\f36\fswiss\fcharset204\fprq2{\*\panose 020b0604020202020204}Arial CYR;}{\f37\fnil\fcharset134\fprq2{\*\panose 02010600030101010101}@SimSun;} +{\f40\froman\fcharset0\fprq2 Times New Roman;}{\f38\froman\fcharset238\fprq2 Times New Roman CE;}{\f41\froman\fcharset161\fprq2 Times New Roman Greek;}{\f42\froman\fcharset162\fprq2 Times New Roman Tur;} +{\f43\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f44\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}{\f45\froman\fcharset186\fprq2 Times New Roman Baltic;}{\f46\froman\fcharset163\fprq2 Times New Roman (Vietnamese);} +{\f50\fswiss\fcharset0\fprq2 Arial;}{\f48\fswiss\fcharset238\fprq2 Arial CE;}{\f51\fswiss\fcharset161\fprq2 Arial Greek;}{\f52\fswiss\fcharset162\fprq2 Arial Tur;}{\f53\fbidi \fswiss\fcharset177\fprq2 Arial (Hebrew);} +{\f54\fbidi \fswiss\fcharset178\fprq2 Arial (Arabic);}{\f55\fswiss\fcharset186\fprq2 Arial Baltic;}{\f56\fswiss\fcharset163\fprq2 Arial (Vietnamese);}{\f170\fnil\fcharset0\fprq2 SimSun Western{\*\falt \'cb\'ce\'cc\'e5};} +{\f400\fswiss\fcharset0\fprq2 Arial CYR;}{\f398\fswiss\fcharset238\fprq2 Arial CYR CE;}{\f401\fswiss\fcharset161\fprq2 Arial CYR Greek;}{\f402\fswiss\fcharset162\fprq2 Arial CYR Tur;}{\f403\fbidi \fswiss\fcharset177\fprq2 Arial CYR (Hebrew);} +{\f404\fbidi \fswiss\fcharset178\fprq2 Arial CYR (Arabic);}{\f405\fswiss\fcharset186\fprq2 Arial CYR Baltic;}{\f406\fswiss\fcharset163\fprq2 Arial CYR (Vietnamese);}{\f410\fnil\fcharset0\fprq2 @SimSun Western;}}{\colortbl;\red0\green0\blue0; +\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128; +\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch \af0\afs24\alang1037 \ltrch +\fs24\lang1049\langfe2052\loch\f0\hich\af0\dbch\af13\cgrid\langnp1049\langfenp2052 \snext0 Normal;}{\*\cs10 \additive \ssemihidden Default Paragraph Font;}{\* +\ts11\tsrowd\trftsWidthB3\trpaddl108\trpaddr108\trpaddfl3\trpaddft3\trpaddfb3\trpaddfr3\trcbpat1\trcfpat1\tscellwidthfts0\tsvertalt\tsbrdrt\tsbrdrl\tsbrdrb\tsbrdrr\tsbrdrdgl\tsbrdrdgr\tsbrdrh\tsbrdrv +\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \rtlch \af0\afs20 \ltrch \fs20\lang1024\langfe1024\cgrid\langnp1024\langfenp1024 \snext11 \ssemihidden Normal Table;}}{\*\latentstyles\lsdstimax156\lsdlockeddef0} +{\*\rsidtbl \rsid1969254}{\*\generator Microsoft Word 11.0.5604;}{\info{\author Alexander}{\operator Alexander}{\creatim\yr2006\mo10\dy28\hr13\min10}{\revtim\yr2006\mo10\dy28\hr13\min11}{\version2}{\edmins1}{\nofpages5}{\nofwords2184}{\nofchars12450} +{\nofcharsws14605}{\vern24689}}\margl1701\margr850\margt1134\margb1134\ltrsect \deftab708\widowctrl\ftnbj\aenddoc\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\hyphcaps0\horzdoc\dghspace120\dgvspace120\dghorigin1701\dgvorigin1984\dghshow0 +\dgvshow3\jcompress\viewkind4\viewscale148\viewzk2\nolnhtadjtbl\rsidroot1969254 \fet0\ltrpar \sectd \ltrsect\linex0\sectdefaultcl\sftnbj {\*\pnseclvl1\pnucrm\pnqc\pnstart1\pnindent720\pnhang {\pntxta .}}{\*\pnseclvl2 +\pnucltr\pnqc\pnstart1\pnindent720\pnhang {\pntxta .}}{\*\pnseclvl3\pndec\pnqc\pnstart1\pnindent720\pnhang {\pntxta .}}{\*\pnseclvl4\pnlcltr\pnqc\pnstart1\pnindent720\pnhang {\pntxta )}}{\*\pnseclvl5\pndec\pnqc\pnstart1\pnindent720\pnhang {\pntxtb (} +{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnqc\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnqc\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnqc\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}} +{\*\pnseclvl9\pnlcrm\pnqc\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}\pard\plain \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0 \rtlch \af0\afs24\alang1037 \ltrch +\fs24\lang1049\langfe2052\loch\af0\hich\af0\dbch\af13\cgrid\langnp1049\langfenp2052 {\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 FastReport }{\rtlch \ab\af1\afs16 \ltrch \b\f1\fs16\insrsid1969254\charrsid1969254 +\hich\af1\dbch\af13\loch\f1 4}{\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \line \line \loch\af36\dbch\af13\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'ff\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed +\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'e5\'ed\'e8\'e5\line +\par }\pard \ltrpar\ql \li0\ri3452\nowidctlpar\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'cf\'ce\'c6\'c0\'cb\'d3\'c9\'d1\'d2\'c0\loch\f36 \hich\f36 , \'c2\'cd\'c8\'cc\'c0\'d2\'c5\'cb\'dc\'cd +\'ce\loch\f36 \hich\f36 \'cf\'d0\'ce\'d7\'c8\'d2\'c0\'c9\'d2\'c5\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'ce\'c5\loch\f36 \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 \'cf\'d0\'c5\'c6\'c4\'c5\loch\f36 \line \hich\f36 \'d7\'c5\'cc +\loch\f36 \hich\f36 \'ca\'ce\'cf\'c8\'d0\'ce\'c2\'c0\'d2\'dc\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'c8\'d1\'cf\'ce\'cb\'dc\'c7\'ce\'c2\'c0\'d2\'dc\loch\f36 \hich\f36 \'cf\'d0\'ce\'c3\'d0\'c0\'cc\'cc\'cd\'ce\'c5\loch\f36 \hich\f36 \'ce +\'c1\'c5\'d1\'cf\'c5\'d7\'c5\'cd\'c8\'c5\loch\f36 . +\par }\pard \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'cd\'c0\'c6\'c8\'cc\'c0\'df\loch\f36 \hich\f36 "\'cf\'d0\'c8\'cd\'c8\'cc\'c0\'de\loch\f36 +\hich\f36 ", \'ce\'d2\'ca\'d0\'db\'c2\'c0\'df\loch\f36 \hich\f36 \'cf\'c0\'ca\'c5\'d2\loch\f36 \hich\f36 , \'d1\'ca\'c0\'d7\'c8\'c2\'c0\'df\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \line \hich\f36 \'c8 +\'d1\'cf\'ce\'cb\'dc\'c7\'d3\'df\loch\f36 \hich\f36 \'ce\'c1\'ce\'d0\'d3\'c4\'ce\'c2\'c0\'cd\loch\af36\dbch\af13\hich\f36 \'c8\'c5\loch\f36 \hich\f36 , \'ca\'ce\'d2\'ce\'d0\'ce\'c5\loch\f36 \hich\f36 \'d1\'ce\'c4\'c5\'d0\'c6\'c8\'d2\loch\f36 \hich\f36 +\'c4\'c0\'cd\'cd\'db\'c9\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 , \'c2\'db\loch\f36 \line \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c0\'c5\'d2\'c5\'d1\'dc\loch\f36 \hich\f36 \'c1\'db\'d2\'dc\loch\f36 \hich\f36 \'d1\'c2\'df\'c7 +\'c0\'cd\'cd\'db\'cc\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'db\'cc\loch\f36 \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c5\'cd\'c8\'c5\'cc\loch\f36 \hich\f36 . \'c5\'d1\'cb\'c8\loch\f36 \hich\f36 \'c2\'db\loch\f36 \hich\f36 \'cd\'c5\loch\f36 \line \hich\f36 +\'d1\'ce\'c3\'cb\'c0\'d1\'cd\'db\loch\f36 \hich\f36 \'d1\'ce\loch\f36 \hich\f36 \'c2\'d1\'c5\'cc\'c8\loch\f36 \hich\f36 \'d3\'d1\'cb\'ce\'c2\'c8\'df\'cc\'c8\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8 +\'c5\'cd\'c8\'df\loch\f36 \hich\f36 , \'cd\'c0\'c6\'cc\'c8\'d2\'c5\loch\f36 \hich\f36 "\'cd\'c5\loch\f36 \line \hich\f36 \'cf\'d0\'c8\'cd\'c8\'cc\'c0\'de\loch\f36 \hich\f36 " \'c8\loch\f36 \hich\f36 \'cf\'d0\'ce\'d6\'c5\'d1\'d1\loch\f36 \hich\f36 \'d3 +\'d1\'d2\'c0\'cd\'ce\'c2\'ca\'c8\loch\f36 \hich\f36 \'cf\'d0\'c5\'d0\'c2\'c5\'d2\'d1\'df\loch\f36 \hich\f36 , \'c2\'c5\'d0\'cd\'c8\'d2\'c5\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 \'c2\loch\f36 \line \hich\f36 \'cc\'c5\'d1 +\'d2\'ce\loch\f36 \hich\f36 \'cf\'ce\'ca\'d3\'cf\'ca\'c8\loch\f36 \hich\f36 \'c7\'c0\loch\f36 \hich\f36 \'cf\'ce\'cb\'cd\'ce\'c5\loch\f36 \hich\f36 \'c2\'ce\'c7\'cc\'c5\'d9\'c5\'cd\'c8\loch\af36\dbch\af13\hich\f36 \'c5\hich\af36\dbch\af13\loch\f36 +\hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'cd\'c5\loch\f36 \hich\f36 \'d1\'ca\'c0\'d7\'c8\'c2\'c0\'c9\'d2\'c5\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 . +\par }\pard \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0\pararsid1969254 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c4\'e0\'ed\'ed\'ee\'e5\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'ee +\'ed\'ed\'ee\'e5\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'ea\'e0\'f1\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'e2\'e0\'f8\'e5\'e3\'ee\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'ff +\loch\f36 }{\rtlch \ai\af36\afs16 \ltrch \i\f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 FastReport }{\rtlch \ai\af36\afs16 \ltrch \i\f36\fs16\insrsid1969254\charrsid1969254 \hich\af36\dbch\af13\loch\f36 4}{\rtlch \af36\afs16 \ltrch +\f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 , \line \hich\f36 \'e5\'e3\'ee\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ea\'ee\'e4\'e0\loch\f36 \hich\f36 , \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'e8 +\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'ed\'ff\'e5\'ec\'fb\'f5\loch\f36 \hich\f36 \'f4\'e0\'e9\'eb\'ee\'e2\loch\f36 \hich\f36 , \'e4\'e0\'eb\'e5\'e5\loch\f36 \hich\f36 \'ee\'e1\'ee\'e7\'ed\'e0\'f7\'e0\'e5\'ec\'fb\'f5 +\loch\f36 \hich\f36 \'ea\'e0\'ea\loch\f36 \line }{\rtlch \ai\af36\afs16 \ltrch \i\f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 \hich\f36 "\'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 "}{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 +\hich\af36\dbch\af13\loch\f36 . +\par }\pard \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c2\'f1\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'ed\'e0\loch\f36 +\hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'ef\'f0\'e8\'ed\'e0\'e4\'eb\'e5\'e6\'e0\'f2\loch\f36 \hich\f36 Fast Reports Inc. \'c2\'fb\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\'e5\hich\af36\dbch\af13\loch\f36 \hich\f36 \'e5\'e3\'ee +\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'e8\loch\f36 \line \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'f2\'fc\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee\loch\f36 \hich\f36 \'e4 +\'e0\'ed\'ed\'ee\'ec\'f3\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'ee\'ed\'ed\'ee\'ec\'f3\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'fe\loch\f36 \hich\f36 . \'c5\'f1\'eb\'e8\loch\f36 \hich\f36 \'e2\'fb\loch\f36 \hich\f36 \'ed\'e5 +\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'fb\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'fb\'ec\'e8\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'ff\'ec\'e8\loch\f36 \hich\f36 , \'ef\'ee\'e6\'e0\'eb\'f3\'e9\'f1\'f2\'e0 +\loch\f36 \hich\f36 , \'f3\'e4\'e0\'eb\'e8\'f2\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'e8\'e7\loch\f36 \hich\f36 \'e2\'e0\'f8\'e5\'e9\loch\f36 \hich\f36 \'f1\'e8\'f1\'f2\'e5\'ec\'fb\loch\f36 . \line \hich\f36 \'c8\'f1 +\'ef\'ee\'eb\'fc\'e7\'f3\'ff\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e2\'e0\'f8\'e5\'e9\loch\f36 \hich\f36 \'f0\'e0\'e1\'ee\'f2\'e5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f0\'e0\'f1 +\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'ff\loch\f36 \hich\f36 \'e5\'e3\'ee\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'e8\'ec\loch\f36 \hich\f36 , \'e2\'fb\loch\f36 \hich\f36 \'e2\'f1\'e5\'f6\'e5\'eb\'ee\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e0 +\'e5\'f2\'e5\'f1\'fc\hich\af36\dbch\af13\loch\f36 \loch\af36\dbch\af13\hich\f36 \'f1\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'ff\'ec\'e8\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'e8\loch\f36 . + +\par \loch\af36\dbch\af13\hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'ff\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'ed\'ee\loch\f36 \hich\f36 -\'e1\'e5\'f1\'ef\'eb\'e0\'f2\'ed\'fb\'ec\loch\f36 \hich\f36 , \'f0\'e0\'f1 +\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'e5\'ec\'fb\'ec\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \hich\f36 \'ef\'f0\'e8\'ed\'f6\'e8\'ef\'f3\loch\f36 \hich\f36 "\'ef\'ee\'ef\'f0\'ee\'e1\'f3\'e9\loch\f36 \line \hich\f36 \'ef\'e5\'f0\'e5\'e4\loch\f36 \hich\f36 + \'f2\'e5\'ec\loch\f36 \hich\f36 , \'ea\'e0\'ea\loch\f36 \hich\f36 \'ea\'f3\'ef\'e8\'f2\'fc\loch\f36 \hich\f36 ". \'dd\'f2\'ee\loch\f36 \hich\f36 \'ee\'e7\'ed\'e0\'f7\'e0\'e5\'f2\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 : +\par \loch\af36\dbch\af13\hich\f36 \'ca\'e0\'ea\loch\f36 \hich\f36 \'e0\'e2\'f2\'ee\'f0\'f1\'ea\'ee\'e5\loch\f36 \hich\f36 \'e8\'e7\'e4\'e5\'eb\'e8\'e5\loch\f36 \hich\f36 Fast Reports Inc., \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'e7\'e0\'f9\'e8 +\'f9\'e5\'ed\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e8\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \line \hich\f36 \'e7\'e0\'ea\'ee\'ed\'e0\'ec\'e8\loch\f36 \hich\f36 \'ee\'e1\loch\f36 \hich\f36 \'e0\'e2\'f2 +\'ee\'f0\'f1\'ea\'ee\'ec\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e5\loch\f36 . Fa\hich\af36\dbch\af13\loch\f36 \hich\f36 st Reports Inc. \'f1\'ee\'f5\'f0\'e0\'ed\'ff\'e5\'f2\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'f1\'ee\'e1\'ee\'e9\loch\f36 +\hich\f36 \'ef\'ee\'eb\'ed\'ee\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \line \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e5\loch\f36 \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'e5\loch\f36 +\hich\f36 . \'cf\'f0\'e8\'ed\'ff\'f2\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'e8\'e5\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'ff\'ec\'e8\loch\f36 \hich\f36 , \'e7\'e0\'ff\'e2\'eb\'e5\'ed +\'ed\'fb\'ec\'e8\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'fd\'f2\'ee\'ec\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 , \'ef\'f0\'e5\'e4\'ee\'f1\'f2\'e0\'e2\'e8\'f2\loch\f36 \hich\f36 \'c2\'e0\'ec\loch\f36 +\hich\f36 \'ee\'e4\'ed\'ee\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\'f1\'ea\'f3\'fe\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'fe\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 . \'cb\'fe +\'e1\'ee\'e5\loch\f36 \line \hich\f36 \'ef\'f0\'e5\'e4\'fb\'e4\'f3\'f9\'e5\'e5\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 Fast Reports Inc. \'ef\'ee\loch\f36 \hich\f36 \'cf\'f0\'ee +\loch\af36\dbch\af13\hich\f36 \'e4\loch\af36\dbch\af13\hich\f36 \'f3\'ea\'f2\'f3\loch\f36 \hich\f36 \'e7\'e0\'ec\'e5\'ed\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'fb\'ec\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5 +\'ec\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'c2\'fb\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\'e5\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ee\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'e2\'e5 +\'f0\'f1\'e8\'fe\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'ef\'f0\'ee\'f2\'ff\'e6\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'ef\'e5\'f0\'e8\'ee +\'e4\'e0\loch\f36 \hich\f36 \'e2\'f0\'e5\'ec\'e5\'ed\'e8\loch\f36 \hich\f36 . \'ce\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ef\'f0\'ee\'ff\'e2\'eb\'ff\'fe\'f2\loch\f36 \hich\f36 \'f1\'e5\'e1\'ff\loch\f36 \hich\f36 \'f2\'ee\'eb\'fc +\'ea\'ee\loch\f36 \hich\f36 \'ef\'f0\'e8\loch\f36 \hich\f36 \'ef\'e5\'f7\'e0\'f2\'e8\loch\f36 \hich\f36 \'ee\'f2\'f7\'e5\'f2\'e0\loch\f36 \hich\f36 : \'ec\'ee\'e6\'ed\'ee\loch\f36 \line \hich\f36 \'f0\'e0\'f1\'ef\'e5\'f7\'e0\'f2\'e0\'f2\'fc\loch\f36 +\hich\f36 \'f2\'ee\'eb\'fc\'ea\'ee\loch\f36 \hich\f36 \'ef\'ff\'f2\'fc\loch\f36 \hich\f36 \'f1\'f2\'f0\'e0\'ed\'e8\'f6\loch\f36 \hich\f36 \'ee\'f2\'f7\'e5\'f2\'e0\loch\f36 \hich\f36 . \'cf\'ee\'eb\'ed\'e0\'ff\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8 +\'ff\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ed\loch\af36\dbch\af13\hich\f36 \'e5\loch\f36 \hich\f36 \'f1\'ee\'e4\'e5\'f0\'e6\'e8\'f2\loch\f36 \line \hich\f36 \'fd\'f2\'e8\'f5\loch\f36 \hich\f36 \'ee\'e3\'f0\'e0\'ed +\'e8\'f7\'e5\'ed\'e8\'e9\loch\f36 \hich\f36 . \'cf\'ee\'f1\'f2\'e0\'e2\'ea\'e0\loch\f36 \hich\f36 \'ef\'ee\'eb\'ed\'ee\'e9\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'e8\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ee\'f1\'f3 +\'f9\'e5\'f1\'f2\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \line \hich\f36 \'f1\'ea\'ee\'ec\'ef\'e8\'eb\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'ec\'ee\'e4\'f3\'eb\'ff\'f5\loch\f36 \hich\f36 (\'e2\'e0\'f0\'e8\'e0\'ed +\'f2\'fb\loch\f36 \hich\f36 Basic \'e8\loch\f36 \hich\f36 Standard) \'e8\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'fb\'f5\loch\f36 \hich\f36 \'f2\'e5\'ea\'f1\'f2\'e0\'f5\loch\f36 \line \hich\f36 (\'e2\'e0\'f0\'e8\'e0\'ed +\'f2\'fb\loch\f36 \hich\f36 Professional \'e8\loch\f36 \hich\f36 Enterprise). \'c5\'f1\'eb\'e8\loch\f36 \hich\f36 \'e2\'fb\loch\f36 \hich\f36 \'f5\'ee\'f2\'e8\'f2\'e5\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 +\hich\f36 \'ef\'ee\'eb\'ed\'f3\'fe\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'fe\loch\f36 \line \hich\f36 \'fd\'f2\'ee\'e9\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e9\loch\f36 \hich\f36 \'f0\'e0\loch\af36\dbch\af13\hich\f36 \'e7 +\loch\af36\dbch\af13\hich\f36 \'f0\'e0\'e1\'ee\'f2\'ea\'e8\loch\f36 \hich\f36 , \'f2\'ee\loch\f36 \hich\f36 \'c4\'ce\'cb\'c6\'cd\'db\loch\f36 \hich\f36 \'e7\'e0\'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e8\'f0\'ee\'e2\'e0\'f2\'fc\'f1\'ff\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'cd\'e5\'e7\'e0\'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'e0\'ff\loch\f36 \hich\f36 \'ee\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'ed\'e0\'ff\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'ff\loch\f36 \hich\f36 \'cf\'f0 +\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'f2\'fc\'f1\'ff\loch\f36 \line \hich\f36 \'f1\'e2\'ee\'e1\'ee\'e4\'ed\'ee\loch\f36 \hich\f36 (\'ea\'f0\'ee\'ec\'e5 +\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\'e2\loch\f36 \hich\f36 , \'ee\'e3\'ee\'e2\'ee\'f0\'e5\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'ed\'e8\'e6\'e5\loch\f36 \hich\f36 ) \'e2\loch\f36 \hich\f36 \'f2\'ee\'ec\loch\f36 \hich\f36 \'e2\'e8\'e4\'e5 +\loch\f36 \hich\f36 , \'e2\loch\f36 \hich\f36 \'ea\'ee\'f2\'ee\'f0\'ee\'ec\loch\f36 \hich\f36 \'ee\'ed\'e0\loch\f36 \line \hich\f36 \'ef\'ee\'f1\'f2\'e0\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 . \'cd\'e8\'ea\'e0\'ea\'e8\'e5\loch\f36 \hich\f36 +\'f4\'e8\'e7\'e8\'f7\'e5\'f1\'ea\'e8\'e5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'fe\'f0\'e8\'e4\'e8\'f7\'e5\'f1\'ea\'e8\'e5\loch\f36 \hich\f36 \'eb\'e8\'f6\'e0\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e8\'ec\'e5\'fe\'f2\loch\f36 +\hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'e2\'e7\'e8\'ec\loch\af36\dbch\af13\hich\f36 \'e0\'f2\'fc\loch\f36 \line \hich\f36 \'ee\'ef\'eb\'e0\'f2\'f3\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed +\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e1\'e5\'e7\loch\f36 \hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'f0\'e0\'e7\'f0\'e5\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ee +\'e1\'eb\'e0\'e4\'e0\'f2\'e5\'eb\'ff\loch\f36 \line \hich\f36 \'e0\'e2\'f2\'ee\'f0\'f1\'ea\'e8\'f5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\loch\f36 \hich\f36 . \'c7\'e0\'ef\'f0\'e5\'f9\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2 +\'f0\'e0\'ed\'ff\'f2\'fc\loch\f36 \hich\f36 \'ed\'e5\'e7\'e0\'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'f3\'fe\loch\f36 \line \hich\f36 \'ee\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'fe\loch\f36 +\hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'ea\'ee\'ec\'ef\'eb\'e5\'ea\'f2\'e5\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'fb\'f5\loch\f36 \hich\f36 \'ef\'e0\'ea\'e5\'f2\'ee\'e2\loch\f36 +\hich\f36 \'e1\'e5\'e7\loch\f36 \hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'f0\'e0\'e7\'f0\'e5\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ee\'e1\'eb\'e0\'e4\'e0\'f2\'e5\'eb\'ff\loch\f36 \hich\f36 \'e0\'e2\'f2\'ee +\'f0\'f1\'ea\'e8\'f5\loch\f36 \hich\f36 \'ef\loch\af36\dbch\af13\hich\f36 \'f0\loch\af36\dbch\af13\hich\f36 \'e0\'e2\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'d1\'ef\'ee\'f1\'ee\'e1\'fb\loch\f36 \hich\f36 \'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'f7\'e8\'f1\'eb\'e5\'ed\'fb\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f4\'e0\'e9\'eb\'e5 +\loch\f36 "readme.rus" +\par }{\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'d0\'c5\'c3\'c8\'d1\'d2\'d0\'c0\'d6\'c8\'df\loch\f36 \hich\f36 \'ce\'c4\'cd\'ce\'c9\loch\f36 \hich\f36 \'cb\'c8\'d6\'c5\'cd\'c7\'c8\'c8\loch\f36 \hich\f36 \'cf\'d0 +\'ce\'c3\'d0\'c0\'cc\'cc\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'ce\'c1\'c5\'d1\'cf\'c5\'d7\'c5\'cd\'c8\'df\loch\f36 \hich\f36 \'c4\'c0\'c5\'d2\loch\f36 \line \hich\f36 \'c2\'c0\'cc\loch\f36 \hich\f36 \'cf\'d0\'c0\'c2\'ce\loch\f36 \hich\f36 \'cd\'c0 +\loch\f36 : +\par }{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 \hich\f36 1. \'d3\'f1\'f2\'e0\'ed\'ee\'e2\'ea\'f3\loch\f36 \hich\f36 , \'e8\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 +\'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e4\'eb\'ff\loch\f36 \hich\f36 \'e5\'e4\'e8\'ed\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'f6\'e5\'eb\'e8\loch\f36 \hich\f36 \'ef\'f0\'ee\'e5\'ea\'f2\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'ff +\loch\f36 , \line \hich\f36 \'f0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'ea\'e8\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'ee\'f2\'eb\'e0\'e4\'ea\'e8\loch\f36 \hich\f36 \'ef\'f0\'e8\'ea\'eb\'e0\'e4\'ed\'fb\'f5\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec +\'ec\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'fb\'e5\hich\af36\dbch\af13\loch\f36 \hich\f36 \'c2\'fb\loch\f36 \hich\f36 \'f1\'ee\'e7\'e4\'e0\'e5\'f2\'e5\loch\f36 \hich\f36 . \'c2\'fb\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\'e5\loch\f36 \line +\hich\f36 \'f3\'f1\'f2\'e0\'ed\'ee\'e2\'e8\'f2\'fc\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'fe\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'ea\'ee\'ec\'ef\'fc\'fe\'f2\'e5\'f0\'e5\loch\f36 \hich\f36 +\'e8\loch\f36 \hich\f36 \'f1\'e2\'ee\'e1\'ee\'e4\'ed\'ee\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'ec\'e5\'f9\'e0\'f2\'fc\loch\f36 \hich\f36 \'cf\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e5\loch\f36 \line \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'e5 +\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'ee\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ea\'ee\'ec\'ef\'fc\'fe\'f2\'e5\'f0\'e0\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 , \'ef\'f0\'e8\loch\f36 +\hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'e8\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'c2\'fb\loch\f36 \hich\f36 - \'e5\'e4\'e8\'ed\'f1\'f2\'e2\'e5\'ed\'ed\'fb\'e9\loch\f36 \line \hich\f36 \'e8\'ed\'e4\'e8\'e2\'e8\'e4\'f3\'f3\'ec\loch\f36 +\hich\f36 , \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'f3\'fe\'f9\'e8\'e9\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 . \'c5\'f1\'eb\'e8\loch\f36 \hich\f36 \'c2\'fb\loch\f36 \hich\f36 - \'fe\'f0\'e8\'e4\'e8\'f7\'e5\'f1\'ea\'ee\'e5\loch\f36 +\hich\f36 \'eb\'e8\'f6\'ee\loch\f36 \hich\f36 , \'c2\'fb\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'ed\'fb\loch\f36 \line \hich\f36 \'ee\'ef\'f0\loch\af36\dbch\af13\hich\f36 \'e5\loch\af36\dbch\af13\hich\f36 \'e4\'e5\'eb\'e8\'f2\'fc\loch\f36 \hich\f36 \'ee +\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'e8\'ed\'e4\'e8\'e2\'e8\'e4\'f3\'f3\'ec\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'e5\'eb\'e0\'f5\loch\f36 \hich\f36 \'e2\'e0\'f8\'e5\'e9\loch\f36 \hich\f36 \'ee\'f0\'e3\'e0\'ed\'e8\'e7 +\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 (\'e2\loch\f36 \hich\f36 \'e4\'e0\'eb\'fc\'ed\'e5\'e9\'f8\'e5\'ec\loch\f36 \line \hich\f36 "\'cf\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 ") \'f7\'f2\'ee\'e1\'fb\loch\f36 \hich\f36 \'e8\'ec\'e5 +\'f2\'fc\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 2. \'cd\'e0\'ef\'e8\'f1\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'ea\'ee\'ec\'ef\'e8\'eb\'ff\'f6\'e8\'fe\loch\f36 \hich\f36 \'e2\'e0\'f8\'e8\'f5\loch\f36 \hich\f36 \'f1\'ee\'e1\'f1\'f2\'e2\'e5 +\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'ef\'f0\'e8\'ea\'eb\'e0\'e4\'ed\'fb\'f5\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\loch\f36 , \line \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'f3\'fe\'f9\'e8\'f5\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec +\'ec\'ed\'ee\'e5\loch\f36 \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 , \'f1\'ee\'e4\'e5\'f0\'e6\'e0\'f9\'e5\'e5\'f1\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e5\loch\f36 . +\loch\af36\dbch\af13\hich\f36 \'c2\'f1\'e5\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'e8\loch\f36 \line \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ea\'ee +\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'c2\'fb\loch\f36 \hich\f36 \'ef\'e8\'f8\'e5\'f2\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'e5\'f2\'e5\loch\f36 \hich\f36 , \'e4\'ee\'eb\'e6\'ed\'fb +\loch\f36 \line \hich\f36 \'e2\'ea\'eb\'fe\'f7\'e0\'f2\'fc\loch\f36 \hich\f36 \'f3\'ea\'e0\'e7\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'e0\'e2\'f2\'ee\'f0\'f1\'ea\'e8\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 + Fast Reports Inc.. +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 3. \'d1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ee\'e4\'ed\'ee\'e9\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'e8\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e4\'eb\'ff\loch\f36 +\hich\f36 \'f0\'e5\'e7\'e5\'f0\'e2\'ed\'fb\'f5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e0\'f0\'f5\'e8\'e2\'ed\'fb\'f5\loch\f36 \hich\f36 \'f6\'e5\'eb\'e5\'e9\loch\f36 \hich\f36 , \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'e8 +\loch\f36 \line \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'ee\'f2\'e4\'e5\'eb\'fc\'ed\'fb\'e9\loch\f36 \hich\f36 \'ed\'ee\'f1\'e8\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'fb\'f5\loch\f36 +\hich\f36 , \'ef\loch\af36\dbch\af13\hich\f36 \'f0\'e8\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'e8\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'c2\'fb\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\'e5\loch\f36 \line \hich\f36 \'e8\'f1\'ef\'ee +\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ee\'f0\'e8\'e3\'e8\'ed\'e0\'eb\loch\f36 \hich\f36 \'e8\'f1\'ea\'eb\'fe\'f7\'e8\'f2\'e5\'eb\'fc\'ed\'ee\loch\f36 \hich\f36 \'e4\'eb\'ff\loch\f36 \hich\f36 \'f0\'e5\'e7\'e5\'f0\'e2\'ed\'fb\'f5 +\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e0\'f0\'f5\'e8\'e2\'ed\'fb\'f5\loch\f36 \hich\f36 \'f6\'e5\'eb\'e5\'e9\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 4. \'d2\'e5\'f5\'ed\'e8\'f7\'e5\'f1\'ea\'f3\'fe\loch\f36 \hich\f36 \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'f3\loch\f36 \hich\f36 , \'f3\'e2\'e5\'e4\'ee\'ec\'eb\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ee\loch\f36 +\hich\f36 \'ef\'ee\'ff\'e2\'eb\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 \'f2\'e5\'f5\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'e9\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 , \line \hich\f36 \'ea\'ee\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 +\'ec\'ee\'e6\'ed\'ee\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e8\'f2\'fc\loch\f36 \hich\f36 \'e1\'e5\'f1\'ef\'eb\'e0\'f2\'ed\'ee\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 5. \'c7\'e0\'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'e0\'ff\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'ff\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'ed\'e5\loch\f36 +\hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'e1\'fb\'f2\'fc\loch\f36 \hich\f36 \'f1\loch\af36\dbch\af13\hich\f36 \'e4\'e0\'ed\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e0\'f0\'e5\'ed\'e4\'f3\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 +\hich\f36 \'e4\'e0\'ed\'e0\loch\f36 \line \hich\f36 \'ed\'e0\'ef\'f0\'ee\'ea\'e0\'f2\loch\f36 \hich\f36 , \'ed\'ee\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'e1\'fb\'f2\'fc\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'e4\'e0\'ed\'e0 +\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'ef\'ee\'eb\'ed\'ee\'ec\loch\f36 \hich\f36 \'ea\'ee\'ec\'ef\'eb\'e5\'ea\'f2\'e5\loch\f36 \hich\f36 , \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e0\'fe\'f9\'e5\'e5\loch\f36 \hich\f36 \'eb\'e8 +\'f6\'ee\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'e5\'e9\loch\f36 \hich\f36 . \'c5\'f1\'eb\'e8\loch\f36 \hich\f36 +\'ef\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'ff\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'ee\'e1\'ed\'ee\'e2\'eb\'e5\'ed\'e8\'e5\'ec\loch\f36 \hich\f36 , \'f2\'ee\loch\f36 \hich\f36 \'ef\'ee\'ec\'e8\'ec\'ee\loch\f36 \line \hich\f36 \'ee +\'e1\'ed\'ee\'e2\'eb\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'ed\'fb\loch\f36 \hich\f36 \'e1\'fb\'f2\'fc\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'e4\'e0\'ed\'fb\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'e2\'f1\'e5\loch\f36 \hich\f36 \'ef +\'f0\'e5\'e4\'fb\'e4\'f3\'f9\'e8\'e5\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'e8\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 6. \'cd\'e5\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'f3\'f1\'ec\'e0\'f2\'f0\'e8\'e2\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'ed\loch\af36\dbch\af13\hich\f36 \'e8\'ea\'e0\'ea\'e8\'f5\loch\f36 \hich\f36 \'e4\'ee\'ef +\'ee\'eb\'ed\'e8\'f2\'e5\'eb\'fc\'ed\'fb\'f5\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'ee\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'ee\'f2\'f7\'e8\'f1\'eb\'e5\'ed\'e8\'e9\loch\f36 , \line \hich\f36 \'ea\'f0\'ee\'ec\'e5\loch\f36 \hich\f36 \'f1\'f2\'ee +\'e8\'ec\'ee\'f1\'f2\'e8\loch\f36 \hich\f36 \'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 , \'f1\'e2\'ff\'e7\'e0\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'f1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\'ec\loch\f36 \hich\f36 \'e8 +\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'e5\'ed\'e8\'e5\'ec\loch\f36 \hich\f36 \'ee\'f2\'f7\'e5\'f2\'ee\'e2\loch\f36 \line \hich\f36 \'e8\loch\f36 \hich\f36 \'f8\'e0\'e1\'eb\'ee\'ed\'ee\'e2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4 +\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 . \'c7\'e0\'f0\'e5\'e3\'e8\'f1\'f2\'f0\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'e8\loch\f36 \hich\f36 , \'ec\'ee\'e3\'f3\'f2\loch\f36 \hich\f36 \'e8\'f1\'ef +\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \line \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\'f5\loch\f36 \hich\f36 "Royalty free". \'dd\'f2\'ee\loch\f36 \hich\f36 \'ee\'e7\'ed\'e0\'f7 +\'e0\'e5\'f2\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'ee\'ed\loch\af36\dbch\af13\hich\f36 \'e8\hich\af36\dbch\af13\loch\f36 \hich\f36 \'ec\'ee\'e3\'f3\'f2\loch\f36 \hich\f36 \'f1\'e2\'ee\'e1\'ee\'e4\'ed\'ee\loch\f36 \line \hich\f36 \'f0 +\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'f2\'fc\loch\f36 \hich\f36 \'f1\'e2\'ee\'e8\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'fb\loch\f36 \hich\f36 , \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'f3\'fe\'f9\'e8\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4 +\'f3\'ea\'f2\loch\f36 \hich\f36 , \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 \'fd\'f2\'ee\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \line \hich\f36 \'ef\'f0\'ee\'f2\'e8\'e2\'ee\'f0\'e5\'f7\'e8\'f2\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'ff\'ec\loch\f36 +\hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'ee\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 . \'ca\'e0\'ea\'e8\'f5\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'f0\'e0\'e7\'f0\'e5\'f8\'e5 +\'ed\'e8\'e9\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'f2\'ee\loch\f36 \line \hich\f36 \'f1\'ee\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 \'e0\'e2\'f2\'ee\'f0\'e0\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'f2 +\'f0\'e5\'e1\'f3\'e5\'f2\'f1\'ff\loch\f36 . +\par }{\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'cb\'de\'c1\'ce\'c5\loch\f36 \hich\f36 \'c8\'c7\loch\f36 \hich\f36 \'c4\'c5\'c9\'d1\'d2\'c2\'c8\'c9\loch\f36 \hich\f36 , \'c2\'cd\'c5\'d1\'c5\'cd\'cd\'db\'d5 +\loch\f36 \hich\f36 \'c2\loch\f36 \hich\f36 \'d1\'cf\'c8\'d1\'ce\'ca\loch\f36 \hich\f36 \'cd\'c8\'c6\'c5\loch\f36 \hich\f36 \'cf\'d0\'c5\'ca\'d0\'c0\'d2\'c8\'d2\loch\f36 \line \hich\f36 \'cb\'c8\'d6\'c5\'cd\'c7\'c8\'de\loch\f36 \hich\f36 \'cd +\loch\af36\dbch\af13\hich\f36 \'c0\loch\f36 \hich\f36 \'cf\'d0\'ce\'c3\'d0\'c0\'cc\'cc\'cd\'ce\'c5\loch\f36 \hich\f36 \'ce\'c1\'c5\'d1\'cf\'c5\'d7\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 . \'c2\loch\f36 \hich\f36 \'c4\'ce\'cf\'ce\'cb\'cd\'c5\'cd\'c8\'c5 +\loch\f36 \hich\f36 \'ca\loch\f36 \line \hich\f36 \'c7\'c0\'c2\'c5\'d0\'d8\'c5\'cd\'c8\'de\loch\f36 \hich\f36 \'cb\'c8\'d6\'c5\'cd\'c7\'c8\'c8\loch\f36 \hich\f36 \'cd\'c0\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 + Fast Reports Inc. \'cc\'ce\'c6\'c5\'d2\loch\f36 \hich\f36 \'cf\'d0\'c8\'c2\'cb\'c5\'d7\'dc\loch\f36 \line \hich\f36 \'cd\'c0\'d0\'d3\'d8\'c8\'d2\'c5\'cb\'df\loch\f36 \hich\f36 \'ca\loch\f36 \hich\f36 \'d3\'c3\'ce\'cb\'ce\'c2\'cd\'ce\'c9\loch\f36 +\hich\f36 , \'c3\'d0\'c0\'c6\'c4\'c0\'cd\'d1\'ca\'ce\'c9\loch\f36 \hich\f36 , \'c8\loch\f36 \hich\f36 \'cb\'de\'c1\'ce\'c9\loch\f36 \hich\f36 \'c4\'d0\'d3\'c3\'ce\'c9\loch\f36 \line \hich\f36 \'ce\'d2\'c2\'c5\'d2\'d1\'d2\'c2\'c5\'cd\'cd\'ce\'d1\'d2\'c8 +\loch\f36 . +\par }{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \hich\af36\dbch\af13\loch\f36 \hich\f36 1. \'d0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'eb\'fe\'e1\'fb\'f5\loch\f36 \hich\f36 \'f4\'e0\'e9\'eb\'ee\'e2\loch\f36 +\hich\f36 , \'f1\'ee\'e4\'e5\'f0\'e6\'e0\'f9\'e8\'f5\'f1\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e5\loch\f36 \hich\f36 , \'e2\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'ec\loch\f36 \hich\f36 \'e2\'e8\'e4\'e5 +\loch\f36 \hich\f36 , \'f7\'e5\'ec\loch\f36 \line \loch\af36\dbch\af13\hich\f36 \'ef\'e0\'ea\'e5\'f2\'fb\loch\f36 \hich\f36 \'e2\'f0\'e5\'ec\'e5\'ed\'e8\loch\f36 \hich\f36 \'e2\'fb\'ef\'ee\'eb\'ed\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ff\'e2\'ed\'ee +\loch\f36 \hich\f36 \'e2\'ed\'e5\'f1\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ef\'e8\'f1\'ee\'ea\loch\f36 \hich\f36 \'e2\'fb\'f8\'e5\loch\f36 \hich\f36 , \'e2\'ea\'eb\'fe\'f7\'e0\'ff\loch\f36 \hich\f36 , \'ed\'ee\loch\f36 +\hich\f36 \'ed\'e5\loch\f36 \line \hich\f36 \'ee\'e3\'f0\'e0\'ed\'e8\'f7\'e8\'e2\'e0\'ff\'f1\'fc\loch\f36 \hich\f36 .pas .dfm .DCU .DCP - \'f4\'e0\'e9\'eb\'fb\loch\f36 \hich\f36 , \'e8\loch\f36 \hich\f36 \'ef\'e0\'ea\'e5\'f2\'fb\loch\f36 \hich\f36 +\'e2\'f0\'e5\'ec\'e5\'ed\'e8\loch\f36 \hich\f36 \'f0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'ea\'e8\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 2. \'cc\'ee\'e4\'e8\'f4\'e8\'ea\'e0\'f6\'e8\'ff\loch\f36 \hich\f36 , \'e4\'e5\'ea\'ee\'ec\'ef\'e8\'eb\'ff\'f6\'e8\'ff\loch\f36 \hich\f36 , \'e4\'e8\'e7\'e0\'f1\'f1\'e5\'ec\'e1\'eb\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5 +\loch\f36 \hich\f36 , \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'e2\'ee\'e4\loch\f36 \line \hich\f36 (\'ef\'ee\'f0\'f2\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 ) \'cf\'f0\'ee\'e4 +\'f3\'ea\'f2\'e0\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 3. \'d3\'e4\'e0\'eb\'e5\'ed\'e8\'e5\loch\f36 \loch\af36\dbch\af13\hich\f36 \'f3\'ea\'e0\'e7\'e0\'ed\'e8\'e9\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'e0\'e2\'f2\'ee\'f0\'f1\'ea\'e8\'e5\loch\f36 \hich\f36 +\'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'e8\'e7\loch\f36 \hich\f36 \'c4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f1\'e0\'ec\'ee\'e3\'ee +\loch\f36 \line \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 4. \'c2\'ea\'eb\'fe\'f7\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'f0\'e5\'e4\'f3\loch\f36 \hich\f36 \'f0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'ea +\'e8\loch\f36 \hich\f36 , ERP \'e8\'eb\'e8\loch\f36 \hich\f36 CRM - \'f1\'e8\'f1\'f2\'e5\'ec\'fb\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 5. \'d1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ef\'f0\'e8\'eb\'ee\'e6\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'ee\'e5\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ee\'f2\'eb\'e8 +\'f7\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'f1\'f3\'f9\'e5\'f1\'f2\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'ee\'f2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 6. \'d0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'ea\'e0\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 /\'e8\'eb\'e8\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e0\'e2\'f2 +\'ee\'ed\'ee\'ec\'ed\loch\af36\dbch\af13\hich\f36 \'ee\'e3\'ee\loch\f36 \hich\f36 \'e3\'e5\'ed\'e5\'f0\'e0\'f2\'ee\'f0\'e0\loch\f36 \hich\f36 \'ee\'f2\'f7\'e5\'f2\'ee\'e2\loch\f36 , \line \hich\f36 \'ee\'f1\'ed\'ee\'e2\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 +\hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e5\loch\f36 . +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 7. \'d1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ef\'f0\'e8\'eb\'ee\'e6\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 (freeware, shareware \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'ec\'ec\'e5\'f0\'f7\'e5\'f1\'ea\'ee +\'e3\'ee\loch\f36 \hich\f36 ) \'ea\'ee\'f2\'ee\'f0\'ee\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \line \hich\f36 \'ea\'ee\'ed\'ea\'f3\'f0\'e8\'f0\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ed\'e5\'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'e5\'ed\'ed +\'ee\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'f1\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'c4\'eb\'ff\loch\f36 \hich\f36 \'e2\'fb\'f8\'e5\'ef\'e5\'f0\'e5\'f7\'e8\'f1\'eb\'e5\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\'e2\loch\f36 \hich\f36 \'f2\'f0\'e5\'e1\'f3\'e5\'f2\'f1\'ff\loch\f36 +\hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'f2\'e8\'ef\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'e8\loch\f36 . +\par }{\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c5\'cd\'c8\loch\af36\dbch\af13\hich\f36 \'c5\loch\f36 \hich\f36 , \'c8\'cc\'c5\'de\'d9\'c5\'c5\loch\f36 \hich\f36 \'ce\'d2\'cd\'ce\'d8\'c5 +\'cd\'c8\'c5\loch\f36 \hich\f36 \'ca\loch\f36 \hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'ce\'cc\'d3\loch\f36 \hich\f36 \'ca\'ce\'c4\'d3\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\'c0\loch\f36 : +\par }{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c8\'d1\'cf\'ce\'cb\'dc\'c7\'ce\'c2\'c0\'cd\'c8\'c5\loch\f36 \hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'ca\'ce\'c4\'c0 +\par \loch\af36\dbch\af13\hich\f36 \'cf\'ee\'eb\'f3\'f7\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed +\'fb\'e9\loch\f36 \hich\f36 \'ea\'ee\'e4\loch\f36 \hich\f36 \'e4\'eb\'ff\loch\f36 \hich\f36 \'f1\'ee\'e7\'e4\'e0\'ed\'e8\'ff\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5 +\'ed\'e8\'ff\loch\f36 \hich\f36 (freeware, shareware \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'ec\'ec\'e5\'f0\'f7\'e5\'f1\'ea\'ee\'e3\'ee\loch\f36 \hich\f36 ) \'ea\'ee\'f2\'ee\'f0\'ee\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'ea +\'ee\'ed\'ea\'f3\'f0\'e8\'f0\'ee\'e2\'e0\'f2\'fc\loch\f36 \line \hich\f36 \'ed\'e5\'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'f1\'e2\'e5\loch\af36\dbch\af13\hich\f36 \'ed\'ed\'ee +\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 \hich\f36 . \'ca\'f0\'ee\'ec\'e5\loch\f36 \hich\f36 \'f2\'ee\'e3\'ee\loch\f36 \hich\f36 , \'cf\'ee\'eb\'f3\'f7\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'ed\'e5 +\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \line \hich\f36 \'f0\'e0\'f1\'ea\'f0\'fb\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ed\'e5\'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'fb\'e9\loch\f36 +\hich\f36 \'ea\'ee\'e4\loch\f36 \hich\f36 , \'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'f0\'e5\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ee\'e1\'ed\'e0\'f0\'f3\'e6\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'f2\'e0\'ec\loch\f36 , \line \hich\f36 \'ea\'e0\'ea +\'ee\'e9\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'e5\loch\f36 \hich\f36 , \'e2\'ee\'e2\'eb\'e5\'f7\'e5\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\loch\f36 +\hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'ee\'e5\loch\f36 \line \hich\f36 \'ea\'ee\'ed\'ea\'f3\'f0\'e8\'f0\'f3\'e5\'f2\loch\f36 +\hich\f36 \'ed\'e5\'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'f1\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 . + +\par \loch\af36\dbch\af13\hich\f36 \'d0\'c0\'d1\'cf\'d0\'ce\'d1\'d2\'d0\'c0\'cd\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'ca\'ce\'c4\'c0 +\par \loch\af36\dbch\af13\hich\f36 \'cf\'ee\'eb\'f3\'f7\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e8\'ec\'e5\'e5\'f2\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'f2 +\'fc\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'fb\'e9\loch\f36 \hich\f36 \'ea\'ee\'e4\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 . \'c2\'ea\'eb\'fe\'f7\'e0\'ff\loch\f36 \line \hich\f36 \'e2\'f1\'e5\loch\f36 \hich\f36 + .dcu .dfm, \'e8\loch\f36 \hich\f36 .pas \'f4\'e0\'e9\'eb\'fb\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'ee\'f1\'f2\'e0\'e2\'e8\'eb\loch\f36 Fast Reports Inc. +\par \loch\af36\dbch\af13\hich\f36 \'c8\'c7\'cc\'c5\'cd\'c5\'cd\'c8\'df\loch\f36 \hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'ca\'ce\'c4\'c0 +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 Fast Reports Inc. \'f1\'ee\'f5\'f0\'e0\'ed\'ff\'e5\'f2\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'f1\'ee\'e1\'ee\'e9\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\'ed\'ff\'f2 +\'fc\loch\f36 \hich\f36 \'eb\'fe\'e1\'f3\'fe\loch\f36 \hich\f36 \'f7\'e0\loch\af36\dbch\af13\hich\f36 \'f1\'f2\'fc\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ea\'ee\'e4\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \line +\hich\f36 \'e1\'f3\'e4\'f3\'f9\'e8\'f5\loch\f36 \hich\f36 \'e2\'e5\'f0\'f1\'e8\'ff\'f5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 . \'dd\'f2\'e8\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 +\'ec\'ee\'e3\'f3\'f2\loch\f36 \hich\f36 \'e2\'ea\'eb\'fe\'f7\'e0\'f2\'fc\loch\f36 \hich\f36 \'f3\'e4\'e0\'eb\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'ea\'eb\'e0\'f1\'f1\'ee\'e2\loch\f36 , \line \hich\f36 \'f1\'e2\'ee\'e9\'f1\'f2\'e2\loch\f36 \hich\f36 +\'e8\loch\f36 \hich\f36 \'ec\'e5\'f2\'ee\'e4\'ee\'e2\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f1\'ee\'e7\'e4\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ed\'ee\'e2\'fb\'f5\loch\f36 \hich\f36 \'ea\'eb\'e0\'f1\'f1\'ee\'e2\loch\f36 \hich\f36 , \'f1 +\'e2\'ee\'e9\'f1\'f2\'e2\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'ec\'e5\'f2\'ee\'e4\'ee\'e2\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'d2\'c5\'d5\'cd\'c8\'d7\'c5\'d1\'ca\'c0\'df\loch\f36 \hich\f36 \'cf\'ce\'c4\'c4\'c5\'d0\'c6\'ca\'c0\loch\f36 \hich\f36 \'c4\'cb\'df\loch\f36 \hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'ce\'c3\'ce\loch\f36 \hich\f36 \'ca\'ce\'c4 +\'c0 +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 FastReports Inc. \'ed\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'e8\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'fb\'e9\loch\f36 \hich\f36 \'ea +\'ee\'e4\loch\f36 \hich\f36 , \'e2\hich\af36\dbch\af13\loch\f36 \hich\f36 \'ea\'ee\'f2\'ee\'f0\'fb\'e9\loch\f36 \hich\f36 \'e2\'ed\'e5\'f1\'e5\'ed\'fb\loch\f36 \line \hich\f36 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ef\'ee\'eb\'fc +\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'e5\'ec\loch\f36 \hich\f36 . \'cf\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'ef\'f0\'e8\'ed\'e8\'ec\'e0\'e5\'f2\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'f1\'e5\'e1\'ff\loch\f36 \hich\f36 \'ef +\'ee\'eb\'ed\'f3\'fe\loch\f36 \line \hich\f36 \'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'fc\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'f3\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e3\'ee\loch\f36 +\hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ea\'ee\'e4\'e0\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ef\'f0\'e8\'eb\'ee\'e6\'e5\'ed\'e8\'ff\loch\f36 , \line \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e5\'ed\'ed\'ee\'e3\'ee +\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f0\'e5\'e7\'f3\'eb\'fc\'f2\'e0\'f2\'e5\loch\f36 \hich\f36 \'f2\'e0\'ea\'ee\'e9\loch\f36 \hich\f36 \'ec\'ee\'e4\'e8\'f4\'e8\'ea\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 . \'cf\'ee\'eb\'f3\'f7\'e0\'f2\'e5\'eb\'fc +\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'f2\'f0\'e5\'e1\'ee\'e2\'e0\'f2\'fc\loch\f36 \line \hich\f36 \'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'e8\loch\f36 Fast Reports I +\hich\af36\dbch\af13\loch\f36 n\hich\af36\dbch\af13\loch\f36 \hich\f36 c., \'ed\'e5\'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ea\'ee\'f1\'e2\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 , \'ef\'f0\'e8 +\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'ff\'f5\loch\f36 \line \hich\f36 \'e2\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'ee\'ec\loch\f36 \hich\f36 \'ea\'ee\'e4\'e5\loch\f36 \hich\f36 , \'e2\'ea\'eb\'fe\'f7\'e0\'ff\loch\f36 \hich\f36 +\'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'f1\'e4\'e5\'eb\'e0\'eb\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \line +\hich\f36 \'f0\'e5\'ea\'ee\'ec\'e5\'ed\'e4\'e0\'f6\'e8\'e8\loch\f36 FastReports Inc. +\par \loch\af36\dbch\af13\hich\f36 \'c2\'fb\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'ed\'fb\loch\f36 \hich\f36 \'ff\'f1\'ed\'ee\loch\f36 \hich\f36 \'ee\'e1\'ee\'e7\'ed\'e0\'f7\'e0\'f2\'fc\loch\f36 \hich\f36 \'eb\'fe\'e1\'fb\'e5\loch\f36 \hich\f36 \'e8\'e7\'ec +\'e5\'ed\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'ed\'e0\'f7\'e0\'eb\'e5\loch\f36 \hich\f36 \'ea\'e0\'e6\'e4\'ee\'e3\'ee\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'f4\'e0\'e9\'eb\'e0\loch\f36 . +\line \hich\f36 \'cf\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e3\'ee\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'ed\'ee\'e3\'ee\hich\af36\dbch\af13\loch\f36 \hich\f36 \'ea\'ee\'e4\'e0\loch\f36 \hich\f36 +\'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'e5\'ed\loch\f36 \hich\f36 \'e7\'ed\'e0\'f2\'fc\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'e8\'f1\'f5\'ee\'e4\'ed\'fb\'e9\loch\f36 \line \hich\f36 \'f4\'e0\'e9\'eb +\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ff\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'ef\'e5\'f0\'e2\'ee\'ed\'e0\'f7\'e0\'eb\'fc\'ed\'fb\'ec\loch\f36 . +\par }{\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c8\'d1\'d5\'ce\'c4\'cd\'db\'c9\loch\f36 \hich\f36 \'d2\'c5\'ca\'d1\'d2\loch\f36 \hich\f36 \'cf\'ce\'d1\'d2\'c0\'c2\'cb\'df\'c5\'d2\'d1\'df\loch\f36 \hich\f36 " +\'ca\'c0\'ca\loch\f36 \hich\f36 \'c5\'d1\'d2\'dc\loch\f36 " +\par }{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 \'d0\'c0\'d1\'cf\'d0\'ce\'d1\'d2\'d0\'c0\'cd\'df\'c5\'d2\'d1\'df\loch\f36 \hich\f36 \'cf\'ce\loch\f36 \hich\f36 \'cf\'d0 +\'c8\'cd\'d6\'c8\'cf\'d3\loch\f36 \hich\f36 "\'ca\'c0\'ca\loch\f36 \hich\f36 \'c5\'d1\'d2\'dc\loch\f36 \hich\f36 ". \'cf\'d0\'c8\loch\f36 \hich\f36 \'dd\'d2\'ce\'cc\loch\f36 \hich\f36 \'cd\'c5\loch\f36 \line \hich\f36 \'cf\'d0\'c5\'c4\'d3\'d1\'cc\'c0 +\'d2\'d0\'c8\'c2\'c0\'c5\'d2\'d1\'df\loch\f36 \hich\f36 \'cd\'c8\'ca\'c0\'ca\'c8\'d5\loch\f36 \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'c9\loch\f36 \hich\f36 , \'df\'c2\'cd\'db\'d5\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \line \hich\f36 \'cf\'ce\'c4 +\'d0\'c0\'c7\'d3\'cc\'c5\'c2\'c0\'c5\'cc\'db\'d5\loch\f36 \hich\f36 . \'c2\'db\loch\f36 \hich\f36 \'c8\'d1\'cf\'ce\'cb\'dc\'c7\'d3\'c5\'d2\'c5\loch\f36 \loch\af36\dbch\af13\hich\f36 \'c5\'c3\'ce\loch\f36 \hich\f36 \'cd\'c0\loch\f36 \hich\f36 \'d1\'c2 +\'ce\'c9\loch\f36 \hich\f36 \'d1\'ce\'c1\'d1\'d2\'c2\'c5\'cd\'cd\'db\'c9\loch\f36 \hich\f36 \'d0\'c8\'d1\'ca\loch\f36 . \line \hich\f36 FastReports Inc. \'cd\'c5\loch\f36 \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'d0\'d3\'c5\'d2\loch\f36 \hich\f36 \'d1 +\'ce\'ce\'d2\'c2\'c5\'d2\'d1\'d2\'c2\'c8\'df\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\'c0\loch\f36 \hich\f36 \'c2\'c0\'d8\'c8\'cc\loch\f36 \line \hich\f36 \'d1\'cf\'c5\'d6\'c8\'d4\'c8\'d7\'c5\'d1\'ca\'c8\'cc\loch\f36 \hich\f36 \'d6\'c5\'cb\'df +\'cc\loch\f36 \hich\f36 . FastReports Inc. \'cd\'c5\loch\f36 \hich\f36 \'ce\'d2\'c2\'c5\'d7\'c0\'c5\'d2\loch\f36 \hich\f36 \'c7\'c0\loch\f36 \hich\f36 \'cf\'ce\'d2\'c5\'d0\'c8\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'db\'d5\loch\f36 , \line \hich\f36 \'cf +\'ce\'c2\'d0\'c5\'c6\'c4\'c5\'cd\'c8\'df\loch\f36 \hich\f36 , \'cf\'ce\'d2\'c5\'d0\'c8\loch\f36 \hich\f36 \'cf\'d0\'c8\'c1\'db\'cb\'c8\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'cb\'de\'c1\'db\'c5\loch\f36 \hich\f36 \'c4\'d0\'d3\'c3\'c8\'c5 +\loch\f36 \hich\f36 \'c2\'c8\'c4\'db\loch\f36 \hich\f36 \'cf\'ce\'d2\'c5\'d0\'dc\loch\f36 , \line \hich\f36 \'d1\'c2\'df\'c7\'c0\'cd\'cd\'db\'c5\loch\f36 \hich\f36 \'d1\loch\f36 \hich\f36 \'c8\'d1\'cf\'ce\'cb\'dc\'c7\'ce\'c2\'c0\'cd\'c8\'c5\'cc +\loch\f36 \hich\f36 (\'cf\'d0\'c0\'c2\'c8\'cb\'dc\loch\af36\dbch\af13\hich\f36 \'cd\loch\af36\dbch\af13\hich\f36 \'db\'cc\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'cd\'c5\'cf\'d0\'c0\'c2\'c8\'cb\'dc\'cd\'db\'cc\loch\f36 ) \line \hich\f36 +\'cf\'d0\'ce\'c4\'d3\'ca\'d2\'c0\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'d1\'f0\'ee\'ea\loch\f36 \hich\f36 \'e4\'e5\'e9\'f1\'f2\'e2\'e8\'ff\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'cf\'f0\'e5\'ea\'f0\'e0\'f9\'e5\'ed\'e8\'e5 +\par \loch\af36\dbch\af13\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'ff\loch\f36 \hich\f36 , \'ef\'f0\'e5\'e4\'ee\'f1\'f2\'e0\'e2\'eb\'e5\'ed\'ed\'e0\'ff\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'ec\'f3 +\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'fe\loch\f36 \hich\f36 , \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'ed\'e0\'f5\'ee\'e4\'e8\'f2\'fc\'f1\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \line \hich\f36 \'f1\'e8\'eb\'e5\loch\f36 \hich\f36 +\'e4\'ee\loch\f36 \hich\f36 \'f2\'e5\'f5\loch\f36 \hich\f36 \'ef\'ee\'f0\loch\f36 \hich\f36 , \'ef\'ee\'ea\'e0\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'ef\'f0\'e5\'ea\'f0\'e0\'f9\'e5\'ed\'e0\loch\f36 +\hich\f36 , \'ea\'e0\'ea\loch\f36 \hich\f36 \'ee\'e1\'ee\'e7\'ed\'e0\'f7\'e5\'ed\'ee\loch\f36 \hich\f36 \'e7\'e4\'e5\'f1\'fc\loch\f36 \hich\f36 \'e6\'e5\loch\f36 \hich\f36 . \'c5\'f1\'eb\'e8\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0 +\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'f1\'f2\'ee\'ff\'ed\'e8\'e8\loch\f36 \hich\f36 \'ee\'ef\'eb\'e0\'f2\'e8\'f2\'fc\loch\f36 \hich\f36 \'ea\'e0\'ea\'e8\'e5\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee +\loch\f36 \hich\f36 \'f1\'f3\loch\af36\dbch\af13\hich\f36 \'ec\'ec\'fb\loch\f36 \hich\f36 \'e4\'e5\'ed\'e5\'e3\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e8\'f2\'fc\loch\f36 \line \hich\f36 \'ea\'e0\'ea\'e8\'ec +\'e8\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'f3\'f1\'eb\'f3\'e3\'e0\'ec\'e8\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'e2\'ff\'e7\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 +\hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ed\'e0\'f0\'f3\'f8\'e0\'e5\'f2\loch\f36 \hich\f36 \'ea\'e0\'ea\'ee\'e5\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \line \hich\f36 \'ef\'ee\'f1\'f2\'e0\'ed\'ee\'e2\'eb\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 +\'e8\'eb\'e8\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'e5\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , Fast Reports \'e8\'eb\'e8\loch\f36 \hich\f36 \'e5\'e3\'ee +\loch\f36 \hich\f36 \'e0\'e3\'e5\'ed\'f2\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \line \hich\f36 \'ef\'f0\'e5\'ea\'f0\'e0\'f2\'e8\'f2\'fc\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'fe +\loch\f36 \hich\f36 \'ed\'e5\'e7\'e0\'ec\'e5\'e4\'eb\'e8\'f2\'e5\'eb\'fc\'ed\'ee\loch\f36 \hich\f36 \'ef\'ee\'f1\'f0\'e5\'e4\'f1\'f2\'e2\'ee\'ec\loch\f36 \hich\f36 \'f3\'e2\'e5\'e4\'ee\'ec\'eb\'e5\'ed\'e8\'ff\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5 +\'ed\'e7\'e8\'e0\'f2\'e0\loch\f36 \hich\f36 \'ee\loch\f36 \hich\f36 \'ef\'f0\loch\af36\dbch\af13\hich\f36 \'e5\loch\af36\dbch\af13\hich\f36 \'ea\'f0\'e0\'f9\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 +. \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'ed\'e5\'f1\'e5\'f2\loch\f36 \hich\f36 \'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'fc\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \line \hich\f36 \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed +\'e8\'e5\loch\f36 \hich\f36 Fast Reports \'e4\'e5\'e9\'f1\'f2\'e2\'e8\'f2\'e5\'eb\'fc\'ed\'ee\'e9\loch\f36 \hich\f36 \'ea\'ee\'ed\'f2\'e0\'ea\'f2\'ed\'ee\'e9\loch\f36 \hich\f36 \'e8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'e5\'e9\loch\f36 \hich\f36 . \'c5\'f1 +\'eb\'e8\loch\f36 \line \hich\f36 \'e4\'e5\'e9\'f1\'f2\'e2\'e8\'f2\'e5\'eb\'fc\'ed\'e0\'ff\loch\f36 \hich\f36 \'ea\'ee\'ed\'f2\'e0\'ea\'f2\'ed\'e0\'ff\loch\f36 \hich\f36 \'e8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'ff\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed +\'e7\'e8\'e0\'f2\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e7\'e0\'ef\'e8\'f1\'ff\'f5\loch\f36 Fast Reports \line \hich\f36 \'ee\'f2\'f1\'f3\'f2\'f1\'f2\'e2\'f3\'e5\'f2\loch\f36 \hich\f36 , \'f2\'ee\loch\f36 \hich\f36 Fast Reports \'ed\'e5 +\loch\f36 \hich\f36 \'ee\'e1\'ff\'e7\'e0\'ed\loch\f36 \hich\f36 \'e4\'e0\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'f3\'e2\'e5\'e4\'ee\'ec\'eb\'e5\'ed\'e8\loch\af36\dbch\af13\hich\f36 \'e5\hich\af36\dbch\af13\loch\f36 \hich\f36 \'ee\loch\f36 \hich\f36 \'e7 +\'e0\'e2\'e5\'f0\'f8\'e5\'ed\'e8\'e8\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'f3\loch\f36 .\line +\par }\pard \ltrpar\ql \li0\ri3452\nowidctlpar\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 +\loch\af36\dbch\af13\hich\f36 \'cf\'ee\'f1\'eb\'e5\'e4\'f1\'f2\'e2\'e8\'ff\loch\f36 \hich\f36 \'cf\'f0\'e5\'ea\'f0\'e0\'f9\'e5\'ed\'e8\'ff\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'cd\'e5\'ec\'e5\'e4\'eb\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \hich\f36 \'e7\'e0\'e2\'e5\'f0\'f8\'e5\'ed\'e8\'fe\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6 +\'e5\'ed\loch\f36 \hich\f36 \'f3\'ed\'e8\'f7\'f2\'ee\'e6\'e8\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e2\'e5\'f0\'ed\'f3\'f2\'fc\loch\f36 Fast \line \hich\f36 Reports \'e2\'f1\'e5\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'e8\loch\f36 +\hich\f36 \'e2\'f1\'e5\'e3\'ee\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f7\'e0\'f1\'f2\'e8\loch\f36 \hich\f36 \'f2\'ee\'e3\'ee\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'fb\'e9\loch\f36 +\hich\f36 \'ed\'e0\'f5\'ee\'e4\'e8\'f2\'f1\'ff\loch\f36 \hich\f36 \'e2\'ee\loch\f36 \hich\f36 \'e2\'eb\'e0\'e4\'e5\'ed\'e8\'e8\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'e0\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ef +\'ee\'e4\loch\f36 \hich\f36 \'e5\'e3\'ee\loch\f36 \hich\f36 \'ea\'ee\'ed\'f2\'f0\'ee\'eb\'e5\'ec\loch\f36 \hich\f36 . \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e8\'ec\'e5\'e5\loch\af36\dbch\af13\hich\f36 +\'f2\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'f5\'f0\'e0\'ed\'e8\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \line \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ea\'e0\'ea\'f3\'fe\loch\f36 +\hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'ea\'ee\'ef\'e8\'fe\loch\f36 \hich\f36 \'cf\'f0\'ee\'e3\'f0\'e0\'ec\'ec\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ce\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f0 +\'ee\'e4\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'e9\loch\f36 \line \hich\f36 \'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'fc\'f1\'ea\'ee\'e9\loch\f36 \hich\f36 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'eb\'fe +\'e1\'ee\'e9\loch\f36 \hich\f36 \'f6\'e5\'eb\'fc\'fe\loch\f36 \hich\f36 \'ef\'ee\'f1\'eb\'e5\loch\f36 \hich\f36 \'ef\'f0\'e5\'ea\'f0\'e0\'f9\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e4\'e5\'e9\'f1\'f2\'e2\'e8\'ff\loch\f36 \line \hich\f36 \'e4\'e0\'ed\'ed +\'ee\'e3\'ee\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff\loch\f36 .\line +\par }\pard \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'cf\'e5\'f0\'e5\'e4\'e0\'f7\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0 +\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'e5\'ed\loch\f36 \hich\f36 \'e8\'ec\'e5\'f2\'fc\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'ef\'e5\'f0 +\'e5\'e4\'e0\'f2\'fc\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed\loch\af36\dbch\af13\hich\f36 \'e7\'e8\'fe\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'f3\loch\f36 \hich\f36 \'e1 +\'e5\'e7\loch\f36 \line \hich\f36 \'ef\'f0\'e5\'e4\'e2\'e0\'f0\'e8\'f2\'e5\'eb\'fc\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'e8\'ff\loch\f36 Fast Reports. +\par }\pard \ltrpar\ql \li0\ri3452\nowidctlpar\tx916\tx1832\tx2748\tx3664\tx4580\tx5496\tx6412\tx7328\tx8244\tx9160\tx10076\tx10992\tx11908\tx12824\tx13740\tx14656\faauto\rin3452\lin0\itap0 {\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 +\loch\af36\dbch\af13\hich\f36 \'ca\'ee\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8\'e0\'eb\'fc\'ed\'ee\'f1\'f2\'fc\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'d1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'ed\'fb\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'ef +\'f0\'e8\'ed\'ff\'f2\'fc\loch\f36 \hich\f36 \'e2\'f1\'e5\loch\f36 \hich\f36 \'f0\'e0\'e7\'f3\'ec\'ed\'fb\'e5\loch\f36 \hich\f36 \'f8\'e0\'e3\'e8\loch\f36 \hich\f36 , \'f7\'f2\'ee\'e1\'fb\loch\f36 \line \hich\f36 \'e3\'e0\'f0\'e0\'ed\'f2\'e8\'f0\'ee +\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e9\loch\f36 \hich\f36 \'ec\'e0\'f2\'e5\'f0\'e8\'e0\'eb\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'ff\loch\f36 +\hich\f36 , \'ef\'ee\'ec\'e5\'f7\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'ee\'e9\loch\f36 \line \hich\f36 \'ea\'e0\'ea\loch\f36 \hich\f36 \'ea\'ee\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8 +\loch\af36\dbch\af13\hich\f36 \'e0\'eb\'fc\'ed\'fb\'e5\loch\f36 \hich\f36 ("\'ca\'ee\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8\'e0\'eb\'fc\'ed\'e0\'ff\loch\f36 \hich\f36 \'c8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'ff\loch\f36 \hich\f36 "), \'ea\'ee\'f2\'ee\'f0\'ee\'e9 +\loch\f36 \hich\f36 \'ee\'e1\'eb\'e0\'e4\'e0\'e5\'f2\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \line \hich\f36 \'e7\'ed\'e0\'e5\'f2\loch\f36 \hich\f36 \'ee\loch\f36 \hich\f36 \'ed\'e5\'e9\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'e0\'ff\loch\f36 +\hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'e0\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'e2\'ff\'e7\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'fb\'ec\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\'ec\loch\f36 +\hich\f36 , \'ed\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'f0\'e0\'e7\'e3\'eb\'e0\'f8\'e5\'ed\loch\f36 \line \hich\f36 \'e4\'f0\'f3\'e3\'e8\'ec\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f6\'e5\'eb\'ee\'ec\loch\f36 \hich\f36 + \'e8\'eb\'e8\loch\f36 \hich\f36 \'f7\'e0\'f1\'f2\'e8\'f7\'ed\'ee\loch\f36 \hich\f36 \'e1\'e5\'e7\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'e2\'e0\'f0\'e8\'f2\'e5\'eb\'fc\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'e3\'ee +\loch\f36 \hich\f36 \'f0\'e0\'e7\'f0\'e5\'f8\'e5\'ed\'e8\'ff\loch\f36 \line \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 . \'cd\'e8\loch\f36 \hich\f36 \'ee\'e4\'ed\'e0\loch\f36 \hich\f36 \'e8 +\'e7\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ee\'e1\'ff\'e7\'f3\'e5\loch\af36\dbch\af13\hich\f36 \'f2\loch\af36\dbch\af13\hich\f36 \'f1\'ff\loch\f36 \hich\f36 \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'e8\'e2 +\'e0\'f2\'fc\loch\f36 \line \hich\f36 \'ea\'ee\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8\'e0\'eb\'fc\'ed\'ee\'f1\'f2\'fc\loch\f36 \hich\f36 \'eb\'fe\'e1\'fb\'f5\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e8 +\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'e8\loch\f36 \hich\f36 , (i) \'ed\'e0\'f5\'ee\'e4\'e8\'e2\'f8\'e5\'e9\'f1\'ff\loch\f36 \hich\f36 \'e2\loch\f36 \line \hich\f36 \'e7\'e0\'ea\'ee\'ed\'ed\'ee\'ec\loch\f36 \hich\f36 \'e2\'eb\'e0\'e4\'e5\'ed\'e8\'e8 +\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e0\'fe\'f9\'e5\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 \'e4\'ee\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'ef\'ee\'e4\'f2\'e2\'e5\'f0\'e6\'e4 +\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \line \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 , (ii) \'ef\'ee\'e7\'e6\'e5\loch\f36 \hich\f36 \'e7\'e0\'ea\'ee\'ed\'ed\'ee\loch\f36 \hich\f36 \'ef\'f0\'e8\'ee\'e1 +\'f0\'e5\'f2\'e5\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e0\'fe\'f9\'e5\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'ee\'e9\loch\f36 \hich\f36 \'ee\'f2\loch\f36 \hich\f36 \'f2\'f0\'e5\'f2\'fc\'e5\'e9\loch\f36 \line \hich\f36 \'f1 +\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 , \'e8\'ec\'e5\'fe\'f9\'e5\'e9\loch\f36 \hich\f36 \'ed\'e8\'ea\'e0\'ea\'ee\loch\af36\dbch\af13\hich\f36 \'e3\loch\af36\dbch\af13\hich\f36 \'ee\loch\f36 \hich\f36 \'ee\'e1\'ff\'e7\'e0\'f2\'e5\'eb\'fc\'f1\'f2 +\'e2\'e0\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \hich\f36 \'f1\'ee\'f5\'f0\'e0\'ed\'e5\'ed\'e8\'fe\loch\f36 \hich\f36 \'ef\'e5\'f0\'e5\'e4\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'ee\'e9\loch\f36 , \line +\hich\f36 (iii) \'e4\'ee\'f1\'f2\'f3\'ef\'ed\'ee\'e9\loch\f36 \hich\f36 \'e2\'f1\'eb\'e5\'e4\'f1\'f2\'e2\'e8\'e5\loch\f36 \hich\f36 \'ee\'f2\'f1\'f3\'f2\'f1\'f2\'e2\'e8\'ff\loch\f36 \hich\f36 \'ea\'e0\'ea\'ee\'e3\'ee\loch\f36 \hich\f36 -\'eb\'e8\'e1 +\'ee\loch\f36 \hich\f36 \'e4\'e5\'e9\'f1\'f2\'e2\'e8\'ff\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ee\'f2\'ea\'e0\'e7\'e0\loch\f36 \hich\f36 \'f1\'ee\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \line \hich\f36 \'ef\'ee\'eb +\'f3\'f7\'e0\'fe\'f9\'e5\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 , (iv) \'f1\loch\f36 \hich\f36 \'e3\'ee\'f2\'ee\'e2\'ed\'ee\'f1\'f2\'fc\'fe\loch\f36 \hich\f36 \'e4\'ee\'f1\'f2\'f3\'ef\'ed\'ee\'e9\loch\f36 \hich\f36 \'e4 +\'eb\'ff\loch\f36 \hich\f36 \'e2\'f1\'e5\'ee\'e1\'f9\'e5\'e3\'ee\loch\f36 \hich\f36 \'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'ff\loch\f36 \line \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 (v) \'ed\'e5\'e7\'e0\'e2\'e8\'f1\'e8\'ec\'ee\loch\f36 \hich\f36 +\'f0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'e0\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e0\'fe\'f9\'e5\'e9\hich\af36\dbch\af13\loch\f36 \loch\af36\dbch\af13\hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'ee\'e9\loch\f36 \hich\f36 . \'cf\'ee\'eb\'f3\'f7\'e0 +\'fe\'f9\'e0\'ff\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'e0\loch\f36 \line \hich\f36 \'e4\'ee\'eb\'e6\'ed\'e0\loch\f36 \hich\f36 \'ed\'e5\'ec\'e5\'e4\'eb\'e5\'ed\'ed\'ee\loch\f36 \hich\f36 \'e2\'ee\'e7\'e2\'f0\'e0\'f2\'e8\'f2\'fc\loch\f36 +\hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f3\'ed\'e8\'f7\'f2\'ee\'e6\'e8\'f2\'fc\loch\f36 \hich\f36 \'ea\'e0\'ea\'f3\'fe\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'f7\'e0\'f1\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 +\hich\f36 \'e2\'f1\'fe\loch\f36 \line \hich\f36 \'ca\'ee\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8\'e0\'eb\'fc\'ed\'f3\'fe\loch\f36 \hich\f36 \'c8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'fe\loch\f36 \hich\f36 , \'ef\'ee\'eb\'f3\'f7\'e5\'ed\'ed\'f3\'fe\loch\f36 +\hich\f36 \'ee\'f2\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 \hich\f36 \'ef\'ee\loch\f36 \hich\f36 \'ef\'f0\'ee\'f1\'fc\'e1\'e5\loch\f36 \line \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 +\hich\f36 \'f1\'f2\'ee\'f0\'ee\'ed\'fb\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'c3\'e0\'f0\'e0\'ed\'f2\'e8\'ff\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2 +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 Fast Reports \'e3\'e0\'f0\'e0\'ed\'f2\'e8\'f0\'f3\'e5\'f2\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'f1\'ee\'ee +\'f2\'e2\loch\af36\dbch\af13\hich\f36 \'e5\'f2\'f1\'f2\'e2\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'ee\'ef\'e8\'f1\'e0\'ed\'e8\'fe\loch\f36 \hich\f36 \'e5\'e3\'ee\loch\f36 \line \hich\f36 \'f4\'f3\'ed\'ea\'f6\'e8\'e9\loch\f36 \hich\f36 \'e8\loch\f36 +\hich\f36 \'f0\'e0\'e1\'ee\'f2\'fb\loch\f36 \hich\f36 . \'c2\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\loch\f36 \hich\f36 \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'f0\'e0\'e1 +\'ee\'f2\'e0\'e5\'f2\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e8\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e9\loch\f36 \line \hich\f36 \'e3\'e0\'f0\'e0\'ed\'f2\'e8\'e5\'e9 +\loch\f36 \hich\f36 , Fast Reports \'f1\'ee\'e3\'eb\'e0\'f8\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'e2\'ee\'f1\'f1\'f2\'e0\'ed\'ee\'e2\'e8\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f3\'f1\'f2\'e0\'ed\'ee\'e2\'e8\'f2\'fc\loch\f36 +\hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \line \hich\f36 \'e1\'e5\'f1\'ef\'eb\'e0\'f2\'ed\'ee\loch\f36 \hich\f36 . \'cd\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 , \'ed\'e5\loch\f36 \hich\f36 \'e4\'e5\'e9\'f1\'f2 +\'e2\'f3\'fe\'f9\'e8\'e9\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e8\'e8\loch\f36 \hich\f36 \'f1\'ee\loch\f36 \hich\f36 \'f1\'e2\'ee\'e8\'ec\loch\f36 \hich\f36 \'ee\'ef\'e8\'f1\'e0\'ed\'e8\'e5\'ec\loch\f36 +\hich\f36 \'ef\'ee\loch\f36 \line \hich\f36 \'ee\'e4\'ed\'ee\loch\af36\dbch\af13\hich\f36 \'e9\hich\af36\dbch\af13\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e1\'ee\'eb\'e5\'e5\loch\f36 \hich\f36 \'f1\'eb\'e5\'e4\'f3\'fe\'f9\'e8\'f5 +\loch\f36 \hich\f36 \'ef\'f0\'e8\'f7\'e8\'ed\loch\f36 \hich\f36 , \'e4\'e0\'ed\'ed\'e0\'ff\loch\f36 \hich\f36 \'e3\'e0\'f0\'e0\'ed\'f2\'e8\'ff\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'f0\'e0\'f1\'ef\'f0\'ee\'f1\'f2\'f0\'e0\'ed\'ff\'e5\'f2\'f1 +\'ff\loch\f36 : (i) \line \hich\f36 \'c8\'f1\'f5\'ee\'e4\'ed\'fb\'e5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'f1\'e2\'ff\'e7\'e0\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'f4\'e0\'e9\'eb\'fb\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'fb +\loch\f36 \hich\f36 \'ea\'e5\'ec\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 , \'ea\'f0\'ee\'ec\'e5\loch\f36 \hich\f36 Fast Reports \'e8\'eb\'e8\loch\f36 (ii) \line \hich\f36 \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2 +\loch\f36 \hich\f36 \'ff\'e2\'eb\'ff\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 \'e7\'e0\'ea\'e0\'e7\'e0\'ed\'ed\'fb\'ec\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 \hich\f36 , \'f0\'e0\'e7\'f0\'e0\'e1\'ee\'f2\'e0\'ed\'ed\'fb\'ec\loch\f36 +\hich\f36 \'e4\'eb\'ff\loch\f36 \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'e0\loch\f36 , \line \hich\f36 \'e7\'e0\'ea\'e0\'e7\'e0\'ed\'ed\'fb\'e9\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'f3\'f1\'f2\'e0\'ed\'e0\'e2\'eb +\'e8\'e2\'e0\'e5\loch\af36\dbch\af13\hich\f36 \'f2\loch\af36\dbch\af13\hich\f36 \'f1\'ff\loch\f36 \hich\f36 \'ea\'e5\'ec\loch\f36 \hich\f36 -\'eb\'e8\'e1\'ee\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'e8\'ec\loch\f36 \hich\f36 \'ea\'f0\'ee\'ec\'e5\loch\f36 + Fast Reports. +\par +\par \loch\af36\dbch\af13\hich\f36 \'c2\'ee\'e7\'ec\'e5\'f9\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'f3\'e1\'fb\'f2\'ea\'ee\'e2 +\par \loch\af36\dbch\af13\hich\f36 \'c2\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\loch\f36 \hich\f36 \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 Fast Reports \'e2\'ee\'e7\'e2\'f0\'e0\'f9\'e0\'e5\'f2\loch\f36 \hich\f36 \'ed\'e5\'ea\'ee\'f2\'ee\'f0\'fb\'e5 +\loch\f36 \hich\f36 \'f1\'f3\'ec\'ec\'fb\loch\f36 \hich\f36 , \'ee\'ef\'eb\'e0\'f7\'e5\'ed\'ed\'fb\'e5\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'ee\'ec\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2 +\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'f1\'ee\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e8\'e8\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 8 \'e0\'e1\'e7\'e0\'f6\'e5\'ec\loch\f36 \hich\f36 \'e2\'fb\'f8\'e5\loch\f36 \hich\f36 , \'cb\'e8\'f6\'e5\'ed\'e7 +\'e8\'e0\'f2\loch\f36 \hich\f36 \'ef\'ee\'ed\'e8\'ec\'e0\'e5\'f2\loch\f36 \hich\f36 \'e8\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e5\loch\f36 +\hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'ff\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\loch\af36\dbch\af13\hich\f36 \'e4\'f3\'ea\'f2\loch\f36 +\hich\f36 \'f0\'e0\'f1\'f2\'ee\'f0\'e3\'ed\'f3\'f2\'fb\loch\f36 \hich\f36 , \'e8\loch\f36 Fast \line \hich\f36 Reports \'e8\'e7\'fb\'ec\'e5\'f2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 , \'ea\'ee\'e4\loch\f36 \hich\f36 \'e8 +\loch\f36 \hich\f36 \'ee\'f2\'ed\'ee\'f1\'ff\'f9\'f3\'fe\'f1\'ff\loch\f36 \hich\f36 \'ea\loch\f36 \hich\f36 \'ed\'e8\'ec\loch\f36 \hich\f36 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'fe\loch\f36 \hich\f36 , \'e7\'e0\loch\f36 \hich\f36 \'ea\'ee\'f2 +\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'e1\'fb\'eb\'ee\loch\f36 \line \hich\f36 \'e2\'fb\'e4\'e0\'ed\'ee\loch\f36 \hich\f36 \'e2\'ee\'e7\'ec\'e5\'f9\'e5\'ed\'e8\'e5\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'d3\'ef\'eb\'e0\'f2\'fb +\par \loch\af36\dbch\af13\hich\f36 \'ca\'ee\'e3\'e4\'e0\loch\f36 \hich\f36 Fast Reports \'e2\'ee\'e7\'ec\'e5\'f9\'e0\'e5\'f2\loch\f36 \hich\f36 \'eb\'fe\'e1\'fb\'e5\loch\f36 \hich\f36 \'ea\'ee\'eb\'e8\'f7\'e5\'f1\'f2\'e2\'e0\loch\f36 \hich\f36 , \'e7\'e0 +\'ef\'eb\'e0\'f7\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'cb\'e8\'f6\'ee\'ec\loch\f36 \hich\f36 , \'e8\'ec\'e5\'fe\'f9\'e8\'ec\loch\f36 \line \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7 +\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'e0\loch\f36 \hich\f36 , \'e2\loch\f36 \hich\f36 \'f1\'ee\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e8\'e8\loch\f36 \hich\f36 \'f1\hich\af36\dbch\af13\loch\f36 \hich\f36 \'cf\'e0\'f0\'e0 +\'e3\'f0\'e0\'f4\'ee\'ec\loch\f36 \hich\f36 \'e2\'fb\'f8\'e5\loch\f36 \hich\f36 , \'cb\'e8\'f6\'ee\loch\f36 , \line \hich\f36 \'e8\'ec\'e5\'fe\'f9\'e5\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 \hich\f36 \'ef\'ee\'ed\'e8\'ec\'e0\'e5\'f2 +\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'fd\'f2\'ee\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 +\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'ff\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \line \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ef\'e0\'ea\'e5\'f2\'e0\loch\f36 \hich\f36 \'ef\'f0\'ee\'e3\'f0\'e0\'ec\'ec +\loch\f36 \hich\f36 \'e7\'e0\'ea\'ee\'ed\'f7\'e5\'ed\'fb\loch\f36 \hich\f36 , \'e8\loch\f36 \hich\f36 Fast Reports \'e8\'e7\'fb\'ec\'e5\'f2\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 , \'ea\'ee\'e4\loch\f36 \hich\f36 \'e8 +\loch\f36 \line \hich\f36 \'f1\'e2\'ff\'e7\'e0\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'fe\loch\f36 \hich\f36 , \'ee\'e1\'e5\'f1\'ef\'e5\'f7\'e5\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee +\loch\f36 \hich\f36 \'fd\'f2\'ee\'ec\'f3\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'fe\loch\f36 \hich\f36 . \'cf\'ee\loch\f36 \line \hich\f36 \'ef\'ee\'eb\'f3\'f7\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 \'f2\loch\af36\dbch\af13\hich\f36 \'e0 +\loch\af36\dbch\af13\hich\f36 \'ea\'ee\'e3\'ee\loch\f36 \hich\f36 \'e2\'ee\'e7\'ec\'e5\'f9\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , \'cb\'e8\'f6\'ee\loch\f36 \hich\f36 , \'e8\'ec\'e5\'fe\'f9\'e5\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'ee\loch\f36 +\hich\f36 \'f1\'ee\'e3\'eb\'e0\'f8\'e0\'e5\'f2\'f1\'ff\loch\f36 \hich\f36 , \'f7\'f2\'ee\loch\f36 \hich\f36 \'e1\'ee\'eb\'fc\'f8\'e5\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \line \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc +\'e7\'ee\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 , \'ef\'f0\'e5\'e4\'ee\'f1\'f2\'e0\'e2\'eb\'ff\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e8\'ed\'e0\'f7\'e5\loch\f36 \hich\f36 \'f3\'ef\'f0\'e0\'e2\'eb\'ff\'f2\'fc\loch\f36 \hich\f36 \'cf +\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 \hich\f36 , \'ea\'ee\'e4\'ee\'ec\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \line \hich\f36 \'f1\'e2\'ff\'e7\'e0\'ed\'ed\'ee\'e9\loch\f36 \hich\f36 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0\'f6\'e8\'e5\'e9\loch\f36 +\hich\f36 , \'e4\'eb\'ff\loch\f36 \hich\f36 \'ea\'ee\'f2\'ee\'f0\'fb\'f5\loch\f36 \hich\f36 \'e2\'ee\'e7\'ec\'e5\'f9\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e1\'fb\'eb\'ee\loch\f36 \hich\f36 \'f1\'ee\'e2\'e5\'f0\'f8\'e5\'ed\'ee\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'ce\'d2\'ca\'c0\'c7\loch\f36 \hich\f36 \'ce\'d2\loch\f36 \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'c8\loch\f36 \hich\f36 \'cd\'c0\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2 +\par \loch\af36\dbch\af13\hich\f36 \'c7\'c0\loch\f36 \hich\f36 \'c8\'d1\'ca\'cb\'de\'d7\'c5\'cd\'c8\'c5\'cc\loch\f36 \hich\f36 \'d1\'cf\'c5\'d6\'c8\'c0\loch\af36\dbch\af13\hich\f36 \'cb\'dc\'cd\'db\'d5\loch\f36 \hich\f36 \'d1\'cb\'d3\'d7\'c0\'c5\'c2 +\loch\f36 \hich\f36 , \'ce\'c1\'ce\'c7\'cd\'c0\'d7\'c5\'cd\'cd\'db\'d5\loch\f36 \hich\f36 \'c2\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'ce\'cc\loch\f36 \line \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c5\'cd\'c8\'c8\loch\f36 \hich\f36 , FAST REPORTS \'ce\'d2\'ca +\'c0\'c7\'db\'c2\'c0\'c5\'d2\'d1\'df\loch\f36 \hich\f36 \'ce\'d2\loch\f36 \hich\f36 \'c2\'d1\'c5\'d5\loch\f36 \hich\f36 \'cf\'d0\'c5\'c4\'cf\'ce\'cb\'c0\'c3\'c0\'c5\'cc\'db\'d5\loch\f36 \line \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'c9\loch\f36 +\hich\f36 \'cd\'c0\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 , \'c2\'ca\'cb\'de\'d7\'c0\'de\'d9\'c8\'d5\loch\f36 \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'c8\loch\f36 \hich\f36 \'d2\'ce\'c2\'c0\'d0\'cd\'ce\'c3\'ce\loch\f36 +\hich\f36 \'d1\'ce\'d1\'d2\'ce\'df\'cd\'c8\'df\loch\f36 \line \hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'d1\'ce\'ce\'d2\'c2\'c5\'d2\'d1\'d2\'c2\'c8\'df\loch\f36 \hich\f36 \'ca\'ce\'cd\'ca\'d0\'c5\'d2\'cd\'ce\'c9\loch\f36 \hich\f36 \'d6\'c5\'cb\'c8 +\loch\f36 \hich\f36 . FAST REPORTS \'cd\'c5\loch\f36 \hich\f36 \'cf\'d0\'c5\'c4\'d1\'d2\'c0\'c2\'cb\'df\'c5\'d2\loch\f36 \line \hich\f36 \'cd\'c8\'ca\'c0\'ca\'c8\'d5\loch\f36 \hich\f36 \'c7\'c0\'df\'c2\'cb\'c5\'cd\'c8\'c9\loch\f36 \hich\f36 , \'ca\'c0 +\'d1\'c0\'de\'d9\'c8\'d5\'d1\'df\hich\af36\dbch\af13\loch\f36 \loch\af36\dbch\af13\hich\f36 \'ca\'c0\'d7\'c5\'d1\'d2\'c2\'c0\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\'c0\loch\f36 \hich\f36 \'c8\loch\f36 \hich\f36 \'cd\'c5\loch\f36 \hich\f36 +\'ce\'c1\'c5\'d9\'c0\'c5\'d2\loch\f36 , \line \hich\f36 \'d7\'d2\'ce\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\loch\f36 \hich\f36 \'c1\'d3\'c4\'c5\'d2\loch\f36 \hich\f36 \'c1\'c5\'c7\'ce\'d8\'c8\'c1\'ce\'d7\'cd\'db\'cc\loch\f36 \hich\f36 \'c8 +\'cb\'c8\loch\f36 \hich\f36 \'c1\'d3\'c4\'c5\'d2\loch\f36 \hich\f36 \'d0\'c0\'c1\'ce\'d2\'c0\'d2\'dc\loch\f36 \line \hich\f36 \'c1\'c5\'d1\'cf\'c5\'d0\'c5\'c1\'ce\'c9\'cd\'ce\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'ce\'c3\'d0\'c0\'cd\'c8\'d7\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 \'ce\'d2\'c2\'c5\'d2\'d1\'d2\'c2\'c5\'cd\'cd\'ce\'d1\'d2\'c8 +\par \loch\af36\dbch\af13\hich\f36 \'cd\'c8\loch\f36 \hich\f36 \'c2\loch\f36 \hich\f36 \'ca\'ce\'c5\'cc\loch\f36 \hich\f36 \'d1\'cb\'d3\'d7\'c0\'c5\loch\f36 \hich\f36 FAST REPORTS \'cd\'c5\loch\f36 \hich\f36 \'c1\'d3\'c4\'c5\'d2\loch\f36 \hich\f36 \'cd +\'c5\'d1\'d2\'c8\loch\f36 \hich\f36 \'ce\'d2\'c2\'c5\'d2\'d1\'d2\'c2\'c5\'cd\'cd\'ce\'d1\'d2\'dc\loch\f36 \hich\f36 \'c7\'c0\loch\f36 \line \hich\f36 \'ca\'c0\'ca\'c8\'c5\loch\f36 \hich\f36 -\'cb\'c8\'c1\'ce\loch\f36 \hich\f36 \'cf\'d0\'df\'cc\'db\'c5 +\loch\f36 \hich\f36 , \'ca\'ce\'d1\'c2\'c5\'cd\'cd\'db\'c5\loch\f36 \hich\f36 , \'d1\'cb\'d3\'d7\'c0\'c9\'cd\'db\'c5\loch\f36 \hich\f36 , \'d1\'cf\'c5\'d6\'c8\'c0\'cb\'dc\'cd\'db\'c5\loch\f36 , \line \hich\f36 \'c2\'cd\'c5\'c7\'c0\'cf\'cd +\loch\af36\dbch\af13\hich\f36 \'db\'c5\loch\f36 \hich\f36 \'c8\'cb\'c8\loch\f36 \hich\f36 \'c4\'d0\'d3\'c3\'c8\'c5\loch\f36 \hich\f36 \'cf\'ce\'c2\'d0\'c5\'c6\'c4\'c5\'cd\'c8\'df\loch\f36 \hich\f36 , \'c2\'ce\'c7\'cd\'c8\'ca\'c0\'de\'d9\'c8\'c5 +\loch\f36 \hich\f36 \'c2\loch\f36 \hich\f36 \'d5\'ce\'c4\'c5\loch\f36 \line \hich\f36 \'c8\'d1\'cf\'ce\'cb\'dc\'c7\'ce\'c2\'c0\'cd\'c8\'df\loch\f36 \hich\f36 \'cf\'d0\'ce\'c4\'d3\'ca\'d2\'c0\loch\f36 \hich\f36 \'ca\'c5\'cc\loch\f36 \hich\f36 -\'cb +\'c8\'c1\'ce\loch\f36 \hich\f36 \'c1\'c5\'c7\'ce\'d2\'cd\'ce\'d1\'c8\'d2\'c5\'cb\'dc\'cd\'ce\loch\f36 \hich\f36 \'ca\loch\f36 \hich\f36 \'d2\'ce\'cc\'d3\loch\f36 , \line \hich\f36 \'d3\'c2\'c5\'c4\'ce\'cc\'cb\'c5\'cd\loch\f36 \hich\f36 \'cb\'c8 +\loch\f36 \hich\f36 FAST REPORTS \'ce\loch\f36 \hich\f36 \'c2\'ce\'c7\'cc\'ce\'c6\'cd\'ce\'d1\'d2\'c8\loch\f36 \hich\f36 \'d3\'d9\'c5\'d0\'c1\'c0\loch\f36 \hich\f36 \'c7\'c0\'d0\'c0\'cd\'c5\'c5\loch\f36 . \line \hich\f36 \'c4\'c0\'cd\'cd\'db\'c5 +\loch\f36 \hich\f36 \'ce\'c3\'d0\'c0\'cd\'c8\'d7\'c5\'cd\'c8\'df\loch\f36 \hich\f36 \'cf\'d0\'c8\'cc\'c5\'cd\'df\'de\'d2\'d1\'df\loch\f36 \hich\f36 \'ca\'ce\loch\f36 \hich\f36 \'c2\'d1\'c5\'cc\loch\f36 \hich\f36 \'cf\'d0\'c8\'d7\'c8\'cd\'c0\'cc +\loch\f36 \line \hich\f36 \'c4\'c5\'df\'d2\'c5\'cb\'dc\'cd\'ce\'d1\'d2\'c8\loch\f36 \hich\f36 , \'c2\'ca\'cb\'de\'d7\'c0\'de\'d9\'c8\'cc\loch\f36 \hich\f36 \'cd\'c0\'d0\'d3\'d8\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 \'ca\'ce\'cd\'d2\'d0\'c0\'ca\'d2\'c0 +\loch\f36 ,\hich\af36\dbch\af13\loch\f36 \loch\af36\dbch\af13\hich\f36 \'cd\'c0\'d0\'d3\'d8\'c5\'cd\'c8\'c5\loch\f36 \line \hich\f36 \'c3\'c0\'d0\'c0\'cd\'d2\'c8\'c8\loch\f36 \hich\f36 , \'cd\'c5\'c1\'d0\'c5\'c6\'cd\'ce\'d1\'d2\'dc\loch\f36 \hich\f36 , +\'ce\'c1\'df\'c7\'c0\'cd\'cd\'ce\'d1\'d2\'c8\loch\f36 \hich\f36 \'c2\'ce\'c7\'cc\'c5\'d9\'c5\'cd\'c8\'df\loch\f36 \hich\f36 \'d3\'d9\'c5\'d0\'c1\'c0\loch\f36 , \line \hich\f36 \'c8\'d1\'ca\'c0\'c6\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 \'d4\'c0\'ca\'d2\'ce +\'c2\loch\f36 \hich\f36 \'c8\loch\f36 \hich\f36 \'c4\'d0\'d3\'c3\'c8\'c5\loch\f36 \hich\f36 \'c3\'d0\'c0\'c6\'c4\'c0\'cd\'d1\'ca\'c8\'c5\loch\f36 \hich\f36 \'cf\'d0\'c0\'c2\'ce\'cd\'c0\'d0\'d3\'d8\'c5\'cd\'c8\'df\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'c2\'eb\'e0\'e4\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\'ee\'ec\loch\f36 +\par \hich\af36\dbch\af13\loch\f36 \hich\f36 Fast Reports \'e8\'ec\'e5\'e5\'f2\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f1\'ee\'f5\'f0\'e0\'ed\'ff\'e5\'f2\loch\f36 \hich\f36 \'e2\'f1\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'f1 +\'ee\'e1\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'e8\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 , \'e2\'ea\'eb\'fe\'f7\'e0\'ff\loch\f36 \hich\f36 \'e2\'f1\'e5\loch\f36 \line \hich\f36 \'ef\'e0\'f2\'e5 +\'ed\'f2\'ed\'fb\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 , \'e0\'e2\'f2\'ee\'f0\'f1\'ea\'e8\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 , \'ef\loch\af36\dbch\af13\hich\f36 \'f0\'ee\'f4\'e5\'f1\'f1\'e8\'ee\'ed +\'e0\'eb\'fc\'ed\'fb\'e5\loch\f36 \hich\f36 \'f2\'e0\'e9\'ed\'fb\loch\f36 \hich\f36 , \'f2\'ee\'f0\'e3\'ee\'e2\'fb\'e5\loch\f36 \hich\f36 \'ec\'e0\'f0\'ea\'e8\loch\f36 , \line \hich\f36 \'f1\'e5\'f0\'e2\'e8\'f1\'ed\'fb\'e5\loch\f36 \hich\f36 \'ec\'e0 +\'f0\'ea\'e8\loch\f36 \hich\f36 , \'f1\'e2\'ff\'e7\'e0\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 \'ed\'e8\'ec\'e8\loch\f36 \hich\f36 \'ef\'f0\'e5\'f1\'f2\'e8\'e6\loch\f36 \hich\f36 \'f4\'e8\'f0\'ec\'fb\loch\f36 \hich\f36 , \'ea\'ee +\'ed\'f4\'e8\'e4\'e5\'ed\'f6\'e8\'e0\'eb\'fc\'ed\'e0\'ff\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'e0\'ff\loch\f36 \line \hich\f36 \'e8\'ed\'f4\'ee\'f0\'ec\'e0\'f6\'e8\'ff\loch\f36 \hich\f36 , \'ff\'e2\'eb\'ff\'fe\'f9\'e0\'ff\'f1\'ff +\loch\f36 \hich\f36 \'f1\'ee\'e1\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'fc\'fe\loch\f36 \hich\f36 \'f4\'e8\'f0\'ec\'fb\loch\f36 \hich\f36 . \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e8\'ec\'e5\'e5\'f2 +\loch\f36 \hich\f36 \'ed\'e8\'ea\'e0\'ea\'e8\'f5\loch\f36 \line \hich\f36 \'ef\'f0\'e0\'e2\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'e8\'f1\'ea\'eb\'fe\'f7\'e5\'ed +\'e8\'e5\'ec\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\'e2\loch\f36 \hich\f36 , \'ee\'e1\'ee\'e7\'ed\'e0\'f7\'e5\'ed\'ed\'fb\'f5\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'ec\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb +\loch\af36\dbch\af13\hich\f36 \'e0\loch\af36\dbch\af13\hich\f36 \'f8\'e5\'ed\'e8\'e8\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'cd\'e0\'e7\'ed\'e0\'f7\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'c4\'e5\'eb\'e5\'e3\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'ef\'ee\'e4\'ef\'e8\'f1\'fb\'e2\'e0\'f2\'fc\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e5 +\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'e8\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee\loch\f36 \line +\hich\f36 \'e5\'ec\'f3\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'ea\'e0\'f7\'e5\'f1\'f2\'e2\'e5\loch\f36 \hich\f36 \'e2\'eb\'e0\'e4\'e5\'eb\'fc\'f6\'e0\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'e5\'e3\'ee\loch\f36 \hich\f36 \'ef\'f0 +\'e5\'e4\'f1\'f2\'e0\'e2\'e8\'f2\'e5\'eb\'ff\loch\f36 \hich\f36 , \'e8\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ec\'ee\'e6\'e5\'f2\loch\f36 \hich\f36 \'ef\'ee\'f0\'f3\'f7\'e0\'f2\'fc\loch\f36 \hich\f36 \'ea\'e0\'ea\'e8\'e5\loch\f36 \hich\f36 - +\'eb\'e8\'e1\'ee\loch\f36 \line \hich\f36 \'ee\'e1\'ff\'e7\'e0\'ed\'ed\'ee\'f1\'f2\'e8\loch\f36 \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'ed\'ee\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'ec\'f3\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'fe +\loch\f36 \hich\f36 \'e1\'e5\'e7\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'e2\'e0\'f0\'e8\'f2\'e5\'eb\'fc\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ef\'e8\loch\af36\dbch\af13\hich\f36 \'f1\'fc\'ec\'e5\'ed\'ed\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'f1\'ee\'e3 +\'eb\'e0\'f1\'e8\'ff\loch\f36 \hich\f36 Fast Reports. \'cb\'fe\'e1\'e0\'ff\loch\f36 \hich\f36 \'ef\'ee\'ef\'fb\'f2\'ea\'e0\loch\f36 \hich\f36 \'ef\'ee\'e4\'ef\'e8\'f1\'e0\'f2\'fc\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ef\'ee\'f0\'f3\'f7 +\'e8\'f2\'fc\loch\f36 \hich\f36 \'e1\'e5\'e7\loch\f36 \hich\f36 \'f3\'ea\'e0\'e7\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'f1\'ee\'e3\'eb\'e0\'f1\'e8\'ff\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e1\'f3\'e4\'e5\'f2\loch\f36 \hich\f36 + \'e8\'ec\'e5\'f2\'fc\loch\f36 \hich\f36 \'f1\'e8\'eb\'fb\loch\f36 . +\par +\par \loch\af36\dbch\af13\hich\f36 \'ce\'e1\'f9\'e5\'e5\loch\f36 : +\par \loch\af36\dbch\af13\hich\f36 \'c4\'e0\'ed\'ed\'ee\'e5\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'f1\'ee\'f1\'f2\'e0\'e2\'eb\'ff\'e5\'f2\loch\f36 \hich\f36 \'ef\'ee\'eb\'ed\'ee\'e5\loch\f36 \hich\f36 \'ef\'ee\'ed +\'e8\'ec\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 \'ec\'e5\'e6\'e4\'f3\loch\f36 \hich\f36 Fast Reports \'e8\loch\f36 \line \hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'ee\'ec\loch\f36 \hich\f36 \'ea\'e0\'f1\'e0\'f2\'e5\'eb\'fc\'ed\'ee\loch\f36 \hich\f36 + \'e4\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'ec\'e5\'f2\'e0\loch\f36 \hich\f36 \'ee\'e1\'f1\'f3\'e6\'e4\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 . \'cb\'fe\'e1\'ee\'e5\loch\f36 \hich\f36 \'e8\'e7\'ec\'e5\loch\af36\dbch\af13\hich\f36 +\'ed\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 \'e2\loch\f36 \line \hich\f36 \'e4\'e0\'ed\'ed\'ee\'ec\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e8\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'ed\'ee\loch\f36 \hich\f36 \'e1\'fb\'f2\'fc\loch\f36 +\hich\f36 \'e2\loch\f36 \hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'ec\loch\f36 \hich\f36 \'e2\'e8\'e4\'e5\loch\f36 \hich\f36 , \'e8\loch\f36 \hich\f36 \'ef\'ee\'e4\'ef\'e8\'f1\'e0\'ed\'ee\loch\f36 \hich\f36 Fast Reports \'e8\loch\f36 \line +\hich\f36 \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\'ee\'ec\loch\f36 \hich\f36 . \'cf\'ee\'f1\'f2\'e0\'ed\'ee\'e2\'eb\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'f3\'f1\'eb\'ee\'e2\'e8\'ff\loch\f36 \hich\f36 , \'ee\'ef\'f0\'e5\'e4\'e5\'eb +\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'e7\'e4\'e5\'f1\'fc\loch\f36 \hich\f36 \'e6\'e5\loch\f36 \hich\f36 \'ef\'f0\'e8\loch\f36 \hich\f36 \'e7\'e0\'ea\'e0\'e7\'e5\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \line \hich\f36 \'ef\'ee\'ea\'f3\'ef\'ea\'f3 +\loch\f36 \hich\f36 , \'ea\'ee\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'ee\'f2\'eb\'e8\'f7\'e0\'fe\'f2\'f1\'ff\loch\f36 \hich\f36 \'ee\'f2\loch\f36 \hich\f36 , \'ea\'ee\'ed\'f4\'eb\'e8\'ea\'f2\'f3\'e5\'f2\loch\f36 \hich\f36 \'f1\loch\f36 \hich\f36 , +\'e8\'eb\'e8\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'e2\'ea\'eb\'fe\'f7\'e5\'ed\'fb\loch\f36 \hich\f36 \'e2\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e5\loch\f36 \line \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 , +\'ed\'e5\loch\f36 \hich\f36 \'f1\'f2\'e0\'ed\'f3\'f2\hich\af36\dbch\af13\loch\f36 \loch\af36\dbch\af13\hich\f36 \'f7\'e0\'f1\'f2\'fc\'fe\loch\f36 \hich\f36 \'e4\'e0\'ed\'ed\'ee\'e3\'ee\loch\f36 \hich\f36 \'d1\'ee\'e3\'eb\'e0\'f8\'e5\'ed\'e8\'ff +\loch\f36 \hich\f36 , \'e5\'f1\'eb\'e8\loch\f36 \hich\f36 \'ee\'ed\loch\f36 \hich\f36 \'ee\'f2\'e4\'e5\'eb\'fc\'ed\'ee\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ef\'f0\'e8\'ed\'ff\'f2\loch\f36 \line \hich\f36 Fast Reports \'e2\loch\f36 +\hich\f36 \'ef\'e8\'f1\'fc\'ec\'e5\'ed\'ed\'ee\'ec\loch\f36 \hich\f36 \'e2\'e8\'e4\'e5\loch\f36 \hich\f36 . \'cb\'e8\'f6\'e5\'ed\'e7\'e8\'e0\'f2\loch\f36 \hich\f36 \'e4\'ee\'eb\'e6\'e5\'ed\loch\f36 \hich\f36 \'ed\'e5\'f1\'f2\'e8\loch\f36 \hich\f36 +\'ee\'f2\'e2\'e5\'f2\'f1\'f2\'e2\'e5\'ed\'ed\'ee\'f1\'f2\'fc\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 , \'e8\loch\f36 \line \hich\f36 \'e4\'ee\'eb\'e6\'e5\'ed\loch\f36 \hich\f36 \'ef\'eb\'e0\'f2\'e8\'f2\'fc\loch\f36 \hich\f36 , \'e8\loch\f36 +\hich\f36 \'e4\'ee\'eb\'e6\'e5\'ed\loch\f36 \hich\f36 \'e2\'ee\'e7\'ec\'e5\'f9\'e0\'f2\'fc\loch\f36 \hich\f36 Fast Reports, \'e2\loch\f36 \hich\f36 \'f1\'eb\'f3\'f7\'e0\'e5\loch\f36 \hich\f36 \'ef\'f0\'ee\'f1\'fc\'e1\'fb\loch\f36 Fast Reports \line +\hich\f36 \'e7\'e0\'ef\'eb\'e0\'f2\'e8\'f2\'fc\loch\f36 \hich\f36 , \'eb\'fe\'e1\'fb\'e5\loch\f36 \hich\f36 \'ef\'f0\'ee\'e4\'e0\'e6\'e8\loch\f36 \hich\f36 , \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 \hich\f36 , \'e4 +\loch\af36\dbch\af13\hich\f36 \'ee\loch\af36\dbch\af13\hich\f36 \'e1\'e0\'e2\'eb\'e5\'ed\'ed\'f3\'fe\loch\f36 \hich\f36 \'f1\'f2\'ee\'e8\'ec\'ee\'f1\'f2\'fc\loch\f36 \hich\f36 (VAT), \'f0\'e0\'f1\'f5\'ee\'e4\loch\f36 \line \hich\f36 \'e8\'eb\'e8 +\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'ed\'e0\'eb\'ee\'e3\loch\f36 \hich\f36 (\'e8\'f1\'ea\'eb\'fe\'f7\'e0\'ff\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e9\loch\f36 \hich\f36 \'ed\'e0\'eb\'ee\'e3\loch\f36 \hich\f36 , \'ee\'f1 +\'ed\'ee\'e2\'e0\'ed\'ed\'fb\'e9\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'f1\'e5\'f2\'e5\'e2\'ee\'ec\loch\f36 \hich\f36 \'e4\'ee\'f5\'ee\'e4\'e5\loch\f36 Fast \line \hich\f36 Reports), \'ee\'e1\'eb\'ee\'e6\'e5\'ed\'e8\'e5\loch\f36 \hich\f36 +\'ed\'e0\'eb\'ee\'e3\'ee\'ec\loch\f36 \hich\f36 , \'ef\'ee\'f8\'eb\'e8\'ed\'ee\'e9\loch\f36 \hich\f36 , \'e8\'eb\'e8\loch\f36 \hich\f36 \'e4\'f0\'f3\'e3\'ee\'e9\loch\f36 \hich\f36 \'ee\'ef\'eb\'e0\'f2\'ee\'e9\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 +\hich\f36 \'e2\'e7\'ed\'ee\'f1\'ee\'ec\loch\f36 \hich\f36 \'eb\'fe\'e1\'ee\'e3\'ee\loch\f36 \line \hich\f36 \'e2\'e8\'e4\'e0\loch\f36 \hich\f36 \'e8\'eb\'e8\loch\f36 \hich\f36 \'ef\'f0\'ee\'e8\'f1\'f5\'ee\'e6\'e4\'e5\'ed\'e8\'ff\loch\f36 \hich\f36 , +\'ea\'ee\'f2\'ee\'f0\'fb\'e5\loch\f36 \hich\f36 \'e2\'e7\'e8\'ec\'e0\'fe\'f2\'f1\'ff\loch\f36 \hich\f36 \'e8\loch\f36 \hich\f36 \'ed\'e0\'eb\'e0\'e3\'e0\'fe\'f2\'f1\'ff\loch\f36 \hich\f36 \'e3\'ee\'f1\'f3\'e4\'e0\'f0\'f1\'f2\'e2\'e5\'ed +\loch\af36\dbch\af13\hich\f36 \'ed\loch\af36\dbch\af13\hich\f36 \'ee\'e9\loch\f36 \line \hich\f36 \'e2\'eb\'e0\'f1\'f2\'fc\'fe\loch\f36 \hich\f36 \'ed\'e0\loch\f36 \hich\f36 \'cf\'f0\'ee\'e4\'f3\'ea\'f2\loch\f36 . +\par +\par }\pard \ltrpar\ql \li0\ri3452\sb100\sa100\nowidctlpar\faauto\rin3452\lin0\itap0 {\rtlch \ab\af36\afs16 \ltrch \b\f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c2\'f1\'e5\loch\f36 \hich\f36 \'ef\'f0\'e0\'e2\'e0\loch\f36 \hich\f36 , \'ff\'e2\'ed +\'ee\loch\f36 \hich\f36 \'ed\'e5\loch\f36 \hich\f36 \'ef\'f0\'e5\'e4\'ee\'f1\'f2\'e0\'e2\'eb\'e5\'ed\'ed\'fb\'e5\loch\f36 \hich\f36 \'e7\'e4\'e5\'f1\'fc\loch\f36 \hich\f36 , \'ef\'f0\'e8\'ed\'e0\'e4\'eb\'e5\'e6\'e0\'f2\loch\f36 Fast Reports Inc. + +\par \loch\af36\dbch\af13\hich\f36 \'cb\'c8\'d6\'c5\'cd\'c7\'c8\'c0\'d2\loch\f36 \hich\f36 \'cf\'d0\'ce\'d7\'c8\'d2\'c0\'cb\loch\f36 \hich\f36 \'c4\'c0\'cd\'cd\'ce\'c5\loch\f36 \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d8\'c5\'cd\'c8\'c5\loch\f36 \hich\f36 , \'cf\'ce +\'cd\'c8\'cc\'c0\'c5\'d2\loch\f36 \hich\f36 \'c8\loch\f36 \hich\f36 \'d1\'ce\'c3\'cb\'c0\'d1\'c5\'cd\loch\f36 \hich\f36 \'d1\'ce\loch\f36 \line \hich\f36 \'c2\'d1\'c5\'cc\'c8\loch\f36 \hich\f36 \'c5\'c3\'ce\loch\f36 \hich\f36 \'cf\'ce\'d1\'d2\'c0 +\'cd\'ce\'c2\'cb\'c5\'cd\'c8\'df\'cc\'c8\loch\f36 \hich\f36 \'c8\loch\f36 \hich\f36 \'d3\'d1\'cb\'ce\'c2\'c8\'df\'cc\'c8\loch\f36 . +\par \loch\af36\dbch\af13\hich\f36 \'d1\'ef\'e0\'f1\'e8\'e1\'ee\loch\f36 \hich\f36 \'e7\'e0\loch\f36 \hich\f36 \'e8\'f1\'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'ed\'e8\'e5\loch\f36 FastReport! +\par }{\rtlch \af36\afs16 \ltrch \f36\fs16\insrsid1969254 \loch\af36\dbch\af13\hich\f36 \'c0\'eb\'e5\'ea\'f1\'e0\'ed\'e4\'f0\loch\f36 \hich\f36 \'d6\'fb\'e3\'e0\'ed\'e5\'ed\'ea\'ee\hich\af36\dbch\af13\loch\f36 \hich\f36 (\'f2\'e5\'f5\'ed\'e8\'f7\'e5\'f1\'ea +\'e8\'e9\loch\f36 \hich\f36 \'e4\'e8\'f0\'e5\'ea\'f2\'ee\'f0\loch\f36 Fast Reports Inc.) +\par +\par }} \ No newline at end of file diff --git a/official/4.2/readme.rtf b/official/4.2/readme.rtf new file mode 100644 index 0000000..971b5d8 Binary files /dev/null and b/official/4.2/readme.rtf differ diff --git a/official/4.2/readme_rus.rtf b/official/4.2/readme_rus.rtf new file mode 100644 index 0000000..7859783 --- /dev/null +++ b/official/4.2/readme_rus.rtf @@ -0,0 +1,157 @@ +{\rtf1\ansi\ansicpg1251\deff0\deflang1049\deflangfe1049\deftab708{\fonttbl{\f0\fswiss\fprq2\fcharset0 Arial;}{\f1\fswiss\fprq2\fcharset204{\*\fname Arial;}Arial CYR;}} +{\colortbl ;\red0\green0\blue255;} +{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\ri3235\lang1033\b\f0\fs16 FastReport\'ae 4.0 VCL\lang1049\f1\par +\b0\par +\pard\nowidctlpar\ri3235\lang1033\f0 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\par +\b\'d1\'ce\'c4\'c5\'d0\'c6\'c0\'cd\'c8\'c5\par +\b0\par +1. \'c2\'e2\'e5\'e4\'e5\'ed\'e8\'e5.\par +\lang1033\f0 2. \lang1049\f1\'cd\'ee\'e2\'fb\'e5 \'e2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'e8 \lang1033\f0 FastReport 4\lang1049\f1\par +\lang1033\f0 3\lang1049\f1 . \'c2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'e8.\par +\par +\pard\nowidctlpar\ri3235\lang1033\f0 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\par +\b 1. \'c2\'c2\'c5\'c4\'c5\'cd\'c8\'c5.\par +\b0\par +\lang1033\f0 FastReport\'ae 4.0 VCL - \lang1049\f1\'fd\'f2\'ee \'ed\'e0\'e1\'ee\'f0 \'ea\'ee\'ec\'ef\'ee\'ed\'e5\'ed\'f2\'ee\'e2 \'e4\'eb\'ff \'ef\'ee\'f1\'f2\'f0\'ee\'e5\'ed\'e8\'ff \'ee\'f2\'f7\'e5\'f2\'ee\'e2, \par +\'ef\'f0\'e5\'e4\'f1\'f2\'e0\'e2\'eb\'ff\'e5\'f2 \'f1\'ee\'e1\'ee\'e9 \'f1\'ee\'f7\'e5\'f2\'e0\'ed\'e8\'e5 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0\'e0, \'e3\'e5\'ed\'e5\'f0\'e0\'f2\'ee\'f0\'e0 \'e8 Preview \'ee\'f2\'f7\'e5\'f2\'ee\'e2. \par +FastReport \'ed\'e0\'ef\'e8\'f1\'e0\'ed \'ed\'e0 100% Object Pascal \'e8 \'ec\'ee\'e6\'e5\'f2 \'e1\'fb\'f2\'fc \'f3\'f1\'f2\'e0\'ed\'ee\'e2\'eb\'e5\'ed \'e2 \par +\pard\nowidctlpar\ri3235\lang1033\f0 Borland\'ae Delphi 4-2006, Borland\'ae C++Builder 4-2006, Turbo Delphi/C++Builder\par +\lang1049\f1\'e8\lang1033\f0 CodeGear\'ae Delphi 2007.\par +\pard\ri3235\lang1049\f1\par +\pard\nowidctlpar\ri3235\lang1033\f0 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\par +\lang1033\b\f0 2\lang1049\f1 . \'cd\'ce\'c2\'db\'c5 \'c2\'ce\'c7\'cc\'ce\'c6\'cd\'ce\'d1\'d2\'c8 \lang1033\f0 FASTREPORT 4\par +\b0\par +\lang1049\f1\'c4\'e8\'e7\'e0\'e9\'ed\'e5\'f0:\par +- \'ee\'f4\'ee\'f0\'ec\'eb\'e5\'ed\'e8\'e5 \'e8\'ed\'f2\'e5\'f0\'f4\'e5\'e9\'f1\'e0 \'e2 \'f1\'f2\'e8\'eb\'e5 XP\par +- \'e7\'e0\'ea\'eb\'e0\'e4\'ea\'e0 "Data" \'f1\'ee \'e2\'f1\'e5\'ec\'e8 \'e8\'f1\'f2\'ee\'f7\'ed\'e8\'ea\'e0\'ec\'e8 \'e4\'e0\'ed\'ed\'fb\'f5 \'ee\'f2\'f7\'e5\'f2\'e0\par +- \'f0\'e8\'f1\'ee\'e2\'e0\'ed\'e8\'e5 \'e4\'e8\'e0\'e3\'f0\'e0\'ec\'ec \'e2 \'e7\'e0\'ea\'eb\'e0\'e4\'ea\'e5 "Data"\par +- code completion (Ctrl+Space)\par +- \'f2\'ee\'f7\'ea\'e8 \'ee\'f1\'f2\'e0\'ed\'ee\'e2\'e0\par +- watches\par +- \'f8\'e0\'e1\'eb\'ee\'ed\'fb \'ee\'f2\'f7\'e5\'f2\'ee\'e2\par +- \'eb\'ee\'ea\'e0\'eb\'fc\'ed\'fb\'e5 \'e2\'fb\'ed\'ee\'f1\'ed\'fb\'e5 \'eb\'e8\'ed\'e8\'e8 (\'ef\'ee\'ff\'e2\'eb\'ff\'fe\'f2\'f1\'ff \'ef\'f0\'e8 \'ef\'e5\'f0\'e5\'ec\'e5\'f9\'e5\'ed\'e8\'e8 \'e8\'eb\'e8 \'e8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'e8 \par +\'f0\'e0\'e7\'ec\'e5\'f0\'ee\'e2 \'ee\'e1\'fa\'e5\'ea\'f2\'e0)\par +- \'e2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'fc \'ed\'e5\'ec\'ee\'e4\'e0\'eb\'fc\'ed\'ee\'e9 \'f0\'e0\'e1\'ee\'f2\'fb, mdi child\par +\par +\'cf\'f0\'e5\'e4\'e2\'e0\'f0\'e8\'f2\'e5\'eb\'fc\'ed\'fb\'e9 \'ef\'f0\'ee\'f1\'ec\'ee\'f2\'f0:\par +- \'fd\'f1\'ea\'e8\'e7\'fb \'f1\'f2\'f0\'e0\'ed\'e8\'f6\par +\par +\'cf\'e5\'f7\'e0\'f2\'fc:\par +- \'f0\'e0\'e7\'f0\'e5\'e7\'e0\'ed\'e8\'e5 \'f1\'f2\'f0\'e0\'ed\'e8\'f6 \'ef\'f0\'e8 \'ef\'e5\'f7\'e0\'f2\'e8 \'ed\'e0 \'ec\'e5\'ed\'fc\'f8\'e8\'e9 \'f0\'e0\'e7\'ec\'e5\'f0 \'e1\'f3\'ec\'e0\'e3\'e8\par +- \'ef\'e5\'f7\'e0\'f2\'fc \'ed\'e5\'f1\'ea\'ee\'eb\'fc\'ea\'e8\'f5 \'f1\'f2\'f0\'e0\'ed\'e8\'f6 \'ed\'e0 \'ee\'e4\'ed\'ee\'e9 \'e1\'ee\'eb\'fc\'f8\'ee\'e9\par +- \'ef\'e5\'f7\'e0\'f2\'fc \'f1 \'ec\'e0\'f1\'f8\'f2\'e0\'e1\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5\'ec\par +- \'f3\'ef\'f0\'e0\'e2\'eb\'e5\'ed\'e8\'e5 \'e4\'f3\'ef\'eb\'e5\'ea\'f1\'ee\'ec \'e8\'e7 \'e4\'e8\'e0\'eb\'ee\'e3\'e0 \'ef\'e5\'f7\'e0\'f2\'e8\par +- \'ef\'e5\'f7\'e0\'f2\'fc \'e8\'ec\'e5\'ed\'e8 \'ea\'ee\'ef\'e8\'e8 \'ed\'e0 \'ea\'e0\'e6\'e4\'ee\'e9 \'ea\'ee\'ef\'e8\'e8 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'e0 (\'ed\'e0\'ef\'f0\'e8\'ec\'e5\'f0, "\'cf\'e5\'f0\'e2\'e0\'ff \'ea\'ee\'ef\'e8\'ff", \par +"\'c2\'f2\'ee\'f0\'e0\'ff \'ea\'ee\'ef\'e8\'ff")\par +\par +\'df\'e4\'f0\'ee:\par +- \'f0\'e5\'e6\'e8\'ec "\'e1\'e5\'f1\'ea\'ee\'ed\'e5\'f7\'ed\'e0\'ff \'f1\'f2\'f0\'e0\'ed\'e8\'f6\'e0"\par +- \'f3\'e2\'e5\'eb\'e8\'f7\'e5\'ed\'e0 \'f1\'ea\'ee\'f0\'ee\'f1\'f2\'fc \'f0\'e0\'e1\'ee\'f2\'fb \'f1 \'e8\'e7\'ee\'e1\'f0\'e0\'e6\'e5\'ed\'e8\'ff\'ec\'e8\par +- \'f0\'e5\'e6\'e8\'ec "reset page numbers" \'e4\'eb\'ff \'e3\'f0\'f3\'ef\'ef\par +- \'f8\'e8\'f4\'f0\'e0\'f6\'e8\'ff \'f4\'e0\'e9\'eb\'ee\'e2 \'ee\'f2\'f7\'e5\'f2\'e0 (Rijndael \'e0\'eb\'e3\'ee\'f0\'e8\'f2\'ec)\par +- \'ed\'e0\'f1\'eb\'e5\'e4\'ee\'e2\'e0\'ed\'e8\'e5 \'ee\'f2\'f7\'e5\'f2\'ee\'e2 (\'e2 \'f4\'e0\'e9\'eb\'e0\'f5 \'e8 \'f4\'ee\'f0\'ec\'e0\'f5 dfm)\par +- drill-down \'ee\'f2\'f7\'e5\'f2\'fb\par +- \'ee\'e1\'fa\'e5\'ea\'f2 frxGlobalVariables\par +- \'f3\'eb\'f3\'f7\'f8\'e5\'ed\'e8\'ff \'e2 \'ee\'e1\'fa\'e5\'ea\'f2\'e5 "cross-tab"\par + - \'f3\'eb\'f3\'f7\'f8\'e5\'ed\'ed\'ee\'e5 \'f3\'ef\'f0\'e0\'e2\'eb\'e5\'ed\'e8\'e5 \'ff\'f7\'e5\'e9\'ea\'e0\'ec\'e8\par + - \'fd\'eb\'e5\'ec\'e5\'ed\'f2\'fb \'ef\'ee\'ea\'e0\'e7\'fb\'e2\'e0\'fe\'f2\'f1\'ff \'e2 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0\'e5\par + - \'e7\'e0\'ef\'ee\'eb\'ed\'e5\'ed\'e8\'e5 \'f3\'e3\'eb\'e0 \'f2\'e0\'e1\'eb\'e8\'f6\'fb (\'f1\'e2-\'e2\'ee ShowCorner)\par + - \'ed\'e5\'f1\'ea\'ee\'eb\'fc\'ea\'ee \'ea\'f0\'ee\'f1\'f1\'ee\'e2 \'e2 \'f8\'e8\'f0\'e8\'ed\'f3 (\'f1\'e2-\'e2\'ee NextCross)\par + - \'ee\'e1\'fa\'e5\'e4\'e8\'ed\'e5\'ed\'e8\'e5 \'ee\'e4\'e8\'ed\'e0\'ea\'ee\'e2\'fb\'f5 \'ff\'f7\'e5\'e5\'ea (\'f1\'e2-\'e2\'ee JoinEqualCells)\par + - \'ee\'e1\'fa\'e5\'e4\'e8\'ed\'e5\'ed\'e8\'e5 \'ee\'e4\'e8\'ed\'e0\'ea\'ee\'e2\'fb\'f5 \'f1\'f2\'f0\'ee\'ea\'ee\'e2\'fb\'f5 \'e7\'ed\'e0\'f7\'e5\'ed\'e8\'e9 \'e2\'ed\'f3\'f2\'f0\'e8 \'ff\'f7\'e5\'e9\'ea\'e8 \par +(\'f1\'e2-\'e2\'ee AllowDuplicates)\par + - \'e2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'fc \'e2\'fb\'e2\'ee\'e4\'e0 \'ef\'ee\'f1\'f2\'ee\'f0\'ee\'ed\'ed\'e8\'f5 \'ee\'e1\'fa\'e5\'ea\'f2\'ee\'e2 \'e2\'ed\'f3\'f2\'f0\'e8 \'ea\'f0\'ee\'f1\'f1-\'f2\'e0\'e1\'eb\'e8\'f6\'fb\par + - \'f1\'e2\'ee\'e9\'f1\'f2\'e2\'e0 AddWidth, AddHeight \'e4\'eb\'ff \'f3\'e2\'e5\'eb\'e8\'f7\'e5\'ed\'e8\'ff \'f8\'e8\'f0\'e8\'ed\'fb \'e8 \'e2\'fb\'f1\'ee\'f2\'fb \'ff\'f7\'e5\'e9\'ea\'e8\par + - \'f1\'e2\'ee\'e9\'f1\'f2\'e2\'ee AutoSize, \'e2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'fc \'ec\'e5\'ed\'ff\'f2\'fc \'f0\'e0\'e7\'ec\'e5\'f0\'fb \'ff\'f7\'e5\'e5\'ea \'e2\'f0\'f3\'f7\'ed\'f3\'fe\par +- \'ee\'e1\'fa\'e5\'ea\'f2 "\'cb\'e8\'ed\'e8\'ff" \'ec\'ee\'e6\'e5\'f2 \'e8\'ec\'e5\'f2\'fc \'f1\'f2\'f0\'e5\'eb\'ea\'e8\par +- \'e4\'ee\'e1\'e0\'e2\'eb\'e5\'ed\'ee \'f1\'e2-\'e2\'ee TfrxPictureView.FileLink (\'ec\'ee\'e6\'e5\'f2 \'f1\'ee\'e4\'e5\'f0\'e6\'e0\'f2\'fc \'ef\'e5\'f0\'e5\'ec\'e5\'ed\'ed\'f3\'fe \'e8\'eb\'e8\par +\'e8\'ec\'ff \'f4\'e0\'e9\'eb\'e0)\par +- \'e8\'ed\'e4\'e8\'e2\'e8\'e4\'f3\'e0\'eb\'fc\'ed\'ee\'e5 \'ee\'f4\'ee\'f0\'ec\'eb\'e5\'ed\'e8\'e5 \'ea\'e0\'e6\'e4\'ee\'e9 \'eb\'e8\'ed\'e8\'e8 \'f0\'e0\'ec\'ea\'e8 (\'f1\'e2\'ee\'e9\'f1\'f2\'e2\'e0 Frame.LeftLine,\par +TopLine, RightLine, BottomLine - \'ed\'e0\'f1\'f2\'f0\'e0\'e8\'e2\'e0\'fe\'f2\'f1\'ff \'e2 \'e8\'ed\'f1\'ef\'e5\'ea\'f2\'ee\'f0\'e5)\par +- \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 PNG \'e8\'e7\'ee\'e1\'f0\'e0\'e6\'e5\'ed\'e8\'e9 (\'f0\'e0\'f1\'ea\'ee\'ec\'ec\'e5\'ed\'f2\'e8\'f0\'f3\'e9\'f2\'e5 \{$DEFINE PNG\} \'e2 \'f4\'e0\'e9\'eb\'e5 frx.inc)\par +- \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'fd\'ea\'f1\'ef\'ee\'f0\'f2\'e0 \'e2 \'f4\'ee\'f0\'ec\'e0\'f2 Open Document Format for Office Applications (OASIS), \par +\'f2\'e0\'e1\'eb\'e8\'f6 (ods) \'e8 \'f2\'e5\'ea\'f1\'f2\'ee\'e2\'fb\'f5 \'e4\'ee\'ea\'f3\'ec\'e5\'ed\'f2\'ee\'e2 (odt)\par +\par +Enterprise \'ea\'ee\'ec\'ef\'ee\'ed\'e5\'ed\'f2\'fb:\par +- \'cf\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'f0\'e0\'e7\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'e8\'ff \'e4\'ee\'f1\'f2\'f3\'ef\'e0 \'ed\'e0 \'ee\'f1\'ed\'ee\'e2\'e5 \'ef\'ee\'eb\'e8\'f2\'e8\'ea\'e8 \'cf\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'e5\'e9/\'c3\'f0\'f3\'ef\'ef\par +- \'cf\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'f8\'e0\'e1\'eb\'ee\'ed\'ee\'e2\par +- \'c4\'e8\'ed\'e0\'ec\'e8\'f7\'e5\'f1\'ea\'ee\'e5 \'ee\'e1\'ed\'ee\'e2\'eb\'e5\'ed\'e8\'e5 \'ea\'ee\'ed\'f4\'e8\'e3\'f3\'f0\'e0\'f6\'e8\'e8, \'f1\'ef\'e8\'f1\'ea\'e0 \'ef\'ee\'eb\'fc\'e7\'ee\'e2\'e0\'f2\'e5\'eb\'e5\'e9/\'e3\'f0\'f3\'ef\'ef\par +\lang1033\f0\par +\pard\nowidctlpar\ri3235 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\par +\lang1033\b\f0 3\lang1049\f1 . \'c2\'ce\'c7\'cc\'ce\'c6\'cd\'ce\'d1\'d2\'c8.\par +\b0\par +- \'c1\'fd\'ed\'e4-\'ee\'f0\'e8\'e5\'ed\'f2\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'fb\'e9 \'e3\'e5\'ed\'e5\'f0\'e0\'f2\'ee\'f0 \'ee\'f2\'f7\'e5\'f2\'ee\'e2;\par +- \'c2\'f1\'f2\'f0\'ee\'e5\'ed\'ed\'fb\'e9 \'ec\'ee\'f9\'ed\'fb\'e9 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0, \'e4\'ee\'f1\'f2\'f3\'ef\'ed\'fb\'e9 \'e8 \'e2 \lang1033\f0 run\lang1049\f1 -\lang1033\f0 time\lang1049\f1 ;\par +\lang1033\f0 - \u1055?\u1086?\u1083?\u1085?\u1099?\u1081? WYSIWYG;\par +- Preview \u1082?\u1072?\u1082? \u1074? MS Word;\par +\lang1049\f1 - \'c2\'fb\'f1\'ee\'ea\'e0\'ff \'f1\'ea\'ee\'f0\'ee\'f1\'f2\'fc \'f0\'e0\'e1\'ee\'f2\'fb;\par +- \'ca\'ee\'ec\'ef\'e0\'ea\'f2\'ed\'ee\'f1\'f2\'fc \'ea\'ee\'e4\'e0;\par +- \'cd\'e5\'ee\'e3\'f0\'e0\'ed\'e8\'f7\'e5\'ed\'ed\'ee\'e5 \'ea\'ee\'eb\'e8\'f7\'e5\'f1\'f2\'e2\'ee \'f1\'f2\'f0\'e0\'ed\'e8\'f6 \'f1\'f4\'ee\'f0\'ec\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'ee\'e3\'ee \'ee\'f2\'f7\'e5\'f2\'e0;\par +- \'cc\'ed\'ee\'e3\'ee\'f1\'f2\'f0\'e0\'ed\'e8\'f7\'ed\'fb\'e5 \'ee\'f2\'f7\'e5\'f2\'fb; \'f1\'ee\'f1\'f2\'e0\'e2\'ed\'fb\'e5 (\'ea\'ee\'ec\'ef\'ee\'e7\'e8\'f2\'ed\'fb\'e5) \'ee\'f2\'f7\'e5\'f2\'fb; \'e2\'eb\'ee\'e6\'e5\'ed\'ed\'fb\'e5 \line\'ee\'f2\'f7\'e5\'f2\'fb;\par + \'e3\'f0\'f3\'ef\'ef\'fb; \'ec\'ed\'ee\'e3\'ee\'ea\'ee\'eb\'ee\'ed\'ee\'f7\'ed\'fb\'e5 \'ee\'f2\'f7\'e5\'f2\'fb; \lang1033\f0 master\lang1049\f1 -\lang1033\f0 detail\lang1049\f1 -\lang1033\f0 detail\lang1049\f1 \'ee\'f2\'f7\'e5\'f2\'fb;\par + \lang1033\f0 cross\lang1049\f1 -\lang1033\f0 tab\lang1049\f1 \'ee\'f2\'f7\'e5\'f2\'fb; \'e4\'e2\'f3\'f5\'ef\'f0\'ee\'f5\'ee\'e4\'ed\'fb\'e5 \'ee\'f2\'f7\'e5\'f2\'fb; "\'e6\'e8\'e2\'fb\'e5" \'ee\'f2\'f7\'e5\'f2\'fb;\par +- \'cf\'ee\'eb\'ed\'fb\'e9 \'ea\'ee\'ed\'f2\'f0\'ee\'eb\'fc \'ed\'e0\'e4 \'ef\'f0\'ee\'f6\'e5\'f1\'f1\'ee\'ec \'ef\'e5\'f7\'e0\'f2\'e8, \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'e2\'f1\'e5\'f5 \'f2\'e8\'ef\'ee\'e2 \'e1\'f3\'ec\'e0\'e3\'e8;\par +- \'dd\'ea\'f1\'ef\'ee\'f0\'f2 \'e2 \lang1033\f0 TXT\lang1049\f1 , \lang1033\f0 RTF\lang1049\f1 , \lang1033\f0 HTML\lang1049\f1 , \lang1033\f0 PDF\lang1049\f1 , \lang1033\f0 XLS\lang1049\f1 , \lang1033\f0 XML\lang1049\f1 , \lang1033\f0 JPG\lang1049\f1 , \lang1033\f0 BMP\lang1049\f1 , \lang1033\f0 TIFF\lang1049\f1 \'f4\'ee\'f0\'ec\'e0\'f2\'fb;\par +\par +- \'c2\'f1\'f2\'f0\'ee\'e5\'ed\'ed\'fb\'e9 \'e8\'ed\'f2\'e5\'f0\'ef\'f0\'e5\'f2\'e0\'f2\'ee\'f0 \'f1\'ea\'f0\'e8\'ef\'f2\'ee\'e2\'ee\'e3\'ee \'ff\'e7\'fb\'ea\'e0 (\'ef\'ee\'e4\'e4\'e5\'f0\'e6\'e8\'e2\'e0\'fe\'f2\'f1\'ff 4 \'ff\'e7\'fb\'ea\'e0 - \par + \lang1033\f0 PascalScript, C++Script, JSCript, BasicScript) \u1076?\u1083?\u1103? \u1091?\u1087?\u1088?\u1072?\u1074?\u1083?\u1077?\u1085?\u1080?\u1103? \u1087?\u1088?\u1086?\u1094?\u1077?\u1089?\u1089?\u1086?\u1084? \par + \lang1049\f1\'ef\'ee\'f1\'f2\'f0\'ee\'e5\'ed\'e8\'ff \'ee\'f2\'f7\'e5\'f2\'e0 \'f1 \'ee\'f2\'eb\'e0\'e4\'f7\'e8\'ea\'ee\'ec;\par +- \'d0\'e5\'e4\'e0\'ea\'f2\'ee\'f0 \'f1\'ea\'f0\'e8\'ef\'f2\'e0 \'f1 \'ef\'ee\'e4\'f1\'e2\'e5\'f2\'ea\'ee\'e9 \'f1\'e8\'ed\'f2\'e0\'ea\'f1\'e8\'f1\'e0;\par +- \'c5\'e4\'e8\'ed\'fb\'e9 \'f1\'ea\'f0\'e8\'ef\'f2 \'e4\'eb\'ff \'e2\'f1\'e5\'e3\'ee \'ee\'f2\'f7\'e5\'f2\'e0 (\'ea\'e0\'ea \lang1033\f0 unit\lang1049\f1 \'e2 \lang1033\f0 Delphi\lang1049\f1 );\par +\par +- \'cd\'e0\'e1\'ee\'f0 \'ed\'e0\'e8\'e1\'ee\'eb\'e5\'e5 \'ef\'ee\'ef\'f3\'eb\'ff\'f0\'ed\'fb\'f5 \'ea\'ee\'ec\'ef\'ee\'ed\'e5\'ed\'f2\'ee\'e2: \'d2\'e5\'ea\'f1\'f2, \'cb\'e8\'ed\'e8\'ff (\'e2 \'f2\'ee\'ec \'f7\'e8\'f1\'eb\'e5 \'e8 \par + \'e4\'e8\'e0\'e3\'ee\'ed\'e0\'eb\'fc\'ed\'e0\'ff), \'d0\'e8\'f1\'f3\'ed\'ee\'ea, \'d4\'e8\'e3\'f3\'f0\'e0, \lang1033\f0 OLE\lang1049\f1 \'ee\'e1\'fa\'e5\'ea\'f2, \lang1033\f0 RichText\lang1049\f1 , \lang1033\f0 RX\lang1049\f1 \lang1033\f0 Rich\lang1049\f1 2.0, \par + \'c4\'e8\'e0\'e3\'f0\'e0\'ec\'ec\'e0, \'d8\'f2\'f0\'e8\'f5-\'ea\'ee\'e4;\par +- \'d0\'e0\'e7\'eb\'e8\'f7\'ed\'fb\'e5 \'f2\'e8\'ef\'fb \'e7\'e0\'eb\'e8\'e2\'ea\'e8 \'e4\'eb\'ff \'ee\'e1\'fa\'e5\'ea\'f2\'ee\'e2; \par +- \'c2\'f0\'e0\'f9\'e5\'ed\'e8\'e5 \'f2\'e5\'ea\'f1\'f2\'e0 \'ef\'ee\'e4 \'f3\'e3\'eb\'ee\'ec 0..360; \par +- \'ce\'f2\'f1\'f2\'f3\'ef \'ef\'e0\'f0\'e0\'e3\'f0\'e0\'f4\'e0;\par +- \'cf\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'ef\'f0\'ee\'f1\'f2\'fb\'f5 \lang1033\f0 html\lang1049\f1 -\'f2\'fd\'e3\'ee\'e2 (\lang1033\f0 font\lang1049\f1 \lang1033\f0 color\lang1049\f1 , \lang1033\f0 b\lang1049\f1 , \lang1033\f0 i\lang1049\f1 , \lang1033\f0 u\lang1049\f1 , \lang1033\f0 sub\lang1049\f1 , \lang1033\f0 sup\lang1049\f1 ) \'e2 \'ee\'e1\'fa\'e5\'ea\'f2\'e5 \lang1033\f0 Memo\lang1049\f1 ;\par +- \'d1\'f2\'e8\'eb\'e8;\par +- \'cf\'e5\'f0\'e5\'f2\'e5\'ea\'e0\'ed\'e8\'e5 \'f2\'e5\'ea\'f1\'f2\'e0; \par +- \'d1\'e2\'ee\'e9\'f1\'f2\'e2\'e0 \lang1033\f0 Cursor\lang1049\f1 , \lang1033\f0 URL\lang1049\f1 \'f3 \'ee\'e1\'fa\'e5\'ea\'f2\'ee\'e2 \'ee\'f2\'f7\'e5\'f2\'e0. \'cf\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \lang1033\f0 anchors\lang1049\f1 ;\par +- \'cf\'ee\'f1\'f2\'f0\'ee\'e5\'ed\'e8\'e5 \'ee\'f2\'f7\'e5\'f2\'ee\'e2 \'e4\'eb\'ff \'e2\'fb\'e2\'ee\'e4\'e0 \'ed\'e0 \'ec\'e0\'f2\'f0\'e8\'f7\'ed\'fb\'e9 \'ef\'f0\'e8\'ed\'f2\'e5\'f0; \par +- \'cc\'e0\'f1\'f8\'f2\'e0\'e1\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5 \'e2 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0\'e5;\par +- \'cb\'e8\'ed\'e5\'e9\'ea\'e8, \'e2\'fb\'ed\'ee\'f1\'ed\'fb\'e5 \'eb\'e8\'ed\'e8\'e8 \'e2 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0\'e5;\par +- \'c8\'ed\'f1\'f2\'f0\'f3\'ec\'e5\'ed\'f2\'fb "\'f0\'f3\'ea\'e0", "\'eb\'f3\'ef\'e0", "\'f2\'e5\'ea\'f1\'f2";\par +- \'c2\'ee\'e7\'ec\'ee\'e6\'ed\'ee\'f1\'f2\'fc \'ee\'f2\'ee\'e1\'f0\'e0\'e6\'e0\'f2\'fc \'f1\'ee\'e4\'e5\'f0\'e6\'e8\'ec\'ee\'e5 \'ef\'ee\'eb\'ff \'c1\'c4 \'e2\'ec\'e5\'f1\'f2\'ee \'e5\'e3\'ee \'ed\'e0\'e7\'e2\'e0\'ed\'e8\'ff;\par +- \'d1\'e5\'f2\'ea\'e0-\'ec\'e8\'eb\'eb\'e8\'ec\'e5\'f2\'f0\'ee\'e2\'ea\'e0, \'e4\'fe\'e9\'ec\'ee\'e2\'ea\'e0, \'f1 \'ef\'f0\'ee\'e8\'e7\'e2\'ee\'eb\'fc\'ed\'fb\'ec \'f8\'e0\'e3\'ee\'ec;\par +- \'c8\'e7\'ec\'e5\'ed\'e5\'ed\'e8\'e5 \'eb\'e5\'e2\'ee\'e9/\'ef\'f0\'e0\'e2\'ee\'e9 \'e3\'f0\'e0\'ed\'e8\'f6 \'eb\'e8\'f1\'f2\'e0 (\'ee\'e1\'fa\'e5\'ea\'f2\'fb \'f1\'e4\'e2\'e8\'e3\'e0\'fe\'f2\'f1\'ff \'e0\'e2\'f2\'ee\'ec\'e0\'f2\'e8\'f7\'e5\'f1\'ea\'e8);\par +- \'cc\'e0\'f1\'f2\'e5\'f0\'e0 \'e4\'eb\'ff \'f1\'ee\'e7\'e4\'e0\'ed\'e8\'ff \'e1\'e0\'e7\'ee\'e2\'fb\'f5 \'f2\'e8\'ef\'ee\'e2 \'ee\'f2\'f7\'e5\'f2\'ee\'e2;\par +- \'ca\'ee\'ef\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5 \'ee\'e1\'fa\'e5\'ea\'f2\'ee\'e2 \'e2 \'e1\'f3\'f4\'e5\'f0 \'ee\'e1\'ec\'e5\'ed\'e0 \lang1033\f0 Windows\lang1049\f1 ;\par +- \'cf\'ee\'eb\'ed\'ee\'e5 \lang1033\f0 Undo\lang1049\f1 /\lang1033\f0 Redo\lang1049\f1 \'e2 \'e4\'e8\'e7\'e0\'e9\'ed\'e5\'f0\'e5;\par +- \'cf\'ee\'e8\'f1\'ea \'f2\'e5\'ea\'f1\'f2\'e0 \'e2 \'f1\'f4\'ee\'f0\'ec\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'ee\'ec \'ee\'f2\'f7\'e5\'f2\'e5;\par +- \'d0\'e5\'e4\'e0\'ea\'f2\'e8\'f0\'ee\'e2\'e0\'ed\'e8\'e5 \'f1\'f4\'ee\'f0\'ec\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'ee\'e3\'ee \'ee\'f2\'f7\'e5\'f2\'e0;\par +\par +- \'ce\'f2\'f7\'e5\'f2 \'ec\'ee\'e6\'e5\'f2 \'f1\'ee\'e4\'e5\'f0\'e6\'e0\'f2\'fc \'e4\'e8\'e0\'eb\'ee\'e3\'ee\'e2\'fb\'e5 \'f4\'ee\'f0\'ec\'fb \'e4\'eb\'ff \'e7\'e0\'ef\'f0\'ee\'f1\'e0 \'ef\'e0\'f0\'e0\'ec\'e5\'f2\'f0\'ee\'e2 \par + \'ef\'e5\'f0\'e5\'e4 \'ef\'ee\'f1\'f2\'f0\'ee\'e5\'ed\'e8\'e5\'ec. \'c2 \'ee\'f2\'f7\'e5\'f2 \'ec\'ee\'e6\'e5\'f2 \'e1\'fb\'f2\'fc \'ed\'e5\'f1\'ea\'ee\'eb\'fc\'ea\'ee \'e4\'e8\'e0\'eb\'ee\'e3\'ee\'e2\'fb\'f5 \'f4\'ee\'f0\'ec.\par + \'c2 \'e4\'e8\'e7\'e0\'ed\'e5\'f0\'e5 \'e4\'e8\'e0\'eb\'ee\'e3\'ee\'e2\'fb\'f5 \'f4\'ee\'f0\'ec \'e4\'ee\'f1\'f2\'f3\'ef\'ed\'fb \'f1\'f2\'e0\'ed\'e4\'e0\'f0\'f2\'ed\'fb\'e5 \'fd\'eb\'e5\'ec\'e5\'ed\'f2\'fb \'f3\'ef\'f0\'e0\'e2\'eb\'e5\'ed\'e8\'ff,\par + \'f2\'e0\'ea\'e8\'e5 \'ea\'e0\'ea: \lang1033\f0 Button\lang1049\f1 , \lang1033\f0 Edit\lang1049\f1 , \lang1033\f0 CheckBox\lang1049\f1 \'e8 \'e4\'f0.;\par +- \'cf\'ee\'eb\'ed\'e0\'ff \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \'e2\'fb\'e2\'ee\'e4\'e0 \lang1033\f0 Bi\lang1049\f1 -\lang1033\f0 directional\lang1049\f1 - \'f2\'e5\'ea\'f1\'f2\'ee\'e2;\par +- \'d4\'ee\'f0\'ec\'e0\'f2 \'f5\'f0\'e0\'ed\'e5\'ed\'e8\'ff \'f4\'e0\'e9\'eb\'ee\'e2 \'f8\'e0\'e1\'eb\'ee\'ed\'ee\'e2 \'e8 \'ee\'f2\'f7\'b8\'f2\'ee\'e2 - \lang1033\f0 xml\lang1049\f1 , \par + \'ef\'ee\'e4\'e4\'e5\'f0\'e6\'ea\'e0 \lang1033\f0 Gzip\lang1049\f1 \'f1\'e6\'e0\'f2\'e8\'ff \'f1\'ee\'f5\'f0\'e0\'ed\'ff\'e5\'ec\'fb\'f5 \'f4\'e0\'e9\'eb\'ee\'e2;\par +- \'d4\'f3\'ed\'ea\'f6\'e8\'ee\'ed\'e0\'eb\'fc\'ed\'ee\'f1\'f2\'fc \'ec\'ee\'e6\'e5\'f2 \'e1\'fb\'f2\'fc \'f0\'e0\'f1\'f8\'e8\'f0\'e5\'ed\'e0 \'e7\'e0 \'f1\'f7\'e5\'f2 \'ed\'e0\'ef\'e8\'f1\'e0\'ed\'e8\'ff \'f1\'ee\'e1\'f1\'f2\'e2\'e5\'ed\'ed\'fb\'f5\par + \'ea\'ee\'ec\'ef\'ee\'ed\'e5\'ed\'f2 - \'e2\'e8\'e7\'f3\'e0\'eb\'fc\'ed\'fb\'f5 \'ee\'e1\'fa\'e5\'ea\'f2\'ee\'e2, \'ec\'e0\'f1\'f2\'e5\'f0\'ee\'e2, \'e1\'e8\'e1\'eb\'e8\'ee\'f2\'e5\'ea \'f4\'f3\'ed\'ea\'f6\'e8\'e9;\par +- \'d0\'e0\'e1\'ee\'f2\'e0 \'ea\'e0\'ea \'f1 \lang1033\f0 Database\lang1049\f1 - \'ee\'f0\'e8\'e5\'ed\'f2\'e8\'f0\'ee\'e2\'e0\'ed\'ed\'fb\'ec\'e8 \'e8\'f1\'f2\'ee\'f7\'ed\'e8\'ea\'e0\'ec\'e8 \'e4\'e0\'ed\'ed\'fb\'f5, \'f2\'e0\'ea \'e8 \'f1\par + \'eb\'fe\'e1\'fb\'ec\'e8 \'e4\'e0\'ed\'ed\'fb\'ec\'e8.\par +\par +\pard\nowidctlpar\ri3235\lang1033\f0 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\par +\'d1\'ee \'e2\'f1\'e5\'ec\'e8 \'e2\'ee\'ef\'f0\'ee\'f1\'e0\'ec\'e8 \'ee \'ef\'ee\'ea\'f3\'ef\'ea\'e5 \'eb\'e8\'f6\'e5\'ed\'e7\'e8\'e8 \lang1033\f0 FastReport\lang1049\f1 \'ee\'e1\'f0\'e0\'f9\'e0\'e9\'f2\'e5\'f1\'fc \'ef\'ee \'e0\'e4\'f0\'e5\'f1\'f3\par +\cf1\lang1033\ul\f0 sales@fast-report.com\cf0\lang1049\ulnone\f1\par +\par +\pard\nowidctlpar\ri3235\lang1033\f0 ----------------------------------------------------------------------------------------------------------\par +\pard\ri3235\lang1049\f1\'ca\'ee\'ee\'f0\'e4\'e8\'ed\'e0\'f2\'fb \'e0\'e2\'f2\'ee\'f0\'ee\'e2:\par +\par +\lang1033\b\f0 Fast Reports Inc.\par +\b0\par +e-mail: \tab\tab\cf1\ul \cf0\ulnone\par +web sites: \tab\cf1\ul \cf0\ulnone\par + \tab\tab\cf1\ul \cf0\ulnone\par +\par +\par +} + \ No newline at end of file diff --git a/official/4.2/recompile.exe b/official/4.2/recompile.exe new file mode 100644 index 0000000..aacbecb Binary files /dev/null and b/official/4.2/recompile.exe differ diff --git a/official/4.2/teechart.txt b/official/4.2/teechart.txt new file mode 100644 index 0000000..614d4ae --- /dev/null +++ b/official/4.2/teechart.txt @@ -0,0 +1,10 @@ +Installing the FastReport with TeeChart Pro + +Run "recompile.exe" and perform the following steps: +1. Select Delphi version +2. Select FR edition +3. Select TeeChart version +4. Click "Browse" button and select path to your TeeChart Pro .dcu files +(typically C:\Program Files\Steema Software\TeeChart X for Delphi X\DelphiX\Lib) +5. Select "Change TeeChart version" +6. Click "Compile" button diff --git a/official/4.2/teechart_rus.txt b/official/4.2/teechart_rus.txt new file mode 100644 index 0000000..95e20bb --- /dev/null +++ b/official/4.2/teechart_rus.txt @@ -0,0 +1,10 @@ +Установка FastReport с TeeChart Pro + +Запустите "recompile.exe" и выполните следующие шаги: +1. Выберите версию Delphi +2. Выберите версию FR +3. Выберите версию TeeChart +4. Нажмите кнопку "Browse" и выберите путь к .dcu файлам TeeChart +(как правило, это C:\Program Files\Steema Software\TeeChart X for Delphi X\DelphiX\Lib) +5. Выберите "Change TeeChart version" +6. Нажмите кнопку "Compile"