├── .gitignore ├── BeautifulDialog ├── BeautifulDialog.fmx ├── BeautifulDialog.pas ├── BeautyDlgDemo.dpr └── BeautyDlgDemo.dproj ├── CameraPerformance ├── .gitignore ├── AndroidManifest.template.xml ├── CameraPerformance.deployproj ├── CameraPerformance.dpr ├── CameraPerformance.dproj ├── Custom │ ├── FMX.Media.AVFoundation.pas │ └── FMX.Media.Android.pas ├── Entitlement.TemplateiOS.xml ├── FMain.NmXhdpiPh.fmx ├── FMain.Windows.fmx ├── FMain.fmx ├── FMain.iPhone4in.fmx ├── FMain.pas ├── Fast │ └── FastUtils.pas └── SIMD │ ├── FastUtils.pas │ ├── libfastutils-android.a │ └── libfastutils.a ├── DonationList.md ├── FMXPrint ├── FMXPrintDemo.dpr ├── FMXPrintDemo.dproj ├── PrintDemoMain.fmx └── PrintDemoMain.pas ├── Gif2PngDemo ├── Gif2PngDemo.dpr ├── Gif2PngDemo.dproj ├── Gif2PngDemo.res ├── Gif2PngDemo.stat ├── GifDemoMain.dfm ├── GifDemoMain.pas ├── Test.gif └── Test.png ├── HtmlParserTest ├── HtmlParserTest.dpr ├── HtmlParserTest.dproj ├── HtmlParserTestMain.dfm ├── HtmlParserTestMain.pas ├── README.md ├── Test.html └── htmlp │ ├── DOMCore.pas │ ├── Entities.pas │ ├── Formatter.pas │ ├── HTMLParser.pas │ ├── HtmlReader.pas │ ├── HtmlTags.pas │ └── WStrings.pas ├── HtmlParserTest_D7 ├── HtmlParserTest.cfg ├── HtmlParserTest.dof ├── HtmlParserTest.dpr ├── HtmlParserTest.dproj ├── HtmlParserTest.res ├── HtmlParserTestMain.dfm ├── HtmlParserTestMain.pas ├── README.md ├── Test.html └── htmlp │ ├── DOMCore.pas │ ├── Entities.pas │ ├── Formatter.pas │ ├── HTMLParser.pas │ ├── HtmlReader.pas │ ├── HtmlTags.pas │ └── WStrings.pas ├── LoadCustomCursor ├── CursorTest.dfm ├── CursorTest.pas ├── LoadCustomCursor.dpr ├── LoadCustomCursor.dproj └── Move.cur ├── README.md ├── Recorder ├── RecorderDemo.dpr ├── RecorderDemo.dproj ├── RecorderDemo.dproj.local ├── RecorderDemo.res ├── RecorderDemoMain.fmx └── RecorderDemoMain.pas ├── RoundImageDemo ├── DemoImage.png ├── RoundImageDemo.dpr ├── RoundImageDemo.dproj ├── RoundImageDemo.res ├── RoundImageForm.fmx └── RoundImageForm.pas ├── ScanCodeDemo ├── AndroidManifest.template.xml ├── CameraConfigurationUtils.pas ├── Custom │ ├── Androidapi.JNI.Embarcadero.pas │ ├── Androidapi.JNI.Hardware.pas │ ├── Androidapi.JNI.Media.pas │ ├── FMX.Media.AVFoundation.pas │ └── FMX.Media.Android.pas ├── Entitlement.TemplateiOS.xml ├── Fast │ └── FastUtils.pas ├── QMScanCode.fmx ├── QMScanCode.pas ├── SIMD │ ├── FastUtils.pas │ ├── libfastutils-android.a │ └── libfastutils.a ├── ScanCodeDemo.deployproj ├── ScanCodeDemo.dpr ├── ScanCodeDemo.dproj ├── readme.md └── res │ └── raw │ └── beep.ogg ├── TestButton ├── Main.fmx ├── Main.pas ├── TestButton.dpr └── TestButton.dproj ├── Tools ├── ResConvert.bdsproj ├── ResConvert.cfg ├── ResConvert.dpr ├── ResConvertMain.dfm └── ResConvertMain.pas └── ZXingScanDemo ├── AndroidManifest.template.xml ├── CameraConfigurationUtils.pas ├── ZXingScanDemo.deployproj ├── ZXingScanDemo.dpr ├── ZXingScanDemo.dproj ├── ZXingScanDemo.res ├── ZXingScanDemo.stat ├── main.LgXhdpiPh.fmx ├── main.NmXhdpiPh.fmx ├── main.fmx ├── main.iPhone55in.fmx └── main.pas /.gitignore: -------------------------------------------------------------------------------- 1 | /HtmlParserTest/Win32 2 | /HtmlParserTest/__history 3 | /HtmlParserTest/HtmlParserTest.dproj.local 4 | /HtmlParserTest/htmlp/__history 5 | /HtmlParserTest/*.identcache 6 | /HtmlParserTest/HtmlParserTest.res 7 | /HtmlParserTest_D7/htmlp/*.dcu 8 | /FMXPrint/Win32/Debug 9 | /FMXPrint/Win64/Debug 10 | /FMXPrint/__history 11 | /FMXPrint/FMXPrintDemo.dproj.local 12 | /FMXPrint/FMXPrintDemo.identcache 13 | /FMXPrint/FMXPrintDemo.res 14 | /BeautifulDialog/__history 15 | /BeautifulDialog/BeautyDlgDemo.dproj.local 16 | /BeautifulDialog/BeautyDlgDemo.res 17 | /BeautifulDialog/Win32/Debug 18 | /BeautifulDialog/BeautyDlgDemo.identcache 19 | /BeautifulDialog/BeautyDlgDemo.stat 20 | /TestButton/__history 21 | /TestButton/Win32/Debug 22 | /FMXPrint/*.stat 23 | /TestButton/*.res 24 | /LoadCustomCursor/Debug/Win32 25 | /LoadCustomCursor/__history 26 | /TestButton/*.local 27 | /TestButton/*.identcache 28 | /TestButton/*.stat 29 | /LoadCustomCursor/LoadCustomCursorResource.rc 30 | /LoadCustomCursor/LoadCustomCursor.dproj.local 31 | /LoadCustomCursor/LoadCustomCursor.dres 32 | /LoadCustomCursor/LoadCustomCursor.identcache 33 | /LoadCustomCursor/LoadCustomCursor.res 34 | /LoadCustomCursor/LoadCustomCursor.stat 35 | /ZXingScanDemo/__history 36 | /ZXingScanDemo/ZXingScanDemo.dproj.local 37 | /ZXingScanDemo/ZXingScanDemo.identcache 38 | /GifDemo/__history 39 | /GifDemo/Win32/Debug 40 | /Gif2PngDemo/__history 41 | /Recorder/Win32/Debug 42 | /Recorder/__history 43 | /Gif2PngDemo/Gif2PngDemo.dproj.local 44 | /Gif2PngDemo/Gif2PngDemo.identcache 45 | /Gif2PngDemo/Win32/Debug 46 | /Gif2PngDemo/Win32/Release 47 | /ZXingScanDemo/Android/Debug 48 | /ZXingScanDemo/Win32/Debug 49 | /CameraPerformance/__history 50 | /RoundImageDemo/Win32/Debug 51 | /RoundImageDemo/__history 52 | /RoundImageDemo/RoundImageDemo.dproj.local 53 | /CameraPerformance/Android/Release-SIMD 54 | 55 | /ScanCodeDemo/Android/Release-SIMD 56 | /ScanCodeDemo/CameraPerformance.identcache 57 | /ScanCodeDemo/CameraPerformance.res 58 | /ScanCodeDemo/CameraPerformance.stat 59 | /ScanCodeDemo/Custom/__history 60 | /ScanCodeDemo/__history 61 | /ScanCodeDemo/ScanCodeDemo.dproj.local 62 | /ScanCodeDemo/ScanCodeDemo.identcache 63 | /ScanCodeDemo/ScanCodeDemo.res 64 | /ScanCodeDemo/ScanCodeDemo.stat 65 | -------------------------------------------------------------------------------- /BeautifulDialog/BeautifulDialog.fmx: -------------------------------------------------------------------------------- 1 | object Form19: TForm19 2 | Left = 0 3 | Top = 0 4 | BorderStyle = None 5 | Caption = 'Form19' 6 | ClientHeight = 148 7 | ClientWidth = 328 8 | StyleBook = stylbk1 9 | StyleLookup = 'dialog-box' 10 | FormFactor.Width = 320 11 | FormFactor.Height = 480 12 | FormFactor.Devices = [Desktop] 13 | DesignerMasterStyle = 0 14 | object Layout1: TLayout 15 | Align = Bottom 16 | Margins.Bottom = 23.000000000000000000 17 | Position.Y = 103.000000000000000000 18 | Size.Width = 328.000000000000000000 19 | Size.Height = 22.000000000000000000 20 | Size.PlatformDefault = False 21 | TabOrder = 1 22 | object btn1: TButton 23 | Align = Center 24 | Margins.Left = 10.000000000000000000 25 | Margins.Top = 10.000000000000000000 26 | Margins.Right = 10.000000000000000000 27 | Margins.Bottom = 10.000000000000000000 28 | Size.Width = 70.000000000000000000 29 | Size.Height = 22.000000000000000000 30 | Size.PlatformDefault = False 31 | StyleLookup = 'a.button' 32 | TabOrder = 0 33 | Text = 'Close' 34 | OnClick = btn1Click 35 | end 36 | end 37 | object Layout2: TLayout 38 | Align = Client 39 | Size.Width = 328.000000000000000000 40 | Size.Height = 103.000000000000000000 41 | Size.PlatformDefault = False 42 | TabOrder = 2 43 | object txt1: TText 44 | StyleName = 'dialog.message' 45 | Align = Contents 46 | Padding.Left = 10.000000000000000000 47 | Padding.Top = 10.000000000000000000 48 | Padding.Right = 10.000000000000000000 49 | Padding.Bottom = 10.000000000000000000 50 | Margins.Left = 13.000000000000000000 51 | Margins.Top = 13.000000000000000000 52 | Margins.Right = 13.000000000000000000 53 | Margins.Bottom = 13.000000000000000000 54 | Size.Width = 302.000000000000000000 55 | Size.Height = 77.000000000000000000 56 | Size.PlatformDefault = False 57 | Text = 58 | 'Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Morbi ' + 59 | 'commodo, ipsum sed pharetra gravida, orci magna rhoncus neque, i' + 60 | 'd pulvinar odio lorem non turpis. Nullam sit amet enim. Suspendi' + 61 | 'sse id velit vitae ligula volutpat condimentum. Aliquam erat vol' + 62 | 'utpat.' 63 | TextSettings.Font.Size = 11.000000000000000000 64 | TextSettings.FontColor = xFF666666 65 | TextSettings.HorzAlign = Leading 66 | TextSettings.VertAlign = Leading 67 | end 68 | end 69 | object stylbk1: TStyleBook 70 | Styles = < 71 | item 72 | ResourcesBin = { 73 | 464D585F5354594C4520322E3501060A6469616C6F672D626F78031901060861 74 | 2E627574746F6E03FA05060E6469616C6F672E6D65737361676503D800005450 75 | 46300C545374796C654F626A65637400095374796C654E616D65060A6469616C 76 | 6F672D626F780A506F736974696F6E2E580500000000000000E507400A506F73 77 | 6974696F6E2E5905000000000000008D07400756697369626C65080A536F7572 78 | 63654C696E6B0E00000A5452656374616E676C6500095374796C654E616D6506 79 | 0F72656374616E676C65317374796C6505416C69676E0708436F6E74656E7473 80 | 0A46696C6C2E436F6C6F7207097846464545454545450748697454657374080A 81 | 53697A652E57696474680500000000000000C804400B53697A652E4865696768 82 | 740500000000000000C804401453697A652E506C6174666F726D44656661756C 83 | 74080B5374726F6B652E4B696E6407044E6F6E650000005450463007544C6179 84 | 6F757400095374796C654E616D650608612E627574746F6E0A506F736974696F 85 | 6E2E580500000000000000E307400A506F736974696F6E2E5905000000000000 86 | 00FD06400A53697A652E576964746805000000000000008C05400B53697A652E 87 | 4865696768740500000000000000B003401453697A652E506C6174666F726D44 88 | 656661756C7408085461624F726465720201000A5452656374616E676C650009 89 | 5374796C654E616D65060A6261636B67726F756E6405416C69676E0708436F6E 90 | 74656E74730A46696C6C2E436F6C6F7207097846464533333130300748697454 91 | 657374080553696465730B06426F74746F6D000A53697A652E57696474680500 92 | 0000000000008C05400B53697A652E4865696768740500000000000000B00340 93 | 1453697A652E506C6174666F726D44656661756C74080C5374726F6B652E436F 94 | 6C6F720709783430303030303030000F54436F6C6F72416E696D6174696F6E00 95 | 095374796C654E616D650614636F6C6F72616E696D6174696F6E317374796C65 96 | 084475726174696F6E050000000000CDCCCCFC3F0C50726F70657274794E616D 97 | 65060A46696C6C2E436F6C6F720A537461727456616C75650709784646453333 98 | 3130300953746F7056616C756507097846464333333130300754726967676572 99 | 061049734D6F7573654F7665723D747275650E54726967676572496E76657273 100 | 65061149734D6F7573654F7665723D66616C73650000000654476C7970680009 101 | 5374796C654E616D65060A676C7970687374796C650C4D617267696E732E4C65 102 | 66740500000000000000C000400B4D617267696E732E546F7005000000000000 103 | 008000400D4D617267696E732E5269676874050000000000000080FF3F0E4D61 104 | 7267696E732E426F74746F6D050000000000000080004005416C69676E07044C 105 | 6566740A53697A652E576964746805000000000000008003400B53697A652E48 106 | 656967687405000000000000008003401453697A652E506C6174666F726D4465 107 | 6661756C740800001654427574746F6E5374796C65546578744F626A65637400 108 | 095374796C654E616D6506047465787405416C69676E070643656E746572064C 109 | 6F636B6564090C4D617267696E732E4C656674050000000000000080FF3F0B4D 110 | 617267696E732E546F7005000000000000008000400D4D617267696E732E5269 111 | 676874050000000000000080FF3F0E4D617267696E732E426F74746F6D050000 112 | 00000000008000400A53697A652E576964746805000000000000009C05400B53 113 | 697A652E48656967687405000000000000009003401453697A652E506C617466 114 | 6F726D44656661756C7408175465787453657474696E67732E466F6E742E5374 115 | 796C650B066673426F6C6400165465787453657474696E67732E466F6E74436F 116 | 6C6F720708636C6157686974650C536861646F772E436F6C6F72070978343030 117 | 303030303010536861646F772E4F66667365742E584902FF10536861646F772E 118 | 4F66667365742E594902010D536861646F7756697369626C650908486F74436F 119 | 6C6F720708636C6157686974650F486F74536861646F772E436F6C6F72070978 120 | 343030303030303013486F74536861646F772E4F66667365742E584902FF1348 121 | 6F74536861646F772E4F66667365742E594902010C466F6375736564436F6C6F 122 | 720708636C61576869746513466F6375736564536861646F772E436F6C6F7207 123 | 0978343030303030303017466F6375736564536861646F772E4F66667365742E 124 | 584902FF17466F6375736564536861646F772E4F66667365742E594902010B4E 125 | 6F726D616C436F6C6F720708636C615768697465124E6F726D616C536861646F 126 | 772E436F6C6F720709783430303030303030164E6F726D616C536861646F772E 127 | 4F66667365742E584902FF164E6F726D616C536861646F772E4F66667365742E 128 | 594902010C50726573736564436F6C6F720708636C6157686974651350726573 129 | 736564536861646F772E436F6C6F720709783430303030303030175072657373 130 | 6564536861646F772E4F66667365742E584902FF175072657373656453686164 131 | 6F772E4F66667365742E594902010000005450463010545374796C6554657874 132 | 4F626A65637400095374796C654E616D65060E6469616C6F672E6D6573736167 133 | 650A506F736974696F6E2E580500000000000000E507400A506F736974696F6E 134 | 2E5905000000000000008D0740165465787453657474696E67732E466F6E7443 135 | 6F6C6F720709784646363636363636165465787453657474696E67732E486F72 136 | 7A416C69676E07074C656164696E67165465787453657474696E67732E566572 137 | 74416C69676E07074C656164696E670756697369626C65080D536861646F7756 138 | 697369626C65080000} 139 | end> 140 | Left = 200 141 | Top = 88 142 | end 143 | end 144 | -------------------------------------------------------------------------------- /BeautifulDialog/BeautifulDialog.pas: -------------------------------------------------------------------------------- 1 | unit BeautifulDialog; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, 8 | FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Effects; 9 | 10 | type 11 | TForm19 = class(TForm) 12 | stylbk1: TStyleBook; 13 | Layout1: TLayout; 14 | btn1: TButton; 15 | txt1: TText; 16 | Layout2: TLayout; 17 | procedure btn1Click(Sender: TObject); 18 | procedure btn2Click(Sender: TObject); 19 | private 20 | { Private declarations } 21 | public 22 | { Public declarations } 23 | end; 24 | 25 | var 26 | Form19: TForm19; 27 | 28 | implementation 29 | 30 | {$R *.fmx} 31 | 32 | procedure TForm19.btn1Click(Sender: TObject); 33 | begin 34 | Close; 35 | end; 36 | 37 | procedure TForm19.btn2Click(Sender: TObject); 38 | begin 39 | Close; 40 | end; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /BeautifulDialog/BeautyDlgDemo.dpr: -------------------------------------------------------------------------------- 1 | program BeautyDlgDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | BeautifulDialog in 'BeautifulDialog.pas' {Form19}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm19, Form19); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /CameraPerformance/.gitignore: -------------------------------------------------------------------------------- 1 | /Android 2 | /CameraPerformance.dproj.local 3 | /CameraPerformance.identcache 4 | /CameraPerformance.res 5 | /CameraPerformance.stat 6 | -------------------------------------------------------------------------------- /CameraPerformance/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | 11 | <%uses-permission%> 12 | 13 | 21 | 22 | <%application-meta-data%> 23 | 25 | 29 | 30 | 32 | 33 | 34 | 35 | 36 | 37 | <%activity%> 38 | 39 | <%receivers%> 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /CameraPerformance/CameraPerformance.dpr: -------------------------------------------------------------------------------- 1 | program CameraPerformance; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | FMain in 'FMain.pas' {FormMain}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TFormMain, FormMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /CameraPerformance/Entitlement.TemplateiOS.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | <%getTaskAllowKey%> 6 | <%applicationIdentifier%> 7 | <%pushNotificationKey%> 8 | <%keychainAccessGroups%> 9 | 10 | 11 | -------------------------------------------------------------------------------- /CameraPerformance/FMain.fmx: -------------------------------------------------------------------------------- 1 | object FormMain: TFormMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Camera Performance' 5 | ClientHeight = 480 6 | ClientWidth = 320 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | OnDestroy = FormDestroy 12 | DesignerMasterStyle = 0 13 | object ToolBar: TToolBar 14 | Padding.Left = 8.000000000000000000 15 | Padding.Right = 8.000000000000000000 16 | Size.Width = 320.000000000000000000 17 | Size.Height = 48.000000000000000000 18 | Size.PlatformDefault = False 19 | TabOrder = 0 20 | object ButtonSwitchCamera: TButton 21 | Align = Right 22 | Images = ImageList 23 | ImageIndex = 0 24 | Margins.Left = 8.000000000000000000 25 | Position.X = 268.000000000000000000 26 | Size.Width = 44.000000000000000000 27 | Size.Height = 48.000000000000000000 28 | Size.PlatformDefault = False 29 | StyleLookup = 'toolbutton' 30 | TabOrder = 0 31 | OnClick = ButtonSwitchCameraClick 32 | end 33 | object LayoutSetting: TLayout 34 | Align = Client 35 | Size.Width = 175.000000000000000000 36 | Size.Height = 48.000000000000000000 37 | Size.PlatformDefault = False 38 | TabOrder = 1 39 | object PopupBoxSetting: TPopupBox 40 | Align = VertCenter 41 | Position.Y = 8.000000000000000000 42 | Size.Width = 175.000000000000000000 43 | Size.Height = 32.000000000000000000 44 | Size.PlatformDefault = False 45 | TabOrder = 0 46 | OnChange = PopupBoxSettingChange 47 | end 48 | end 49 | object LabelSetting: TLabel 50 | Align = Left 51 | HitTest = True 52 | Position.X = 8.000000000000000000 53 | Size.Width = 77.000000000000000000 54 | Size.Height = 48.000000000000000000 55 | Size.PlatformDefault = False 56 | StyleLookup = 'toollabel' 57 | Text = 'Setting' 58 | end 59 | end 60 | object StatusBar: TStatusBar 61 | Padding.Left = 8.000000000000000000 62 | Padding.Right = 8.000000000000000000 63 | Position.Y = 458.000000000000000000 64 | ShowSizeGrip = True 65 | Size.Width = 320.000000000000000000 66 | Size.Height = 22.000000000000000000 67 | Size.PlatformDefault = False 68 | TabOrder = 2 69 | object LabelFPS: TLabel 70 | Align = Client 71 | Size.Width = 304.000000000000000000 72 | Size.Height = 22.000000000000000000 73 | Size.PlatformDefault = False 74 | end 75 | end 76 | object PaintBox: TPaintBox 77 | Align = Client 78 | Size.Width = 320.000000000000000000 79 | Size.Height = 391.000000000000000000 80 | Size.PlatformDefault = False 81 | OnPaint = PaintBoxPaint 82 | end 83 | object CheckBoxDisplay: TCheckBox 84 | Align = Top 85 | IsChecked = True 86 | Margins.Left = 8.000000000000000000 87 | Position.X = 8.000000000000000000 88 | Position.Y = 48.000000000000000000 89 | Size.Width = 312.000000000000000000 90 | Size.Height = 19.000000000000000000 91 | Size.PlatformDefault = False 92 | TabOrder = 4 93 | Text = 'Display' 94 | OnChange = CheckBoxDisplayChange 95 | end 96 | object CameraComponent: TCameraComponent 97 | Kind = FrontCamera 98 | OnSampleBufferReady = CameraComponentSampleBufferReady 99 | Left = 156 100 | Top = 112 101 | end 102 | object ImageList: TImageList 103 | Source = <> 104 | Destination = <> 105 | Left = 60 106 | Top = 112 107 | end 108 | end 109 | -------------------------------------------------------------------------------- /CameraPerformance/FMain.pas: -------------------------------------------------------------------------------- 1 | unit FMain; 2 | 3 | { 32-bit iPad 3 64-bit iPad 3 4 | "Normal" "Fast" "SIMD" "Normal" "Fast" "SIMD" 5 | 1080 x 1920 13.97 26.66 30.00 15.81 28.91 30.00 6 | +Display 10.96 17.68 26.53 12.30 18.67 27.00 7 | 1936 x 2592 6.03 11.81 24.11 6.73 12.37 24.02 8 | +Display 4.76 7.61 12.97 5.24 8.18 14.02 9 | 10 | Android TF300 11 | "Normal" "Fast" "SIMD" 12 | 480 x 640 5.40 15.44 16.70 13 | +Display 5.23 15.10 16.66 14 | 960 x 1280 1.61 3.87 13.69 15 | +Display 1.72 3.85 9.00 16 | } 17 | 18 | interface 19 | 20 | uses 21 | System.SysUtils, 22 | System.Types, 23 | System.UITypes, 24 | System.Classes, 25 | System.Variants, 26 | System.ImageList, 27 | System.Diagnostics, 28 | FMX.Types, 29 | FMX.Controls, 30 | FMX.Forms, 31 | FMX.Graphics, 32 | FMX.Dialogs, 33 | FMX.StdCtrls, 34 | FMX.ExtCtrls, 35 | FMX.Controls.Presentation, 36 | FMX.Media, 37 | FMX.ImgList, 38 | FMX.Layouts, 39 | FMX.Objects; 40 | 41 | type 42 | TFormMain = class(TForm) 43 | ToolBar: TToolBar; 44 | PopupBoxSetting: TPopupBox; 45 | ButtonSwitchCamera: TButton; 46 | ImageList: TImageList; 47 | LayoutSetting: TLayout; 48 | CheckBoxDisplay: TCheckBox; 49 | StatusBar: TStatusBar; 50 | LabelFPS: TLabel; 51 | PaintBox: TPaintBox; 52 | LabelSetting: TLabel; 53 | CameraComponent: TCameraComponent; 54 | procedure FormCreate(Sender: TObject); 55 | procedure FormDestroy(Sender: TObject); 56 | procedure PaintBoxPaint(Sender: TObject; Canvas: TCanvas); 57 | procedure ButtonSwitchCameraClick(Sender: TObject); 58 | procedure PopupBoxSettingChange(Sender: TObject); 59 | procedure CheckBoxDisplayChange(Sender: TObject); 60 | procedure CameraComponentSampleBufferReady(Sender: TObject; 61 | const ATime: TMediaTime); 62 | private 63 | { Private declarations } 64 | FCaptureSettings: TArray; 65 | FBitmap: TBitmap; 66 | FStopwatch: TStopwatch; 67 | FFrameCount: Integer; 68 | FUpdating: Boolean; 69 | procedure UpdateCaptureSettings; 70 | procedure ResetCapture; 71 | public 72 | { Public declarations } 73 | end; 74 | 75 | var 76 | FormMain: TFormMain; 77 | 78 | implementation 79 | 80 | {$R *.fmx} 81 | {$R *.iPhone4in.fmx IOS} 82 | {$R *.Windows.fmx MSWINDOWS} 83 | {$R *.NmXhdpiPh.fmx ANDROID} 84 | 85 | uses 86 | System.Generics.Collections, 87 | System.Generics.Defaults; 88 | 89 | procedure TFormMain.ButtonSwitchCameraClick(Sender: TObject); 90 | begin 91 | if (CameraComponent.Kind = TCameraKind.FrontCamera) then 92 | CameraComponent.Kind := TCameraKind.BackCamera 93 | else 94 | CameraComponent.Kind := TCameraKind.FrontCamera; 95 | 96 | UpdateCaptureSettings; 97 | ResetCapture; 98 | end; 99 | 100 | procedure TFormMain.CameraComponentSampleBufferReady(Sender: TObject; 101 | const ATime: TMediaTime); 102 | var 103 | Sec: Double; 104 | begin 105 | CameraComponent.SampleBufferToBitmap(FBitmap, True); 106 | 107 | if (CheckBoxDisplay.IsChecked) then 108 | PaintBox.Repaint; 109 | 110 | Sec := FStopwatch.Elapsed.TotalSeconds; 111 | 112 | { Ignore the first 3 seconds to get up to speed } 113 | if (Sec > 3) then 114 | begin 115 | Sec := Sec - 3; 116 | Inc(FFrameCount); 117 | LabelFPS.Text := Format('%.2f fps (%d x %d)', [FFrameCount / Sec, FBitmap.Width, FBitmap.Height]); 118 | end; 119 | end; 120 | 121 | procedure TFormMain.CheckBoxDisplayChange(Sender: TObject); 122 | begin 123 | ResetCapture; 124 | end; 125 | 126 | procedure TFormMain.FormCreate(Sender: TObject); 127 | begin 128 | ToolBar.Height := ToolBar.DefaultSize.Height; 129 | CheckBoxDisplay.Height := CheckBoxDisplay.DefaultSize.Height * 2; 130 | PopupBoxSetting.Height := PopupBoxSetting.DefaultSize.Height; 131 | 132 | FBitmap := TBitmap.Create; 133 | CameraComponent.Quality := TVideoCaptureQuality.CaptureSettings; 134 | UpdateCaptureSettings; 135 | end; 136 | 137 | procedure TFormMain.FormDestroy(Sender: TObject); 138 | begin 139 | FBitmap.Free; 140 | end; 141 | 142 | procedure TFormMain.PaintBoxPaint(Sender: TObject; Canvas: TCanvas); 143 | var 144 | SR, DR, PR: TRectF; 145 | begin 146 | if (CheckBoxDisplay.IsChecked) then 147 | begin 148 | PR := RectF(0, 0, PaintBox.Width, PaintBox.Height); 149 | Canvas.Fill.Kind := TBrushKind.Solid; 150 | Canvas.Fill.Color := TAlphaColors.Black; 151 | Canvas.FillRect(PR, 0, 0, [], 1); 152 | 153 | if (FBitmap.Width > 0) then 154 | begin 155 | SR := RectF(0, 0, FBitmap.Width, FBitmap.Height); 156 | DR := SR; 157 | if (DR.Width < PaintBox.Width) and (DR.Height < PaintBox.Height) then 158 | RectCenter(DR, PR) 159 | else 160 | DR := DR.FitInto(PR); 161 | Canvas.DrawBitmap(FBitmap, SR, DR, 1); 162 | end; 163 | end; 164 | end; 165 | 166 | procedure TFormMain.PopupBoxSettingChange(Sender: TObject); 167 | var 168 | Setting: TVideoCaptureSetting; 169 | begin 170 | if (FUpdating) then 171 | Exit; 172 | 173 | if (PopupBoxSetting.ItemIndex < 0) or (PopupBoxSetting.ItemIndex >= Length(FCaptureSettings)) then 174 | Exit; 175 | 176 | Setting := FCaptureSettings[PopupBoxSetting.ItemIndex]; 177 | 178 | CameraComponent.Active := False; 179 | CameraComponent.CaptureSetting := Setting; 180 | CameraComponent.Active := True; 181 | 182 | ResetCapture; 183 | end; 184 | 185 | procedure TFormMain.ResetCapture; 186 | begin 187 | LabelFPS.Text := 'Starting capture...'; 188 | FFrameCount := 0; 189 | FStopwatch := TStopwatch.StartNew; 190 | end; 191 | 192 | procedure TFormMain.UpdateCaptureSettings; 193 | var 194 | Setting, MaxSetting: TVideoCaptureSetting; 195 | UsefulSettings: TDictionary; 196 | Size: TSize; 197 | I: Integer; 198 | begin 199 | { GetAvailableCaptureSettings can return A LOT of settings. For each supported 200 | resolution, it can return a large number of settings with different frame 201 | rates. We only care about the highest framerate supported by each 202 | resolution. We use a dictionary to keep track of this. } 203 | UsefulSettings := TDictionary.Create; 204 | try 205 | for Setting in CameraComponent.GetDefaultCanvasCaptureSettings do 206 | begin 207 | Size := TSize.Create(Setting.Width, Setting.Height); 208 | if (UsefulSettings.TryGetValue(Size, MaxSetting)) then 209 | begin 210 | { Dictionary contains requested resolution. Update its framerate to the 211 | maximum supported one. } 212 | if (Setting.FrameRate > MaxSetting.FrameRate) then 213 | UsefulSettings.AddOrSetValue(Size, Setting); 214 | end 215 | else 216 | UsefulSettings.Add(Size, Setting); 217 | end; 218 | 219 | { Now we can get a list of settings, with only one per resolution. We sort it 220 | maually by resolution. } 221 | FCaptureSettings := UsefulSettings.Values.ToArray; 222 | TArray.Sort(FCaptureSettings, 223 | TComparer.Construct( 224 | function (const Left, Right: TVideoCaptureSetting): Integer 225 | var 226 | Difference: Integer; 227 | begin 228 | Difference := (Left.Width * Left.Height) - (Right.Width * Right.Height); 229 | if (Difference < 0) then 230 | Result := 1 231 | else if (Difference > 0) then 232 | Result := -1 233 | else 234 | Result := 0; 235 | end)); 236 | finally 237 | UsefulSettings.Free; 238 | end; 239 | 240 | { Populate popup box with settings } 241 | FUpdating := True; 242 | try 243 | PopupBoxSetting.BeginUpdate; 244 | try 245 | PopupBoxSetting.Items.Clear; 246 | for I := 0 to Length(FCaptureSettings) - 1 do 247 | begin 248 | Setting := FCaptureSettings[I]; 249 | PopupBoxSetting.Items.Add(Format('%d x %d', [Setting.Width, Setting.Height])); 250 | end; 251 | finally 252 | PopupBoxSetting.EndUpdate; 253 | end; 254 | PopupBoxSetting.ItemIndex := -1; 255 | finally 256 | FUpdating := False; 257 | end; 258 | end; 259 | 260 | end. 261 | -------------------------------------------------------------------------------- /CameraPerformance/Fast/FastUtils.pas: -------------------------------------------------------------------------------- 1 | unit FastUtils; 2 | { Optimized Delphi routines for RGBA<>BGRA conversion, YV12>RGBA conversion and 3 | bitmap rotation } 4 | 5 | interface 6 | 7 | { Swaps the Red and Blue components of pixels in a memory buffer. 8 | 9 | Parameters: 10 | ASrc: points to the source buffer containing the pixels to convert. 11 | ADst: points to the destination buffer for the converted pixels. May be 12 | the same as ASrc. 13 | APixelCount: the number of pixels to convert. 14 | 15 | The Src and Dst buffers must have room for at least PixelCount * 4 bytes. } 16 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 17 | 18 | { Converts a buffer from YV12 format to RGBA format. 19 | 20 | Parameters: 21 | AYPtr: pointer to the source Y (luminance) plane 22 | AUPtr: pointer to the source U (chrominance) plane 23 | AVPtr: pointer to the source V (chrominance) plane 24 | ARGBAPtr: pointer to the target interleaved RGBA buffer 25 | AYStride: number of bytes between two rows in the Y plane 26 | AUVStride: number of bytes between two rows in the U and V planes 27 | ARGBAStride: number of bytes between two rows in the RGBA buffer 28 | AWidth: width of the image to convert (must be even). 29 | AHeight: height of the image to convert (must be even). 30 | 31 | The buffers must be large enough to accomodate AWidth * AHeight pixels in 32 | their corresponding format. 33 | 34 | The alpha values will be set to $FF (opaque) 35 | 36 | NOTE: Currently, this procedure only works when AWidth is a multiple of 16 and 37 | AHeight is a multiple of 2. If this is not the case, then some rightmost and 38 | bottommost pixels will not get converted. } 39 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 40 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 41 | 42 | { Rotates a 32-bit bitmap 0, 90, 180 or 270 degrees. 43 | 44 | Parameters: 45 | ASrc: pointer to the source bitmap data 46 | ADst: pointer to the target bitmap data. This must be different than ASrc. 47 | The ASrc and ADst buffers may not share any data. 48 | ASrcWidth: width of the source bitmap (must be a multiple of 4) 49 | ASrcHeight: height of the source bitmap (must be a multiple of 4) 50 | AAngle: the angle of rotation (0, 90, 180 or 270) 51 | 52 | When rotating 0 or 180 degrees, the dimensions of ADst must match the 53 | dimensions of ASrc. When rotating 90 or 270 degrees, the width of ASrc must 54 | match the height of ADst and the height of ASrc must match the width of ADst. 55 | 56 | Furthermore, this routine expects the dimensions to be a multiple of 4. If 57 | not, an assertion will be raised and the results may be unpredictable. } 58 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 59 | ASrcHeight: Integer; const AAngle: Integer); 60 | 61 | implementation 62 | 63 | uses 64 | System.UITypes; 65 | 66 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 67 | var 68 | I: Integer; 69 | S, D: PAlphaColorRec; 70 | Temp: Byte; 71 | begin 72 | if (ASrc = ADst) then 73 | begin 74 | D := ADst; 75 | for I := 0 to APixelCount - 1 do 76 | begin 77 | Temp := D.B; 78 | D.B := D.R; 79 | D.R := Temp; 80 | Inc(D); 81 | end; 82 | end 83 | else 84 | begin 85 | S := ASrc; 86 | D := ADst; 87 | for I := 0 to APixelCount - 1 do 88 | begin 89 | D.B := S.R; 90 | D.G := S.G; 91 | D.R := S.B; 92 | D.A := S.A; 93 | Inc(S); 94 | Inc(D); 95 | end; 96 | end; 97 | end; 98 | 99 | const 100 | SHIFT = 6; 101 | MAX_VAL = (256 shl SHIFT) - 1; 102 | 103 | function Clip(const AValue: Integer): Integer; inline; 104 | begin 105 | if (AValue < 0) then 106 | Result := 0 107 | else if (AValue > MAX_VAL) then 108 | Result := MAX_VAL 109 | else 110 | Result := AValue; 111 | end; 112 | 113 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 114 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 115 | { This version uses relative low-precision 2.6 integer arithmetic to match the 116 | NEON version. 117 | 118 | Formulas: 119 | R := 1.164*(Y-16) + 1.596*(V-128) 120 | G := 1.164*(Y-16) - 0.391*(U-128) - 0.813*(V-128) 121 | B := 1.164*(Y-16) + 2.018*(U-128) 122 | 123 | We use 2.6 integer arithmetic, so the formulas become: 124 | R := (74*(Y-16) + 102*(V-128)) shr 6 125 | G := (74*(Y-16) - 25*(U-128) - 52*(V-128)) shr 6 126 | B := (74*(Y-16) + 129*(U-128) ) shr 6 127 | 128 | NOTE: we use "127*(U-128)" instead of "129*(U-128)" to match the ARM SIMD 129 | version. } 130 | const 131 | Y_BIAS = 16; 132 | UV_BIAS = 128; 133 | 134 | U_TO_G = 25; 135 | U_TO_B = 127; // Should be 129 136 | V_TO_R = 102; 137 | V_TO_G = 52; 138 | Y_TO_RGB = 74; 139 | 140 | R_INDEX = 0; 141 | G_INDEX = 1; 142 | B_INDEX = 2; 143 | A_INDEX = 3; 144 | var 145 | PaddedWidth, RGBAExtra, YExtra, UVExtra, Row, Col, Y, U, V: Integer; 146 | VtoR, UtoB, UVtoG: Integer; 147 | YPtr, UPtr, VPtr, RGBA: PByte; 148 | begin 149 | if (AWidth <= 0) or (AHeight <= 0) then 150 | Exit; 151 | 152 | Assert(Assigned(AYPtr)); 153 | Assert(Assigned(AUPtr)); 154 | Assert(Assigned(AVPtr)); 155 | Assert(Assigned(ARGBAPtr)); 156 | Assert(AYStride > 0); 157 | Assert(AUVStride > 0); 158 | Assert(ARGBAStride > 0); 159 | Assert((AWidth and 1) = 0); 160 | Assert((AHeight and 1) = 0); 161 | 162 | PaddedWidth := (AWidth + 1) and (not 1); 163 | RGBAExtra := (ARGBAStride - (4 * PaddedWidth)) + ARGBAStride; 164 | YExtra := (AYStride - PaddedWidth) + AYStride; 165 | UVExtra := AUVStride - (PaddedWidth shr 1); 166 | 167 | YPtr := AYPtr; 168 | UPtr := AUPtr; 169 | VPtr := AVPtr; 170 | RGBA := ARGBAPtr; 171 | 172 | Row := 0; 173 | while (Row < AHeight) do 174 | begin 175 | Col := 0; 176 | while (Col < AWidth) do 177 | begin 178 | U := UPtr[0] - UV_BIAS; 179 | V := VPtr[0] - UV_BIAS; 180 | 181 | VtoR := V_TO_R * V; 182 | UVtoG := (U_TO_G * U) + (V_TO_G * V); 183 | UtoB := U_TO_B * U; 184 | 185 | Y := (YPtr[0] - Y_BIAS) * Y_TO_RGB; 186 | RGBA[R_INDEX] := Clip(Y + VtoR) shr SHIFT; 187 | RGBA[G_INDEX] := Clip(Y - UVtoG) shr SHIFT; 188 | RGBA[B_INDEX] := Clip(Y + UtoB) shr SHIFT; 189 | RGBA[A_INDEX] := $FF; 190 | 191 | Y := (YPtr[1] - Y_BIAS) * Y_TO_RGB; 192 | RGBA[R_INDEX + 4] := Clip(Y + VtoR) shr SHIFT; 193 | RGBA[G_INDEX + 4] := Clip(Y - UVtoG) shr SHIFT; 194 | RGBA[B_INDEX + 4] := Clip(Y + UtoB) shr SHIFT; 195 | RGBA[A_INDEX + 4] := $FF; 196 | 197 | Y := (YPtr[AYStride] - Y_BIAS) * Y_TO_RGB; 198 | RGBA[ARGBAStride + R_INDEX] := Clip(Y + VtoR) shr SHIFT; 199 | RGBA[ARGBAStride + G_INDEX] := Clip(Y - UVtoG) shr SHIFT; 200 | RGBA[ARGBAStride + B_INDEX] := Clip(Y + UtoB) shr SHIFT; 201 | RGBA[ARGBAStride + A_INDEX] := $FF; 202 | 203 | Y := (YPtr[AYStride + 1] - Y_BIAS) * Y_TO_RGB; 204 | RGBA[ARGBAStride + R_INDEX + 4] := Clip(Y + VtoR) shr SHIFT; 205 | RGBA[ARGBAStride + G_INDEX + 4] := Clip(Y - UVtoG) shr SHIFT; 206 | RGBA[ARGBAStride + B_INDEX + 4] := Clip(Y + UtoB) shr SHIFT; 207 | RGBA[ARGBAStride + A_INDEX + 4] := $FF; 208 | 209 | Inc(RGBA, 8); 210 | Inc(YPtr, 2); 211 | Inc(UPtr); 212 | Inc(VPtr); 213 | Inc(Col, 2); 214 | end; 215 | Inc(RGBA, RGBAExtra); 216 | Inc(YPtr, YExtra); 217 | Inc(UPtr, UVExtra); 218 | Inc(VPtr, UVExtra); 219 | Inc(Row, 2); 220 | end; 221 | end; 222 | 223 | procedure RotateBitmap0Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 224 | ASrcHeight: Integer); 225 | begin 226 | Move(ASrc^, ADst^, ASrcWidth * ASrcHeight * 4); 227 | end; 228 | 229 | procedure RotateBitmap90Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 230 | ASrcHeight: Integer); 231 | var 232 | S, D: PCardinal; 233 | DstX, DstY, DstDelta: Integer; 234 | begin 235 | S := ASrc; 236 | D := ADst; 237 | Inc(D, ASrcHeight - 1); 238 | 239 | DstDelta := (ASrcWidth * ASrcHeight) + 1; 240 | for DstX := 0 to ASrcHeight - 1 do 241 | begin 242 | for DstY := 0 to ASrcWidth - 1 do 243 | begin 244 | D^ := S^; 245 | Inc(S); 246 | Inc(D, ASrcHeight); 247 | end; 248 | Dec(D, DstDelta); 249 | end; 250 | end; 251 | 252 | procedure RotateBitmap180Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 253 | ASrcHeight: Integer); 254 | var 255 | S, D: PCardinal; 256 | I: Integer; 257 | begin 258 | S := ASrc; 259 | D := ADst; 260 | Inc(D, (ASrcWidth * ASrcHeight) - 1); 261 | for I := 0 to (ASrcWidth * ASrcHeight) - 1 do 262 | begin 263 | D^ := S^; 264 | Inc(S); 265 | Dec(D); 266 | end; 267 | end; 268 | 269 | procedure RotateBitmap270Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 270 | ASrcHeight: Integer); 271 | var 272 | S, D: PCardinal; 273 | DstX, DstY, SrcDelta: Integer; 274 | begin 275 | S := ASrc; 276 | D := ADst; 277 | Inc(S, ASrcWidth - 1); 278 | 279 | SrcDelta := (ASrcHeight * ASrcWidth) + 1; 280 | for DstY := 0 to ASrcWidth - 1 do 281 | begin 282 | for DstX := 0 to ASrcHeight - 1 do 283 | begin 284 | D^ := S^; 285 | Inc(S, ASrcWidth); 286 | Inc(D); 287 | end; 288 | Dec(S, SrcDelta); 289 | end; 290 | end; 291 | 292 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 293 | ASrcHeight: Integer; const AAngle: Integer); 294 | begin 295 | if (ASrcWidth <= 0) or (ASrcHeight <= 0) then 296 | Exit; 297 | 298 | Assert(Assigned(ASrc)); 299 | Assert(Assigned(ADst)); 300 | Assert((ASrcHeight and 3) = 0); 301 | Assert((ASrcWidth and 3) = 0); 302 | 303 | case AAngle of 304 | 0: RotateBitmap0Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 305 | 90: RotateBitmap90Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 306 | 180: RotateBitmap180Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 307 | 270: RotateBitmap270Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 308 | else 309 | Assert(False); 310 | end; 311 | end; 312 | 313 | end. 314 | -------------------------------------------------------------------------------- /CameraPerformance/SIMD/FastUtils.pas: -------------------------------------------------------------------------------- 1 | unit FastUtils; 2 | { NEON/Arm64 optimized assembly routines for RGBA<>BGRA conversion, YV12>RGBA 3 | conversion and bitmap rotation } 4 | 5 | interface 6 | 7 | {$IFDEF IOS} 8 | { Swaps the Red and Blue components of pixels in a memory buffer. 9 | 10 | Parameters: 11 | ASrc: points to the source buffer containing the pixels to convert. 12 | ADst: points to the destination buffer for the converted pixels. May be 13 | the same as ASrc. 14 | APixelCount: the number of pixels to convert. 15 | 16 | The Src and Dst buffers must have room for at least PixelCount * 4 bytes. } 17 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 18 | {$ENDIF} 19 | 20 | {$IFDEF ANDROID} 21 | { Converts a buffer from YV12 format to RGBA format. 22 | 23 | Parameters: 24 | AYPtr: pointer to the source Y (luminance) plane 25 | AUPtr: pointer to the source U (chrominance) plane 26 | AVPtr: pointer to the source V (chrominance) plane 27 | ARGBAPtr: pointer to the target interleaved RGBA buffer 28 | AYStride: number of bytes between two rows in the Y plane 29 | AUVStride: number of bytes between two rows in the U and V planes 30 | ARGBAStride: number of bytes between two rows in the RGBA buffer 31 | AWidth: width of the image to convert (must be even). 32 | AHeight: height of the image to convert (must be even). 33 | 34 | The buffers must be large enough to accomodate AWidth * AHeight pixels in 35 | their corresponding format. 36 | 37 | The alpha values will be set to $FF (opaque) 38 | 39 | NOTE: Currently, this procedure only works when AWidth is a multiple of 16 and 40 | AHeight is a multiple of 2. If this is not the case, then some rightmost and 41 | bottommost pixels will not get converted. } 42 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 43 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 44 | 45 | { Rotates a 32-bit bitmap 0, 90, 180 or 270 degrees. 46 | 47 | Parameters: 48 | ASrc: pointer to the source bitmap data 49 | ADst: pointer to the target bitmap data. This must be different than ASrc. 50 | The ASrc and ADst buffers may not share any data. 51 | ASrcWidth: width of the source bitmap (must be a multiple of 4) 52 | ASrcHeight: height of the source bitmap (must be a multiple of 4) 53 | AAngle: the angle of rotation (0, 90, 180 or 270) 54 | 55 | When rotating 0 or 180 degrees, the dimensions of ADst must match the 56 | dimensions of ASrc. When rotating 90 or 270 degrees, the width of ASrc must 57 | match the height of ADst and the height of ASrc must match the width of ADst. 58 | 59 | Furthermore, this routine expects the dimensions to be a multiple of 4. If 60 | not, an assertion will be raised and the results may be unpredictable. } 61 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 62 | ASrcHeight: Integer; const AAngle: Integer); 63 | {$ENDIF} 64 | 65 | implementation 66 | 67 | uses 68 | System.UITypes; 69 | 70 | const 71 | {$IF Defined(IOS)} 72 | LIB_FAST_UTILS = 'libfastutils.a'; 73 | _PU = ''; 74 | {$ELSEIF Defined(ANDROID)} 75 | LIB_FAST_UTILS = 'libfastutils-android.a'; 76 | _PU = '_'; 77 | {$ENDIF} 78 | 79 | {$IFDEF IOS} 80 | procedure swap_rb(ASrc, ADst: Pointer; ACount: Integer); cdecl; 81 | external LIB_FAST_UTILS name _PU + 'swap_rb'; 82 | 83 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 84 | var 85 | NeonCount, Remainder: Integer; 86 | S, D: PAlphaColorRec; 87 | Temp: Byte; 88 | begin 89 | NeonCount := APixelCount shr 4; 90 | Remainder := APixelCount and 15; 91 | 92 | if (NeonCount > 0) then 93 | swap_rb(ASrc, ADst, NeonCount); 94 | 95 | if (Remainder > 0) then 96 | begin 97 | S := ASrc; 98 | D := ADst; 99 | Inc(S, NeonCount * 16); 100 | Inc(D, NeonCount * 16); 101 | if (ASrc = ADst) then 102 | begin 103 | while (Remainder > 0) do 104 | begin 105 | Temp := D.B; 106 | D.B := D.R; 107 | D.R := Temp; 108 | Inc(D); 109 | Dec(Remainder); 110 | end; 111 | end 112 | else 113 | begin 114 | while (Remainder > 0) do 115 | begin 116 | D.B := S.R; 117 | D.G := S.G; 118 | D.R := S.B; 119 | D.A := S.A; 120 | Inc(S); 121 | Inc(D); 122 | Dec(Remainder); 123 | end; 124 | end; 125 | end; 126 | end; 127 | {$ENDIF} 128 | 129 | {$IFDEF ANDROID} 130 | procedure yv12_to_rgba(AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 131 | AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); cdecl; 132 | external LIB_FAST_UTILS name _PU + 'yv12_to_rgba'; 133 | 134 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 135 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 136 | begin 137 | yv12_to_rgba(AYPtr, AUPtr, AVPtr, ARGBAPtr, AYStride, AUVStride, 138 | ARGBAStride, AWidth and (not 15), AHeight and (not 1)); 139 | end; 140 | 141 | procedure RotateBitmap0Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 142 | ASrcHeight: Integer); 143 | begin 144 | Move(ASrc^, ADst^, ASrcWidth * ASrcHeight * 4); 145 | end; 146 | 147 | procedure RotateBitmap90Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 148 | external LIB_FAST_UTILS name _PU + 'rotate_90'; 149 | 150 | procedure RotateBitmap180Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 151 | external LIB_FAST_UTILS name _PU + 'rotate_180'; 152 | 153 | procedure RotateBitmap270Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 154 | external LIB_FAST_UTILS name _PU + 'rotate_270'; 155 | 156 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 157 | ASrcHeight: Integer; const AAngle: Integer); 158 | begin 159 | if (ASrcWidth <= 0) or (ASrcHeight <= 0) then 160 | Exit; 161 | 162 | Assert(Assigned(ASrc)); 163 | Assert(Assigned(ADst)); 164 | Assert((ASrcHeight and 3) = 0); 165 | Assert((ASrcWidth and 3) = 0); 166 | 167 | case AAngle of 168 | 0: RotateBitmap0Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 169 | 90: RotateBitmap90Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 170 | 180: RotateBitmap180Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 171 | 270: RotateBitmap270Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 172 | else 173 | Assert(False); 174 | end; 175 | end; 176 | {$ENDIF} 177 | 178 | end. 179 | -------------------------------------------------------------------------------- /CameraPerformance/SIMD/libfastutils-android.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/CameraPerformance/SIMD/libfastutils-android.a -------------------------------------------------------------------------------- /CameraPerformance/SIMD/libfastutils.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/CameraPerformance/SIMD/libfastutils.a -------------------------------------------------------------------------------- /DonationList.md: -------------------------------------------------------------------------------- 1 | # 捐助名单 Donation list 2 | 3 | 感谢 Leo (1505250187) 对项目的捐助 2017-09-01 -------------------------------------------------------------------------------- /FMXPrint/FMXPrintDemo.dpr: -------------------------------------------------------------------------------- 1 | program FMXPrintDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | PrintDemoMain in 'PrintDemoMain.pas' {Form30}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm30, Form30); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /FMXPrint/PrintDemoMain.fmx: -------------------------------------------------------------------------------- 1 | object Form30: TForm30 2 | Left = 0 3 | Top = 0 4 | Caption = 'PrintMainForm' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object btn1: TButton 12 | Position.X = 200.000000000000000000 13 | Position.Y = 72.000000000000000000 14 | Size.Width = 185.000000000000000000 15 | Size.Height = 49.000000000000000000 16 | Size.PlatformDefault = False 17 | TabOrder = 0 18 | Text = 'Print Demo' 19 | OnClick = btn1Click 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /FMXPrint/PrintDemoMain.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/FMXPrint/PrintDemoMain.pas -------------------------------------------------------------------------------- /Gif2PngDemo/Gif2PngDemo.dpr: -------------------------------------------------------------------------------- 1 | program Gif2PngDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | GifDemoMain in 'GifDemoMain.pas' {Form31}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm31, Form31); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Gif2PngDemo/Gif2PngDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/Gif2PngDemo/Gif2PngDemo.res -------------------------------------------------------------------------------- /Gif2PngDemo/Gif2PngDemo.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=1 3 | DesignerSecs=16 4 | InspectorSecs=1 5 | CompileSecs=1255 6 | OtherSecs=17 7 | StartTime=2016/6/3 8:37:23 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /Gif2PngDemo/GifDemoMain.dfm: -------------------------------------------------------------------------------- 1 | object Form31: TForm31 2 | Left = 0 3 | Top = 0 4 | Caption = 'Gif2Png Demo' 5 | ClientHeight = 161 6 | ClientWidth = 600 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 24 18 | Top = 67 19 | Width = 28 20 | Height = 13 21 | Caption = 'Width' 22 | end 23 | object Label2: TLabel 24 | Left = 248 25 | Top = 67 26 | Width = 31 27 | Height = 13 28 | Caption = 'Height' 29 | end 30 | object Button1: TButton 31 | Left = 512 32 | Top = 24 33 | Width = 75 34 | Height = 25 35 | Caption = 'Convert' 36 | TabOrder = 0 37 | OnClick = Button1Click 38 | end 39 | object edtFilename: TEdit 40 | Left = 24 41 | Top = 26 42 | Width = 465 43 | Height = 21 44 | TabOrder = 1 45 | Text = '..\..\Test.gif' 46 | end 47 | object edtWidth: TEdit 48 | Left = 72 49 | Top = 64 50 | Width = 121 51 | Height = 21 52 | ReadOnly = True 53 | TabOrder = 2 54 | end 55 | object edtHeight: TEdit 56 | Left = 312 57 | Top = 64 58 | Width = 121 59 | Height = 21 60 | ReadOnly = True 61 | TabOrder = 3 62 | end 63 | end 64 | -------------------------------------------------------------------------------- /Gif2PngDemo/GifDemoMain.pas: -------------------------------------------------------------------------------- 1 | unit GifDemoMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 | Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL, Vcl.ExtCtrls, 9 | System.IOUtils, System.TypInfo; 10 | 11 | type 12 | TForm31 = class(TForm) 13 | Button1: TButton; 14 | edtFilename: TEdit; 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | edtWidth: TEdit; 18 | edtHeight: TEdit; 19 | procedure Button1Click(Sender: TObject); 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | var 27 | Form31: TForm31; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | procedure TForm31.Button1Click(Sender: TObject); 34 | var 35 | Image: TGPImage; 36 | ImageControl: TImage; 37 | I, PageCount, RowCount: Integer; 38 | PngImage: TGPBitmap; 39 | G: TGPGraphics; 40 | pngFileName: string; 41 | s: Status; 42 | ClsID: TGUID; 43 | w, h: Integer; 44 | begin 45 | Image := TGPImage.Create(edtFilename.Text); 46 | try 47 | edtWidth.Text := IntToStr(Image.GetWidth); 48 | edtHeight.Text := IntToStr(Image.GetHeight); 49 | PageCount := Image.GetFrameCount(FrameDimensionTime); 50 | 51 | RowCount := (PageCount + 4) div 5; 52 | w := Image.GetWidth * 5; 53 | h := Image.GetHeight * RowCount; 54 | PngImage := TGPBitmap.Create(w, h); 55 | G := TGPGraphics.Create(PngImage); 56 | try 57 | for I := 0 to PageCount-1 do 58 | begin 59 | Image.SelectActiveFrame(FrameDimensionTime, I); 60 | G.DrawImage(Image, 61 | (I mod 5) * Image.GetWidth, (I div 5) * Image.GetHeight, 62 | Image.GetWidth, Image.GetHeight); 63 | end; 64 | pngFileName := TPath.ChangeExtension(edtFilename.Text, '.png'); 65 | if GetEncoderClsid('image/png',Clsid) >= 0 then 66 | begin 67 | s := PngImage.Save(pngFileName, ClsID); 68 | // label3.Caption := 'Error' + GetEnumName(TypeInfo(Status), 69 | // integer(s)) ; 70 | end; 71 | finally 72 | G.Free; 73 | PngImage.Free; 74 | end; 75 | finally 76 | Image.Free; 77 | end; 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /Gif2PngDemo/Test.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/Gif2PngDemo/Test.gif -------------------------------------------------------------------------------- /Gif2PngDemo/Test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/Gif2PngDemo/Test.png -------------------------------------------------------------------------------- /HtmlParserTest/HtmlParserTest.dpr: -------------------------------------------------------------------------------- 1 | program HtmlParserTest; 2 | 3 | uses 4 | Vcl.Forms, 5 | HtmlParserTestMain in 'HtmlParserTestMain.pas' {Form16}, 6 | DOMCore in 'htmlp\DOMCore.pas', 7 | Entities in 'htmlp\Entities.pas', 8 | Formatter in 'htmlp\Formatter.pas', 9 | HTMLParser in 'htmlp\HTMLParser.pas', 10 | HtmlReader in 'htmlp\HtmlReader.pas', 11 | HtmlTags in 'htmlp\HtmlTags.pas', 12 | WStrings in 'htmlp\WStrings.pas'; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | Application.MainFormOnTaskbar := True; 19 | Application.CreateForm(TForm16, Form16); 20 | Application.Run; 21 | end. 22 | -------------------------------------------------------------------------------- /HtmlParserTest/HtmlParserTest.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {EC1AC04C-625B-48CB-B12D-AB291F79A569} 4 | 15.4 5 | VCL 6 | HtmlParserTest.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 39 | $(BDS)\bin\default_app.manifest 40 | 2052 41 | $(BDS)\bin\delphi_PROJECTICON.ico 42 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 43 | HtmlParserTest 44 | .\$(Platform)\$(Config) 45 | .\$(Platform)\$(Config) 46 | false 47 | false 48 | false 49 | false 50 | false 51 | 52 | 53 | .\ 54 | true 55 | JvBDE;JvGlobus;UnitSystem;JvMM;TeeGL920;JvManagedThreads;SmartComponents;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;ZRGraph;ZRLicense;FireDACPgDriver;TeeLanguage920;fmx;RaizeComponentsVcl;IndySystem;JvDlgs;JvCrypt;tethering;TP_LockBox3;NativeXmlPkg;ZRCore;vclib;inetdbbde;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;TeeDB920;JvNet;DataSnapProviderClient;TeeUI920;DBXSybaseASEDriver;JvDotNetCtrls;DbxCommonDriver;vclimg;FmxTeeUI920;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;FMXTee920;SynEdit_RXE6;JvXPCtrls;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;ColorMapComponents;DBXOracleDriver;CustomIPTransport;JvCore;vclribbon;dsnap;IndyIPServer;FMXTeeLanguage920;fmxase;vcl;IndyCore;tmsxlsdXE6;mbColorLib;DBXMSSQLDriver;CloudService;IndyIPCommon;TsiLang_XE6r;FireDACIBDriver;TeeImage920;DataSnapFireDAC;FireDACDBXDriver;JvAppFrm;soapserver;JvDB;JvRuntimeDesign;inetdbxpress;GLScene_RunTime_VCL;dsnapxml;tmsdXE6;FireDACInfxDriver;FireDACDb2Driver;JclDeveloperTools;ALGLIB;JvDocking;adortl;FMXTeePro920;TeePro920;JvWizards;madBasic_;FireDACASADriver;JvHMI;TeeMaker120;TeeTree2D20Tee9;bindcompfmx;JvBands;vcldbx;RaizeComponentsVclDb;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;SmartStorage;FireDACCommon;bindcomp;inetdb;JvPluginSystem;JclContainers;DBXOdbcDriver;JvCmp;vclFireDAC;madDisAsm_;AlgorithmProvider;JvSystem;xmlrtl;DataSnapNativeClient;ibxpress;svnui;JvControls;Tee920;JvTimeFramework;IndyProtocols;DBXMySQLDriver;FMXTeeDB920;FireDACCommonDriver;MIT3DPkg;tmswizdXE6;bindcompdbx;bindengine;vclactnband;soaprtl;JvJans;JvPageComps;bindcompvcl;JvStdCtrls;JvCustom;Jcl;vclie;JvPrintPreview;ZRComponnets;ZRZonationModel;madExcept_;FireDACADSDriver;vcltouch;ZRRockyModel;GraphPackage;PngComponents;VCLRESTComponents;FireDAC;DBXInformixDriver;FireDACMSSQLDriver;Intraweb;VclSmp;TeeWorld920;DataSnapConnectors;DataSnapServerMidas;DBXFirebirdDriver;dsnapcon;inet;fmxobj;JclVcl;JvPascalInterpreter;FireDACMySQLDriver;soapmidas;vclx;tmsexdXE6;ZRLithPack;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;bdertl;GdiPlus;dbexpress;FireDACMSAccDriver;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) 56 | 1033 57 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 58 | 59 | 60 | DEBUG;$(DCC_Define) 61 | true 62 | false 63 | true 64 | true 65 | true 66 | 67 | 68 | 1033 69 | true 70 | false 71 | 72 | 73 | false 74 | RELEASE;$(DCC_Define) 75 | 0 76 | 0 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 |
Form16
84 | dfm 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | Cfg_2 96 | Base 97 | 98 | 99 | Base 100 | 101 | 102 | Cfg_1 103 | Base 104 | 105 | 106 | 107 | Delphi.Personality.12 108 | 109 | 110 | 111 | 112 | HtmlParserTest.dpr 113 | 114 | 115 | Microsoft Office 2000 Sample Automation Server Wrapper Components 116 | Microsoft Office XP Sample Automation Server Wrapper Components 117 | 118 | 119 | 120 | 121 | True 122 | 123 | 124 | 12 125 | 126 | 127 | 128 | 129 | -------------------------------------------------------------------------------- /HtmlParserTest/HtmlParserTestMain.dfm: -------------------------------------------------------------------------------- 1 | object Form16: TForm16 2 | Left = 0 3 | Top = 0 4 | Caption = 'Html Parser Test' 5 | ClientHeight = 298 6 | ClientWidth = 849 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 849 16 | 298) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object btn1: TButton 20 | Left = 749 21 | Top = 8 22 | Width = 75 23 | Height = 25 24 | Anchors = [akTop, akRight] 25 | Caption = 'Parse' 26 | TabOrder = 0 27 | OnClick = btn1Click 28 | ExplicitLeft = 387 29 | end 30 | object lv1: TListView 31 | Left = 8 32 | Top = 8 33 | Width = 735 34 | Height = 281 35 | Anchors = [akLeft, akTop, akRight, akBottom] 36 | Columns = < 37 | item 38 | Caption = 'href' 39 | Width = 240 40 | end 41 | item 42 | Caption = 'Content' 43 | Width = 240 44 | end 45 | item 46 | Caption = 'Date' 47 | Width = 120 48 | end> 49 | ReadOnly = True 50 | TabOrder = 1 51 | ViewStyle = vsReport 52 | end 53 | end 54 | -------------------------------------------------------------------------------- /HtmlParserTest/HtmlParserTestMain.pas: -------------------------------------------------------------------------------- 1 | unit HtmlParserTestMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 | HTMLParser, Vcl.Grids, Vcl.ComCtrls; 9 | 10 | type 11 | TForm16 = class(TForm) 12 | btn1: TButton; 13 | lv1: TListView; 14 | procedure btn1Click(Sender: TObject); 15 | private 16 | { Private declarations } 17 | HtmlParser: THtmlParser; 18 | function LoadHtmlFile: String; 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | Form16: TForm16; 25 | 26 | implementation 27 | 28 | uses 29 | DomCore, Formatter; 30 | 31 | {$R *.dfm} 32 | 33 | procedure TForm16.btn1Click(Sender: TObject); 34 | var 35 | HtmlDoc: TDocument; 36 | Formatter: TBaseFormatter; 37 | list: TNodeList; 38 | I: Integer; 39 | span: TNode; 40 | classAttr: TNode; 41 | href: TNode; 42 | Item: TListItem; 43 | begin 44 | HtmlParser := THtmlParser.Create; 45 | try 46 | HtmlDoc := HtmlParser.parseString(LoadHtmlFile); 47 | list := HtmlDoc.getElementsByTagName('span'); 48 | for I := 0 to list.length-1 do 49 | begin 50 | span := list.item(i); 51 | classAttr := span.attributes.getNamedItem('class'); 52 | if Assigned(classAttr) then 53 | begin 54 | if classAttr.childNodes.item(0).NodeValue = 'ina_zh' then 55 | begin 56 | href := span.childNodes.item(0); 57 | if href.nodeName = 'a' then 58 | begin 59 | Item := lv1.Items.Add; 60 | Item.Caption := href.attributes.getNamedItem('href').childNodes.item(0).nodeValue; 61 | Item.SubItems.Add(href.childNodes.item(0).NodeValue); 62 | Item.SubItems.Add(span.parentNode.childNodes.item(2).childNodes.item(0).NodeValue); 63 | end; 64 | end; 65 | end; 66 | end; 67 | list.Free; 68 | finally 69 | HtmlParser.Free 70 | end; 71 | 72 | 73 | 74 | HtmlDoc.Free; 75 | 76 | end; 77 | 78 | function TForm16.LoadHtmlFile: String; 79 | var 80 | F: TFileStream; 81 | Reader: TStreamReader; 82 | begin 83 | F := TFileStream.Create('Test.html', fmOpenRead); 84 | try 85 | Reader := TStreamReader.Create(F); 86 | try 87 | Result := Reader.ReadToEnd; 88 | finally 89 | Reader.Free; 90 | end; 91 | finally 92 | F.Free 93 | end; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /HtmlParserTest/README.md: -------------------------------------------------------------------------------- 1 | # Html Parser Test for delphi XE6 2 | 3 | This Demo use "Delphi Dom HTML Parser and Converter", the original address is: 4 | 5 | http://sourceforge.net/projects/htmlp/ 6 | 7 | This Demo demonstrate how to use HTML Parser parse a HTML file and get information. 8 | 9 | 这个Demo使用了Delphi Dom HTML Parser and Converter，原始的源代码可以到以下地址下载： 10 | 11 | http://sourceforge.net/projects/htmlp/ 12 | 13 | 该Demo演示了使用HTML Parser解析一个HTML文件，并提取其中信息。 -------------------------------------------------------------------------------- /HtmlParserTest/htmlp/Entities.pas: -------------------------------------------------------------------------------- 1 | unit Entities; 2 | 3 | interface 4 | 5 | const 6 | MaxEntNameLen = 8; 7 | 8 | function GetEntValue(const Name: String): WideChar; 9 | function GetEntName(Code: Word): String; 10 | 11 | implementation 12 | 13 | uses 14 | SysUtils, Classes; 15 | 16 | const 17 | EntCount = 252; 18 | 19 | type 20 | PEntity = ^TEntity; 21 | TEntity = record 22 | Name: String; 23 | Code: Word 24 | end; 25 | 26 | TEntities = array[0..EntCount - 1] of TEntity; 27 | 28 | const 29 | EntTab: TEntities = ( 30 | (Name: 'nbsp'; Code: 160), 31 | (Name: 'iexcl'; Code: 161), 32 | (Name: 'cent'; Code: 162), 33 | (Name: 'pound'; Code: 163), 34 | (Name: 'curren'; Code: 164), 35 | (Name: 'yen'; Code: 165), 36 | (Name: 'brvbar'; Code: 166), 37 | (Name: 'sect'; Code: 167), 38 | (Name: 'uml'; Code: 168), 39 | (Name: 'copy'; Code: 169), 40 | (Name: 'ordf'; Code: 170), 41 | (Name: 'laquo'; Code: 171), 42 | (Name: 'not'; Code: 172), 43 | (Name: 'shy'; Code: 173), 44 | (Name: 'reg'; Code: 174), 45 | (Name: 'macr'; Code: 175), 46 | (Name: 'deg'; Code: 176), 47 | (Name: 'plusmn'; Code: 177), 48 | (Name: 'sup2'; Code: 178), 49 | (Name: 'sup3'; Code: 179), 50 | (Name: 'acute'; Code: 180), 51 | (Name: 'micro'; Code: 181), 52 | (Name: 'para'; Code: 182), 53 | (Name: 'middot'; Code: 183), 54 | (Name: 'cedil'; Code: 184), 55 | (Name: 'sup1'; Code: 185), 56 | (Name: 'ordm'; Code: 186), 57 | (Name: 'raquo'; Code: 187), 58 | (Name: 'frac14'; Code: 188), 59 | (Name: 'frac12'; Code: 189), 60 | (Name: 'frac34'; Code: 190), 61 | (Name: 'iquest'; Code: 191), 62 | (Name: 'Agrave'; Code: 192), 63 | (Name: 'Aacute'; Code: 193), 64 | (Name: 'Acirc'; Code: 194), 65 | (Name: 'Atilde'; Code: 195), 66 | (Name: 'Auml'; Code: 196), 67 | (Name: 'Aring'; Code: 197), 68 | (Name: 'AElig'; Code: 198), 69 | (Name: 'Ccedil'; Code: 199), 70 | (Name: 'Egrave'; Code: 200), 71 | (Name: 'Eacute'; Code: 201), 72 | (Name: 'Ecirc'; Code: 202), 73 | (Name: 'Euml'; Code: 203), 74 | (Name: 'Igrave'; Code: 204), 75 | (Name: 'Iacute'; Code: 205), 76 | (Name: 'Icirc'; Code: 206), 77 | (Name: 'Iuml'; Code: 207), 78 | (Name: 'ETH'; Code: 208), 79 | (Name: 'Ntilde'; Code: 209), 80 | (Name: 'Ograve'; Code: 210), 81 | (Name: 'Oacute'; Code: 211), 82 | (Name: 'Ocirc'; Code: 212), 83 | (Name: 'Otilde'; Code: 213), 84 | (Name: 'Ouml'; Code: 214), 85 | (Name: 'times'; Code: 215), 86 | (Name: 'Oslash'; Code: 216), 87 | (Name: 'Ugrave'; Code: 217), 88 | (Name: 'Uacute'; Code: 218), 89 | (Name: 'Ucirc'; Code: 219), 90 | (Name: 'Uuml'; Code: 220), 91 | (Name: 'Yacute'; Code: 221), 92 | (Name: 'THORN'; Code: 222), 93 | (Name: 'szlig'; Code: 223), 94 | (Name: 'agrave'; Code: 224), 95 | (Name: 'aacute'; Code: 225), 96 | (Name: 'acirc'; Code: 226), 97 | (Name: 'atilde'; Code: 227), 98 | (Name: 'auml'; Code: 228), 99 | (Name: 'aring'; Code: 229), 100 | (Name: 'aelig'; Code: 230), 101 | (Name: 'ccedil'; Code: 231), 102 | (Name: 'egrave'; Code: 232), 103 | (Name: 'eacute'; Code: 233), 104 | (Name: 'ecirc'; Code: 234), 105 | (Name: 'euml'; Code: 235), 106 | (Name: 'igrave'; Code: 236), 107 | (Name: 'iacute'; Code: 237), 108 | (Name: 'icirc'; Code: 238), 109 | (Name: 'iuml'; Code: 239), 110 | (Name: 'eth'; Code: 240), 111 | (Name: 'ntilde'; Code: 241), 112 | (Name: 'ograve'; Code: 242), 113 | (Name: 'oacute'; Code: 243), 114 | (Name: 'ocirc'; Code: 244), 115 | (Name: 'otilde'; Code: 245), 116 | (Name: 'ouml'; Code: 246), 117 | (Name: 'divide'; Code: 247), 118 | (Name: 'oslash'; Code: 248), 119 | (Name: 'ugrave'; Code: 249), 120 | (Name: 'uacute'; Code: 250), 121 | (Name: 'ucirc'; Code: 251), 122 | (Name: 'uuml'; Code: 252), 123 | (Name: 'yacute'; Code: 253), 124 | (Name: 'thorn'; Code: 254), 125 | (Name: 'yuml'; Code: 255), 126 | (Name: 'fnof'; Code: 402), 127 | (Name: 'Alpha'; Code: 913), 128 | (Name: 'Beta'; Code: 914), 129 | (Name: 'Gamma'; Code: 915), 130 | (Name: 'Delta'; Code: 916), 131 | (Name: 'Epsilon'; Code: 917), 132 | (Name: 'Zeta'; Code: 918), 133 | (Name: 'Eta'; Code: 919), 134 | (Name: 'Theta'; Code: 920), 135 | (Name: 'Iota'; Code: 921), 136 | (Name: 'Kappa'; Code: 922), 137 | (Name: 'Lambda'; Code: 923), 138 | (Name: 'Mu'; Code: 924), 139 | (Name: 'Nu'; Code: 925), 140 | (Name: 'Xi'; Code: 926), 141 | (Name: 'Omicron'; Code: 927), 142 | (Name: 'Pi'; Code: 928), 143 | (Name: 'Rho'; Code: 929), 144 | (Name: 'Sigma'; Code: 931), 145 | (Name: 'Tau'; Code: 932), 146 | (Name: 'Upsilon'; Code: 933), 147 | (Name: 'Phi'; Code: 934), 148 | (Name: 'Chi'; Code: 935), 149 | (Name: 'Psi'; Code: 936), 150 | (Name: 'Omega'; Code: 937), 151 | (Name: 'alpha'; Code: 945), 152 | (Name: 'beta'; Code: 946), 153 | (Name: 'gamma'; Code: 947), 154 | (Name: 'delta'; Code: 948), 155 | (Name: 'epsilon'; Code: 949), 156 | (Name: 'zeta'; Code: 950), 157 | (Name: 'eta'; Code: 951), 158 | (Name: 'theta'; Code: 952), 159 | (Name: 'iota'; Code: 953), 160 | (Name: 'kappa'; Code: 954), 161 | (Name: 'lambda'; Code: 955), 162 | (Name: 'mu'; Code: 956), 163 | (Name: 'nu'; Code: 957), 164 | (Name: 'xi'; Code: 958), 165 | (Name: 'omicron'; Code: 959), 166 | (Name: 'pi'; Code: 960), 167 | (Name: 'rho'; Code: 961), 168 | (Name: 'sigmaf'; Code: 962), 169 | (Name: 'sigma'; Code: 963), 170 | (Name: 'tau'; Code: 964), 171 | (Name: 'upsilon'; Code: 965), 172 | (Name: 'phi'; Code: 966), 173 | (Name: 'chi'; Code: 967), 174 | (Name: 'psi'; Code: 968), 175 | (Name: 'omega'; Code: 969), 176 | (Name: 'thetasym'; Code: 977), 177 | (Name: 'upsih'; Code: 978), 178 | (Name: 'piv'; Code: 982), 179 | (Name: 'bull'; Code: 8226), 180 | (Name: 'hellip'; Code: 8230), 181 | (Name: 'prime'; Code: 8242), 182 | (Name: 'Prime'; Code: 8243), 183 | (Name: 'oline'; Code: 8254), 184 | (Name: 'frasl'; Code: 8260), 185 | (Name: 'weierp'; Code: 8472), 186 | (Name: 'image'; Code: 8465), 187 | (Name: 'real'; Code: 8476), 188 | (Name: 'trade'; Code: 8482), 189 | (Name: 'alefsym'; Code: 8501), 190 | (Name: 'larr'; Code: 8592), 191 | (Name: 'uarr'; Code: 8593), 192 | (Name: 'rarr'; Code: 8594), 193 | (Name: 'darr'; Code: 8595), 194 | (Name: 'harr'; Code: 8596), 195 | (Name: 'crarr'; Code: 8629), 196 | (Name: 'lArr'; Code: 8656), 197 | (Name: 'uArr'; Code: 8657), 198 | (Name: 'rArr'; Code: 8658), 199 | (Name: 'dArr'; Code: 8659), 200 | (Name: 'hArr'; Code: 8660), 201 | (Name: 'forall'; Code: 8704), 202 | (Name: 'part'; Code: 8706), 203 | (Name: 'exist'; Code: 8707), 204 | (Name: 'empty'; Code: 8709), 205 | (Name: 'nabla'; Code: 8711), 206 | (Name: 'isin'; Code: 8712), 207 | (Name: 'notin'; Code: 8713), 208 | (Name: 'ni'; Code: 8715), 209 | (Name: 'prod'; Code: 8719), 210 | (Name: 'sum'; Code: 8721), 211 | (Name: 'minus'; Code: 8722), 212 | (Name: 'lowast'; Code: 8727), 213 | (Name: 'radic'; Code: 8730), 214 | (Name: 'prop'; Code: 8733), 215 | (Name: 'infin'; Code: 8734), 216 | (Name: 'ang'; Code: 8736), 217 | (Name: 'and'; Code: 8743), 218 | (Name: 'or'; Code: 8744), 219 | (Name: 'cap'; Code: 8745), 220 | (Name: 'cup'; Code: 8746), 221 | (Name: 'int'; Code: 8747), 222 | (Name: 'there4'; Code: 8756), 223 | (Name: 'sim'; Code: 8764), 224 | (Name: 'cong'; Code: 8773), 225 | (Name: 'asymp'; Code: 8776), 226 | (Name: 'ne'; Code: 8800), 227 | (Name: 'equiv'; Code: 8801), 228 | (Name: 'le'; Code: 8804), 229 | (Name: 'ge'; Code: 8805), 230 | (Name: 'sub'; Code: 8834), 231 | (Name: 'sup'; Code: 8835), 232 | (Name: 'nsub'; Code: 8836), 233 | (Name: 'sube'; Code: 8838), 234 | (Name: 'supe'; Code: 8839), 235 | (Name: 'oplus'; Code: 8853), 236 | (Name: 'otimes'; Code: 8855), 237 | (Name: 'perp'; Code: 8869), 238 | (Name: 'sdot'; Code: 8901), 239 | (Name: 'lceil'; Code: 8968), 240 | (Name: 'rceil'; Code: 8969), 241 | (Name: 'lfloor'; Code: 8970), 242 | (Name: 'rfloor'; Code: 8971), 243 | (Name: 'lang'; Code: 9001), 244 | (Name: 'rang'; Code: 9002), 245 | (Name: 'loz'; Code: 9674), 246 | (Name: 'spades'; Code: 9824), 247 | (Name: 'clubs'; Code: 9827), 248 | (Name: 'hearts'; Code: 9829), 249 | (Name: 'diams'; Code: 9830), 250 | (Name: 'quot'; Code: 34), 251 | (Name: 'amp'; Code: 38), 252 | (Name: 'lt'; Code: 60), 253 | (Name: 'gt'; Code: 62), 254 | (Name: 'OElig'; Code: 338), 255 | (Name: 'oelig'; Code: 339), 256 | (Name: 'Scaron'; Code: 352), 257 | (Name: 'scaron'; Code: 353), 258 | (Name: 'Yuml'; Code: 376), 259 | (Name: 'circ'; Code: 710), 260 | (Name: 'tilde'; Code: 732), 261 | (Name: 'ensp'; Code: 8194), 262 | (Name: 'emsp'; Code: 8195), 263 | (Name: 'thinsp'; Code: 8201), 264 | (Name: 'zwnj'; Code: 8204), 265 | (Name: 'zwj'; Code: 8205), 266 | (Name: 'lrm'; Code: 8206), 267 | (Name: 'rlm'; Code: 8207), 268 | (Name: 'ndash'; Code: 8211), 269 | (Name: 'mdash'; Code: 8212), 270 | (Name: 'lsquo'; Code: 8216), 271 | (Name: 'rsquo'; Code: 8217), 272 | (Name: 'sbquo'; Code: 8218), 273 | (Name: 'ldquo'; Code: 8220), 274 | (Name: 'rdquo'; Code: 8221), 275 | (Name: 'bdquo'; Code: 8222), 276 | (Name: 'dagger'; Code: 8224), 277 | (Name: 'Dagger'; Code: 8225), 278 | (Name: 'permil'; Code: 8240), 279 | (Name: 'lsaquo'; Code: 8249), 280 | (Name: 'rsaquo'; Code: 8250), 281 | (Name: 'euro'; Code: 8364) 282 | ); 283 | 284 | type 285 | TEntList = class(TList) 286 | private 287 | function GetCode(const Name: String): Integer; 288 | public 289 | constructor Create; 290 | property Code[const Name: String]: Integer read GetCode; 291 | end; 292 | 293 | var 294 | EntityList: TEntList; 295 | 296 | function EntCompare(Ent1, Ent2: Pointer): Integer; 297 | begin 298 | Result := CompareStr(PEntity(Ent1)^.Name, PEntity(Ent2)^.Name) 299 | end; 300 | 301 | constructor TEntList.Create; 302 | var 303 | I: Integer; 304 | begin 305 | inherited Create; 306 | Capacity := EntCount; 307 | for I := 0 to EntCount - 1 do 308 | Add(@EntTab[I]); 309 | Sort(EntCompare) 310 | end; 311 | 312 | function TEntList.GetCode(const Name: String): Integer; 313 | var 314 | I, L, U, Cmp: Integer; 315 | begin 316 | L := 0; 317 | U := Count - 1; 318 | while L <= U do 319 | begin 320 | I := (L + U) div 2; 321 | Cmp := CompareStr(Name, PEntity(Items[I])^.Name); 322 | if Cmp = 0 then 323 | begin 324 | Result := PEntity(Items[I])^.Code; 325 | Exit 326 | end; 327 | if Cmp < 0 then 328 | U := I - 1 329 | else 330 | L := I + 1 331 | end; 332 | Result := 32 333 | end; 334 | 335 | function GetEntValue(const Name: String): WideChar; 336 | begin 337 | Result := WideChar(EntityList.Code[Name]) 338 | end; 339 | 340 | function GetEntName(Code: Word): String; 341 | var 342 | I: Integer; 343 | begin 344 | for I := 0 to EntCount - 1 do 345 | if EntTab[I].Code = Code then 346 | begin 347 | Result := EntTab[I].Name; 348 | Exit 349 | end; 350 | Result := '' 351 | end; 352 | 353 | initialization 354 | 355 | EntityList := TEntList.Create 356 | 357 | finalization 358 | 359 | EntityList.Free 360 | 361 | end. 362 | -------------------------------------------------------------------------------- /HtmlParserTest/htmlp/HTMLParser.pas: -------------------------------------------------------------------------------- 1 | unit HtmlParser; 2 | 3 | interface 4 | 5 | uses 6 | DomCore, HtmlReader, HtmlTags; 7 | 8 | type 9 | THtmlParser = class 10 | private 11 | FHtmlDocument: TDocument; 12 | FHtmlReader: THtmlReader; 13 | FCurrentNode: TNode; 14 | FCurrentTag: THtmlTag; 15 | function FindDefParent: TElement; 16 | function FindParent: TElement; 17 | function FindParentElement(tagList: THtmlTagSet): TElement; 18 | function FindTableParent: TElement; 19 | function FindThisElement: TElement; 20 | function GetMainElement(const tagName: TDomString): TElement; 21 | procedure ProcessAttributeEnd(Sender: TObject); 22 | procedure ProcessAttributeStart(Sender: TObject); 23 | procedure ProcessCDataSection(Sender: TObject); 24 | procedure ProcessComment(Sender: TObject); 25 | procedure ProcessDocType(Sender: TObject); 26 | procedure ProcessElementEnd(Sender: TObject); 27 | procedure ProcessElementStart(Sender: TObject); 28 | procedure ProcessEndElement(Sender: TObject); 29 | procedure ProcessEntityReference(Sender: TObject); 30 | procedure ProcessTextNode(Sender: TObject); 31 | public 32 | constructor Create; 33 | destructor Destroy; override; 34 | function parseString(const htmlStr: TDomString): TDocument; 35 | property HtmlDocument: TDocument read FHtmlDocument; 36 | end; 37 | 38 | implementation 39 | 40 | const 41 | htmlTagName = 'html'; 42 | headTagName = 'head'; 43 | bodyTagName = 'body'; 44 | 45 | constructor THtmlParser.Create; 46 | begin 47 | inherited Create; 48 | FHtmlReader := THtmlReader.Create; 49 | with FHtmlReader do 50 | begin 51 | OnAttributeEnd := ProcessAttributeEnd; 52 | OnAttributeStart := ProcessAttributeStart; 53 | OnCDataSection := ProcessCDataSection; 54 | OnComment := ProcessComment; 55 | OnDocType := ProcessDocType; 56 | OnElementEnd := ProcessElementEnd; 57 | OnElementStart := ProcessElementStart; 58 | OnEndElement := ProcessEndElement; 59 | OnEntityReference := ProcessEntityReference; 60 | //OnNotation := ProcessNotation; 61 | //OnProcessingInstruction := ProcessProcessingInstruction; 62 | OnTextNode := ProcessTextNode; 63 | end 64 | end; 65 | 66 | destructor THtmlParser.Destroy; 67 | begin 68 | FHtmlReader.Free; 69 | inherited Destroy 70 | end; 71 | 72 | function THtmlParser.FindDefParent: TElement; 73 | begin 74 | if FCurrentTag.Number in [HEAD_TAG, BODY_TAG] then 75 | Result := FHtmlDocument.appendChild(FHtmlDocument.createElement(htmlTagName)) as TElement 76 | else 77 | if FCurrentTag.Number in HeadTags then 78 | Result := GetMainElement(headTagName) 79 | else 80 | Result := GetMainElement(bodyTagName) 81 | end; 82 | 83 | function THtmlParser.FindParent: TElement; 84 | begin 85 | if (FCurrentTag.Number = P_TAG) or (FCurrentTag.Number in BlockTags) then 86 | Result := FindParentElement(BlockParentTags) 87 | else 88 | if FCurrentTag.Number = LI_TAG then 89 | Result := FindParentElement(ListItemParentTags) 90 | else 91 | if FCurrentTag.Number in [DD_TAG, DT_TAG] then 92 | Result := FindParentElement(DefItemParentTags) 93 | else 94 | if FCurrentTag.Number in [TD_TAG, TH_TAG] then 95 | Result := FindParentElement(CellParentTags) 96 | else 97 | if FCurrentTag.Number = TR_TAG then 98 | Result := FindParentElement(RowParentTags) 99 | else 100 | if FCurrentTag.Number = COL_TAG then 101 | Result := FindParentElement(ColParentTags) 102 | else 103 | if FCurrentTag.Number in [COLGROUP_TAG, THEAD_TAG, TFOOT_TAG, TBODY_TAG] then 104 | Result := FindParentElement(TableSectionParentTags) 105 | else 106 | if FCurrentTag.Number = TABLE_TAG then 107 | Result := FindTableParent 108 | else 109 | if FCurrentTag.Number = OPTION_TAG then 110 | Result := FindParentElement(OptionParentTags) 111 | else 112 | if FCurrentTag.Number in [HEAD_TAG, BODY_TAG] then 113 | Result := FHtmlDocument.documentElement as TElement 114 | else 115 | Result := nil; 116 | if Result = nil then 117 | Result := FindDefParent 118 | end; 119 | 120 | function THtmlParser.FindParentElement(tagList: THtmlTagSet): TElement; 121 | var 122 | Node: TNode; 123 | HtmlTag: THtmlTag; 124 | begin 125 | Node := FCurrentNode; 126 | while Node.nodeType = ELEMENT_NODE do 127 | begin 128 | HtmlTag := HtmlTagList.GetTagByName(Node.nodeName); 129 | if HtmlTag.Number in tagList then 130 | begin 131 | Result := Node as TElement; 132 | Exit 133 | end; 134 | Node := Node.parentNode 135 | end; 136 | Result := nil 137 | end; 138 | 139 | function THtmlParser.FindTableParent: TElement; 140 | var 141 | Node: TNode; 142 | HtmlTag: THtmlTag; 143 | begin 144 | Node := FCurrentNode; 145 | while Node.nodeType = ELEMENT_NODE do 146 | begin 147 | HtmlTag := HtmlTagList.GetTagByName(Node.nodeName); 148 | if (HtmlTag.Number = TD_TAG) or (HtmlTag.Number in BlockTags) then 149 | begin 150 | Result := Node as TElement; 151 | Exit 152 | end; 153 | Node := Node.parentNode 154 | end; 155 | Result := GetMainElement(bodyTagName) 156 | end; 157 | 158 | function THtmlParser.FindThisElement: TElement; 159 | var 160 | Node: TNode; 161 | begin 162 | Node := FCurrentNode; 163 | while Node.nodeType = ELEMENT_NODE do 164 | begin 165 | Result := Node as TElement; 166 | if Result.tagName = FHtmlReader.nodeName then 167 | Exit; 168 | Node := Node.parentNode 169 | end; 170 | Result := nil 171 | end; 172 | 173 | function THtmlParser.GetMainElement(const tagName: TDomString): TElement; 174 | var 175 | child: TNode; 176 | I: Integer; 177 | begin 178 | if FHtmlDocument.documentElement = nil then 179 | FHtmlDocument.appendChild(FHtmlDocument.createElement(htmlTagName)); 180 | for I := 0 to FHtmlDocument.documentElement.childNodes.length - 1 do 181 | begin 182 | child := FHtmlDocument.documentElement.childNodes.item(I); 183 | if (child.nodeType = ELEMENT_NODE) and (child.nodeName = tagName) then 184 | begin 185 | Result := child as TElement; 186 | Exit 187 | end 188 | end; 189 | Result := FHtmlDocument.createElement(tagName); 190 | FHtmlDocument.documentElement.appendChild(Result) 191 | end; 192 | 193 | procedure THtmlParser.ProcessAttributeEnd(Sender: TObject); 194 | begin 195 | FCurrentNode := (FCurrentNode as TAttr).ownerElement 196 | end; 197 | 198 | procedure THtmlParser.ProcessAttributeStart(Sender: TObject); 199 | var 200 | Attr: TAttr; 201 | begin 202 | Attr := FHtmlDocument.createAttribute((Sender as THtmlReader).nodeName); 203 | (FCurrentNode as TElement).setAttributeNode(Attr); 204 | FCurrentNode := Attr 205 | end; 206 | 207 | procedure THtmlParser.ProcessCDataSection(Sender: TObject); 208 | var 209 | CDataSection: TCDataSection; 210 | begin 211 | CDataSection := FHtmlDocument.createCDATASection(FHtmlReader.nodeValue); 212 | FCurrentNode.appendChild(CDataSection) 213 | end; 214 | 215 | procedure THtmlParser.ProcessComment(Sender: TObject); 216 | var 217 | Comment: TComment; 218 | begin 219 | Comment := FHtmlDocument.createComment(FHtmlReader.nodeValue); 220 | FCurrentNode.appendChild(Comment) 221 | end; 222 | 223 | procedure THtmlParser.ProcessDocType(Sender: TObject); 224 | begin 225 | with FHtmlReader do 226 | FHtmlDocument.docType := DomImplementation.createDocumentType(nodeName, publicID, systemID); 227 | end; 228 | 229 | procedure THtmlParser.ProcessElementEnd(Sender: TObject); 230 | begin 231 | if FHtmlReader.isEmptyElement or (FCurrentTag.Number in EmptyTags) then 232 | FCurrentNode := FCurrentNode.parentNode; 233 | FCurrentTag := nil 234 | end; 235 | 236 | procedure THtmlParser.ProcessElementStart(Sender: TObject); 237 | var 238 | Element: TElement; 239 | Parent: TNode; 240 | begin 241 | FCurrentTag := HtmlTagList.GetTagByName(FHtmlReader.nodeName); 242 | if FCurrentTag.Number in NeedFindParentTags + BlockTags then 243 | begin 244 | Parent := FindParent; 245 | if not Assigned(Parent) then 246 | raise DomException.Create(HIERARCHY_REQUEST_ERR); 247 | FCurrentNode := Parent 248 | end; 249 | Element := FHtmlDocument.createElement(FHtmlReader.nodeName); 250 | FCurrentNode.appendChild(Element); 251 | FCurrentNode := Element 252 | end; 253 | 254 | procedure THtmlParser.ProcessEndElement(Sender: TObject); 255 | var 256 | Element: TElement; 257 | begin 258 | Element := FindThisElement; 259 | if Assigned(Element) then 260 | FCurrentNode := Element.parentNode 261 | { else 262 | if IsBlockTagName(FHtmlReader.nodeName) then 263 | raise DomException.Create(HIERARCHY_REQUEST_ERR)} 264 | end; 265 | 266 | procedure THtmlParser.ProcessEntityReference(Sender: TObject); 267 | var 268 | EntityReference: TEntityReference; 269 | begin 270 | EntityReference := FHtmlDocument.createEntityReference(FHtmlReader.nodeName); 271 | FCurrentNode.appendChild(EntityReference) 272 | end; 273 | 274 | procedure THtmlParser.ProcessTextNode(Sender: TObject); 275 | var 276 | TextNode: TTextNode; 277 | begin 278 | TextNode := FHtmlDocument.createTextNode(FHtmlReader.nodeValue); 279 | FCurrentNode.appendChild(TextNode) 280 | end; 281 | 282 | function THtmlParser.parseString(const htmlStr: TDomString): TDocument; 283 | begin 284 | FHtmlReader.htmlStr := htmlStr; 285 | FHtmlDocument := DomImplementation.createEmptyDocument(nil); 286 | FCurrentNode := FHtmlDocument; 287 | try 288 | while FHtmlReader.Read do; 289 | except 290 | // TODO: Add event ? 291 | end; 292 | Result := FHtmlDocument 293 | end; 294 | 295 | end. 296 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTest.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\program files\borland\delphi7\Projects\Bpl" 35 | -LN"c:\program files\borland\delphi7\Projects\Bpl" 36 | -U";C:\DelphiTools\TeeChart.v8.01.Full.Source.Delphi.BCB.BDS.CRS.ccrun.776754\Sources\Compiled\Delphi7\Lib" 37 | -O";C:\DelphiTools\TeeChart.v8.01.Full.Source.Delphi.BCB.BDS.CRS.ccrun.776754\Sources\Compiled\Delphi7\Lib" 38 | -I";C:\DelphiTools\TeeChart.v8.01.Full.Source.Delphi.BCB.BDS.CRS.ccrun.776754\Sources\Compiled\Delphi7\Lib" 39 | -R";C:\DelphiTools\TeeChart.v8.01.Full.Source.Delphi.BCB.BDS.CRS.ccrun.776754\Sources\Compiled\Delphi7\Lib" 40 | -w-UNSAFE_TYPE 41 | -w-UNSAFE_CODE 42 | -w-UNSAFE_CAST 43 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTest.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath=;C:\DelphiTools\TeeChart.v8.01.Full.Source.Delphi.BCB.BDS.CRS.ccrun.776754\Sources\Compiled\Delphi7\Lib 98 | Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;TMSD7;tmsexd7;tmswizd7;tmsxlsd7;RaizeComponentsVcl;RaizeComponentsVclDb;Tee87;TeeUI87;TeeDB87;TeePro87;TeeGL87;TeeImage87;TeeLanguage87;TeeWorld87 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Language] 109 | ActiveLang= 110 | ProjectLang= 111 | RootDir=C:\Program Files\Borland\Delphi7\Bin\ 112 | [Version Info] 113 | IncludeVerInfo=0 114 | AutoIncBuild=0 115 | MajorVer=1 116 | MinorVer=0 117 | Release=0 118 | Build=0 119 | Debug=0 120 | PreRelease=0 121 | Special=0 122 | Private=0 123 | DLL=0 124 | Locale=2052 125 | CodePage=936 126 | [Version Info Keys] 127 | CompanyName= 128 | FileDescription= 129 | FileVersion=1.0.0.0 130 | InternalName= 131 | LegalCopyright= 132 | LegalTrademarks= 133 | OriginalFilename= 134 | ProductName= 135 | ProductVersion=1.0.0.0 136 | Comments= 137 | [Excluded Packages] 138 | c:\program files\borland\delphi7\Bin\dcltee77.bpl=TeeChart Components 139 | c:\program files\borland\delphi7\Bin\dclteepro77.bpl=TeeChart Pro Components 140 | c:\program files\borland\delphi7\Bin\dcltqr77.bpl=TeeChart for QuickReport 141 | c:\program files\borland\delphi7\Bin\dcltgl77.bpl=TeeChart OpenGL 142 | c:\program files\borland\delphi7\Bin\dcltee70.bpl=TeeChart Standard 143 | c:\program files\borland\delphi7\Bin\dcltqr70.bpl=TeeChart for QuickReport 144 | c:\program files\borland\delphi7\Bin\dcltee7100.bpl=TeeChart Components 145 | c:\program files\borland\delphi7\Bin\dcltee67.bpl=TeeChart Components 146 | c:\program files\borland\delphi7\Bin\dclteepro67.bpl=TeeChart Pro Components 147 | c:\program files\borland\delphi7\Bin\dcltqr67.bpl=TeeChart for QuickReport 148 | c:\program files\borland\delphi7\Bin\dcltgl67.bpl=TeeChart OpenGL 149 | c:\program files\borland\delphi7\Bin\dcltee6100.bpl=TeeChart Components 150 | c:\program files\borland\delphi7\Bin\dcltee57.bpl=TeeChart Components 151 | c:\program files\borland\delphi7\Bin\dcltep57.bpl=TeeChart Pro Components 152 | c:\program files\borland\delphi7\Bin\dcltqr57.bpl=TeeChart for QuickReport 153 | c:\program files\borland\delphi7\Bin\dcltgl57.bpl=TeeChart OpenGL 154 | c:\program files\borland\delphi7\Bin\dcltee5100.bpl=TeeChart Components 155 | c:\program files\borland\delphi7\Bin\dcltee47.bpl=TeeChart Components 156 | c:\program files\borland\delphi7\Bin\dcltep47.bpl=TeeChart Pro Components 157 | c:\program files\borland\delphi7\Bin\dcltqr47.bpl=TeeChart for QuickReport 158 | c:\program files\borland\delphi7\Bin\dcltgl47.bpl=TeeChart OpenGL 159 | c:\program files\borland\delphi7\Bin\dcltee4100.bpl=TeeChart Components 160 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTest.dpr: -------------------------------------------------------------------------------- 1 | program HtmlParserTest; 2 | 3 | uses 4 | Forms, 5 | HtmlParserTestMain in 'HtmlParserTestMain.pas' {Form16}, 6 | DOMCore in 'htmlp\DOMCore.pas', 7 | Entities in 'htmlp\Entities.pas', 8 | Formatter in 'htmlp\Formatter.pas', 9 | HTMLParser in 'htmlp\HTMLParser.pas', 10 | HtmlReader in 'htmlp\HtmlReader.pas', 11 | HtmlTags in 'htmlp\HtmlTags.pas', 12 | WStrings in 'htmlp\WStrings.pas'; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | Application.CreateForm(TForm16, Form16); 19 | Application.Run; 20 | end. 21 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTest.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {EC1AC04C-625B-48CB-B12D-AB291F79A569} 4 | 15.4 5 | VCL 6 | HtmlParserTest.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 39 | $(BDS)\bin\default_app.manifest 40 | 2052 41 | $(BDS)\bin\delphi_PROJECTICON.ico 42 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 43 | HtmlParserTest 44 | .\$(Platform)\$(Config) 45 | .\$(Platform)\$(Config) 46 | false 47 | false 48 | false 49 | false 50 | false 51 | 52 | 53 | .\ 54 | true 55 | JvBDE;JvGlobus;UnitSystem;JvMM;TeeGL920;JvManagedThreads;SmartComponents;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;ZRGraph;ZRLicense;FireDACPgDriver;TeeLanguage920;fmx;RaizeComponentsVcl;IndySystem;JvDlgs;JvCrypt;tethering;TP_LockBox3;NativeXmlPkg;ZRCore;vclib;inetdbbde;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;TeeDB920;JvNet;DataSnapProviderClient;TeeUI920;DBXSybaseASEDriver;JvDotNetCtrls;DbxCommonDriver;vclimg;FmxTeeUI920;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;FMXTee920;SynEdit_RXE6;JvXPCtrls;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;ColorMapComponents;DBXOracleDriver;CustomIPTransport;JvCore;vclribbon;dsnap;IndyIPServer;FMXTeeLanguage920;fmxase;vcl;IndyCore;tmsxlsdXE6;mbColorLib;DBXMSSQLDriver;CloudService;IndyIPCommon;TsiLang_XE6r;FireDACIBDriver;TeeImage920;DataSnapFireDAC;FireDACDBXDriver;JvAppFrm;soapserver;JvDB;JvRuntimeDesign;inetdbxpress;GLScene_RunTime_VCL;dsnapxml;tmsdXE6;FireDACInfxDriver;FireDACDb2Driver;JclDeveloperTools;ALGLIB;JvDocking;adortl;FMXTeePro920;TeePro920;JvWizards;madBasic_;FireDACASADriver;JvHMI;TeeMaker120;TeeTree2D20Tee9;bindcompfmx;JvBands;vcldbx;RaizeComponentsVclDb;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;SmartStorage;FireDACCommon;bindcomp;inetdb;JvPluginSystem;JclContainers;DBXOdbcDriver;JvCmp;vclFireDAC;madDisAsm_;AlgorithmProvider;JvSystem;xmlrtl;DataSnapNativeClient;ibxpress;svnui;JvControls;Tee920;JvTimeFramework;IndyProtocols;DBXMySQLDriver;FMXTeeDB920;FireDACCommonDriver;MIT3DPkg;tmswizdXE6;bindcompdbx;bindengine;vclactnband;soaprtl;JvJans;JvPageComps;bindcompvcl;JvStdCtrls;JvCustom;Jcl;vclie;JvPrintPreview;ZRComponnets;ZRZonationModel;madExcept_;FireDACADSDriver;vcltouch;ZRRockyModel;GraphPackage;PngComponents;VCLRESTComponents;FireDAC;DBXInformixDriver;FireDACMSSQLDriver;Intraweb;VclSmp;TeeWorld920;DataSnapConnectors;DataSnapServerMidas;DBXFirebirdDriver;dsnapcon;inet;fmxobj;JclVcl;JvPascalInterpreter;FireDACMySQLDriver;soapmidas;vclx;tmsexdXE6;ZRLithPack;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;bdertl;GdiPlus;dbexpress;FireDACMSAccDriver;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) 56 | 1033 57 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 58 | 59 | 60 | DEBUG;$(DCC_Define) 61 | true 62 | false 63 | true 64 | true 65 | true 66 | 67 | 68 | 1033 69 | true 70 | false 71 | 72 | 73 | false 74 | RELEASE;$(DCC_Define) 75 | 0 76 | 0 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 |
Form16
84 | dfm 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | Cfg_2 96 | Base 97 | 98 | 99 | Base 100 | 101 | 102 | Cfg_1 103 | Base 104 | 105 | 106 | 107 | Delphi.Personality.12 108 | 109 | 110 | 111 | 112 | HtmlParserTest.dpr 113 | 114 | 115 | Microsoft Office 2000 Sample Automation Server Wrapper Components 116 | Microsoft Office XP Sample Automation Server Wrapper Components 117 | 118 | 119 | 120 | 121 | True 122 | 123 | 124 | 12 125 | 126 | 127 | 128 | 129 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/HtmlParserTest_D7/HtmlParserTest.res -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTestMain.dfm: -------------------------------------------------------------------------------- 1 | object Form16: TForm16 2 | Left = 311 3 | Top = 238 4 | Width = 857 5 | Height = 332 6 | Caption = 'Html Parser Test' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 849 16 | 298) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object btn1: TButton 20 | Left = 749 21 | Top = 8 22 | Width = 75 23 | Height = 25 24 | Anchors = [akTop, akRight] 25 | Caption = 'Parse' 26 | TabOrder = 0 27 | OnClick = btn1Click 28 | end 29 | object lv1: TListView 30 | Left = 8 31 | Top = 8 32 | Width = 735 33 | Height = 281 34 | Anchors = [akLeft, akTop, akRight, akBottom] 35 | Columns = < 36 | item 37 | Caption = 'href' 38 | Width = 240 39 | end 40 | item 41 | Caption = 'Content' 42 | Width = 240 43 | end 44 | item 45 | Caption = 'Date' 46 | Width = 120 47 | end> 48 | ReadOnly = True 49 | TabOrder = 1 50 | ViewStyle = vsReport 51 | end 52 | end 53 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/HtmlParserTestMain.pas: -------------------------------------------------------------------------------- 1 | unit HtmlParserTestMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, 7 | Controls, Forms, Dialogs, StdCtrls, 8 | HTMLParser, Grids, ComCtrls; 9 | 10 | type 11 | TForm16 = class(TForm) 12 | btn1: TButton; 13 | lv1: TListView; 14 | procedure btn1Click(Sender: TObject); 15 | private 16 | { Private declarations } 17 | HtmlParser: THtmlParser; 18 | function LoadHtmlFile: WideString; 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | Form16: TForm16; 25 | 26 | implementation 27 | 28 | uses 29 | DomCore, Formatter; 30 | 31 | {$R *.dfm} 32 | 33 | procedure TForm16.btn1Click(Sender: TObject); 34 | var 35 | HtmlDoc: TDocument; 36 | Formatter: TBaseFormatter; 37 | list: TNodeList; 38 | I: Integer; 39 | span: TNode; 40 | classAttr: TNode; 41 | href: TNode; 42 | Item: TListItem; 43 | begin 44 | HtmlParser := THtmlParser.Create; 45 | try 46 | try 47 | HtmlDoc := HtmlParser.parseString(LoadHtmlFile); 48 | except 49 | end; 50 | list := HtmlDoc.getElementsByTagName('span'); 51 | for I := 0 to list.length-1 do 52 | begin 53 | span := list.item(i); 54 | classAttr := span.attributes.getNamedItem('class'); 55 | if Assigned(classAttr) then 56 | begin 57 | if classAttr.childNodes.item(0).NodeValue = 'ina_zh' then 58 | begin 59 | href := span.childNodes.item(0); 60 | if href.nodeName = 'a' then 61 | begin 62 | Item := lv1.Items.Add; 63 | Item.Caption := href.attributes.getNamedItem('href').childNodes.item(0).nodeValue; 64 | Item.SubItems.Add(href.childNodes.item(0).NodeValue); 65 | Item.SubItems.Add(span.parentNode.childNodes.item(2).childNodes.item(0).NodeValue); 66 | end; 67 | end; 68 | end; 69 | end; 70 | list.Free; 71 | finally 72 | HtmlParser.Free 73 | end; 74 | 75 | 76 | 77 | HtmlDoc.Free; 78 | 79 | end; 80 | 81 | function TForm16.LoadHtmlFile: WideString; 82 | var 83 | F: TFileStream; 84 | S: AnsiString; 85 | begin 86 | F := TFileStream.Create('Test.html', fmOpenRead); 87 | try 88 | SetLength(S, F.Size); 89 | F.Read(S[1], F.Size); 90 | Result := UTF8Decode(s); 91 | finally 92 | F.Free 93 | end; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /HtmlParserTest_D7/README.md: -------------------------------------------------------------------------------- 1 | # Html Parser Test for delphi 7 2 | 3 | This Demo use "Delphi Dom HTML Parser and Converter", the original address is: 4 | 5 | http://sourceforge.net/projects/htmlp/ 6 | 7 | This Demo demonstrate how to use HTML Parser parse a HTML file and get information. 8 | 9 | 这个Demo使用了Delphi Dom HTML Parser and Converter，原始的源代码可以到以下地址下载： 10 | 11 | http://sourceforge.net/projects/htmlp/ 12 | 13 | 该Demo演示了使用HTML Parser解析一个HTML文件，并提取其中信息。 -------------------------------------------------------------------------------- /HtmlParserTest_D7/htmlp/HTMLParser.pas: -------------------------------------------------------------------------------- 1 | unit HtmlParser; 2 | 3 | interface 4 | 5 | uses 6 | DomCore, HtmlReader, HtmlTags; 7 | 8 | type 9 | THtmlParser = class 10 | private 11 | FHtmlDocument: TDocument; 12 | FHtmlReader: THtmlReader; 13 | FCurrentNode: TNode; 14 | FCurrentTag: THtmlTag; 15 | function FindDefParent: TElement; 16 | function FindParent: TElement; 17 | function FindParentElement(tagList: THtmlTagSet): TElement; 18 | function FindTableParent: TElement; 19 | function FindThisElement: TElement; 20 | function GetMainElement(const tagName: TDomString): TElement; 21 | procedure ProcessAttributeEnd(Sender: TObject); 22 | procedure ProcessAttributeStart(Sender: TObject); 23 | procedure ProcessCDataSection(Sender: TObject); 24 | procedure ProcessComment(Sender: TObject); 25 | procedure ProcessDocType(Sender: TObject); 26 | procedure ProcessElementEnd(Sender: TObject); 27 | procedure ProcessElementStart(Sender: TObject); 28 | procedure ProcessEndElement(Sender: TObject); 29 | procedure ProcessEntityReference(Sender: TObject); 30 | procedure ProcessTextNode(Sender: TObject); 31 | public 32 | constructor Create; 33 | destructor Destroy; override; 34 | function parseString(const htmlStr: TDomString): TDocument; 35 | property HtmlDocument: TDocument read FHtmlDocument; 36 | end; 37 | 38 | implementation 39 | 40 | const 41 | htmlTagName = 'html'; 42 | headTagName = 'head'; 43 | bodyTagName = 'body'; 44 | 45 | constructor THtmlParser.Create; 46 | begin 47 | inherited Create; 48 | FHtmlReader := THtmlReader.Create; 49 | with FHtmlReader do 50 | begin 51 | OnAttributeEnd := ProcessAttributeEnd; 52 | OnAttributeStart := ProcessAttributeStart; 53 | OnCDataSection := ProcessCDataSection; 54 | OnComment := ProcessComment; 55 | OnDocType := ProcessDocType; 56 | OnElementEnd := ProcessElementEnd; 57 | OnElementStart := ProcessElementStart; 58 | OnEndElement := ProcessEndElement; 59 | OnEntityReference := ProcessEntityReference; 60 | //OnNotation := ProcessNotation; 61 | //OnProcessingInstruction := ProcessProcessingInstruction; 62 | OnTextNode := ProcessTextNode; 63 | end 64 | end; 65 | 66 | destructor THtmlParser.Destroy; 67 | begin 68 | FHtmlReader.Free; 69 | inherited Destroy 70 | end; 71 | 72 | function THtmlParser.FindDefParent: TElement; 73 | begin 74 | if FCurrentTag.Number in [HEAD_TAG, BODY_TAG] then 75 | Result := FHtmlDocument.appendChild(FHtmlDocument.createElement(htmlTagName)) as TElement 76 | else 77 | if FCurrentTag.Number in HeadTags then 78 | Result := GetMainElement(headTagName) 79 | else 80 | Result := GetMainElement(bodyTagName) 81 | end; 82 | 83 | function THtmlParser.FindParent: TElement; 84 | begin 85 | if (FCurrentTag.Number = P_TAG) or (FCurrentTag.Number in BlockTags) then 86 | Result := FindParentElement(BlockParentTags) 87 | else 88 | if FCurrentTag.Number = LI_TAG then 89 | Result := FindParentElement(ListItemParentTags) 90 | else 91 | if FCurrentTag.Number in [DD_TAG, DT_TAG] then 92 | Result := FindParentElement(DefItemParentTags) 93 | else 94 | if FCurrentTag.Number in [TD_TAG, TH_TAG] then 95 | Result := FindParentElement(CellParentTags) 96 | else 97 | if FCurrentTag.Number = TR_TAG then 98 | Result := FindParentElement(RowParentTags) 99 | else 100 | if FCurrentTag.Number = COL_TAG then 101 | Result := FindParentElement(ColParentTags) 102 | else 103 | if FCurrentTag.Number in [COLGROUP_TAG, THEAD_TAG, TFOOT_TAG, TBODY_TAG] then 104 | Result := FindParentElement(TableSectionParentTags) 105 | else 106 | if FCurrentTag.Number = TABLE_TAG then 107 | Result := FindTableParent 108 | else 109 | if FCurrentTag.Number = OPTION_TAG then 110 | Result := FindParentElement(OptionParentTags) 111 | else 112 | if FCurrentTag.Number in [HEAD_TAG, BODY_TAG] then 113 | Result := FHtmlDocument.documentElement as TElement 114 | else 115 | Result := nil; 116 | if Result = nil then 117 | Result := FindDefParent 118 | end; 119 | 120 | function THtmlParser.FindParentElement(tagList: THtmlTagSet): TElement; 121 | var 122 | Node: TNode; 123 | HtmlTag: THtmlTag; 124 | begin 125 | Node := FCurrentNode; 126 | while Node.nodeType = ELEMENT_NODE do 127 | begin 128 | HtmlTag := HtmlTagList.GetTagByName(Node.nodeName); 129 | if HtmlTag.Number in tagList then 130 | begin 131 | Result := Node as TElement; 132 | Exit 133 | end; 134 | Node := Node.parentNode 135 | end; 136 | Result := nil 137 | end; 138 | 139 | function THtmlParser.FindTableParent: TElement; 140 | var 141 | Node: TNode; 142 | HtmlTag: THtmlTag; 143 | begin 144 | Node := FCurrentNode; 145 | while Node.nodeType = ELEMENT_NODE do 146 | begin 147 | HtmlTag := HtmlTagList.GetTagByName(Node.nodeName); 148 | if (HtmlTag.Number = TD_TAG) or (HtmlTag.Number in BlockTags) then 149 | begin 150 | Result := Node as TElement; 151 | Exit 152 | end; 153 | Node := Node.parentNode 154 | end; 155 | Result := GetMainElement(bodyTagName) 156 | end; 157 | 158 | function THtmlParser.FindThisElement: TElement; 159 | var 160 | Node: TNode; 161 | begin 162 | Node := FCurrentNode; 163 | while Node.nodeType = ELEMENT_NODE do 164 | begin 165 | Result := Node as TElement; 166 | if Result.tagName = FHtmlReader.nodeName then 167 | Exit; 168 | Node := Node.parentNode 169 | end; 170 | Result := nil 171 | end; 172 | 173 | function THtmlParser.GetMainElement(const tagName: TDomString): TElement; 174 | var 175 | child: TNode; 176 | I: Integer; 177 | begin 178 | if FHtmlDocument.documentElement = nil then 179 | FHtmlDocument.appendChild(FHtmlDocument.createElement(htmlTagName)); 180 | for I := 0 to FHtmlDocument.documentElement.childNodes.length - 1 do 181 | begin 182 | child := FHtmlDocument.documentElement.childNodes.item(I); 183 | if (child.nodeType = ELEMENT_NODE) and (child.nodeName = tagName) then 184 | begin 185 | Result := child as TElement; 186 | Exit 187 | end 188 | end; 189 | Result := FHtmlDocument.createElement(tagName); 190 | FHtmlDocument.documentElement.appendChild(Result) 191 | end; 192 | 193 | procedure THtmlParser.ProcessAttributeEnd(Sender: TObject); 194 | begin 195 | FCurrentNode := (FCurrentNode as TAttr).ownerElement 196 | end; 197 | 198 | procedure THtmlParser.ProcessAttributeStart(Sender: TObject); 199 | var 200 | Attr: TAttr; 201 | begin 202 | Attr := FHtmlDocument.createAttribute((Sender as THtmlReader).nodeName); 203 | (FCurrentNode as TElement).setAttributeNode(Attr); 204 | FCurrentNode := Attr 205 | end; 206 | 207 | procedure THtmlParser.ProcessCDataSection(Sender: TObject); 208 | var 209 | CDataSection: TCDataSection; 210 | begin 211 | CDataSection := FHtmlDocument.createCDATASection(FHtmlReader.nodeValue); 212 | FCurrentNode.appendChild(CDataSection) 213 | end; 214 | 215 | procedure THtmlParser.ProcessComment(Sender: TObject); 216 | var 217 | Comment: TComment; 218 | begin 219 | Comment := FHtmlDocument.createComment(FHtmlReader.nodeValue); 220 | FCurrentNode.appendChild(Comment) 221 | end; 222 | 223 | procedure THtmlParser.ProcessDocType(Sender: TObject); 224 | begin 225 | with FHtmlReader do 226 | FHtmlDocument.docType := DomImplementation.createDocumentType(nodeName, publicID, systemID); 227 | end; 228 | 229 | procedure THtmlParser.ProcessElementEnd(Sender: TObject); 230 | begin 231 | if FHtmlReader.isEmptyElement or (FCurrentTag.Number in EmptyTags) then 232 | FCurrentNode := FCurrentNode.parentNode; 233 | FCurrentTag := nil 234 | end; 235 | 236 | procedure THtmlParser.ProcessElementStart(Sender: TObject); 237 | var 238 | Element: TElement; 239 | Parent: TNode; 240 | begin 241 | FCurrentTag := HtmlTagList.GetTagByName(FHtmlReader.nodeName); 242 | if FCurrentTag.Number in NeedFindParentTags + BlockTags then 243 | begin 244 | Parent := FindParent; 245 | if not Assigned(Parent) then 246 | raise DomException.Create(HIERARCHY_REQUEST_ERR); 247 | FCurrentNode := Parent 248 | end; 249 | Element := FHtmlDocument.createElement(FHtmlReader.nodeName); 250 | FCurrentNode.appendChild(Element); 251 | FCurrentNode := Element 252 | end; 253 | 254 | procedure THtmlParser.ProcessEndElement(Sender: TObject); 255 | var 256 | Element: TElement; 257 | begin 258 | Element := FindThisElement; 259 | if Assigned(Element) then 260 | FCurrentNode := Element.parentNode 261 | { else 262 | if IsBlockTagName(FHtmlReader.nodeName) then 263 | raise DomException.Create(HIERARCHY_REQUEST_ERR)} 264 | end; 265 | 266 | procedure THtmlParser.ProcessEntityReference(Sender: TObject); 267 | var 268 | EntityReference: TEntityReference; 269 | begin 270 | EntityReference := FHtmlDocument.createEntityReference(FHtmlReader.nodeName); 271 | FCurrentNode.appendChild(EntityReference) 272 | end; 273 | 274 | procedure THtmlParser.ProcessTextNode(Sender: TObject); 275 | var 276 | TextNode: TTextNode; 277 | begin 278 | TextNode := FHtmlDocument.createTextNode(FHtmlReader.nodeValue); 279 | FCurrentNode.appendChild(TextNode) 280 | end; 281 | 282 | function THtmlParser.parseString(const htmlStr: TDomString): TDocument; 283 | begin 284 | FHtmlReader.htmlStr := htmlStr; 285 | FHtmlDocument := DomImplementation.createEmptyDocument(nil); 286 | FCurrentNode := FHtmlDocument; 287 | try 288 | while FHtmlReader.Read do; 289 | except 290 | // TODO: Add event ? 291 | end; 292 | Result := FHtmlDocument 293 | end; 294 | 295 | end. 296 | -------------------------------------------------------------------------------- /LoadCustomCursor/CursorTest.dfm: -------------------------------------------------------------------------------- 1 | object LoadCursorTestForm: TLoadCursorTestForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Load Custom Cursor Test' 5 | ClientHeight = 452 6 | ClientWidth = 562 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object pnlCanvas: TPaintBox 18 | Left = 70 19 | Top = 75 20 | Width = 404 21 | Height = 305 22 | OnMouseMove = pnlCanvasMouseMove 23 | OnPaint = pnlCanvasPaint 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /LoadCustomCursor/CursorTest.pas: -------------------------------------------------------------------------------- 1 | unit CursorTest; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls; 8 | 9 | const 10 | cr5 = 5; 11 | cr6 = 6; 12 | cr7 = 7; 13 | cr8 = 8; 14 | cr9 = 9; 15 | cr10 = 10; 16 | 17 | type 18 | TLoadCursorTestForm = class(TForm) 19 | pnlCanvas: TPaintBox; 20 | procedure pnlCanvasPaint(Sender: TObject); 21 | procedure FormCreate(Sender: TObject); 22 | procedure pnlCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 23 | private 24 | { Private declarations } 25 | public 26 | { Public declarations } 27 | end; 28 | 29 | var 30 | LoadCursorTestForm: TLoadCursorTestForm; 31 | 32 | implementation 33 | 34 | {$R *.dfm} 35 | 36 | procedure TLoadCursorTestForm.FormCreate(Sender: TObject); 37 | begin 38 | screen.cursors[cr5] := LoadCursor(hInstance, pChar('Cursor_Move')); 39 | end; 40 | 41 | procedure TLoadCursorTestForm.pnlCanvasMouseMove(Sender: TObject; Shift: TShiftState; X, 42 | Y: Integer); 43 | begin 44 | if PtInRect(Rect(100,100,200,200), Point(x,y)) then 45 | Screen.Cursor := cr5 46 | else 47 | Screen.Cursor := crDefault; 48 | end; 49 | 50 | procedure TLoadCursorTestForm.pnlCanvasPaint(Sender: TObject); 51 | begin 52 | pnlCanvas.Canvas.Rectangle(Rect(100,100,200,200)); 53 | end; 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /LoadCustomCursor/LoadCustomCursor.dpr: -------------------------------------------------------------------------------- 1 | program LoadCustomCursor; 2 | 3 | 4 | 5 | {$R *.dres} 6 | 7 | uses 8 | Forms, 9 | CursorTest in 'CursorTest.pas' {LoadCursorTestForm}; 10 | 11 | {$R *.res} 12 | 13 | begin 14 | Application.Initialize; 15 | Application.MainFormOnTaskbar := True; 16 | Application.CreateForm(TLoadCursorTestForm, LoadCursorTestForm); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /LoadCustomCursor/Move.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/LoadCustomCursor/Move.cur -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DelphiDemos 2 | 3 | 4 | ZXingScanDemo 是使用ZXing.Delphi扫描的一个demo，与原有的demo相比，增加了一些优化和辅助的美化，使用这个Demo，需要自己下载ZXing.Delphi，https://github.com/Spelt/ZXing.Delphi 5 | 6 | ScanCodeDemo 相比ZXingScanDemo，对相机的聚焦（安卓）和性能进行了优化 7 | 8 | 9 | [捐助名单](DonationList.md) 10 | 11 | 12 | #关于捐助： 13 | 14 | 本项目所有示例均可免费下载和使用，无需通知我， 15 | 如果你觉得本项目的示例对你有所帮助而你刚好又想对本项目进行捐助,请联系作者：QQ 21114963 16 | 17 | 18 | # Site Links 19 | 20 | ## [learndelphi](//learndelphi.org) 21 | 22 | ## [embarcadero](//embarcadero.com) 23 | -------------------------------------------------------------------------------- /Recorder/RecorderDemo.dpr: -------------------------------------------------------------------------------- 1 | program RecorderDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | RecorderDemoMain in 'RecorderDemoMain.pas' {RecorderdDemoForm}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TRecorderdDemoForm, RecorderdDemoForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Recorder/RecorderDemo.dproj.local: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 2016/06/21 15:47:36.990,=C:\Users\zhaoyp\Documents\Embarcadero\Studio\Projects\Unit33.pas 5 | 2016/06/21 15:49:22.096,E:\Develop\Delphi\Group\DelphiDemos\Recorder\RecorderDemoMain.pas=C:\Users\zhaoyp\Documents\Embarcadero\Studio\Projects\Unit33.pas 6 | 2016/06/21 15:49:22.096,E:\Develop\Delphi\Group\DelphiDemos\Recorder\RecorderDemoMain.fmx=C:\Users\zhaoyp\Documents\Embarcadero\Studio\Projects\Unit33.fmx 7 | 2016/06/21 16:05:25.352,E:\Develop\Delphi\Group\DelphiDemos\Recorder\RecorderDemo.dproj=C:\Users\zhaoyp\Documents\Embarcadero\Studio\Projects\Project27.dproj 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /Recorder/RecorderDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/Recorder/RecorderDemo.res -------------------------------------------------------------------------------- /Recorder/RecorderDemoMain.fmx: -------------------------------------------------------------------------------- 1 | object RecorderdDemoForm: TRecorderdDemoForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form33' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | DesignerMasterStyle = 0 12 | object Button2: TButton 13 | Action = acPlay 14 | Enabled = True 15 | ImageIndex = -1 16 | Position.X = 280.000000000000000000 17 | Position.Y = 232.000000000000000000 18 | TabOrder = 5 19 | Visible = True 20 | end 21 | object Button3: TButton 22 | Action = acStop 23 | Enabled = True 24 | ImageIndex = -1 25 | Position.X = 280.000000000000000000 26 | Position.Y = 264.000000000000000000 27 | TabOrder = 4 28 | Visible = True 29 | end 30 | object Button4: TButton 31 | Action = acStartRecording 32 | Enabled = True 33 | ImageIndex = -1 34 | Position.X = 280.000000000000000000 35 | Position.Y = 296.000000000000000000 36 | TabOrder = 3 37 | Visible = True 38 | end 39 | object Button5: TButton 40 | Action = acStopRecording 41 | Enabled = True 42 | ImageIndex = -1 43 | Position.X = 280.000000000000000000 44 | Position.Y = 328.000000000000000000 45 | TabOrder = 2 46 | Visible = True 47 | OnClick = Button5Click 48 | end 49 | object Label1: TLabel 50 | Position.X = 136.000000000000000000 51 | Position.Y = 136.000000000000000000 52 | Text = 'Label1' 53 | end 54 | object Label2: TLabel 55 | Position.X = 136.000000000000000000 56 | Position.Y = 176.000000000000000000 57 | Text = 'Label1' 58 | end 59 | object ActionList1: TActionList 60 | OnUpdate = ActionList1Update 61 | Left = 328 62 | Top = 80 63 | object acStartRecording: TAction 64 | Text = #24320#22987#24405#38899 65 | OnExecute = acStartRecordingExecute 66 | end 67 | object acStopRecording: TAction 68 | Text = #20572#27490#24405#38899 69 | end 70 | object acPlay: TAction 71 | Text = 'acPlay' 72 | OnExecute = acPlayExecute 73 | end 74 | object acStop: TAction 75 | Text = 'acStop' 76 | OnExecute = acStopExecute 77 | end 78 | end 79 | object MediaPlayer1: TMediaPlayer 80 | Left = 112 81 | Top = 248 82 | end 83 | end 84 | -------------------------------------------------------------------------------- /Recorder/RecorderDemoMain.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/Recorder/RecorderDemoMain.pas -------------------------------------------------------------------------------- /RoundImageDemo/DemoImage.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/RoundImageDemo/DemoImage.png -------------------------------------------------------------------------------- /RoundImageDemo/RoundImageDemo.dpr: -------------------------------------------------------------------------------- 1 | program RoundImageDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | RoundImageForm in 'RoundImageForm.pas' {Form11}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm11, Form11); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /RoundImageDemo/RoundImageDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/RoundImageDemo/RoundImageDemo.res -------------------------------------------------------------------------------- /RoundImageDemo/RoundImageForm.fmx: -------------------------------------------------------------------------------- 1 | object Form11: TForm11 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form11' 5 | ClientHeight = 250 6 | ClientWidth = 385 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object Image1: TImage 12 | MultiResBitmap = < 13 | item 14 | end> 15 | Position.X = 32.000000000000000000 16 | Position.Y = 32.000000000000000000 17 | Size.Width = 161.000000000000000000 18 | Size.Height = 153.000000000000000000 19 | Size.PlatformDefault = False 20 | end 21 | object Button1: TButton 22 | Position.X = 208.000000000000000000 23 | Position.Y = 80.000000000000000000 24 | Size.Width = 169.000000000000000000 25 | Size.Height = 41.000000000000000000 26 | Size.PlatformDefault = False 27 | TabOrder = 1 28 | Text = 'Show RoundRect Image' 29 | OnClick = Button1Click 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /RoundImageDemo/RoundImageForm.pas: -------------------------------------------------------------------------------- 1 | unit RoundImageForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, 8 | FMX.Controls.Presentation, FMX.StdCtrls; 9 | 10 | type 11 | TForm11 = class(TForm) 12 | Image1: TImage; 13 | Button1: TButton; 14 | procedure Button1Click(Sender: TObject); 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | var 22 | Form11: TForm11; 23 | 24 | implementation 25 | 26 | {$R *.fmx} 27 | 28 | procedure TForm11.Button1Click(Sender: TObject); 29 | var 30 | B1, B2: TBitmap; 31 | begin 32 | B1 := TBitmap.Create; 33 | B1.LoadFromFile('..\..\DemoImage.png'); 34 | B2 := TBitmap.Create(B1.Width, B1.Height); 35 | try 36 | B2.Clear(0); 37 | B2.Canvas.BeginScene; 38 | B2.Canvas.Fill.Bitmap.Bitmap := B1; 39 | B2.Canvas.Fill.Bitmap.WrapMode := TWrapMode.TileStretch; 40 | B2.Canvas.Fill.Kind := TBrushKind.Bitmap; 41 | B2.Canvas.FillRect(RectF(0, 0, B2.Width, B2.Height), 30, 30, AllCorners, 1); 42 | B2.Canvas.EndScene; 43 | Image1.Bitmap.Assign(B2); 44 | finally 45 | B1.Free; 46 | B2.Free; 47 | end; 48 | end; 49 | 50 | end. 51 | -------------------------------------------------------------------------------- /ScanCodeDemo/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | 11 | <%uses-permission%> 12 | 13 | 21 | 22 | <%application-meta-data%> 23 | 25 | 29 | 30 | 32 | 33 | 34 | 35 | 36 | 37 | <%activity%> 38 | 39 | <%receivers%> 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /ScanCodeDemo/Entitlement.TemplateiOS.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | <%getTaskAllowKey%> 6 | <%applicationIdentifier%> 7 | <%pushNotificationKey%> 8 | <%keychainAccessGroups%> 9 | 10 | 11 | -------------------------------------------------------------------------------- /ScanCodeDemo/Fast/FastUtils.pas: -------------------------------------------------------------------------------- 1 | unit FastUtils; 2 | { Optimized Delphi routines for RGBA<>BGRA conversion, YV12>RGBA conversion and 3 | bitmap rotation } 4 | 5 | interface 6 | 7 | { Swaps the Red and Blue components of pixels in a memory buffer. 8 | 9 | Parameters: 10 | ASrc: points to the source buffer containing the pixels to convert. 11 | ADst: points to the destination buffer for the converted pixels. May be 12 | the same as ASrc. 13 | APixelCount: the number of pixels to convert. 14 | 15 | The Src and Dst buffers must have room for at least PixelCount * 4 bytes. } 16 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 17 | 18 | { Converts a buffer from YV12 format to RGBA format. 19 | 20 | Parameters: 21 | AYPtr: pointer to the source Y (luminance) plane 22 | AUPtr: pointer to the source U (chrominance) plane 23 | AVPtr: pointer to the source V (chrominance) plane 24 | ARGBAPtr: pointer to the target interleaved RGBA buffer 25 | AYStride: number of bytes between two rows in the Y plane 26 | AUVStride: number of bytes between two rows in the U and V planes 27 | ARGBAStride: number of bytes between two rows in the RGBA buffer 28 | AWidth: width of the image to convert (must be even). 29 | AHeight: height of the image to convert (must be even). 30 | 31 | The buffers must be large enough to accomodate AWidth * AHeight pixels in 32 | their corresponding format. 33 | 34 | The alpha values will be set to $FF (opaque) 35 | 36 | NOTE: Currently, this procedure only works when AWidth is a multiple of 16 and 37 | AHeight is a multiple of 2. If this is not the case, then some rightmost and 38 | bottommost pixels will not get converted. } 39 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 40 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 41 | 42 | { Rotates a 32-bit bitmap 0, 90, 180 or 270 degrees. 43 | 44 | Parameters: 45 | ASrc: pointer to the source bitmap data 46 | ADst: pointer to the target bitmap data. This must be different than ASrc. 47 | The ASrc and ADst buffers may not share any data. 48 | ASrcWidth: width of the source bitmap (must be a multiple of 4) 49 | ASrcHeight: height of the source bitmap (must be a multiple of 4) 50 | AAngle: the angle of rotation (0, 90, 180 or 270) 51 | 52 | When rotating 0 or 180 degrees, the dimensions of ADst must match the 53 | dimensions of ASrc. When rotating 90 or 270 degrees, the width of ASrc must 54 | match the height of ADst and the height of ASrc must match the width of ADst. 55 | 56 | Furthermore, this routine expects the dimensions to be a multiple of 4. If 57 | not, an assertion will be raised and the results may be unpredictable. } 58 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 59 | ASrcHeight: Integer; const AAngle: Integer); 60 | 61 | implementation 62 | 63 | uses 64 | System.UITypes; 65 | 66 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 67 | var 68 | I: Integer; 69 | S, D: PAlphaColorRec; 70 | Temp: Byte; 71 | begin 72 | if (ASrc = ADst) then 73 | begin 74 | D := ADst; 75 | for I := 0 to APixelCount - 1 do 76 | begin 77 | Temp := D.B; 78 | D.B := D.R; 79 | D.R := Temp; 80 | Inc(D); 81 | end; 82 | end 83 | else 84 | begin 85 | S := ASrc; 86 | D := ADst; 87 | for I := 0 to APixelCount - 1 do 88 | begin 89 | D.B := S.R; 90 | D.G := S.G; 91 | D.R := S.B; 92 | D.A := S.A; 93 | Inc(S); 94 | Inc(D); 95 | end; 96 | end; 97 | end; 98 | 99 | const 100 | SHIFT = 6; 101 | MAX_VAL = (256 shl SHIFT) - 1; 102 | 103 | function Clip(const AValue: Integer): Integer; inline; 104 | begin 105 | if (AValue < 0) then 106 | Result := 0 107 | else if (AValue > MAX_VAL) then 108 | Result := MAX_VAL 109 | else 110 | Result := AValue; 111 | end; 112 | 113 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 114 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 115 | { This version uses relative low-precision 2.6 integer arithmetic to match the 116 | NEON version. 117 | 118 | Formulas: 119 | R := 1.164*(Y-16) + 1.596*(V-128) 120 | G := 1.164*(Y-16) - 0.391*(U-128) - 0.813*(V-128) 121 | B := 1.164*(Y-16) + 2.018*(U-128) 122 | 123 | We use 2.6 integer arithmetic, so the formulas become: 124 | R := (74*(Y-16) + 102*(V-128)) shr 6 125 | G := (74*(Y-16) - 25*(U-128) - 52*(V-128)) shr 6 126 | B := (74*(Y-16) + 129*(U-128) ) shr 6 127 | 128 | NOTE: we use "127*(U-128)" instead of "129*(U-128)" to match the ARM SIMD 129 | version. } 130 | const 131 | Y_BIAS = 16; 132 | UV_BIAS = 128; 133 | 134 | U_TO_G = 25; 135 | U_TO_B = 127; // Should be 129 136 | V_TO_R = 102; 137 | V_TO_G = 52; 138 | Y_TO_RGB = 74; 139 | 140 | R_INDEX = 0; 141 | G_INDEX = 1; 142 | B_INDEX = 2; 143 | A_INDEX = 3; 144 | var 145 | PaddedWidth, RGBAExtra, YExtra, UVExtra, Row, Col, Y, U, V: Integer; 146 | VtoR, UtoB, UVtoG: Integer; 147 | YPtr, UPtr, VPtr, RGBA: PByte; 148 | begin 149 | if (AWidth <= 0) or (AHeight <= 0) then 150 | Exit; 151 | 152 | Assert(Assigned(AYPtr)); 153 | Assert(Assigned(AUPtr)); 154 | Assert(Assigned(AVPtr)); 155 | Assert(Assigned(ARGBAPtr)); 156 | Assert(AYStride > 0); 157 | Assert(AUVStride > 0); 158 | Assert(ARGBAStride > 0); 159 | Assert((AWidth and 1) = 0); 160 | Assert((AHeight and 1) = 0); 161 | 162 | PaddedWidth := (AWidth + 1) and (not 1); 163 | RGBAExtra := (ARGBAStride - (4 * PaddedWidth)) + ARGBAStride; 164 | YExtra := (AYStride - PaddedWidth) + AYStride; 165 | UVExtra := AUVStride - (PaddedWidth shr 1); 166 | 167 | YPtr := AYPtr; 168 | UPtr := AUPtr; 169 | VPtr := AVPtr; 170 | RGBA := ARGBAPtr; 171 | 172 | Row := 0; 173 | while (Row < AHeight) do 174 | begin 175 | Col := 0; 176 | while (Col < AWidth) do 177 | begin 178 | U := UPtr[0] - UV_BIAS; 179 | V := VPtr[0] - UV_BIAS; 180 | 181 | VtoR := V_TO_R * V; 182 | UVtoG := (U_TO_G * U) + (V_TO_G * V); 183 | UtoB := U_TO_B * U; 184 | 185 | Y := (YPtr[0] - Y_BIAS) * Y_TO_RGB; 186 | RGBA[R_INDEX] := Clip(Y + VtoR) shr SHIFT; 187 | RGBA[G_INDEX] := Clip(Y - UVtoG) shr SHIFT; 188 | RGBA[B_INDEX] := Clip(Y + UtoB) shr SHIFT; 189 | RGBA[A_INDEX] := $FF; 190 | 191 | Y := (YPtr[1] - Y_BIAS) * Y_TO_RGB; 192 | RGBA[R_INDEX + 4] := Clip(Y + VtoR) shr SHIFT; 193 | RGBA[G_INDEX + 4] := Clip(Y - UVtoG) shr SHIFT; 194 | RGBA[B_INDEX + 4] := Clip(Y + UtoB) shr SHIFT; 195 | RGBA[A_INDEX + 4] := $FF; 196 | 197 | Y := (YPtr[AYStride] - Y_BIAS) * Y_TO_RGB; 198 | RGBA[ARGBAStride + R_INDEX] := Clip(Y + VtoR) shr SHIFT; 199 | RGBA[ARGBAStride + G_INDEX] := Clip(Y - UVtoG) shr SHIFT; 200 | RGBA[ARGBAStride + B_INDEX] := Clip(Y + UtoB) shr SHIFT; 201 | RGBA[ARGBAStride + A_INDEX] := $FF; 202 | 203 | Y := (YPtr[AYStride + 1] - Y_BIAS) * Y_TO_RGB; 204 | RGBA[ARGBAStride + R_INDEX + 4] := Clip(Y + VtoR) shr SHIFT; 205 | RGBA[ARGBAStride + G_INDEX + 4] := Clip(Y - UVtoG) shr SHIFT; 206 | RGBA[ARGBAStride + B_INDEX + 4] := Clip(Y + UtoB) shr SHIFT; 207 | RGBA[ARGBAStride + A_INDEX + 4] := $FF; 208 | 209 | Inc(RGBA, 8); 210 | Inc(YPtr, 2); 211 | Inc(UPtr); 212 | Inc(VPtr); 213 | Inc(Col, 2); 214 | end; 215 | Inc(RGBA, RGBAExtra); 216 | Inc(YPtr, YExtra); 217 | Inc(UPtr, UVExtra); 218 | Inc(VPtr, UVExtra); 219 | Inc(Row, 2); 220 | end; 221 | end; 222 | 223 | procedure RotateBitmap0Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 224 | ASrcHeight: Integer); 225 | begin 226 | Move(ASrc^, ADst^, ASrcWidth * ASrcHeight * 4); 227 | end; 228 | 229 | procedure RotateBitmap90Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 230 | ASrcHeight: Integer); 231 | var 232 | S, D: PCardinal; 233 | DstX, DstY, DstDelta: Integer; 234 | begin 235 | S := ASrc; 236 | D := ADst; 237 | Inc(D, ASrcHeight - 1); 238 | 239 | DstDelta := (ASrcWidth * ASrcHeight) + 1; 240 | for DstX := 0 to ASrcHeight - 1 do 241 | begin 242 | for DstY := 0 to ASrcWidth - 1 do 243 | begin 244 | D^ := S^; 245 | Inc(S); 246 | Inc(D, ASrcHeight); 247 | end; 248 | Dec(D, DstDelta); 249 | end; 250 | end; 251 | 252 | procedure RotateBitmap180Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 253 | ASrcHeight: Integer); 254 | var 255 | S, D: PCardinal; 256 | I: Integer; 257 | begin 258 | S := ASrc; 259 | D := ADst; 260 | Inc(D, (ASrcWidth * ASrcHeight) - 1); 261 | for I := 0 to (ASrcWidth * ASrcHeight) - 1 do 262 | begin 263 | D^ := S^; 264 | Inc(S); 265 | Dec(D); 266 | end; 267 | end; 268 | 269 | procedure RotateBitmap270Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 270 | ASrcHeight: Integer); 271 | var 272 | S, D: PCardinal; 273 | DstX, DstY, SrcDelta: Integer; 274 | begin 275 | S := ASrc; 276 | D := ADst; 277 | Inc(S, ASrcWidth - 1); 278 | 279 | SrcDelta := (ASrcHeight * ASrcWidth) + 1; 280 | for DstY := 0 to ASrcWidth - 1 do 281 | begin 282 | for DstX := 0 to ASrcHeight - 1 do 283 | begin 284 | D^ := S^; 285 | Inc(S, ASrcWidth); 286 | Inc(D); 287 | end; 288 | Dec(S, SrcDelta); 289 | end; 290 | end; 291 | 292 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 293 | ASrcHeight: Integer; const AAngle: Integer); 294 | begin 295 | if (ASrcWidth <= 0) or (ASrcHeight <= 0) then 296 | Exit; 297 | 298 | Assert(Assigned(ASrc)); 299 | Assert(Assigned(ADst)); 300 | Assert((ASrcHeight and 3) = 0); 301 | Assert((ASrcWidth and 3) = 0); 302 | 303 | case AAngle of 304 | 0: RotateBitmap0Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 305 | 90: RotateBitmap90Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 306 | 180: RotateBitmap180Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 307 | 270: RotateBitmap270Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 308 | else 309 | Assert(False); 310 | end; 311 | end; 312 | 313 | end. 314 | -------------------------------------------------------------------------------- /ScanCodeDemo/QMScanCode.fmx: -------------------------------------------------------------------------------- 1 | object QMScanCodeForm: TQMScanCodeForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 562 6 | ClientWidth = 401 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnActivate = FormActivate 11 | OnCreate = FormCreate 12 | OnClose = FormClose 13 | OnDestroy = FormDestroy 14 | OnShow = FormShow 15 | DesignerMasterStyle = 0 16 | object CameraComponent1: TCameraComponent 17 | Kind = BackCamera 18 | OnSampleBufferReady = CameraComponent1SampleBufferReady 19 | Left = 160 20 | Top = 96 21 | end 22 | object pbCamera: TPaintBox 23 | Align = Contents 24 | Size.Width = 401.000000000000000000 25 | Size.Height = 562.000000000000000000 26 | Size.PlatformDefault = False 27 | OnPaint = pbCameraPaint 28 | object lytScanMask: TLayout 29 | Align = Client 30 | Size.Width = 401.000000000000000000 31 | Size.Height = 562.000000000000000000 32 | Size.PlatformDefault = False 33 | OnResize = lytScanMaskResize 34 | object rectTop: TRectangle 35 | Align = Top 36 | Fill.Color = x80000000 37 | Size.Width = 401.000000000000000000 38 | Size.Height = 130.000000000000000000 39 | Size.PlatformDefault = False 40 | Stroke.Kind = None 41 | end 42 | object rectLeft: TRectangle 43 | Align = Left 44 | Fill.Color = x80000000 45 | Position.Y = 130.000000000000000000 46 | Size.Width = 120.000000000000000000 47 | Size.Height = 302.000000000000000000 48 | Size.PlatformDefault = False 49 | Stroke.Kind = None 50 | end 51 | object rectRight: TRectangle 52 | Align = Right 53 | Fill.Color = x80000000 54 | Position.X = 281.000000000000000000 55 | Position.Y = 130.000000000000000000 56 | Size.Width = 120.000000000000000000 57 | Size.Height = 302.000000000000000000 58 | Size.PlatformDefault = False 59 | Stroke.Kind = None 60 | end 61 | object rectBottom: TRectangle 62 | Align = Bottom 63 | Fill.Color = x80000000 64 | Position.Y = 432.000000000000000000 65 | Size.Width = 401.000000000000000000 66 | Size.Height = 130.000000000000000000 67 | Size.PlatformDefault = False 68 | Stroke.Kind = None 69 | object Text1: TText 70 | Align = Top 71 | Margins.Top = 10.000000000000000000 72 | Position.Y = 10.000000000000000000 73 | Size.Width = 401.000000000000000000 74 | Size.Height = 49.000000000000000000 75 | Size.PlatformDefault = False 76 | Text = #23558#20108#32500#30721#25918#20837#26694#20869#65292#21363#21487#33258#21160#25195#25551 77 | TextSettings.Font.Size = 14.000000000000000000 78 | TextSettings.FontColor = claWhite 79 | TextSettings.VertAlign = Leading 80 | end 81 | end 82 | object lytScanWindow: TRectangle 83 | Align = Client 84 | Fill.Kind = None 85 | Size.Width = 161.000000000000000000 86 | Size.Height = 302.000000000000000000 87 | Size.PlatformDefault = False 88 | Stroke.Color = claWhite 89 | object rectIndicator: TRectangle 90 | Fill.Kind = Gradient 91 | Fill.Gradient.Points = < 92 | item 93 | Color = claWhite 94 | Offset = 0.000000000000000000 95 | end 96 | item 97 | Color = claBlue 98 | Offset = 0.180124223232269300 99 | end 100 | item 101 | Color = claBlue 102 | Offset = 0.493788808584213300 103 | end 104 | item 105 | Color = claBlue 106 | Offset = 0.807453393936157200 107 | end 108 | item 109 | Color = claWhite 110 | Offset = 1.000000000000000000 111 | end> 112 | Fill.Gradient.StartPosition.X = 1.000000000000000000 113 | Fill.Gradient.StartPosition.Y = 0.499999970197677600 114 | Fill.Gradient.StopPosition.Y = 0.500000059604644800 115 | Position.X = 10.000000000000000000 116 | Position.Y = 20.000000000000000000 117 | Size.Width = 120.000000000000000000 118 | Size.Height = 2.000000000000000000 119 | Size.PlatformDefault = False 120 | Stroke.Kind = None 121 | Stroke.Thickness = 2.000000000000000000 122 | object FloatAnimation1: TFloatAnimation 123 | Enabled = True 124 | Duration = 2.000000000000000000 125 | Loop = True 126 | PropertyName = 'Position.Y' 127 | StartValue = 0.000000000000000000 128 | StopValue = 0.000000000000000000 129 | end 130 | end 131 | object rectLefTop: TRectangle 132 | Fill.Color = claWhite 133 | Size.Width = 8.000000000000000000 134 | Size.Height = 20.000000000000000000 135 | Size.PlatformDefault = False 136 | Stroke.Kind = None 137 | end 138 | object rectTopRight: TRectangle 139 | Anchors = [akTop, akRight] 140 | Fill.Color = claWhite 141 | Position.X = 141.000000000000000000 142 | Size.Width = 20.000000000000000000 143 | Size.Height = 8.000000000000000000 144 | Size.PlatformDefault = False 145 | Stroke.Kind = None 146 | end 147 | object rectLeftBottom: TRectangle 148 | Anchors = [akLeft, akBottom] 149 | Fill.Color = claWhite 150 | Position.Y = 282.000000000000000000 151 | Size.Width = 8.000000000000000000 152 | Size.Height = 20.000000000000000000 153 | Size.PlatformDefault = False 154 | Stroke.Kind = None 155 | end 156 | object rectRightTop: TRectangle 157 | Anchors = [akTop, akRight] 158 | Fill.Color = claWhite 159 | Position.X = 153.000000000000000000 160 | Size.Width = 8.000000000000000000 161 | Size.Height = 20.000000000000000000 162 | Size.PlatformDefault = False 163 | Stroke.Kind = None 164 | end 165 | object rectTopLeft: TRectangle 166 | Fill.Color = claWhite 167 | Size.Width = 20.000000000000000000 168 | Size.Height = 8.000000000000000000 169 | Size.PlatformDefault = False 170 | Stroke.Kind = None 171 | end 172 | object rectRightBottom: TRectangle 173 | Anchors = [akRight, akBottom] 174 | Fill.Color = claWhite 175 | Position.X = 153.000000000000000000 176 | Position.Y = 282.000000000000000000 177 | Size.Width = 8.000000000000000000 178 | Size.Height = 20.000000000000000000 179 | Size.PlatformDefault = False 180 | Stroke.Kind = None 181 | end 182 | object Rectangle5: TRectangle 183 | Anchors = [akLeft, akBottom] 184 | Fill.Color = claWhite 185 | Position.Y = 294.000000000000000000 186 | Size.Width = 20.000000000000000000 187 | Size.Height = 8.000000000000000000 188 | Size.PlatformDefault = False 189 | Stroke.Kind = None 190 | end 191 | object Rectangle6: TRectangle 192 | Anchors = [akRight, akBottom] 193 | Fill.Color = claWhite 194 | Position.X = 141.000000000000000000 195 | Position.Y = 294.000000000000000000 196 | Size.Width = 20.000000000000000000 197 | Size.Height = 8.000000000000000000 198 | Size.PlatformDefault = False 199 | Stroke.Kind = None 200 | end 201 | end 202 | end 203 | end 204 | object Layout1: TRectangle 205 | Align = Top 206 | Fill.Color = x80000000 207 | Size.Width = 401.000000000000000000 208 | Size.Height = 48.000000000000000000 209 | Size.PlatformDefault = False 210 | Stroke.Kind = None 211 | object btnBack: TSpeedButton 212 | Align = Left 213 | ModalResult = 2 214 | Margins.Left = 10.000000000000000000 215 | Position.X = 10.000000000000000000 216 | Size.Width = 48.000000000000000000 217 | Size.Height = 48.000000000000000000 218 | Size.PlatformDefault = False 219 | StyleLookup = 'backtoolbutton' 220 | Text = #36820#22238 221 | TouchTargetExpansion.Left = 10.000000000000000000 222 | end 223 | end 224 | object Rectangle1: TRectangle 225 | Align = Bottom 226 | Fill.Color = x80000000 227 | Position.Y = 514.000000000000000000 228 | Size.Width = 401.000000000000000000 229 | Size.Height = 48.000000000000000000 230 | Size.PlatformDefault = False 231 | Stroke.Kind = None 232 | object LabelFPS: TLabel 233 | Align = Client 234 | StyledSettings = [Family, Size, Style] 235 | Size.Width = 152.000000000000000000 236 | Size.Height = 48.000000000000000000 237 | Size.PlatformDefault = False 238 | TextSettings.FontColor = claWhite 239 | Text = 'LabelFPS' 240 | end 241 | object lblResult: TLabel 242 | Align = Right 243 | StyledSettings = [Family, Size, Style] 244 | Position.X = 152.000000000000000000 245 | Size.Width = 249.000000000000000000 246 | Size.Height = 48.000000000000000000 247 | Size.PlatformDefault = False 248 | TextSettings.FontColor = claWhite 249 | end 250 | end 251 | object MediaPlayer1: TMediaPlayer 252 | Left = 344 253 | Top = 264 254 | end 255 | object ActionList1: TActionList 256 | Left = 184 257 | Top = 264 258 | object TakePhotoFromLibraryAction1: TTakePhotoFromLibraryAction 259 | Category = 'Media Library' 260 | end 261 | end 262 | end 263 | -------------------------------------------------------------------------------- /ScanCodeDemo/SIMD/FastUtils.pas: -------------------------------------------------------------------------------- 1 | unit FastUtils; 2 | { NEON/Arm64 optimized assembly routines for RGBA<>BGRA conversion, YV12>RGBA 3 | conversion and bitmap rotation } 4 | 5 | interface 6 | 7 | {$IFDEF IOS} 8 | { Swaps the Red and Blue components of pixels in a memory buffer. 9 | 10 | Parameters: 11 | ASrc: points to the source buffer containing the pixels to convert. 12 | ADst: points to the destination buffer for the converted pixels. May be 13 | the same as ASrc. 14 | APixelCount: the number of pixels to convert. 15 | 16 | The Src and Dst buffers must have room for at least PixelCount * 4 bytes. } 17 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 18 | {$ENDIF} 19 | 20 | {$IFDEF ANDROID} 21 | { Converts a buffer from YV12 format to RGBA format. 22 | 23 | Parameters: 24 | AYPtr: pointer to the source Y (luminance) plane 25 | AUPtr: pointer to the source U (chrominance) plane 26 | AVPtr: pointer to the source V (chrominance) plane 27 | ARGBAPtr: pointer to the target interleaved RGBA buffer 28 | AYStride: number of bytes between two rows in the Y plane 29 | AUVStride: number of bytes between two rows in the U and V planes 30 | ARGBAStride: number of bytes between two rows in the RGBA buffer 31 | AWidth: width of the image to convert (must be even). 32 | AHeight: height of the image to convert (must be even). 33 | 34 | The buffers must be large enough to accomodate AWidth * AHeight pixels in 35 | their corresponding format. 36 | 37 | The alpha values will be set to $FF (opaque) 38 | 39 | NOTE: Currently, this procedure only works when AWidth is a multiple of 16 and 40 | AHeight is a multiple of 2. If this is not the case, then some rightmost and 41 | bottommost pixels will not get converted. } 42 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 43 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 44 | 45 | { Rotates a 32-bit bitmap 0, 90, 180 or 270 degrees. 46 | 47 | Parameters: 48 | ASrc: pointer to the source bitmap data 49 | ADst: pointer to the target bitmap data. This must be different than ASrc. 50 | The ASrc and ADst buffers may not share any data. 51 | ASrcWidth: width of the source bitmap (must be a multiple of 4) 52 | ASrcHeight: height of the source bitmap (must be a multiple of 4) 53 | AAngle: the angle of rotation (0, 90, 180 or 270) 54 | 55 | When rotating 0 or 180 degrees, the dimensions of ADst must match the 56 | dimensions of ASrc. When rotating 90 or 270 degrees, the width of ASrc must 57 | match the height of ADst and the height of ASrc must match the width of ADst. 58 | 59 | Furthermore, this routine expects the dimensions to be a multiple of 4. If 60 | not, an assertion will be raised and the results may be unpredictable. } 61 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 62 | ASrcHeight: Integer; const AAngle: Integer); 63 | {$ENDIF} 64 | 65 | implementation 66 | 67 | uses 68 | System.UITypes; 69 | 70 | const 71 | {$IF Defined(IOS)} 72 | LIB_FAST_UTILS = 'libfastutils.a'; 73 | _PU = ''; 74 | {$ELSEIF Defined(ANDROID)} 75 | LIB_FAST_UTILS = 'libfastutils-android.a'; 76 | _PU = '_'; 77 | {$ENDIF} 78 | 79 | {$IFDEF IOS} 80 | procedure swap_rb(ASrc, ADst: Pointer; ACount: Integer); cdecl; 81 | external LIB_FAST_UTILS name _PU + 'swap_rb'; 82 | 83 | procedure SwapRB(const ASrc, ADst: Pointer; const APixelCount: Integer); 84 | var 85 | NeonCount, Remainder: Integer; 86 | S, D: PAlphaColorRec; 87 | Temp: Byte; 88 | begin 89 | NeonCount := APixelCount shr 4; 90 | Remainder := APixelCount and 15; 91 | 92 | if (NeonCount > 0) then 93 | swap_rb(ASrc, ADst, NeonCount); 94 | 95 | if (Remainder > 0) then 96 | begin 97 | S := ASrc; 98 | D := ADst; 99 | Inc(S, NeonCount * 16); 100 | Inc(D, NeonCount * 16); 101 | if (ASrc = ADst) then 102 | begin 103 | while (Remainder > 0) do 104 | begin 105 | Temp := D.B; 106 | D.B := D.R; 107 | D.R := Temp; 108 | Inc(D); 109 | Dec(Remainder); 110 | end; 111 | end 112 | else 113 | begin 114 | while (Remainder > 0) do 115 | begin 116 | D.B := S.R; 117 | D.G := S.G; 118 | D.R := S.B; 119 | D.A := S.A; 120 | Inc(S); 121 | Inc(D); 122 | Dec(Remainder); 123 | end; 124 | end; 125 | end; 126 | end; 127 | {$ENDIF} 128 | 129 | {$IFDEF ANDROID} 130 | procedure yv12_to_rgba(AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 131 | AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); cdecl; 132 | external LIB_FAST_UTILS name _PU + 'yv12_to_rgba'; 133 | 134 | procedure YV12ToRGBA(const AYPtr, AUPtr, AVPtr, ARGBAPtr: Pointer; 135 | const AYStride, AUVStride, ARGBAStride, AWidth, AHeight: Integer); 136 | begin 137 | yv12_to_rgba(AYPtr, AUPtr, AVPtr, ARGBAPtr, AYStride, AUVStride, 138 | ARGBAStride, AWidth and (not 15), AHeight and (not 1)); 139 | end; 140 | 141 | procedure RotateBitmap0Degrees(const ASrc, ADst: Pointer; const ASrcWidth, 142 | ASrcHeight: Integer); 143 | begin 144 | Move(ASrc^, ADst^, ASrcWidth * ASrcHeight * 4); 145 | end; 146 | 147 | procedure RotateBitmap90Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 148 | external LIB_FAST_UTILS name _PU + 'rotate_90'; 149 | 150 | procedure RotateBitmap180Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 151 | external LIB_FAST_UTILS name _PU + 'rotate_180'; 152 | 153 | procedure RotateBitmap270Degrees(ASrc, ADst: Pointer; ASrcWidth, ASrcHeight: Integer); cdecl; 154 | external LIB_FAST_UTILS name _PU + 'rotate_270'; 155 | 156 | procedure RotateBitmap(const ASrc, ADst: Pointer; const ASrcWidth, 157 | ASrcHeight: Integer; const AAngle: Integer); 158 | begin 159 | if (ASrcWidth <= 0) or (ASrcHeight <= 0) then 160 | Exit; 161 | 162 | Assert(Assigned(ASrc)); 163 | Assert(Assigned(ADst)); 164 | Assert((ASrcHeight and 3) = 0); 165 | Assert((ASrcWidth and 3) = 0); 166 | 167 | case AAngle of 168 | 0: RotateBitmap0Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 169 | 90: RotateBitmap90Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 170 | 180: RotateBitmap180Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 171 | 270: RotateBitmap270Degrees(ASrc, ADst, ASrcWidth, ASrcHeight); 172 | else 173 | Assert(False); 174 | end; 175 | end; 176 | {$ENDIF} 177 | 178 | end. 179 | -------------------------------------------------------------------------------- /ScanCodeDemo/SIMD/libfastutils-android.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/ScanCodeDemo/SIMD/libfastutils-android.a -------------------------------------------------------------------------------- /ScanCodeDemo/SIMD/libfastutils.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/ScanCodeDemo/SIMD/libfastutils.a -------------------------------------------------------------------------------- /ScanCodeDemo/ScanCodeDemo.dpr: -------------------------------------------------------------------------------- 1 | program ScanCodeDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | QMScanCode in 'QMScanCode.pas' {QMScanCodeForm}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TQMScanCodeForm, QMScanCodeForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /ScanCodeDemo/readme.md: -------------------------------------------------------------------------------- 1 | 本 demo优化了相机的聚焦和扫描，识别部分使用的还是zxing，需要下载ZXing.Delphi进行编译 2 | 3 | ZXing.Delphi项目地址： 4 | https://github.com/Spelt/ZXing.Delphi 5 |   6 | 支持Berlin版本，如果SIMD版本出现问题，选择Fast版本，其他问题可到QQ群咨询，群号：165232328 7 | -------------------------------------------------------------------------------- /ScanCodeDemo/res/raw/beep.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/ScanCodeDemo/res/raw/beep.ogg -------------------------------------------------------------------------------- /TestButton/Main.fmx: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Button by Aone' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | StyleBook = StyleBook1 8 | FormFactor.Width = 320 9 | FormFactor.Height = 480 10 | FormFactor.Devices = [Desktop] 11 | DesignerMasterStyle = 0 12 | object Rectangle1: TRectangle 13 | Fill.Color = claBrown 14 | HitTest = False 15 | Position.X = 5.000000000000000000 16 | Position.Y = 5.000000000000000000 17 | Size.Width = 251.000000000000000000 18 | Size.Height = 145.000000000000000000 19 | Size.PlatformDefault = False 20 | Stroke.Kind = None 21 | XRadius = 20.000000000000000000 22 | YRadius = 20.000000000000000000 23 | object Rectangle2: TRectangle 24 | Align = Client 25 | Fill.Color = claRed 26 | Margins.Bottom = 5.000000000000000000 27 | Size.Width = 251.000000000000000000 28 | Size.Height = 140.000000000000000000 29 | Size.PlatformDefault = False 30 | Stroke.Kind = None 31 | XRadius = 20.000000000000000000 32 | YRadius = 20.000000000000000000 33 | OnMouseDown = Rectangle2MouseDown 34 | OnMouseUp = Rectangle2MouseUp 35 | OnMouseLeave = Rectangle2MouseLeave 36 | object Text1: TText 37 | Align = Client 38 | HitTest = False 39 | Size.Width = 251.000000000000000000 40 | Size.Height = 140.000000000000000000 41 | Size.PlatformDefault = False 42 | Text = 'test' 43 | TextSettings.Font.Size = 50.000000000000000000 44 | TextSettings.FontColor = claWhite 45 | end 46 | object FloatAnimation1: TFloatAnimation 47 | Duration = 0.200000002980232200 48 | PropertyName = 'Margins.Bottom' 49 | StartValue = 5.000000000000000000 50 | StopValue = 0.000000000000000000 51 | Trigger = 'IsMouseOver=true' 52 | TriggerInverse = 'IsMouseOver=false' 53 | end 54 | end 55 | object ShadowEffect1: TShadowEffect 56 | Distance = 3.000000000000000000 57 | Direction = 45.000000000000000000 58 | Softness = 0.300000011920929000 59 | Opacity = 0.600000023841857900 60 | ShadowColor = claBlack 61 | end 62 | end 63 | object btn1: TButton 64 | Position.X = 288.000000000000000000 65 | Position.Y = 8.000000000000000000 66 | Size.Width = 249.000000000000000000 67 | Size.Height = 145.000000000000000000 68 | Size.PlatformDefault = False 69 | StyleLookup = 'btn1Style1' 70 | TabOrder = 0 71 | Text = 'test' 72 | end 73 | object StyleBook1: TStyleBook 74 | Styles = < 75 | item 76 | end 77 | item 78 | Platform = 'Windows 10 Desktop' 79 | ResourcesBin = { 80 | 464D585F5354594C4520322E3501060A62746E315374796C6531032507060A62 81 | 746E325374796C6531031E07005450463007544C61796F757400095374796C65 82 | 4E616D65060A62746E315374796C65310A506F736974696F6E2E580500000000 83 | 0000009607400A506F736974696F6E2E5905000000000000009B07400A53697A 84 | 652E576964746805000000000000808807400B53697A652E4865696768740500 85 | 000000000000C205401453697A652E506C6174666F726D44656661756C740808 86 | 5461624F726465720200000A5452656374616E676C6500095374796C654E616D 87 | 65060A6261636B67726F756E6405416C69676E0708436F6E74656E74730A4669 88 | 6C6C2E436F6C6F720708636C6142726F776E0748697454657374080A53697A65 89 | 2E576964746805000000000000808807400B53697A652E486569676874050000 90 | 0000000000C205401453697A652E506C6174666F726D44656661756C74080B53 91 | 74726F6B652E4B696E6407044E6F6E6507585261646975730500000000000000 92 | A0034007595261646975730500000000000000A00340000A5452656374616E67 93 | 6C6507546F7052656374095374796C654E616D65060F72656374616E676C6531 94 | 7374796C6505416C69676E0708436F6E74656E74730A46696C6C2E436F6C6F72 95 | 0706636C615265640748697454657374080E4D617267696E732E426F74746F6D 96 | 0500000000000000A001400A53697A652E576964746805000000000000808807 97 | 400B53697A652E4865696768740500000000000000B805401453697A652E506C 98 | 6174666F726D44656661756C74080B5374726F6B652E4B696E6407044E6F6E65 99 | 07585261646975730500000000000000A0034007595261646975730500000000 100 | 000000A00340000F54466C6F6174416E696D6174696F6E00095374796C654E61 101 | 6D650614666C6F6174616E696D6174696F6E317374796C65084475726174696F 102 | 6E050000000000CDCCCCFA3F0C50726F70657274794E616D650616546F705265 103 | 63742E4D617267696E732E426F74746F6D0A537461727456616C756505000000 104 | 00000000A001400953746F7056616C7565050000000000000000000007547269 105 | 67676572060E4973507265737365643D747275650E54726967676572496E7665 106 | 727365060F4973507265737365643D66616C7365000000000654476C79706800 107 | 095374796C654E616D65060A676C7970687374796C650C4D617267696E732E4C 108 | 6566740500000000000000C000400B4D617267696E732E546F70050000000000 109 | 00008000400D4D617267696E732E5269676874050000000000000080FF3F0E4D 110 | 617267696E732E426F74746F6D050000000000000080004005416C69676E0704 111 | 4C6566740A53697A652E576964746805000000000000008003400B53697A652E 112 | 48656967687405000000000000008003401453697A652E506C6174666F726D44 113 | 656661756C740800001654427574746F6E5374796C65546578744F626A656374 114 | 00095374796C654E616D6506047465787405416C69676E0706436C69656E7406 115 | 4C6F636B6564090C4D617267696E732E4C656674050000000000000080FF3F0B 116 | 4D617267696E732E546F7005000000000000008000400D4D617267696E732E52 117 | 69676874050000000000000080FF3F0E4D617267696E732E426F74746F6D0500 118 | 0000000000008000400A53697A652E576964746805000000000000808707400B 119 | 53697A652E4865696768740500000000000000BA05401453697A652E506C6174 120 | 666F726D44656661756C7408165465787453657474696E67732E466F6E742E53 121 | 697A650500000000000000C80440165465787453657474696E67732E466F6E74 122 | 436F6C6F720708636C6157686974650C536861646F772E436F6C6F7207097834 123 | 3030303030303010536861646F772E4F66667365742E594902FD0D536861646F 124 | 7756697369626C650908486F74436F6C6F720708636C6157686974650F486F74 125 | 536861646F772E436F6C6F72070978343030303030303013486F74536861646F 126 | 772E4F66667365742E594902FD0C466F6375736564436F6C6F720708636C6157 127 | 6869746513466F6375736564536861646F772E436F6C6F720709783430303030 128 | 30303017466F6375736564536861646F772E4F66667365742E594902FD0B4E6F 129 | 726D616C436F6C6F720708636C615768697465124E6F726D616C536861646F77 130 | 2E436F6C6F720709783430303030303030164E6F726D616C536861646F772E4F 131 | 66667365742E594902FD0C50726573736564436F6C6F720708636C6157686974 132 | 651350726573736564536861646F772E436F6C6F720709783430303030303030 133 | 1750726573736564536861646F772E4F66667365742E594902FD00000D545368 134 | 61646F7745666665637400095374796C654E616D650612736861646F77656666 135 | 656374317374796C650844697374616E63650500000000000000C00040094469 136 | 72656374696F6E0500000000000000B4044008536F66746E6573730500000000 137 | 009A9999FD3F074F7061636974790500000000009A9999FE3F0B536861646F77 138 | 436F6C6F720708636C61426C61636B0000005450463007544C61796F75740009 139 | 5374796C654E616D65060A62746E325374796C65310A506F736974696F6E2E58 140 | 0500000000000000C607400A506F736974696F6E2E590500000000000000AE07 141 | 400A53697A652E57696474680500000000000000A005400B53697A652E486569 142 | 6768740500000000000000B003401453697A652E506C6174666F726D44656661 143 | 756C74080756697369626C6508085461624F726465720201001254427574746F 144 | 6E5374796C654F626A65637400095374796C654E616D65060A6261636B67726F 145 | 756E6405416C69676E0708436F6E74656E74730C536F757263654C6F6F6B7570 146 | 061B57696E646F7773203130204465736B746F707374796C652E706E670A5369 147 | 7A652E57696474680500000000000000A005400B53697A652E48656967687405 148 | 00000000000000B003401453697A652E506C6174666F726D44656661756C7408 149 | 07486F744C696E6B0E010E436170496E736574732E4C65667405000000000000 150 | 00C000400D436170496E736574732E546F700500000000000000C000400F4361 151 | 70496E736574732E52696768740500000000000000C0004010436170496E7365 152 | 74732E426F74746F6D0500000000000000C000400F536F75726365526563742E 153 | 4C65667405000000000000008001400E536F75726365526563742E546F700500 154 | 000000000000C7064010536F75726365526563742E5269676874050000000000 155 | 0000A8054011536F75726365526563742E426F74746F6D0500000000000000E4 156 | 064000000B466F63757365644C696E6B0E010E436170496E736574732E4C6566 157 | 740500000000000000C000400D436170496E736574732E546F70050000000000 158 | 0000C000400F436170496E736574732E52696768740500000000000000C00040 159 | 10436170496E736574732E426F74746F6D0500000000000000C000400F536F75 160 | 726365526563742E4C65667405000000000000008001400E536F757263655265 161 | 63742E546F70050000000000008082074010536F75726365526563742E526967 162 | 68740500000000000000A8054011536F75726365526563742E426F74746F6D05 163 | 0000000000000091074000000A4E6F726D616C4C696E6B0E010E436170496E73 164 | 6574732E4C6566740500000000000000C000400D436170496E736574732E546F 165 | 700500000000000000C000400F436170496E736574732E526967687405000000 166 | 00000000C0004010436170496E736574732E426F74746F6D0500000000000000 167 | C000400F536F75726365526563742E4C65667405000000000000008001400E53 168 | 6F75726365526563742E546F700500000000000000A8064010536F7572636552 169 | 6563742E52696768740500000000000000A8054011536F75726365526563742E 170 | 426F74746F6D0500000000000000C5064000000B507265737365644C696E6B0E 171 | 010E436170496E736574732E4C6566740500000000000000C000400D43617049 172 | 6E736574732E546F700500000000000000C000400F436170496E736574732E52 173 | 696768740500000000000000C0004010436170496E736574732E426F74746F6D 174 | 0500000000000000C000400F536F75726365526563742E4C6566740500000000 175 | 0000008001400E536F75726365526563742E546F700500000000000000E60640 176 | 10536F75726365526563742E52696768740500000000000000A8054011536F75 177 | 726365526563742E426F74746F6D0500000000000080810740000013546F7563 178 | 68416E696D6174696F6E2E4C696E6B0E0000000654476C79706800095374796C 179 | 654E616D65060A676C7970687374796C650C4D617267696E732E4C6566740500 180 | 000000000000C000400B4D617267696E732E546F700500000000000000800040 181 | 0D4D617267696E732E5269676874050000000000000080FF3F0E4D617267696E 182 | 732E426F74746F6D050000000000000080004005416C69676E07044C6566740A 183 | 53697A652E576964746805000000000000008003400B53697A652E4865696768 184 | 7405000000000000008003401453697A652E506C6174666F726D44656661756C 185 | 740800001654427574746F6E5374796C65546578744F626A6563740009537479 186 | 6C654E616D6506047465787405416C69676E0706436C69656E74064C6F636B65 187 | 64090C4D617267696E732E4C656674050000000000000080FF3F0B4D61726769 188 | 6E732E546F7005000000000000008000400D4D617267696E732E526967687405 189 | 0000000000000080FF3F0E4D617267696E732E426F74746F6D05000000000000 190 | 008000400A53697A652E576964746805000000000000009C05400B53697A652E 191 | 48656967687405000000000000009003401453697A652E506C6174666F726D44 192 | 656661756C74080D536861646F7756697369626C650808486F74436F6C6F7207 193 | 08636C61426C61636B0C466F6375736564436F6C6F720708636C61426C61636B 194 | 0B4E6F726D616C436F6C6F720708636C61426C61636B0C50726573736564436F 195 | 6C6F720708636C61426C61636B000000} 196 | end> 197 | end 198 | end 199 | -------------------------------------------------------------------------------- /TestButton/Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/TestButton/Main.pas -------------------------------------------------------------------------------- /TestButton/TestButton.dpr: -------------------------------------------------------------------------------- 1 | program TestButton; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Main in 'Main.pas' {Form1}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Tools/ResConvert.bdsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | ResConvert.dpr 14 | 15 | 16 | 7.0 17 | 18 | 19 | 8 20 | 0 21 | 1 22 | 1 23 | 0 24 | 0 25 | 1 26 | 1 27 | 1 28 | 0 29 | 0 30 | 1 31 | 0 32 | 1 33 | 1 34 | 1 35 | 0 36 | 0 37 | 0 38 | 0 39 | 0 40 | 1 41 | 0 42 | 1 43 | 1 44 | 1 45 | True 46 | True 47 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 48 | 49 | False 50 | 51 | True 52 | True 53 | True 54 | True 55 | True 56 | True 57 | True 58 | True 59 | True 60 | True 61 | True 62 | True 63 | True 64 | True 65 | True 66 | True 67 | True 68 | True 69 | True 70 | True 71 | True 72 | True 73 | True 74 | True 75 | True 76 | True 77 | True 78 | True 79 | True 80 | True 81 | True 82 | True 83 | True 84 | True 85 | True 86 | True 87 | True 88 | True 89 | True 90 | True 91 | True 92 | True 93 | True 94 | True 95 | True 96 | True 97 | False 98 | False 99 | False 100 | True 101 | True 102 | True 103 | True 104 | True 105 | True 106 | True 107 | True 108 | True 109 | True 110 | True 111 | True 112 | True 113 | True 114 | True 115 | 116 | 117 | 118 | 0 119 | 0 120 | False 121 | 1 122 | False 123 | False 124 | False 125 | 16384 126 | 1048576 127 | 4194304 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | False 140 | 141 | 142 | 143 | 144 | 145 | False 146 | 147 | 148 | True 149 | False 150 | 151 | 152 | False 153 | 154 | 155 | False 156 | False 157 | 1 158 | 0 159 | 0 160 | 0 161 | False 162 | False 163 | False 164 | False 165 | False 166 | 2052 167 | 936 168 | 169 | 170 | 171 | 172 | 1.0.0.0 173 | 174 | 175 | 176 | 177 | 178 | 1.0.0.0 179 | 180 | 181 | 182 | 183 | 190 | 191 | -------------------------------------------------------------------------------- /Tools/ResConvert.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"C:\Users\Public\Documents\RAD Studio\5.0\Bpl" 35 | -LN"C:\Users\Public\Documents\RAD Studio\5.0\Dcp" 36 | -------------------------------------------------------------------------------- /Tools/ResConvert.dpr: -------------------------------------------------------------------------------- 1 | program ResConvert; 2 | 3 | uses 4 | Forms, 5 | ResConvertMain in 'ResConvertMain.pas' {Form5}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm5, Form5); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Tools/ResConvertMain.dfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 0 3 | Top = 0 4 | Caption = #20998#36776#29575#36716#25442 5 | ClientHeight = 240 6 | ClientWidth = 483 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object lbl1: TLabel 17 | Left = 256 18 | Top = 136 19 | Width = 16 20 | Height = 13 21 | Caption = 'lbl1' 22 | end 23 | object lbl2: TLabel 24 | Left = 104 25 | Top = 21 26 | Width = 24 27 | Height = 13 28 | Caption = #23485#24230 29 | end 30 | object lbl3: TLabel 31 | Left = 32 32 | Top = 83 33 | Width = 60 34 | Height = 13 35 | Caption = #30446#26631#20998#36776#29575 36 | end 37 | object lbl4: TLabel 38 | Left = 32 39 | Top = 43 40 | Width = 60 41 | Height = 13 42 | Caption = #32654#24037#20998#36776#29575 43 | end 44 | object lbl5: TLabel 45 | Left = 256 46 | Top = 21 47 | Width = 24 48 | Height = 13 49 | Caption = #39640#24230 50 | end 51 | object lbl6: TLabel 52 | Left = 32 53 | Top = 131 54 | Width = 48 55 | Height = 13 56 | Caption = #35774#35745#22352#26631 57 | end 58 | object lbl7: TLabel 59 | Left = 256 60 | Top = 176 61 | Width = 16 62 | Height = 13 63 | Caption = 'lbl1' 64 | end 65 | object lbl8: TLabel 66 | Left = 32 67 | Top = 171 68 | Width = 48 69 | Height = 13 70 | Caption = #36716#25442#22352#26631 71 | end 72 | object edtDesignY: TEdit 73 | Left = 256 74 | Top = 128 75 | Width = 121 76 | Height = 21 77 | TabOrder = 5 78 | OnChange = edtDesignYChange 79 | end 80 | object edtDesignX: TEdit 81 | Left = 104 82 | Top = 128 83 | Width = 121 84 | Height = 21 85 | TabOrder = 4 86 | OnChange = edtDesignXChange 87 | end 88 | object edtScreenHeight: TEdit 89 | Left = 256 90 | Top = 80 91 | Width = 121 92 | Height = 21 93 | TabOrder = 3 94 | Text = '540' 95 | end 96 | object edtScreenWidth: TEdit 97 | Left = 104 98 | Top = 80 99 | Width = 121 100 | Height = 21 101 | TabOrder = 2 102 | Text = '320' 103 | end 104 | object edtDesignHeight: TEdit 105 | Left = 256 106 | Top = 40 107 | Width = 121 108 | Height = 21 109 | TabOrder = 1 110 | Text = '1319' 111 | end 112 | object edtDesignWidth: TEdit 113 | Left = 104 114 | Top = 40 115 | Width = 121 116 | Height = 21 117 | TabOrder = 0 118 | Text = '720' 119 | end 120 | object edtConvertedY: TEdit 121 | Left = 256 122 | Top = 168 123 | Width = 121 124 | Height = 21 125 | TabOrder = 7 126 | end 127 | object edtConvertedX: TEdit 128 | Left = 104 129 | Top = 168 130 | Width = 121 131 | Height = 21 132 | TabOrder = 6 133 | end 134 | end 135 | -------------------------------------------------------------------------------- /Tools/ResConvertMain.pas: -------------------------------------------------------------------------------- 1 | unit ResConvertMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TForm5 = class(TForm) 11 | edtDesignY: TEdit; 12 | edtDesignX: TEdit; 13 | edtScreenHeight: TEdit; 14 | edtScreenWidth: TEdit; 15 | lbl1: TLabel; 16 | lbl2: TLabel; 17 | lbl3: TLabel; 18 | lbl4: TLabel; 19 | edtDesignHeight: TEdit; 20 | edtDesignWidth: TEdit; 21 | lbl5: TLabel; 22 | lbl6: TLabel; 23 | edtConvertedY: TEdit; 24 | edtConvertedX: TEdit; 25 | lbl7: TLabel; 26 | lbl8: TLabel; 27 | procedure edtDesignXChange(Sender: TObject); 28 | procedure edtDesignYChange(Sender: TObject); 29 | private 30 | { Private declarations } 31 | FDesignWidth, FDesignHeight, FScreenWidth, FScreenHeight: Integer; 32 | function GetParameters: Boolean; 33 | public 34 | { Public declarations } 35 | end; 36 | 37 | var 38 | Form5: TForm5; 39 | 40 | implementation 41 | 42 | {$R *.dfm} 43 | 44 | procedure TForm5.edtDesignXChange(Sender: TObject); 45 | var 46 | X: Integer; 47 | CX: Double; 48 | begin 49 | if GetParameters then 50 | begin 51 | try 52 | X := StrToInt(edtDesignX.Text); 53 | CX := X * FScreenWidth / FDesignWidth; 54 | edtConvertedX.Text := FloatToStr(CX); 55 | except 56 | 57 | end; 58 | end; 59 | end; 60 | 61 | procedure TForm5.edtDesignYChange(Sender: TObject); 62 | var 63 | Y: Integer; 64 | CY: Double; 65 | begin 66 | if GetParameters then 67 | begin 68 | try 69 | Y := StrToInt(edtDesignY.Text); 70 | CY := Y * FScreenHeight / FDesignHeight; 71 | edtConvertedY.Text := FloatToStr(CY); 72 | except 73 | 74 | end; 75 | end; 76 | end; 77 | 78 | function TForm5.GetParameters: Boolean; 79 | begin 80 | try 81 | FDesignWidth := StrToInt(edtDesignWidth.Text); 82 | FDesignHeight := StrToInt(edtDesignHeight.Text); 83 | FScreenWidth := StrToInt(edtScreenWidth.Text); 84 | FScreenHeight := StrToInt(edtScreenHeight.Text); 85 | Result := True; 86 | except 87 | Result := False; 88 | end; 89 | end; 90 | 91 | end. 92 | -------------------------------------------------------------------------------- /ZXingScanDemo/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | 11 | <%uses-permission%> 12 | 13 | 21 | 22 | <%application-meta-data%> 23 | <%services%> 24 | 26 | 30 | 31 | 33 | 34 | 35 | 36 | 37 | 38 | <%activity%> 39 | <%receivers%> 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /ZXingScanDemo/CameraConfigurationUtils.pas: -------------------------------------------------------------------------------- 1 | unit CameraConfigurationUtils; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | System.SysUtils, 8 | Fmx.Forms, 9 | Fmx.Dialogs, 10 | Androidapi.JNI.Hardware, 11 | Androidapi.JNI.JavaTypes, 12 | Androidapi.Helpers; 13 | 14 | type 15 | TCameraConfigurationUtils = class sealed 16 | private 17 | class function findSettableValue(name: string; 18 | const supportedValues: JList; desiredValues: TArray): JString; 19 | public 20 | class procedure setVideoStabilization(parameters: JCamera_Parameters); static; 21 | class procedure setBarcodeSceneMode(parameters: JCamera_Parameters); static; 22 | end; 23 | implementation 24 | 25 | { TCameraConfigurationUtils } 26 | 27 | class function TCameraConfigurationUtils.findSettableValue(name: string; 28 | const supportedValues: JList; desiredValues: TArray): JString; 29 | var 30 | desiredValue: JString; 31 | s: string; 32 | I: Integer; 33 | begin 34 | if supportedValues <> nil then 35 | begin 36 | for desiredValue in desiredValues do 37 | begin 38 | if supportedValues.contains( desiredValue) then 39 | Exit(desiredValue); 40 | end; 41 | end; 42 | Result := nil; 43 | end; 44 | 45 | class procedure TCameraConfigurationUtils.setBarcodeSceneMode(parameters: JCamera_Parameters ) ; 46 | var 47 | sceneMode: JString; 48 | begin 49 | if SameText(JStringToString(parameters.getSceneMode), JStringToString(TJCamera_Parameters.JavaClass.SCENE_MODE_BARCODE)) then 50 | begin 51 | // Log.i(TAG, "Barcode scene mode already set"); 52 | Exit; 53 | end; 54 | sceneMode := findSettableValue('scene mode', 55 | parameters.getSupportedSceneModes(), 56 | [TJCamera_Parameters.JavaClass.SCENE_MODE_BARCODE]); 57 | if (sceneMode <> nil) then 58 | parameters.setSceneMode(sceneMode); 59 | end; 60 | 61 | class procedure TCameraConfigurationUtils.setVideoStabilization(parameters: JCamera_Parameters); 62 | begin 63 | if (parameters.isVideoStabilizationSupported()) then 64 | begin 65 | if (parameters.getVideoStabilization()) then 66 | begin 67 | // Log.i(TAG, "Video stabilization already enabled"); 68 | end else begin 69 | // Log.i(TAG, "Enabling video stabilization..."); 70 | parameters.setVideoStabilization(true); 71 | end; 72 | end else begin 73 | // Log.i(TAG, "This device does not support video stabilization"); 74 | end; 75 | end; 76 | 77 | 78 | end. 79 | -------------------------------------------------------------------------------- /ZXingScanDemo/ZXingScanDemo.dpr: -------------------------------------------------------------------------------- 1 | program ZXingScanDemo; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | main in 'main.pas' {MainForm}, 7 | CameraConfigurationUtils in 'CameraConfigurationUtils.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /ZXingScanDemo/ZXingScanDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/zhaoyipeng/DelphiDemos/HEAD/ZXingScanDemo/ZXingScanDemo.res -------------------------------------------------------------------------------- /ZXingScanDemo/ZXingScanDemo.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=42 3 | DesignerSecs=113 4 | InspectorSecs=74 5 | CompileSecs=51590 6 | OtherSecs=152 7 | StartTime=2016/8/5 9:53:47 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /ZXingScanDemo/main.LgXhdpiPh.fmx: -------------------------------------------------------------------------------- 1 | inherited MainForm_LgXhdpiPh: TMainForm_LgXhdpiPh 2 | ClientHeight = 695 3 | ClientWidth = 450 4 | DesignerMasterStyle = 2 5 | inherited Layout2: TLayout 6 | Size.Width = 450.000000000000000000 7 | Size.Height = 695.000000000000000000 8 | inherited ToolBar1: TToolBar 9 | Size.Width = 450.000000000000000000 10 | Size.Height = 48.000000000000000000 11 | inherited btnMenu: TButton 12 | Size.Width = 48.000000000000000000 13 | Size.Height = 48.000000000000000000 14 | end 15 | inherited lblScanStatus: TLabel 16 | Position.X = 250.363616943359400000 17 | Size.Width = 194.636352539062500000 18 | Size.Height = 47.999996185302730000 19 | end 20 | inherited chkAutoFocus: TCheckBox 21 | Size.Height = 48.000000000000000000 22 | end 23 | inherited btnAvailableSettings: TSpeedButton 24 | Position.Y = 8.000000000000000000 25 | Size.Height = 48.000000000000000000 26 | end 27 | end 28 | inherited imgCamera: TImage 29 | Size.Width = 450.000000000000000000 30 | Size.Height = 391.000000000000000000 31 | inherited lytScanMask: TLayout 32 | Size.Width = 450.000000000000000000 33 | Size.Height = 391.000000000000000000 34 | inherited Rectangle1: TRectangle 35 | Size.Width = 450.000000000000000000 36 | Size.Height = 100.000000000000000000 37 | end 38 | inherited Rectangle2: TRectangle 39 | Position.Y = 100.000000000000000000 40 | Size.Height = 191.000000000000000000 41 | end 42 | inherited Rectangle3: TRectangle 43 | Position.X = 330.000000000000000000 44 | Position.Y = 100.000000000000000000 45 | Size.Height = 191.000000000000000000 46 | end 47 | inherited Rectangle4: TRectangle 48 | Position.Y = 291.000000000000000000 49 | Size.Width = 450.000000000000000000 50 | Size.Height = 100.000000000000000000 51 | inherited Text1: TText 52 | Size.Width = 450.000000000000000000 53 | end 54 | end 55 | inherited lytScanWindow: TLayout 56 | Size.Width = 210.000000000000000000 57 | Size.Height = 191.000000000000000000 58 | inherited Line1: TLine 59 | Size.Width = 210.000000000000000000 60 | end 61 | inherited rectTopRight: TRectangle 62 | Position.X = 190.000000000000000000 63 | end 64 | inherited rectLeftBottom: TRectangle 65 | Position.Y = 171.000000000000000000 66 | end 67 | inherited rectRightTop: TRectangle 68 | Position.X = 202.000000000000000000 69 | end 70 | inherited rectRightBottom: TRectangle 71 | Position.X = 202.000000000000000000 72 | Position.Y = 171.000000000000000000 73 | end 74 | inherited Rectangle5: TRectangle 75 | Position.Y = 183.000000000000000000 76 | end 77 | inherited Rectangle6: TRectangle 78 | Position.X = 190.000000000000000000 79 | Position.Y = 183.000000000000000000 80 | end 81 | end 82 | end 83 | end 84 | inherited Memo1: TMemo 85 | Position.Y = 439.000000000000000000 86 | Size.Width = 450.000000000000000000 87 | Viewport.Width = 442.000000000000000000 88 | Viewport.Height = 200.000000000000000000 89 | end 90 | inherited ToolBar3: TToolBar 91 | Position.Y = 647.000000000000000000 92 | Size.Width = 450.000000000000000000 93 | Size.Height = 48.000000000000000000 94 | inherited btnStopCamera: TButton 95 | Size.Width = 120.000000000000000000 96 | Size.Height = 48.000000000000000000 97 | end 98 | inherited btnStartCamera: TButton 99 | Position.X = 120.000000000000000000 100 | Size.Width = 120.000000000000000000 101 | Size.Height = 48.000000000000000000 102 | end 103 | inherited lblStatus: TLabel 104 | Size.Width = 210.000000000000000000 105 | Size.Height = 48.000000000000000000 106 | end 107 | end 108 | end 109 | end 110 | -------------------------------------------------------------------------------- /ZXingScanDemo/main.NmXhdpiPh.fmx: -------------------------------------------------------------------------------- 1 | inherited MainForm_NmXhdpiPh: TMainForm_NmXhdpiPh 2 | ClientHeight = 615 3 | ClientWidth = 400 4 | DesignerMasterStyle = 2 5 | inherited Layout2: TLayout 6 | Size.Width = 400.000000000000000000 7 | Size.Height = 615.000000000000000000 8 | inherited ToolBar1: TToolBar 9 | Size.Width = 400.000000000000000000 10 | Size.Height = 48.000000000000000000 11 | inherited btnMenu: TButton 12 | Size.Width = 48.000000000000000000 13 | Size.Height = 48.000000000000000000 14 | end 15 | inherited lblScanStatus: TLabel 16 | Position.X = 200.363616943359400000 17 | Size.Width = 194.636352539062500000 18 | Size.Height = 47.999996185302730000 19 | end 20 | inherited chkAutoFocus: TCheckBox 21 | Size.Height = 48.000000000000000000 22 | end 23 | inherited btnAvailableSettings: TSpeedButton 24 | Position.Y = 8.000000000000000000 25 | Size.Height = 48.000000000000000000 26 | end 27 | end 28 | inherited imgCamera: TImage 29 | Size.Width = 400.000000000000000000 30 | Size.Height = 311.000000000000000000 31 | inherited lytScanMask: TLayout 32 | Size.Width = 400.000000000000000000 33 | Size.Height = 311.000000000000000000 34 | inherited Rectangle1: TRectangle 35 | Size.Width = 400.000000000000000000 36 | Size.Height = 60.000000000000000000 37 | end 38 | inherited Rectangle2: TRectangle 39 | Position.Y = 60.000000000000000000 40 | Size.Width = 100.000000000000000000 41 | Size.Height = 191.000000000000000000 42 | end 43 | inherited Rectangle3: TRectangle 44 | Position.X = 300.000000000000000000 45 | Position.Y = 60.000000000000000000 46 | Size.Width = 100.000000000000000000 47 | Size.Height = 191.000000000000000000 48 | end 49 | inherited Rectangle4: TRectangle 50 | Position.Y = 251.000000000000000000 51 | Size.Width = 400.000000000000000000 52 | Size.Height = 60.000000000000000000 53 | inherited Text1: TText 54 | Size.Width = 400.000000000000000000 55 | end 56 | end 57 | inherited lytScanWindow: TLayout 58 | Size.Width = 200.000000000000000000 59 | Size.Height = 191.000000000000000000 60 | inherited Line1: TLine 61 | Size.Width = 200.000000000000000000 62 | end 63 | inherited rectTopRight: TRectangle 64 | Position.X = 180.000000000000000000 65 | end 66 | inherited rectLeftBottom: TRectangle 67 | Position.Y = 171.000000000000000000 68 | end 69 | inherited rectRightTop: TRectangle 70 | Position.X = 192.000000000000000000 71 | end 72 | inherited rectRightBottom: TRectangle 73 | Position.X = 192.000000000000000000 74 | Position.Y = 171.000000000000000000 75 | end 76 | inherited Rectangle5: TRectangle 77 | Position.Y = 183.000000000000000000 78 | end 79 | inherited Rectangle6: TRectangle 80 | Position.X = 180.000000000000000000 81 | Position.Y = 183.000000000000000000 82 | end 83 | end 84 | end 85 | end 86 | inherited Memo1: TMemo 87 | Position.Y = 359.000000000000000000 88 | Size.Width = 400.000000000000000000 89 | Viewport.Width = 392.000000000000000000 90 | Viewport.Height = 200.000000000000000000 91 | end 92 | inherited ToolBar3: TToolBar 93 | Position.Y = 567.000000000000000000 94 | Size.Width = 400.000000000000000000 95 | Size.Height = 48.000000000000000000 96 | inherited btnStopCamera: TButton 97 | Size.Height = 48.000000000000000000 98 | end 99 | inherited btnStartCamera: TButton 100 | Size.Height = 48.000000000000000000 101 | end 102 | inherited lblStatus: TLabel 103 | Size.Width = 66.000000000000000000 104 | Size.Height = 48.000000000000000000 105 | end 106 | end 107 | end 108 | end 109 | -------------------------------------------------------------------------------- /ZXingScanDemo/main.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Delphi Camera Scanner' 5 | ClientHeight = 829 6 | ClientWidth = 480 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | OnDestroy = FormDestroy 12 | DesignerMasterStyle = 2 13 | object Layout2: TLayout 14 | Align = Client 15 | Size.Width = 480.000000000000000000 16 | Size.Height = 829.000000000000000000 17 | Size.PlatformDefault = False 18 | TabOrder = 6 19 | object ToolBar1: TToolBar 20 | Size.Width = 480.000000000000000000 21 | Size.Height = 44.000000000000000000 22 | Size.PlatformDefault = False 23 | TabOrder = 0 24 | object btnMenu: TButton 25 | Align = Left 26 | Padding.Bottom = 4.000000000000000000 27 | Size.Width = 44.000000000000000000 28 | Size.Height = 44.000000000000000000 29 | Size.PlatformDefault = False 30 | StyleLookup = 'detailstoolbutton' 31 | TabOrder = 0 32 | Text = 'btnMenu' 33 | Visible = False 34 | end 35 | object lblScanStatus: TLabel 36 | Align = FitRight 37 | StyledSettings = [Size, Style, FontColor] 38 | Margins.Right = 5.000000000000000000 39 | Position.X = 297.000000000000000000 40 | Size.Width = 178.000000000000000000 41 | Size.Height = 44.000000000000000000 42 | Size.PlatformDefault = False 43 | TextSettings.Font.Family = 'Default' 44 | TextSettings.HorzAlign = Trailing 45 | Text = 'ScanStatus' 46 | end 47 | object chkAutoFocus: TCheckBox 48 | Align = Left 49 | IsChecked = True 50 | Size.Width = 120.000000000000000000 51 | Size.Height = 44.000000000000000000 52 | Size.PlatformDefault = False 53 | TabOrder = 8 54 | Text = #33258#21160#32858#28966 55 | end 56 | object btnAvailableSettings: TSpeedButton 57 | Position.X = 136.000000000000000000 58 | Size.Width = 161.000000000000000000 59 | Size.Height = 44.000000000000000000 60 | Size.PlatformDefault = False 61 | Text = #35774#32622#21015#34920 62 | OnClick = btnAvailableSettingsClick 63 | end 64 | end 65 | object imgCamera: TImage 66 | MultiResBitmap = < 67 | item 68 | end> 69 | Align = Client 70 | Size.Width = 480.000000000000000000 71 | Size.Height = 533.000000000000000000 72 | Size.PlatformDefault = False 73 | WrapMode = Stretch 74 | object lytScanMask: TLayout 75 | Align = Client 76 | Size.Width = 480.000000000000000000 77 | Size.Height = 533.000000000000000000 78 | Size.PlatformDefault = False 79 | Visible = False 80 | TabOrder = 0 81 | object Rectangle1: TRectangle 82 | Align = Top 83 | Fill.Color = x80000000 84 | Size.Width = 480.000000000000000000 85 | Size.Height = 130.000000000000000000 86 | Size.PlatformDefault = False 87 | Stroke.Kind = None 88 | end 89 | object Rectangle2: TRectangle 90 | Align = Left 91 | Fill.Color = x80000000 92 | Position.Y = 130.000000000000000000 93 | Size.Width = 120.000000000000000000 94 | Size.Height = 273.000000000000000000 95 | Size.PlatformDefault = False 96 | Stroke.Kind = None 97 | end 98 | object Rectangle3: TRectangle 99 | Align = Right 100 | Fill.Color = x80000000 101 | Position.X = 360.000000000000000000 102 | Position.Y = 130.000000000000000000 103 | Size.Width = 120.000000000000000000 104 | Size.Height = 273.000000000000000000 105 | Size.PlatformDefault = False 106 | Stroke.Kind = None 107 | end 108 | object Rectangle4: TRectangle 109 | Align = Bottom 110 | Fill.Color = x80000000 111 | Position.Y = 403.000000000000000000 112 | Size.Width = 480.000000000000000000 113 | Size.Height = 130.000000000000000000 114 | Size.PlatformDefault = False 115 | Stroke.Kind = None 116 | object Text1: TText 117 | Align = Top 118 | Margins.Top = 10.000000000000000000 119 | Position.Y = 10.000000000000000000 120 | Size.Width = 480.000000000000000000 121 | Size.Height = 49.000000000000000000 122 | Size.PlatformDefault = False 123 | Text = #35831#23545#20934#26041#26694#36827#34892#25195#25551 124 | TextSettings.Font.Size = 14.000000000000000000 125 | TextSettings.FontColor = claWhite 126 | end 127 | end 128 | object lytScanWindow: TLayout 129 | Align = Client 130 | Size.Width = 240.000000000000000000 131 | Size.Height = 273.000000000000000000 132 | Size.PlatformDefault = False 133 | TabOrder = 4 134 | object Line1: TLine 135 | Align = Top 136 | LineType = Bottom 137 | Size.Width = 240.000000000000000000 138 | Size.Height = 50.000000000000000000 139 | Size.PlatformDefault = False 140 | Stroke.Color = claBlue 141 | Stroke.Thickness = 2.000000000000000000 142 | object FloatAnimation1: TFloatAnimation 143 | Enabled = True 144 | Duration = 2.000000000000000000 145 | Loop = True 146 | PropertyName = 'Height' 147 | StartValue = 0.000000000000000000 148 | StopValue = 0.000000000000000000 149 | end 150 | end 151 | object rectLefTop: TRectangle 152 | Fill.Color = claWhite 153 | Size.Width = 8.000000000000000000 154 | Size.Height = 20.000000000000000000 155 | Size.PlatformDefault = False 156 | Stroke.Kind = None 157 | end 158 | object rectTopRight: TRectangle 159 | Anchors = [akTop, akRight] 160 | Fill.Color = claWhite 161 | Position.X = 220.000000000000000000 162 | Size.Width = 20.000000000000000000 163 | Size.Height = 8.000000000000000000 164 | Size.PlatformDefault = False 165 | Stroke.Kind = None 166 | end 167 | object rectLeftBottom: TRectangle 168 | Anchors = [akLeft, akBottom] 169 | Fill.Color = claWhite 170 | Position.Y = 253.000000000000000000 171 | Size.Width = 8.000000000000000000 172 | Size.Height = 20.000000000000000000 173 | Size.PlatformDefault = False 174 | Stroke.Kind = None 175 | end 176 | object rectRightTop: TRectangle 177 | Anchors = [akTop, akRight] 178 | Fill.Color = claWhite 179 | Position.X = 232.000000000000000000 180 | Size.Width = 8.000000000000000000 181 | Size.Height = 20.000000000000000000 182 | Size.PlatformDefault = False 183 | Stroke.Kind = None 184 | end 185 | object rectTopLeft: TRectangle 186 | Fill.Color = claWhite 187 | Size.Width = 20.000000000000000000 188 | Size.Height = 8.000000000000000000 189 | Size.PlatformDefault = False 190 | Stroke.Kind = None 191 | end 192 | object rectRightBottom: TRectangle 193 | Anchors = [akRight, akBottom] 194 | Fill.Color = claWhite 195 | Position.X = 232.000000000000000000 196 | Position.Y = 253.000000000000000000 197 | Size.Width = 8.000000000000000000 198 | Size.Height = 20.000000000000000000 199 | Size.PlatformDefault = False 200 | Stroke.Kind = None 201 | end 202 | object Rectangle5: TRectangle 203 | Anchors = [akLeft, akBottom] 204 | Fill.Color = claWhite 205 | Position.Y = 265.000000000000000000 206 | Size.Width = 20.000000000000000000 207 | Size.Height = 8.000000000000000000 208 | Size.PlatformDefault = False 209 | Stroke.Kind = None 210 | end 211 | object Rectangle6: TRectangle 212 | Anchors = [akRight, akBottom] 213 | Fill.Color = claWhite 214 | Position.X = 220.000000000000000000 215 | Position.Y = 265.000000000000000000 216 | Size.Width = 20.000000000000000000 217 | Size.Height = 8.000000000000000000 218 | Size.PlatformDefault = False 219 | Stroke.Kind = None 220 | end 221 | end 222 | end 223 | end 224 | object Memo1: TMemo 225 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 226 | DataDetectorTypes = [] 227 | Align = Bottom 228 | Position.Y = 577.000000000000000000 229 | Size.Width = 480.000000000000000000 230 | Size.Height = 208.000000000000000000 231 | Size.PlatformDefault = False 232 | TabOrder = 1 233 | Viewport.Width = 472.000000000000000000 234 | Viewport.Height = 200.000000000000000000 235 | end 236 | object ToolBar3: TToolBar 237 | Align = MostBottom 238 | Position.Y = 785.000000000000000000 239 | Size.Width = 480.000000000000000000 240 | Size.Height = 44.000000000000000000 241 | Size.PlatformDefault = False 242 | TabOrder = 2 243 | object btnStopCamera: TButton 244 | Align = Left 245 | Size.Width = 151.000000000000000000 246 | Size.Height = 44.000000000000000000 247 | Size.PlatformDefault = False 248 | TabOrder = 1 249 | Text = #20572#27490#25195#25551 250 | OnClick = btnStopCameraClick 251 | end 252 | object btnStartCamera: TButton 253 | Align = Left 254 | Position.X = 151.000000000000000000 255 | Size.Width = 183.000000000000000000 256 | Size.Height = 44.000000000000000000 257 | Size.PlatformDefault = False 258 | TabOrder = 2 259 | Text = #24320#22987#25195#25551 260 | OnClick = btnStartCameraClick 261 | end 262 | object lblStatus: TLabel 263 | Align = Client 264 | Size.Width = 146.000000000000000000 265 | Size.Height = 44.000000000000000000 266 | Size.PlatformDefault = False 267 | end 268 | end 269 | end 270 | object CameraComponent1: TCameraComponent 271 | OnSampleBufferReady = CameraComponent1SampleBufferReady 272 | Left = 552 273 | Top = 88 274 | end 275 | end 276 | -------------------------------------------------------------------------------- /ZXingScanDemo/main.iPhone55in.fmx: -------------------------------------------------------------------------------- 1 | inherited MainForm_iPhone55in: TMainForm_iPhone55in 2 | ClientHeight = 716 3 | ClientWidth = 414 4 | DesignerMasterStyle = 2 5 | inherited Layout2: TLayout 6 | Size.Width = 414.000000000000000000 7 | Size.Height = 716.000000000000000000 8 | inherited ToolBar1: TToolBar 9 | Size.Width = 414.000000000000000000 10 | inherited lblScanStatus: TLabel 11 | Position.X = 231.000000000000000000 12 | end 13 | inherited btnAvailableSettings: TSpeedButton 14 | Position.Y = 8.000000000000000000 15 | end 16 | end 17 | inherited imgCamera: TImage 18 | Size.Width = 414.000000000000000000 19 | Size.Height = 420.000000000000000000 20 | end 21 | inherited Memo1: TMemo 22 | Position.Y = 464.000000000000000000 23 | Size.Width = 414.000000000000000000 24 | Viewport.Width = 406.000000000000000000 25 | Viewport.Height = 200.000000000000000000 26 | end 27 | inherited ToolBar3: TToolBar 28 | Position.Y = 672.000000000000000000 29 | Size.Width = 414.000000000000000000 30 | inherited lblStatus: TLabel 31 | Size.Width = 80.000000000000000000 32 | end 33 | end 34 | end 35 | end 36 | -------------------------------------------------------------------------------- /ZXingScanDemo/main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | { 3 | * Copyright 2015 E Spelt for test project stuff 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | 17 | * Implemented by E. Spelt for Delphi 18 | } 19 | interface 20 | 21 | uses 22 | System.SysUtils, System.Types, System.UITypes, System.Classes, 23 | System.Variants, 24 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, 25 | FMX.StdCtrls, FMX.Media, FMX.Platform, FMX.MultiView, FMX.ListView.Types, 26 | FMX.ListView, FMX.Layouts, System.Actions, FMX.ActnList, FMX.TabControl, 27 | FMX.ListBox, Threading, BarcodeFormat, ReadResult, 28 | FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, ScanManager, FMX.Ani 29 | {$IFDEF ANDROID} 30 | ,Androidapi.JNIBridge 31 | ,System.Rtti 32 | ,Androidapi.JNI.Hardware 33 | ,FMX.Media.Android 34 | ,CameraConfigurationUtils 35 | {$ENDIF} 36 | ; 37 | 38 | type 39 | TMainForm = class(TForm) 40 | btnStartCamera: TButton; 41 | btnStopCamera: TButton; 42 | lblScanStatus: TLabel; 43 | imgCamera: TImage; 44 | ToolBar1: TToolBar; 45 | btnMenu: TButton; 46 | Layout2: TLayout; 47 | ToolBar3: TToolBar; 48 | CameraComponent1: TCameraComponent; 49 | Memo1: TMemo; 50 | lblStatus: TLabel; 51 | lytScanMask: TLayout; 52 | Rectangle1: TRectangle; 53 | Rectangle2: TRectangle; 54 | Rectangle3: TRectangle; 55 | Rectangle4: TRectangle; 56 | lytScanWindow: TLayout; 57 | Line1: TLine; 58 | FloatAnimation1: TFloatAnimation; 59 | rectLefTop: TRectangle; 60 | rectTopRight: TRectangle; 61 | rectLeftBottom: TRectangle; 62 | rectRightTop: TRectangle; 63 | rectTopLeft: TRectangle; 64 | rectRightBottom: TRectangle; 65 | Rectangle5: TRectangle; 66 | Rectangle6: TRectangle; 67 | Text1: TText; 68 | chkAutoFocus: TCheckBox; 69 | btnAvailableSettings: TSpeedButton; 70 | procedure btnStartCameraClick(Sender: TObject); 71 | procedure FormCreate(Sender: TObject); 72 | procedure btnStopCameraClick(Sender: TObject); 73 | 74 | procedure FormDestroy(Sender: TObject); 75 | procedure CameraComponent1SampleBufferReady(Sender: TObject; 76 | const ATime: TMediaTime); 77 | procedure btnAvailableSettingsClick(Sender: TObject); 78 | private 79 | { Private declarations } 80 | FStartTime: TDateTime; 81 | FScanManager: TScanManager; 82 | FScanInProgress: Boolean; 83 | frameTake: Integer; 84 | procedure GetImage(); 85 | procedure FocusReady; 86 | function AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; 87 | 88 | public 89 | { Public declarations } 90 | end; 91 | 92 | var 93 | MainForm: TMainForm; 94 | 95 | implementation 96 | 97 | {$R *.fmx} 98 | {$R *.NmXhdpiPh.fmx ANDROID} 99 | {$R *.LgXhdpiPh.fmx ANDROID} 100 | {$R *.iPhone55in.fmx IOS} 101 | 102 | type 103 | TMyCamera = class(TCameraComponent) 104 | 105 | end; 106 | 107 | {$IFDEF ANDROID} 108 | TAndroidCameraCallback = class(TJavaLocal, JCamera_AutoFocusCallback) 109 | private 110 | [Weak] FMainForm: TMainForm; 111 | public 112 | procedure onAutoFocus(success: Boolean; camera: JCamera); cdecl; 113 | end; 114 | 115 | procedure TAndroidCameraCallback.onAutoFocus(success: Boolean; camera: JCamera); cdecl; 116 | begin 117 | FMainForm.FocusReady; 118 | end; 119 | 120 | var 121 | CameraCallBack: TAndroidCameraCallback = nil; 122 | 123 | function GetCameraCallBack: TAndroidCameraCallback; 124 | begin 125 | if CameraCallBack = nil then 126 | CameraCallBack := TAndroidCameraCallback.Create; 127 | 128 | Result := TAndroidCameraCallback.Create; 129 | end; 130 | {$ENDIF} 131 | 132 | procedure TMainForm.FocusReady; 133 | begin 134 | 135 | end; 136 | 137 | procedure TMainForm.FormCreate(Sender: TObject); 138 | var 139 | AppEventSvc: IFMXApplicationEventService; 140 | begin 141 | 142 | lblScanStatus.Text := ''; 143 | frameTake := 0; 144 | 145 | { by default, we start with Front Camera and Flash Off } 146 | { cbFrontCamera.IsChecked := True; 147 | CameraComponent1.Kind := FMX.Media.TCameraKind.ckFrontCamera; 148 | 149 | cbFlashOff.IsChecked := True; 150 | if CameraComponent1.HasFlash then 151 | CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmFlashOff; 152 | } 153 | 154 | { Add platform service to see camera state. } 155 | if TPlatformServices.Current.SupportsPlatformService 156 | (IFMXApplicationEventService, IInterface(AppEventSvc)) then 157 | AppEventSvc.SetApplicationEventHandler(AppEvent); 158 | 159 | CameraComponent1.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality; 160 | lblScanStatus.Text := ''; 161 | FScanManager := TScanManager.Create(TBarcodeFormat.Auto, nil); 162 | end; 163 | 164 | procedure TMainForm.FormDestroy(Sender: TObject); 165 | begin 166 | FScanManager.Free; 167 | end; 168 | 169 | procedure TMainForm.btnAvailableSettingsClick(Sender: TObject); 170 | var 171 | Settings: TArray; 172 | I: Integer; 173 | s: string; 174 | begin 175 | // 176 | Settings := CameraComponent1.AvailableCaptureSettings; 177 | for I := 0 to High(Settings) do 178 | begin 179 | s := Format('%d: Width=%d, Height=%d, FrameRate=%f, Min=%f, Max=%f', 180 | [I+1, Settings[I].Width, Settings[I].Height, 181 | Settings[I].FrameRate, Settings[I].MinFrameRate, Settings[I].MaxFrameRate]); 182 | Memo1.Lines.Add(s); 183 | end; 184 | end; 185 | 186 | procedure TMainForm.btnStartCameraClick(Sender: TObject); 187 | var 188 | Setting: TVideoCaptureSetting; 189 | {$IFDEF ANDROID} 190 | JC: JCamera; 191 | Device: TCaptureDevice; 192 | ClassRef: TClass; 193 | ctx: TRttiContext; 194 | t: TRttiType; 195 | Params: JCamera_Parameters; 196 | {$ENDIF} 197 | begin 198 | FStartTime := Now; 199 | frameTake := 0; 200 | CameraComponent1.Active := False; 201 | 202 | Setting:= CameraComponent1.CaptureSetting; 203 | Setting.Width := 352; 204 | Setting.Height := 288; 205 | Setting.FrameRate := 30; 206 | Setting.SetFrameRate(30, 30); 207 | if chkAutoFocus.IsChecked then 208 | CameraComponent1.FocusMode := TFocusMode.ContinuousAutoFocus 209 | else 210 | CameraComponent1.FocusMode := TFocusMode.AutoFocus; 211 | CameraComponent1.SetCaptureSetting(Setting); 212 | CameraComponent1.Quality := TVideoCaptureQuality.MediumQuality; 213 | CameraComponent1.Kind := FMX.Media.TCameraKind.BackCamera; 214 | 215 | {$IFDEF ANDROID} 216 | Device := TMyCamera(CameraComponent1).Device; 217 | 218 | ClassRef := Device.ClassType; 219 | ctx := TRttiContext.Create; 220 | try 221 | t := ctx.GetType(ClassRef); 222 | JC := t.GetProperty('Camera').GetValue(Device).AsInterface as JCamera; 223 | TCameraConfigurationUtils.setBarcodeSceneMode(JC.getParameters); 224 | TCameraConfigurationUtils.setVideoStabilization(JC.getParameters); 225 | //JC.cancelAutoFocus(); 226 | //GetCameraCallback().FMainForm := Self; 227 | //JC.autoFocus(GetCameraCallback()); 228 | finally 229 | ctx.Free; 230 | end; 231 | {$ENDIF} 232 | CameraComponent1.Active := True; 233 | 234 | lblScanStatus.Text := ''; 235 | memo1.Lines.Clear; 236 | 237 | lytScanMask.Visible := True; 238 | FloatAnimation1.StopValue := lytScanWindow.Height; 239 | FloatAnimation1.Start; 240 | end; 241 | 242 | procedure TMainForm.btnStopCameraClick(Sender: TObject); 243 | begin 244 | CameraComponent1.Active := False; 245 | //self.imgCamera.Bitmap.Clear(0); 246 | FloatAnimation1.Stop; 247 | lytScanMask.Visible := False; 248 | end; 249 | 250 | procedure TMainForm.CameraComponent1SampleBufferReady(Sender: TObject; 251 | const ATime: TMediaTime); 252 | begin 253 | TThread.Synchronize(TThread.CurrentThread, GetImage); 254 | end; 255 | 256 | procedure TMainForm.GetImage; 257 | var 258 | scanBitmap: TBitmap; 259 | ReadResult: TReadResult; 260 | dt: TDateTime; 261 | fps: double; 262 | w, h, x, y: Integer; 263 | begin 264 | 265 | CameraComponent1.SampleBufferToBitmap(imgCamera.Bitmap, True); 266 | if (FScanInProgress) then 267 | begin 268 | Exit; 269 | end; 270 | 271 | inc(frameTake); 272 | // if (frameTake mod 4 <> 0) then 273 | // begin 274 | // Exit; 275 | // end; 276 | dt := (Now - FStartTime) * SecsPerDay; 277 | fps := (frameTake / dt); 278 | lblStatus.Text := Format('Frame:%d, FPS:%.2f', [frameTake, fps]); 279 | w := imgCamera.Bitmap.Width; 280 | h := imgCamera.Bitmap.Height; 281 | x := Round(w * lytScanWindow.Position.X / imgCamera.Width); 282 | y := Round(h * lytScanWindow.Position.Y / imgCamera.Height); 283 | 284 | scanBitmap := TBitmap.Create(); 285 | scanBitmap.SetSize(w - 2 * x, h - 2 * y); 286 | scanBitmap.Canvas.DrawBitmap(imgCamera.Bitmap, 287 | RectF(x, y, w - x, h - y), 288 | RectF(0,0,scanBitmap.Width, scanBitmap.Height), 289 | 1); 290 | // scanBitmap.Assign(imgCamera.Bitmap); 291 | 292 | TTask.Run( 293 | procedure 294 | begin 295 | 296 | try 297 | FScanInProgress := True; 298 | 299 | scanBitmap.Assign(imgCamera.Bitmap); 300 | 301 | ReadResult := FScanManager.Scan(scanBitmap); 302 | FScanInProgress := False; 303 | except 304 | on E: Exception do 305 | begin 306 | FScanInProgress := False; 307 | TThread.Synchronize(nil, 308 | procedure 309 | begin 310 | // lblScanStatus.Text := E.Message; 311 | // lblScanResults.Text := ''; 312 | end); 313 | 314 | if (scanBitmap <> nil) then 315 | begin 316 | scanBitmap.Free; 317 | end; 318 | 319 | Exit; 320 | 321 | end; 322 | 323 | end; 324 | 325 | TThread.Synchronize(nil, 326 | procedure 327 | begin 328 | 329 | if (length(lblScanStatus.Text) > 10) then 330 | begin 331 | lblScanStatus.Text := '*'; 332 | end; 333 | 334 | lblScanStatus.Text := lblScanStatus.Text + '*'; 335 | 336 | if (ReadResult <> nil) then 337 | begin 338 | memo1.Lines.Insert(0,ReadResult.Text); 339 | if Memo1.Lines.Count >= 10 then 340 | Memo1.Lines.Clear; 341 | end; 342 | 343 | if (scanBitmap <> nil) then 344 | begin 345 | scanBitmap.Free; 346 | end; 347 | 348 | FreeAndNil(ReadResult); 349 | 350 | end); 351 | end); 352 | 353 | end; 354 | 355 | { Make sure the ca mera is released if you're going away. } 356 | function TMainForm.AppEvent(AAppEvent: TApplicationEvent; 357 | AContext: TObject): Boolean; 358 | begin 359 | 360 | case AAppEvent of 361 | TApplicationEvent.WillBecomeInactive: 362 | CameraComponent1.Active := False; 363 | TApplicationEvent.EnteredBackground: 364 | CameraComponent1.Active := False; 365 | TApplicationEvent.WillTerminate: 366 | CameraComponent1.Active := False; 367 | end; 368 | 369 | end; 370 | 371 | initialization 372 | finalization 373 | //CameraCallBack.Free; 374 | end. 375 | --------------------------------------------------------------------------------