├── .gitignore ├── COPYING.MIT.txt ├── COPYING.modifiedLGPL.txt ├── README.md ├── design ├── image │ ├── twbutton.xpm │ ├── twcheckbox.xpm │ ├── twcombobox.xpm │ ├── twdatagrid.xpm │ ├── twdateeditbox.xpm │ ├── twedit.xpm │ ├── twfilebutton.xpm │ ├── twfloatedit.xpm │ ├── twimage.xpm │ ├── twintegeredit.xpm │ ├── twlabel.xpm │ ├── twmemo.xpm │ ├── twpagecontrol.xpm │ ├── twpagination.xpm │ ├── twpanel.xpm │ ├── twtimeeditbox.xpm │ └── webctrls.lrs ├── package │ ├── wcldsgn.lpk │ └── wcldsgn.pas └── source │ ├── btnctrls.pas │ ├── datagrid.pas │ ├── dttctrls.pas │ ├── numctrls.pas │ ├── pas2js_ide_descriptor.pas │ ├── webctrls.lrs │ ├── webctrls.pas │ └── websocket.pas └── widgets ├── btnctrls.pas ├── comctrls.pas ├── controls.pas ├── datagrid.pas ├── dialogs.pas ├── dttctrls.pas ├── extctrls.pas ├── forms.pas ├── graphics.pas ├── grids.pas ├── interfaces.pas ├── maskutils.pas ├── numctrls.pas ├── pas2js_widget.inc ├── stdctrls.pas ├── wcl.lpk ├── wcl.pas ├── wclstrconsts.pas ├── webctrls.pas ├── webextra.pas └── wresources.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # FPC compiler-generated binaries (in addition to the above) 49 | *.ppl 50 | *.ppu 51 | *.pcp 52 | 53 | # Lazarus unit output directory 54 | lib/ 55 | 56 | # Delphi autogenerated files (duplicated info) 57 | #.cfg 58 | *.hpp 59 | *Resource.rc 60 | 61 | # Delphi local files (user-specific info) 62 | *.local 63 | *.identcache 64 | *.projdata 65 | *.tvsconfig 66 | *.dsk 67 | 68 | # Lazarus local files 69 | *.lps 70 | *.compiled 71 | 72 | # Delphi history and backups 73 | __history/ 74 | __recovery/ 75 | *.~* 76 | 77 | # Lazarus history and backups 78 | *.bak 79 | backup/ 80 | 81 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 82 | *.stat 83 | /widgets/wcl.js 84 | -------------------------------------------------------------------------------- /COPYING.MIT.txt: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Helio S. Ribeiro and Anderson J. Gado da Silva 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /COPYING.modifiedLGPL.txt: -------------------------------------------------------------------------------- 1 | This is the file COPYING.modifiedLGPL, it applies to several units in the 2 | Lazarus sources distributed by members of the Lazarus Development Team. 3 | All files contains headers showing the appropriate license. See there if this 4 | modification can be applied. 5 | 6 | These files are distributed under the Library GNU General Public License 7 | (see the file COPYING.LGPL) with the following modification: 8 | 9 | As a special exception, the copyright holders of this library give you 10 | permission to link this library with independent modules to produce an 11 | executable, regardless of the license terms of these independent modules, 12 | and to copy and distribute the resulting executable under terms of your choice, 13 | provided that you also meet, for each linked independent module, the terms 14 | and conditions of the license of that module. An independent module is a 15 | module which is not derived from or based on this library. If you modify this 16 | library, you may extend this exception to your version of the library, but 17 | you are not obligated to do so. If you do not wish to do so, delete this 18 | exception statement from your version. 19 | 20 | 21 | If you didn't receive a copy of the file COPYING.LGPL, contact: 22 | Free Software Foundation, Inc., 23 | 675 Mass Ave 24 | Cambridge, MA 02139 25 | USA 26 | 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Web Component Library 2 | Web Component Library (formerly Pas2JS Widgetset) is a RAD Framework to develop Web Applications like to develop Windows Applications originally started by Hélio S. Ribeiro and Anderson J. Gado da Silva and further improved by Sven Barth. 3 | 4 | ### Thanks 5 | This project is only possible thanks to [Free Pascal](https://www.freepascal.org/ "Free Pascal"), [Lazarus](https://www.lazarus-ide.org/ "Lazarus") and the fabulous compiler [Pas2JS](http://wiki.freepascal.org/pas2js "Pas2JS") 6 | 7 | ### Requirements 8 | * Lazarus 2.1 or newer 9 | * _pas2js_ 2.0 or newer 10 | 11 | ### Help Please 12 | This project is under development. 13 | This version is an basic implementation and many bugs need to be corrected. 14 | Please help us to take this project forward. 15 | 16 | ### Install 17 | This was tested with Lazarus 2.1 using version 2.0 of _pas2js_. 18 | * make sure that the _pas2jsdsgn_ package is installed 19 | * the _pas2js_rtl_ package should have been opened (so that the IDE knows about it) 20 | * install the _wcldsgn_ package from _design/package_ 21 | * open the _wcl_ package in _widgets_ (again so that the IDE knows about it) 22 | 23 | ### Usage 24 | * create a new _Web GUI Application_ 25 | 26 | ### Notes 27 | * you can only use components from the _WCL_ tab 28 | 29 | ### Further plans 30 | * test data module template 31 | * implement support for DB controls 32 | * implement a Lazarus compatible grid 33 | * better maintenance of the project's HTML file 34 | * better maintenance of the project's main program file 35 | * more dynamic layouting of the components 36 | -------------------------------------------------------------------------------- /design/image/twbutton.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *graphic[] = { 3 | "23 23 27 1", 4 | ". c None", 5 | ", c #FFFFFF", 6 | "- c #424242", 7 | "* c #D6D6CE", 8 | "a c #848484", 9 | "b c #D6CEC6", 10 | "c c #565752", 11 | "d c #4B4A47", 12 | "e c #000000", 13 | "f c #8F8C87", 14 | "g c #635F5B", 15 | "h c #77736F", 16 | "i c #736F6B", 17 | "j c #A7A59E", 18 | "k c #5A5A57", 19 | "l c #141413", 20 | "m c #C7BDB7", 21 | "n c #AFA7A5", 22 | "o c #524E4B", 23 | "p c #353533", 24 | "q c #A59D97", 25 | "r c #2B2B29", 26 | "s c #96948E", 27 | "t c #252523", 28 | "u c #8C8685", 29 | "v c #21211F", 30 | "w c #7B7773", 31 | ".......................", 32 | ".......................", 33 | ".......................", 34 | ".......................", 35 | ",,,,,,,,,,,,,,,,,,,,,,-", 36 | ",********************a-", 37 | ",********************a-", 38 | ",****bcddcb*e**fg****a-", 39 | ",****gh**ig*e*jk*****a-", 40 | ",****lm**ml*enob*****a-", 41 | ",****e****e*epq******a-", 42 | ",****lm**ml*emrs*****a-", 43 | ",****gh**ig*e*mtu****a-", 44 | ",****bcddcb*e**mvw***a-", 45 | ",********************a-", 46 | ",********************a-", 47 | ",aaaaaaaaaaaaaaaaaaaaa-", 48 | "-----------------------", 49 | ".......................", 50 | ".......................", 51 | ".......................", 52 | ".......................", 53 | "......................."} 54 | -------------------------------------------------------------------------------- /design/image/twcheckbox.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *graphic[] = { 3 | "23 23 6 1", 4 | ". c None", 5 | ", c #848484", 6 | "- c #FFFFFF", 7 | "* c #424242", 8 | "a c #D6D6CE", 9 | "b c #000000", 10 | ".......................", 11 | ".......................", 12 | ".......................", 13 | ".......................", 14 | ".......................", 15 | ".....,,,,,,,,,,,,-.....", 16 | ".....,**********a-.....", 17 | ".....,*---------a-.....", 18 | ".....,*-------b-a-.....", 19 | ".....,*------bb-a-.....", 20 | ".....,*-b---bbb-a-.....", 21 | ".....,*-bb-bbb--a-.....", 22 | ".....,*-bbbbb---a-.....", 23 | ".....,*--bbb----a-.....", 24 | ".....,*---b-----a-.....", 25 | ".....,*---------a-.....", 26 | ".....,aaaaaaaaaaa-.....", 27 | ".....-------------.....", 28 | ".......................", 29 | ".......................", 30 | ".......................", 31 | ".......................", 32 | "......................."} 33 | -------------------------------------------------------------------------------- /design/image/twcombobox.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tcombobox_xpm[] = { 3 | "20 18 166 2", 4 | " c None", 5 | ". c #000200", 6 | "+ c #121212", 7 | "@ c #000000", 8 | "# c #040404", 9 | "$ c #010103", 10 | "% c #000002", 11 | "& c #FBF7FF", 12 | "* c #FFFAFF", 13 | "= c #F7F0FF", 14 | "- c #FFF7FF", 15 | "; c #F5ECFF", 16 | "> c #FFF6FF", 17 | ", c #FCF5FF", 18 | "' c #F7F1FF", 19 | ") c #FEFAFF", 20 | "! c #FFFBFF", 21 | "~ c #FDFAFF", 22 | "{ c #000007", 23 | "] c #FFFFFF", 24 | "^ c #FEFEFC", 25 | "/ c #FFFFFA", 26 | "( c #B9BBB0", 27 | "_ c #010300", 28 | ": c #070125", 29 | "< c #0A032D", 30 | "[ c #1A1245", 31 | "} c #0D043D", 32 | "| c #130946", 33 | "1 c #0F063F", 34 | "2 c #160E3F", 35 | "3 c #160F38", 36 | "4 c #00001E", 37 | "5 c #120D2D", 38 | "6 c #0C0821", 39 | "7 c #FFFCFF", 40 | "8 c #000009", 41 | "9 c #FFFEFF", 42 | "0 c #030301", 43 | "a c #000100", 44 | "b c #CCCEC3", 45 | "c c #FEFDFF", 46 | "d c #F6F4FF", 47 | "e c #FFFDFF", 48 | "f c #FBF8FF", 49 | "g c #FCF8FF", 50 | "h c #FAF6FF", 51 | "i c #FAF7FF", 52 | "j c #FEFCFF", 53 | "k c #010006", 54 | "l c #7A7A7A", 55 | "m c #898989", 56 | "n c #BCBCBC", 57 | "o c #FAFBF3", 58 | "p c #FFFFFB", 59 | "q c #F2F3F7", 60 | "r c #FEFFFF", 61 | "s c #FEFEFF", 62 | "t c #F4F2FD", 63 | "u c #F6F5FA", 64 | "v c #C0C1C3", 65 | "w c #C1C2C6", 66 | "x c #B8B7BC", 67 | "y c #C6C5CB", 68 | "z c #020500", 69 | "A c #000102", 70 | "B c #000005", 71 | "C c #040612", 72 | "D c #00000B", 73 | "E c #000104", 74 | "F c #000207", 75 | "G c #F6FAF9", 76 | "H c #FBFFFF", 77 | "I c #FBFEFF", 78 | "J c #ECEEFF", 79 | "K c #FBFDFF", 80 | "L c #FAFEFF", 81 | "M c #FAFDFF", 82 | "N c #F9FBFF", 83 | "O c #FCFFFF", 84 | "P c #000106", 85 | "Q c #FCFEFF", 86 | "R c #F4F6FF", 87 | "S c #0A0D2E", 88 | "T c #03052E", 89 | "U c #090A36", 90 | "V c #0C0B33", 91 | "W c #0C0A39", 92 | "X c #0A0A3C", 93 | "Y c #0C0940", 94 | "Z c #0A0A3E", 95 | "` c #0A0B39", 96 | " . c #0A0D30", 97 | ".. c #101227", 98 | "+. c #F6FAFF", 99 | "@. c #050801", 100 | "#. c #000010", 101 | "$. c #F5F6FF", 102 | "%. c #F6F8FF", 103 | "&. c #F8F8FF", 104 | "*. c #F5F4FF", 105 | "=. c #F8F5FF", 106 | "-. c #F8F4FF", 107 | ";. c #F8F3FF", 108 | ">. c #F7F3FF", 109 | ",. c #F8F2FF", 110 | "'. c #F8F7FF", 111 | "). c #F6F9FF", 112 | "!. c #00001C", 113 | "~. c #8C000B", 114 | "{. c #F9F6FF", 115 | "]. c #FBFBFF", 116 | "^. c #000013", 117 | "/. c #000020", 118 | "(. c #000022", 119 | "_. c #F3F2FF", 120 | ":. c #F4F4FF", 121 | "<. c #F4F5FF", 122 | "[. c #F5F5FF", 123 | "}. c #F7F6FF", 124 | "|. c #F6F5FF", 125 | "1. c #000026", 126 | "2. c #00001F", 127 | "3. c #000015", 128 | "4. c #F9FCFF", 129 | "5. c #F5F7FF", 130 | "6. c #F8FBFF", 131 | "7. c #F8FDFF", 132 | "8. c #000107", 133 | "9. c #111521", 134 | "0. c #F0F5FF", 135 | "a. c #EFF2FF", 136 | "b. c #F7F9FF", 137 | "c. c #F7FAFF", 138 | "d. c #F7F8FF", 139 | "e. c #F7F7FF", 140 | "f. c #F8FAFF", 141 | "g. c #F3F7FF", 142 | "h. c #F6FBFF", 143 | "i. c #000300", 144 | "j. c #090D2A", 145 | "k. c #05072D", 146 | "l. c #0B0E3B", 147 | "m. c #080740", 148 | "n. c #080647", 149 | "o. c #07064A", 150 | "p. c #07064C", 151 | "q. c #07054E", 152 | "r. c #070745", 153 | "s. c #08083A", 154 | "t. c #F5FAFF", 155 | "u. c #EFF4FA", 156 | "v. c #000602", 157 | "w. c #F3F4FF", 158 | "x. c #FCF9FF", 159 | "y. c #FBF9FF", 160 | "z. c #FBFAFF", 161 | "A. c #FBFCFF", 162 | "B. c #080C0F", 163 | "C. c #0B0B0D", 164 | "D. c #01000E", 165 | "E. c #050414", 166 | "F. c #00000E", 167 | "G. c #00000C", 168 | "H. c #00010E", 169 | "I. c #040613", 170 | ". . . . . . . . . . . . . . + @ # @ $ % ", 171 | ". & * = - - ; > , ' * ) ! ~ { ] ^ / ( _ ", 172 | ". ! : < [ } | 1 2 3 4 5 6 7 8 9 0 a b . ", 173 | ". c d e f & g ) h ) 7 i e j k ] l m n @ ", 174 | ". o p ] q r s s e t 9 r u r % v w x y { ", 175 | ". . z a A B C D B % a a a a A E F B { { ", 176 | " . G H I J K K K K L K M M L N O r % ", 177 | " P Q R S T U V V W X Y Z ` ...+.O @.", 178 | " #.$.N %.&.*.=.-.;.>.,.>.-.'.N K ).a ", 179 | " !.N '.~.~.~.~.~.~.~.~.~.~.~.{.&.].^.", 180 | " /.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~./.", 181 | " (.~.~._._.:.<.<.[.R $.$.$.}.|.~.~.1.", 182 | " 2.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.~.!.", 183 | " 3.4.5.~.~.~.~.~.~.~.~.~.~.~.6.7.4.8.", 184 | " 9.0.4.6.a.b.c.c.b.d.e.e.d.f.g.h.H i.", 185 | " B H K j.k.l.m.n.o.p.q.p.r.s. .t.u.v.", 186 | " a 4.b.I K w.x.g f f y.y.z.4.A.M H B.", 187 | " @ C.B 8 D.E.F.G.D 8 { { 8 8 H.G.I.D "}; 188 | -------------------------------------------------------------------------------- /design/image/twdatagrid.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tstringgrid_xpm[] = { 3 | "23 23 5 1", 4 | " c None", 5 | ". c #000000", 6 | "+ c #C0C0C0", 7 | "@ c #FFFFFF", 8 | "# c #000080", 9 | " ", 10 | " .................. ", 11 | " .+.@+++++@+++++++. ", 12 | " .................. ", 13 | " .+.@@@@@+@@@@@@@@. ", 14 | " .@.@###@+@######@. ", 15 | " .+.@@@@@+@@@@@@@@. ", 16 | " .@.@###@+@#####@@. ", 17 | " .+.@@@@@+@@@@@@@@. ", 18 | " .@.@###@+@######@. ", 19 | " .+.@@@@@+@@@@@@@@. ", 20 | " .@.@###@+@#####@@. ", 21 | " .+.@@@@@+@@@@@@@@. ", 22 | " .................. ", 23 | " # ", 24 | " # ", 25 | " ## ### ## ", 26 | " # # # # # ", 27 | " ### # # # ", 28 | " # # # # # ", 29 | " # # # # # # ", 30 | " ### ### ## ", 31 | " "}; 32 | -------------------------------------------------------------------------------- /design/image/twdateeditbox.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tedit_xpm[] = { 3 | "23 16 102 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #747474", 7 | "@ c #818181", 8 | "# c #7C7C7C", 9 | "$ c #7D7D7D", 10 | "% c #777777", 11 | "& c #7E7E7E", 12 | "* c #878787", 13 | "= c #888888", 14 | "- c #7A7A7A", 15 | "; c #858585", 16 | "> c #7B7B7B", 17 | ", c #8A8A8A", 18 | "' c #868686", 19 | ") c #787878", 20 | "! c #727272", 21 | "~ c #0B0B0B", 22 | "{ c #000000", 23 | "] c #030303", 24 | "^ c #050505", 25 | "/ c #0A0A0A", 26 | "( c #040404", 27 | "_ c #FFFFFF", 28 | ": c #F9F9F9", 29 | "< c #FCFCFC", 30 | "[ c #FDFDFD", 31 | "} c #BEBEBE", 32 | "| c #FFFDFF", 33 | "1 c #AA4747", 34 | "2 c #FDFBFF", 35 | "3 c #C2C2C2", 36 | "4 c #020003", 37 | "5 c #FFFAFF", 38 | "6 c #FCFDFF", 39 | "7 c #FFFEFF", 40 | "8 c #C5C5C5", 41 | "9 c #010103", 42 | "0 c #FBF9FE", 43 | "a c #FAF5F9", 44 | "b c #FEFDFE", 45 | "c c #F6F4F4", 46 | "d c #FAF8FD", 47 | "e c #FAFAF9", 48 | "f c #020307", 49 | "g c #FBFBFC", 50 | "h c #F6F5F5", 51 | "i c #F2F5FF", 52 | "j c #000103", 53 | "k c #FBFCFE", 54 | "l c #F0F6FF", 55 | "m c #FBFEFF", 56 | "n c #FBFFFF", 57 | "o c #000201", 58 | "p c #FCFFFF", 59 | "q c #F5FBF9", 60 | "r c #050503", 61 | "s c #FEFFFB", 62 | "t c #F8FAFD", 63 | "u c #F8F8F8", 64 | "v c #8D8D8D", 65 | "w c #FDFEF9", 66 | "x c #FCFEF9", 67 | "y c #FDFDFB", 68 | "z c #FCFEFD", 69 | "A c #FBFDFA", 70 | "B c #FBFEF1", 71 | "C c #FEFFFF", 72 | "D c #F9FAFE", 73 | "E c #FCFFF6", 74 | "F c #FEFFF4", 75 | "G c #FCFFF2", 76 | "H c #FFFFF3", 77 | "I c #FEFFF5", 78 | "J c #FFFFFB", 79 | "K c #BCBCBC", 80 | "L c #C2C2C0", 81 | "M c #C3C0C7", 82 | "N c #C2C1C6", 83 | "O c #C2C0CB", 84 | "P c #C2BFD0", 85 | "Q c #C3C1CE", 86 | "R c #BEBFBA", 87 | "S c #C9CBC0", 88 | "T c #BBBCB7", 89 | "U c #BEBEBC", 90 | "V c #B9B8B4", 91 | "W c #C2C3BE", 92 | "X c #B7B7B5", 93 | "Y c #CACACA", 94 | "Z c #B5B5B5", 95 | "` c #BBBBBB", 96 | " . c #FAFAFC", 97 | ".. c #FDFAFF", 98 | "+. c #FDFCFA", 99 | "@. c #FDFBFC", 100 | "#. c #FDF9FF", 101 | "$. c #FCF8FF", 102 | "%. c #FEFDF9", 103 | "&. c #F8F8F0", 104 | "*. c #FFFEFC", 105 | "=. c #FAF7FE", 106 | ". + @ @ @ @ @ @ @ @ # # $ % & * = - ; > , ' ) ", 107 | "! ~ { { { { { { { { ] ^ { / { { { ] { ( { { _ ", 108 | "@ { _ _ _ _ _ _ _ _ _ : _ < _ < _ [ < _ _ } _ ", 109 | "@ { | _ 1 _ _ 1 1 1 2 1 1 1 _ 1 1 1 _ _ [ 3 _ ", 110 | "& 4 5 1 1 _ _ 1 _ 1 _ 1 6 1 _ 1 7 1 7 _ _ 8 _ ", 111 | "& 9 | _ 1 _ _ 1 _ 1 _ 1 0 1 _ 1 a 1 _ _ _ 8 _ ", 112 | "& 9 b _ 1 _ _ 1 _ 1 _ 1 c 1 _ 1 7 1 _ _ _ 8 _ ", 113 | "& 9 d _ 1 _ _ 1 1 1 e 1 1 1 _ 1 1 1 _ _ _ 8 _ ", 114 | "& f g _ 1 _ _ _ _ 1 h _ _ 1 _ _ i 1 _ _ _ 8 _ ", 115 | "& j k _ 1 _ _ _ _ 1 _ _ _ 1 _ _ l 1 _ _ _ 8 _ ", 116 | "& j m _ 1 _ _ _ _ 1 _ _ _ 1 _ _ n 1 _ _ _ 8 _ ", 117 | "& o p _ 1 _ _ _ _ 1 _ _ _ 1 _ _ q 1 _ _ _ 8 _ ", 118 | "+ r s 1 1 1 _ _ 1 1 t _ 1 1 _ _ 1 1 _ _ [ 8 u ", 119 | "v { w x y z 6 A B _ C D s E F G H I J u _ K _ ", 120 | ", { L 3 M N L L N O P Q R S T U V W X Y Z ` _ ", 121 | "# .......2 +.@...#.$...%.&.*.7 | =._ _ _ _ [ "}; 122 | -------------------------------------------------------------------------------- /design/image/twedit.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tedit_xpm[] = { 3 | "23 16 157 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #747474", 7 | "@ c #818181", 8 | "# c #7C7C7C", 9 | "$ c #7D7D7D", 10 | "% c #777777", 11 | "& c #7E7E7E", 12 | "* c #878787", 13 | "= c #888888", 14 | "- c #7A7A7A", 15 | "; c #858585", 16 | "> c #7B7B7B", 17 | ", c #8A8A8A", 18 | "' c #868686", 19 | ") c #787878", 20 | "! c #727272", 21 | "~ c #0B0B0B", 22 | "{ c #000000", 23 | "] c #030303", 24 | "^ c #050505", 25 | "/ c #0A0A0A", 26 | "( c #040404", 27 | "_ c #FFFFFF", 28 | ": c #F9F9F9", 29 | "< c #FCFCFC", 30 | "[ c #FDFDFD", 31 | "} c #BEBEBE", 32 | "| c #FFFDFF", 33 | "1 c #FEFEFE", 34 | "2 c #FDFFFE", 35 | "3 c #FDFEFF", 36 | "4 c #FDFDFF", 37 | "5 c #FDFBFF", 38 | "6 c #FEFCFF", 39 | "7 c #FEFEFF", 40 | "8 c #FFFFFD", 41 | "9 c #010000", 42 | "0 c #FFFEFF", 43 | "a c #020202", 44 | "b c #C2C2C2", 45 | "c c #020003", 46 | "d c #FFFAFF", 47 | "e c #FEFCFD", 48 | "f c #FBFBFB", 49 | "g c #FEFFFF", 50 | "h c #FCFFFF", 51 | "i c #F8F8FF", 52 | "j c #AA4747", 53 | "k c #FCFDFF", 54 | "l c #FEFFFD", 55 | "m c #FAFBF3", 56 | "n c #FFFFFA", 57 | "o c #030004", 58 | "p c #C5C5C5", 59 | "q c #010103", 60 | "r c #FFFBFF", 61 | "s c #FBFAFF", 62 | "t c #F6F9FF", 63 | "u c #FBFEFF", 64 | "v c #F9FAFF", 65 | "w c #FBF9FF", 66 | "x c #F6F8FF", 67 | "y c #FCFBF6", 68 | "z c #FAF5F9", 69 | "A c #020005", 70 | "B c #EEECF9", 71 | "C c #FEFDFF", 72 | "D c #F8FBFF", 73 | "E c #F2F2FF", 74 | "F c #F4F6FF", 75 | "G c #000004", 76 | "H c #F5F5FD", 77 | "I c #FCFBFF", 78 | "J c #F1EFFF", 79 | "K c #F5F1FF", 80 | "L c #F5F7FF", 81 | "M c #F8F2FF", 82 | "N c #000002", 83 | "O c #000105", 84 | "P c #F7FBFF", 85 | "Q c #F4F3FF", 86 | "R c #F1F4FF", 87 | "S c #F5F3FF", 88 | "T c #F9FBFF", 89 | "U c #F2F5FF", 90 | "V c #060A0B", 91 | "W c #000103", 92 | "X c #FBFFFF", 93 | "Y c #F4F8FF", 94 | "Z c #F3EFFF", 95 | "` c #F3F6FF", 96 | " . c #F5F2FF", 97 | ".. c #F8FAFF", 98 | "+. c #F0F6FF", 99 | "@. c #000202", 100 | "#. c #F9FEFF", 101 | "$. c #F8F1FF", 102 | "%. c #F1F1FF", 103 | "&. c #F7F1FF", 104 | "*. c #F7F9FF", 105 | "=. c #010602", 106 | "-. c #000201", 107 | ";. c #FAFAFF", 108 | ">. c #F7F6FF", 109 | ",. c #F5FBF9", 110 | "'. c #000300", 111 | "). c #050503", 112 | "!. c #FEFFFB", 113 | "~. c #FCFCFF", 114 | "{. c #FBFDFF", 115 | "]. c #FBFCFF", 116 | "^. c #F5F8FF", 117 | "/. c #000200", 118 | "(. c #FEFFF4", 119 | "_. c #010200", 120 | ":. c #F8F8F8", 121 | "<. c #8D8D8D", 122 | "[. c #FDFEF9", 123 | "}. c #FCFEF9", 124 | "|. c #FDFDFB", 125 | "1. c #FCFEFD", 126 | "2. c #FCFEFB", 127 | "3. c #FCFFF2", 128 | "4. c #FCFFF4", 129 | "5. c #F9FAFE", 130 | "6. c #FCFFF6", 131 | "7. c #FFFFF3", 132 | "8. c #FEFFF5", 133 | "9. c #FFFFFB", 134 | "0. c #BCBCBC", 135 | "a. c #C2C2C0", 136 | "b. c #C3C0C7", 137 | "c. c #C2C1C6", 138 | "d. c #C2C0CB", 139 | "e. c #C2BFD0", 140 | "f. c #C3C1CE", 141 | "g. c #BEBFBA", 142 | "h. c #C9CBC0", 143 | "i. c #BBBCB7", 144 | "j. c #BEBEBC", 145 | "k. c #B9B8B4", 146 | "l. c #C2C3BE", 147 | "m. c #B7B7B5", 148 | "n. c #CACACA", 149 | "o. c #B5B5B5", 150 | "p. c #BBBBBB", 151 | "q. c #FAFAFC", 152 | "r. c #FDFAFF", 153 | "s. c #FDFCFA", 154 | "t. c #FDFBFC", 155 | "u. c #FDF9FF", 156 | "v. c #FCF8FF", 157 | "w. c #FEFDF9", 158 | "x. c #F8F8F0", 159 | "y. c #FFFEFC", 160 | "z. c #FAF7FE", 161 | ". + @ @ @ @ @ @ @ @ # # $ % & * = - ; > , ' ) ", 162 | "! ~ { { { { { { { { ] ^ { / { { { ] { ( { { _ ", 163 | "@ { _ _ _ _ _ _ _ _ _ : _ < _ < _ [ < _ _ } _ ", 164 | "@ { | | 1 1 1 2 3 4 5 6 7 : 8 { 9 0 a { [ b _ ", 165 | "& c d | e f g h h i j j k l m n 0 o 0 _ _ p _ ", 166 | "& q | r | s k t u v j j w x 8 y z A 0 _ _ p _ ", 167 | "& q 0 B C j j j D E j j j j F g 0 G _ _ _ p _ ", 168 | "& q H k I J K j j L j j M j j t h N _ _ _ p _ ", 169 | "& O h P Q j j j j R j j S j j T U V g _ _ p _ ", 170 | "& W X Y j j Z j j ` j j .j j ..+.@.g _ _ p _ ", 171 | "& W u #.j j $.j j %.j j &.j j *.X =.g _ _ p _ ", 172 | "& -.h P ;.j j j j i j j j j >.u ,.'.l _ _ p _ ", 173 | "+ ).!.h h k ~.{.X X T ].{.^.h /.'.(._.{ [ p :.", 174 | "<.{ [.}.|.1.k 2.3.4.g 5.!.6.(.3.7.8.9.:._ 0._ ", 175 | ", { a.b b.c.a.a.c.d.e.f.g.h.i.j.k.l.m.n.o.p._ ", 176 | "# q.r.r.r.5 s.t.r.u.v.r.w.x.y.0 | z._ _ _ _ [ "}; 177 | -------------------------------------------------------------------------------- /design/image/twfilebutton.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tbutton_xpm[] = { 3 | "23 23 6 1", 4 | " c None", 5 | ". c #FFFFFF", 6 | "+ c #424242", 7 | "@ c #D6D6CE", 8 | "# c #848484", 9 | "$ c #474744", 10 | " ", 11 | " ", 12 | " ", 13 | " ", 14 | "......................+", 15 | ".@@@@@@@@@@@@@@@@@@@@#+", 16 | ".@@@@@@@@@@@@@@@@@@@@#+", 17 | ".@@$$$$@$@@$@@@@$$$$@#+", 18 | ".@@$@@@@$@@$@@@@$@@@@#+", 19 | ".@@$@@@@$@@$@@@@$@@@@#+", 20 | ".@@$$$$@$@@$@@@@$$@@@#+", 21 | ".@@$@@@@$@@$@@@@$@@@@#+", 22 | ".@@$@@@@$@@$@@@@$@@@@#+", 23 | ".@@$@@@@$@@$$$$@$$$$@#+", 24 | ".@@@@@@@@@@@@@@@@@@@@#+", 25 | ".@@@@@@@@@@@@@@@@@@@@#+", 26 | ".#####################+", 27 | "+++++++++++++++++++++++", 28 | " ", 29 | " ", 30 | " ", 31 | " ", 32 | " "}; 33 | -------------------------------------------------------------------------------- /design/image/twfloatedit.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tfloatspinedit_xpm[] = { 3 | "23 16 123 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #747474", 7 | "@ c #818181", 8 | "# c #7C7C7C", 9 | "$ c #7D7D7D", 10 | "% c #777777", 11 | "& c #7E7E7E", 12 | "* c #878787", 13 | "= c #888888", 14 | "- c #7A7A7A", 15 | "; c #858585", 16 | "> c #7B7B7B", 17 | ", c #8A8A8A", 18 | "' c #868686", 19 | ") c #787878", 20 | "! c #727272", 21 | "~ c #0B0B0B", 22 | "{ c #000000", 23 | "] c #030303", 24 | "^ c #050505", 25 | "/ c #0A0A0A", 26 | "( c #040404", 27 | "_ c #FFFFFF", 28 | ": c #F9F9F9", 29 | "< c #FCFCFC", 30 | "[ c #FDFDFD", 31 | "} c #BEBEBE", 32 | "| c #FFFDFF", 33 | "1 c #FEFCFF", 34 | "2 c #FEFEFF", 35 | "3 c #010000", 36 | "4 c #020202", 37 | "5 c #C2C2C2", 38 | "6 c #020003", 39 | "7 c #FFFAFF", 40 | "8 c #FCFDFF", 41 | "9 c #FAFBF3", 42 | "0 c #FFFFFA", 43 | "a c #FFFEFF", 44 | "b c #010103", 45 | "c c #FFFFFD", 46 | "d c #F8BDBD", 47 | "e c #EF6464", 48 | "f c #E81F1F", 49 | "g c #F06E6E", 50 | "h c #FEFFFF", 51 | "i c #EB3E3E", 52 | "j c #FCE3E3", 53 | "k c #FCE2E2", 54 | "l c #EB4040", 55 | "m c #FDF0F0", 56 | "n c #000105", 57 | "o c #FCFFFF", 58 | "p c #E82020", 59 | "q c #FEFDFD", 60 | "r c #FEFCFC", 61 | "s c #E82121", 62 | "t c #F6A9A9", 63 | "u c #F07070", 64 | "v c #F17B7B", 65 | "w c #000103", 66 | "x c #FBFFFF", 67 | "y c #FCE4E4", 68 | "z c #EB3F3F", 69 | "A c #FDF4F4", 70 | "B c #E82525", 71 | "C c #F8FAFF", 72 | "D c #FBFEFF", 73 | "E c #F3BBBC", 74 | "F c #EF6363", 75 | "G c #EF6666", 76 | "H c #E92F2F", 77 | "I c #F17D7D", 78 | "J c #EF6767", 79 | "K c #F38F8F", 80 | "L c #000201", 81 | "M c #FEFFFD", 82 | "N c #050503", 83 | "O c #FEFFFB", 84 | "P c #F9FBFF", 85 | "Q c #FBFCFF", 86 | "R c #C5C5C5", 87 | "S c #F8F8F8", 88 | "T c #8D8D8D", 89 | "U c #FDFEF9", 90 | "V c #FCFEF9", 91 | "W c #FDFDFB", 92 | "X c #FCFEFB", 93 | "Y c #FCFFF2", 94 | "Z c #FCFFF6", 95 | "` c #FEFFF4", 96 | " . c #FFFFF3", 97 | ".. c #FEFFF5", 98 | "+. c #FFFFFB", 99 | "@. c #BCBCBC", 100 | "#. c #C2C2C0", 101 | "$. c #C3C0C7", 102 | "%. c #C2C1C6", 103 | "&. c #C2C0CB", 104 | "*. c #C2BFD0", 105 | "=. c #C3C1CE", 106 | "-. c #BEBFBA", 107 | ";. c #C9CBC0", 108 | ">. c #BBBCB7", 109 | ",. c #BEBEBC", 110 | "'. c #B9B8B4", 111 | "). c #C2C3BE", 112 | "!. c #B7B7B5", 113 | "~. c #CACACA", 114 | "{. c #B5B5B5", 115 | "]. c #BBBBBB", 116 | "^. c #FAFAFC", 117 | "/. c #FDFAFF", 118 | "(. c #FDFBFF", 119 | "_. c #FDFCFA", 120 | ":. c #FDFBFC", 121 | "<. c #FDF9FF", 122 | "[. c #FCF8FF", 123 | "}. c #FEFDF9", 124 | "|. c #F8F8F0", 125 | "1. c #FFFEFC", 126 | "2. c #FAF7FE", 127 | ". + @ @ @ @ @ @ @ @ # # $ % & * = - ; > , ' ) ", 128 | "! ~ { { { { { { { { ] ^ { / { { { ] { ( { { _ ", 129 | "@ { _ _ _ _ _ _ _ _ _ : _ < _ < _ [ < _ _ } _ ", 130 | "@ { | _ _ _ _ _ _ _ _ 1 2 { { { 3 { 4 { [ 5 _ ", 131 | "& 6 7 _ _ _ _ _ _ _ _ _ 8 { 9 0 { 8 a { _ 5 _ ", 132 | "& b | _ _ _ _ _ _ _ _ _ _ { c { { { a { _ 5 _ ", 133 | "& b a d e e d _ _ f g g _ { _ h a 8 _ { _ 5 _ ", 134 | "& b _ i j k l _ _ f m _ _ { { { { { { { _ 5 _ ", 135 | "& n o p q r s _ _ t u v _ { { { { { { { _ 5 _ ", 136 | "& w x i y j z _ _ _ A B _ { _ C _ 8 h { _ 5 _ ", 137 | "& w D E F G d H _ I J K _ { _ { { { h { 8 5 _ ", 138 | "& L o _ _ _ _ _ _ _ _ _ _ { _ D { 8 M { _ 5 _ ", 139 | "+ N O o o 8 _ _ x x P Q _ { { { { { { { [ R S ", 140 | "T { U V W _ 8 X Y _ _ _ _ Z ` Y ...+.S _ @._ ", 141 | ", { #.5 $.%.#.#.%.&.*.=.-.;.>.,.'.).!.~.{.]._ ", 142 | "# ^./././.(._.:./.<.[./.}.|.1.a | 2._ _ _ _ [ "}; 143 | -------------------------------------------------------------------------------- /design/image/twimage.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *timage[]={ 3 | "20 20 5 1", 4 | "c c #0058c0", 5 | "b c #008000", 6 | ". c #a8dcff", 7 | "# c #ffff00", 8 | "a c #ffffff", 9 | "....................", 10 | "....................", 11 | ".#....#.............", 12 | "..#..#......a.a.aa..", 13 | "...##.......a..a..a.", 14 | "...##........a.aa...", 15 | "..#..#............a.", 16 | ".#....#.............", 17 | "....................", 18 | "....................", 19 | "....................", 20 | "...................b", 21 | "..................bb", 22 | "cccccccccccccccccbbb", 23 | "ccccccccccccccccbbbb", 24 | "cccccccccccccccbbbbb", 25 | "ccccccccccccccbbbbbb", 26 | "cccccccccccccbbbbbbb", 27 | "ccccccccccccbbbbbbbb", 28 | "cccccccccccbbbbbbbbb"}; 29 | -------------------------------------------------------------------------------- /design/image/twintegeredit.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tspinedit_xpm[] = { 3 | "23 16 99 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #747474", 7 | "@ c #818181", 8 | "# c #7C7C7C", 9 | "$ c #7D7D7D", 10 | "% c #777777", 11 | "& c #7E7E7E", 12 | "* c #878787", 13 | "= c #888888", 14 | "- c #7A7A7A", 15 | "; c #858585", 16 | "> c #7B7B7B", 17 | ", c #8A8A8A", 18 | "' c #868686", 19 | ") c #787878", 20 | "! c #727272", 21 | "~ c #0B0B0B", 22 | "{ c #000000", 23 | "] c #030303", 24 | "^ c #050505", 25 | "/ c #0A0A0A", 26 | "( c #040404", 27 | "_ c #FFFFFF", 28 | ": c #F9F9F9", 29 | "< c #FCFCFC", 30 | "[ c #FDFDFD", 31 | "} c #BEBEBE", 32 | "| c #FFFDFF", 33 | "1 c #AA4747", 34 | "2 c #FEFCFF", 35 | "3 c #FEFEFF", 36 | "4 c #010000", 37 | "5 c #020202", 38 | "6 c #C2C2C2", 39 | "7 c #020003", 40 | "8 c #FFFAFF", 41 | "9 c #FCFDFF", 42 | "0 c #FAFBF3", 43 | "a c #FFFFFA", 44 | "b c #FFFEFF", 45 | "c c #010103", 46 | "d c #FFFBFF", 47 | "e c #FFFFFD", 48 | "f c #FEFFFF", 49 | "g c #000105", 50 | "h c #FCFFFF", 51 | "i c #000103", 52 | "j c #FBFFFF", 53 | "k c #F8FAFF", 54 | "l c #FBFEFF", 55 | "m c #F9FEFF", 56 | "n c #000201", 57 | "o c #FEFFFD", 58 | "p c #050503", 59 | "q c #FEFFFB", 60 | "r c #F9FBFF", 61 | "s c #FBFCFF", 62 | "t c #C5C5C5", 63 | "u c #F8F8F8", 64 | "v c #8D8D8D", 65 | "w c #FDFEF9", 66 | "x c #FCFEF9", 67 | "y c #FDFDFB", 68 | "z c #FCFEFB", 69 | "A c #FCFFF2", 70 | "B c #FCFFF6", 71 | "C c #FEFFF4", 72 | "D c #FFFFF3", 73 | "E c #FEFFF5", 74 | "F c #FFFFFB", 75 | "G c #BCBCBC", 76 | "H c #C2C2C0", 77 | "I c #C3C0C7", 78 | "J c #C2C1C6", 79 | "K c #C2C0CB", 80 | "L c #C2BFD0", 81 | "M c #C3C1CE", 82 | "N c #BEBFBA", 83 | "O c #C9CBC0", 84 | "P c #BBBCB7", 85 | "Q c #BEBEBC", 86 | "R c #B9B8B4", 87 | "S c #C2C3BE", 88 | "T c #B7B7B5", 89 | "U c #CACACA", 90 | "V c #B5B5B5", 91 | "W c #BBBBBB", 92 | "X c #FAFAFC", 93 | "Y c #FDFAFF", 94 | "Z c #FDFBFF", 95 | "` c #FDFCFA", 96 | " . c #FDFBFC", 97 | ".. c #FDF9FF", 98 | "+. c #FCF8FF", 99 | "@. c #FEFDF9", 100 | "#. c #F8F8F0", 101 | "$. c #FFFEFC", 102 | "%. c #FAF7FE", 103 | ". + @ @ @ @ @ @ @ @ # # $ % & * = - ; > , ' ) ", 104 | "! ~ { { { { { { { { ] ^ { / { { { ] { ( { { _ ", 105 | "@ { _ _ _ _ _ _ _ _ _ : _ < _ < _ [ < _ _ } _ ", 106 | "@ { | 1 1 1 1 1 1 1 1 2 3 { { { 4 { 5 { [ 6 _ ", 107 | "& 7 8 1 1 1 1 1 1 1 1 _ 9 { 0 a { 9 b { _ _ ", 108 | "& c | d | _ _ _ _ 1 1 _ _ { e { { { b { _ _ ", 109 | "& c b _ _ _ _ _ _ 1 1 _ _ { _ f b 9 _ { _ _ ", 110 | "& c _ _ _ _ _ _ 1 1 _ _ _ { { { { { { { _ _ ", 111 | "& g h _ _ _ _ _ 1 1 _ _ _ { { { { { { { _ _ ", 112 | "& i j _ _ _ _ 1 1 _ _ _ _ { _ k _ 9 f { _ _ ", 113 | "& i l m _ _ _ 1 1 _ _ _ _ { _ { { { f { 9 _ ", 114 | "& n h _ _ _ 1 1 _ _ _ _ _ { _ l { 9 o { _ _ ", 115 | "+ p q h h 9 1 1 j j r s _ { { { { { { { [ t u ", 116 | "v { w x y _ 9 z A _ _ _ _ B C A D E F u _ G _ ", 117 | ", { H 6 I J H H J K L M N O P Q R S T U V W _ ", 118 | "# X Y Y Y Z ` .Y ..+.Y @.#.$.b | %._ _ _ _ [ "}; 119 | -------------------------------------------------------------------------------- /design/image/twlabel.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *graphic[] = { 3 | "23 23 28 1", 4 | ". c None", 5 | ", c #FFFFFF", 6 | "- c #C6C6C6", 7 | "* c #ADADAD", 8 | "a c #0F0F0F", 9 | "b c #5F5F5F", 10 | "c c #BFBFBF", 11 | "d c #2B2B2B", 12 | "e c #373737", 13 | "f c #4A4A4A", 14 | "g c #4B4B4B", 15 | "h c #636363", 16 | "i c #7F7F7F", 17 | "j c #313131", 18 | "k c #7B7B7B", 19 | "l c #949494", 20 | "m c #1B1B1B", 21 | "n c #9D9D9D", 22 | "o c #1E1E1E", 23 | "p c #B7B7B7", 24 | "q c #060606", 25 | "r c #B5B5B5", 26 | "s c #9E9E9E", 27 | "t c #000000", 28 | "u c #A5A5A5", 29 | "v c #272727", 30 | "w c #8F8F8F", 31 | "x c #A7A7A7", 32 | ".......................", 33 | ".......................", 34 | ".......................", 35 | ".......................", 36 | ",,,,,,,,,,,,,,,,,,,,,,,", 37 | ",---------------------,", 38 | ",---------------------,", 39 | ",----------*ab--------,", 40 | ",---------cdef--------,", 41 | ",---------ghij--------,", 42 | ",--------ke-lm--------,", 43 | ",-------nop-*q--------,", 44 | ",------ros---tp-------,", 45 | ",------ettttttu-------,", 46 | ",-----hf-----vw-------,", 47 | ",----mtt*---bttx------,", 48 | ",---------------------,", 49 | ",---------------------,", 50 | ",,,,,,,,,,,,,,,,,,,,,,,", 51 | ".......................", 52 | ".......................", 53 | ".......................", 54 | "......................."} 55 | -------------------------------------------------------------------------------- /design/image/twmemo.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tmemo_xpm[] = { 3 | "16 18 107 2", 4 | " c None", 5 | ". c #848484", 6 | "+ c #7F7F81", 7 | "@ c #818088", 8 | "# c #86858D", 9 | "$ c #7C7B83", 10 | "% c #79787D", 11 | "& c #838385", 12 | "* c #7B7B7B", 13 | "= c #8E8F8A", 14 | "- c #777872", 15 | "; c #81827C", 16 | "> c #7B7C74", 17 | ", c #7E7F79", 18 | "' c #757670", 19 | ") c #91928D", 20 | "! c #8A8A8A", 21 | "~ c #FCFBFF", 22 | "{ c #FFFDFF", 23 | "] c #F6F3FF", 24 | "^ c #F8F7FF", 25 | "/ c #FFFEFF", 26 | "( c #FDFDFD", 27 | "_ c #FFFFFD", 28 | ": c #FBFCF7", 29 | "< c #FEFFF9", 30 | "[ c #FEFFFA", 31 | "} c #FFFFFB", 32 | "| c #000000", 33 | "1 c #FFFCFF", 34 | "2 c #F4F1FF", 35 | "3 c #F7F6FE", 36 | "4 c #F7F7F7", 37 | "5 c #FEFEFC", 38 | "6 c #FAFAF8", 39 | "7 c #F6F6F4", 40 | "8 c #7C7C7C", 41 | "9 c #020107", 42 | "0 c #040019", 43 | "a c #FEFCFF", 44 | "b c #FDFCFF", 45 | "c c #F9F9FB", 46 | "d c #F8F8F8", 47 | "e c #FFFFFF", 48 | "f c #000002", 49 | "g c #7F7F7F", 50 | "h c #FEFBFF", 51 | "i c #F5F0FF", 52 | "j c #FEFAFF", 53 | "k c #FBF7FF", 54 | "l c #F3EFFF", 55 | "m c #F8F6FF", 56 | "n c #FEFDFF", 57 | "o c #FCFAFF", 58 | "p c #7E7E7E", 59 | "q c #FBF9FF", 60 | "r c #F9F8FF", 61 | "s c #F9F9FF", 62 | "t c #F9F7FF", 63 | "u c #FFFBFF", 64 | "v c #070513", 65 | "w c #0B092E", 66 | "x c #00000B", 67 | "y c #F9FAFF", 68 | "z c #F8F9FF", 69 | "A c #F7F9FF", 70 | "B c #F8F8FF", 71 | "C c #F3F4FF", 72 | "D c #FBFBFF", 73 | "E c #000004", 74 | "F c #F1F0FE", 75 | "G c #060709", 76 | "H c #F7F8FF", 77 | "I c #F7F7FF", 78 | "J c #F6F4FF", 79 | "K c #000009", 80 | "L c #0A0931", 81 | "M c #F6F6FF", 82 | "N c #FAFAFF", 83 | "O c #FCFDFF", 84 | "P c #05080D", 85 | "Q c #000007", 86 | "R c #FBFAFF", 87 | "S c #00000C", 88 | "T c #787878", 89 | "U c #FEFEFF", 90 | "V c #808080", 91 | "W c #FBFDFF", 92 | "X c #FAFDFF", 93 | "Y c #F8FEFF", 94 | "Z c #FBFEFF", 95 | "` c #F6F8FF", 96 | " . c #FCFFFF", 97 | ".. c #FDFFFA", 98 | "+. c #0E1204", 99 | "@. c #FEFFFF", 100 | "#. c #FBFFFF", 101 | "$. c #FAFFFF", 102 | "%. c #FBFFFC", 103 | "&. c #FCFFFA", 104 | "*. c #FAFDF2", 105 | "=. c #000300", 106 | "-. c #000100", 107 | ";. c #000200", 108 | ">. c #090D0C", 109 | ",. c #000201", 110 | "'. c #040500", 111 | ". + @ # $ % & * = - ; > , ' - ) ", 112 | "! ~ { ] { { ^ / ( _ : < [ } } | ", 113 | "* / 1 2 1 { { 3 / 4 _ _ 5 6 7 | ", 114 | "8 / 9 9 0 9 1 a b / c d e e e f ", 115 | "g { h i j k l h h m a b n o n 9 ", 116 | "p n q r r r r r r s t q m j u v ", 117 | "p n 9 9 9 9 9 9 9 9 9 9 9 w q x ", 118 | "p n y z A A A A B B r C o D n E ", 119 | "p n 9 9 9 9 9 9 9 9 9 9 c s F G ", 120 | "p n s ^ H H I I I I ^ J m o a K ", 121 | "p n 9 9 9 9 9 9 9 9 9 9 9 L M x ", 122 | "p n y B B B H H I H B z q N O P ", 123 | "p n 9 9 9 9 9 c c c 9 9 9 D y Q ", 124 | "g n R r r B B B ^ ^ J r t D D S ", 125 | "T U 9 9 9 9 9 9 9 9 9 9 9 9 O Q ", 126 | "V O W X W X X Y X X Z Z ` ...+.", 127 | ". e @. . . . .#.#.#.$.$.%.&.*.=.", 128 | "8 f E E f -.-.;.;.;.-.>.,.-.'.-."}; 129 | -------------------------------------------------------------------------------- /design/image/twpagecontrol.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char *graphic[] = { 3 | "23 23 9 1", 4 | ". c None", 5 | ", c #FFFFFF", 6 | "- c #080808", 7 | "* c #000000", 8 | "a c #030303", 9 | "b c #848484", 10 | "c c #020202", 11 | "d c #050505", 12 | "e c #010101", 13 | ".......................", 14 | ".......................", 15 | ".,,,,,,,,,-**********..", 16 | ".,........-....*....*..", 17 | ".,........-....*....*..", 18 | ".,........-....*....*..", 19 | ",,........,,,,,,,,,,,,a", 20 | ",....................b*", 21 | ",....................b*", 22 | ",....................b*", 23 | ",....................b*", 24 | ",bbbbbbbbbbbbbbbbbbbbb*", 25 | "*c**d*e**e**********c*.", 26 | ".......................", 27 | ".......................", 28 | ".......................", 29 | ".......................", 30 | ".......................", 31 | ".......................", 32 | ".......................", 33 | ".......................", 34 | ".......................", 35 | "......................."} 36 | -------------------------------------------------------------------------------- /design/image/twpagination.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tdbnavigator_xpm[] = { 3 | "23 23 77 1", 4 | " c None", 5 | ". c #828282", 6 | "+ c #FFFFFF", 7 | "@ c #BFBFBF", 8 | "# c #F8F8F8", 9 | "$ c #EFEFEF", 10 | "% c #F0F0F0", 11 | "& c #030303", 12 | "* c #C1C1C1", 13 | "= c #BCBCBC", 14 | "- c #BDBDBD", 15 | "; c #C5C5C5", 16 | "> c #9D9D9D", 17 | ", c #202020", 18 | "' c #808080", 19 | ") c #000000", 20 | "! c #3D3D3D", 21 | "~ c #8D8D8D", 22 | "{ c #F4F4F4", 23 | "] c #C8C8C8", 24 | "^ c #BEBEBE", 25 | "/ c #C6C6C6", 26 | "( c #969696", 27 | "_ c #929292", 28 | ": c #3A3A3A", 29 | "< c #7B7B7B", 30 | "[ c #686868", 31 | "} c #898989", 32 | "| c #9C9C9C", 33 | "1 c #848484", 34 | "2 c #C3C3C3", 35 | "3 c #323232", 36 | "4 c #C0C0C0", 37 | "5 c #6F6F6F", 38 | "6 c #D8D8D8", 39 | "7 c #666666", 40 | "8 c #8C8C8C", 41 | "9 c #CACACA", 42 | "0 c #313131", 43 | "a c #BBBBBB", 44 | "b c #B0B0B0", 45 | "c c #A0A0A0", 46 | "d c #939393", 47 | "e c #4A4A4A", 48 | "f c #A9A9A9", 49 | "g c #9A9A9A", 50 | "h c #303030", 51 | "i c #575757", 52 | "j c #949494", 53 | "k c #868686", 54 | "l c #262626", 55 | "m c #979797", 56 | "n c #878787", 57 | "o c #2F2F2F", 58 | "p c #484848", 59 | "q c #909090", 60 | "r c #3C3C3C", 61 | "s c #343434", 62 | "t c #3F3F3F", 63 | "u c #959595", 64 | "v c #8F8F8F", 65 | "w c #919191", 66 | "x c #353535", 67 | "y c #242424", 68 | "z c #383838", 69 | "A c #B8B8B8", 70 | "B c #989898", 71 | "C c #101010", 72 | "D c #FEFEFE", 73 | "E c #7C7C7C", 74 | "F c #8B8B8B", 75 | "G c #767676", 76 | "H c #7A7A7A", 77 | "I c #7F7F7F", 78 | "J c #020202", 79 | "K c #050505", 80 | "L c #010101", 81 | "................ ", 82 | ".++.++@++@++@++. ", 83 | ".@@............. ", 84 | ".++.++@++@++@++. ", 85 | ".@@.@@@@@@@@@@@. ", 86 | ".++.++@++@++@++. ", 87 | ".@@.@@@@@@@@@@@. ", 88 | ".++.++@++@++@++. ", 89 | ".@@.@@@@@@@@@@@. ", 90 | ".++.++@++@++@++. ", 91 | "...#+$++%+++&#+$++%+++&", 92 | " +*=-;>,*')+*!~;*@*')", 93 | " {]^/(_:/'){]<[}]^/')", 94 | " +=*|1234')+=5678*4')", 95 | " #@119_0a')#@7bc7da')", 96 | " #@efg1ha')#@ijk>la')", 97 | " #@m!n|oa')#@p~m:da')", 98 | " #@;qr.sa')#@tu:v;a')", 99 | " +=*4wxy4')+=z:~=*4')", 100 | " {]^/ABC/'){]CjA]^/')", 101 | " +*=-;*@=')+*=-;*@=')", 102 | " DEFG.nHI})DEFG.nHI})", 103 | " )J)K)L))) )J)K)L))) "}; 104 | -------------------------------------------------------------------------------- /design/image/twpanel.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tpanel_xpm[] = { 3 | "20 21 4 1", 4 | " c None", 5 | ". c #808080", 6 | "+ c #FFFFFF", 7 | "@ c #C0C0C0", 8 | "................... ", 9 | ".+++++++++++++++++@+", 10 | ".+@@@@@@@@@@@@@@@@.+", 11 | ".+@@@@@@@@@@@@@@@@.+", 12 | ".+@@@@@@@@@@@@@@@@.+", 13 | ".+@@@@@@@@@@@@@@@@.+", 14 | ".+@@@@@@@@@@@@@@@@.+", 15 | ".+@@@@@@@@@@@@@@@@.+", 16 | ".+@@@@@@@@@@@@@@@@.+", 17 | ".+@@@@@@@@@@@@@@@@.+", 18 | ".+@@@@@@@@@@@@@@@@.+", 19 | ".+@@@@@@@@@@@@@@@@.+", 20 | ".+@@@@@@@@@@@@@@@@.+", 21 | ".+@@@@@@@@@@@@@@@@.+", 22 | ".+@@@@@@@@@@@@@@@@.+", 23 | ".+@@@@@@@@@@@@@@@@.+", 24 | ".+@@@@@@@@@@@@@@@@.+", 25 | ".+@@@@@@@@@@@@@@@@.+", 26 | ".@.................+", 27 | " +++++++++++++++++++", 28 | " "}; 29 | 30 | -------------------------------------------------------------------------------- /design/image/twtimeeditbox.xpm: -------------------------------------------------------------------------------- 1 | /* XPM */ 2 | static char * tedit_xpm[] = { 3 | "23 16 136 2", 4 | " c None", 5 | ". c #929292", 6 | "+ c #747474", 7 | "@ c #818181", 8 | "# c #7C7C7C", 9 | "$ c #7D7D7D", 10 | "% c #777777", 11 | "& c #7E7E7E", 12 | "* c #878787", 13 | "= c #888888", 14 | "- c #7A7A7A", 15 | "; c #858585", 16 | "> c #7B7B7B", 17 | ", c #8A8A8A", 18 | "' c #868686", 19 | ") c #787878", 20 | "! c #727272", 21 | "~ c #0B0B0B", 22 | "{ c #000000", 23 | "] c #030303", 24 | "^ c #050505", 25 | "/ c #0A0A0A", 26 | "( c #040404", 27 | "_ c #FFFFFF", 28 | ": c #F9F9F9", 29 | "< c #FCFCFC", 30 | "[ c #FDFDFD", 31 | "} c #BEBEBE", 32 | "| c #FFFDFF", 33 | "1 c #AA4747", 34 | "2 c #FEFEFE", 35 | "3 c #FDFBFF", 36 | "4 c #FEFCFF", 37 | "5 c #FEFEFF", 38 | "6 c #C2C2C2", 39 | "7 c #020003", 40 | "8 c #FFFAFF", 41 | "9 c #FEFCFD", 42 | "0 c #FCFFFF", 43 | "a c #FCFDFF", 44 | "b c #FAFBF3", 45 | "c c #FFFEFF", 46 | "d c #C5C5C5", 47 | "e c #010103", 48 | "f c #FEFDFE", 49 | "g c #FBFEFF", 50 | "h c #FBF9FE", 51 | "i c #FDFEFD", 52 | "j c #FAF5F9", 53 | "k c #FBFBFB", 54 | "l c #F9FBFE", 55 | "m c #F6F4F4", 56 | "n c #F7F9FE", 57 | "o c #FAF8FD", 58 | "p c #FCFDFD", 59 | "q c #F8FAFB", 60 | "r c #F9FBFB", 61 | "s c #FAFAF9", 62 | "t c #F8F6F6", 63 | "u c #F9F5FB", 64 | "v c #F9FAFA", 65 | "w c #020307", 66 | "x c #FBFBFC", 67 | "y c #FBFBFD", 68 | "z c #FBFAFC", 69 | "A c #F6F6FB", 70 | "B c #F6F5F5", 71 | "C c #F9FAFC", 72 | "D c #F8F9F9", 73 | "E c #F2F5FF", 74 | "F c #FEFFFF", 75 | "G c #000103", 76 | "H c #FBFCFE", 77 | "I c #F9FAFB", 78 | "J c #F9FCFD", 79 | "K c #F6F6F7", 80 | "L c #F0F6FF", 81 | "M c #FBFDFD", 82 | "N c #FAFBFD", 83 | "O c #F6F4F5", 84 | "P c #FBFFFF", 85 | "Q c #000201", 86 | "R c #FAF9FB", 87 | "S c #F5F3F5", 88 | "T c #F8F7F7", 89 | "U c #F7F8FE", 90 | "V c #F5FBF9", 91 | "W c #FEFFFD", 92 | "X c #050503", 93 | "Y c #FEFFFB", 94 | "Z c #F8F9FE", 95 | "` c #F8FAFD", 96 | " . c #F9FAFE", 97 | ".. c #F8FAFE", 98 | "+. c #F8F8F8", 99 | "@. c #8D8D8D", 100 | "#. c #FDFEF9", 101 | "$. c #FCFEF9", 102 | "%. c #FDFDFB", 103 | "&. c #FCFEFD", 104 | "*. c #FBFDFA", 105 | "=. c #FBFEF1", 106 | "-. c #FCFFF4", 107 | ";. c #FCFFF6", 108 | ">. c #FEFFF4", 109 | ",. c #FCFFF2", 110 | "'. c #FFFFF3", 111 | "). c #FEFFF5", 112 | "!. c #FFFFFB", 113 | "~. c #BCBCBC", 114 | "{. c #C2C2C0", 115 | "]. c #C3C0C7", 116 | "^. c #C2C1C6", 117 | "/. c #C2C0CB", 118 | "(. c #C2BFD0", 119 | "_. c #C3C1CE", 120 | ":. c #BEBFBA", 121 | "<. c #C9CBC0", 122 | "[. c #BBBCB7", 123 | "}. c #BEBEBC", 124 | "|. c #B9B8B4", 125 | "1. c #C2C3BE", 126 | "2. c #B7B7B5", 127 | "3. c #CACACA", 128 | "4. c #B5B5B5", 129 | "5. c #BBBBBB", 130 | "6. c #FAFAFC", 131 | "7. c #FDFAFF", 132 | "8. c #FDFCFA", 133 | "9. c #FDFBFC", 134 | "0. c #FDF9FF", 135 | "a. c #FCF8FF", 136 | "b. c #FEFDF9", 137 | "c. c #F8F8F0", 138 | "d. c #FFFEFC", 139 | "e. c #FAF7FE", 140 | ". + @ @ @ @ @ @ @ @ # # $ % & * = - ; > , ' ) ", 141 | "! ~ { { { { { { { { ] ^ { / { { { ] { ( { { _ ", 142 | "@ { _ _ _ _ _ _ _ _ _ : _ < _ < _ [ < _ _ } _ ", 143 | "@ { | 1 1 1 2 1 1 1 3 4 5 1 1 1 _ 1 1 1 [ 6 _ ", 144 | "& 7 8 1 9 1 _ 1 0 1 _ _ a 1 b 1 c 1 c 1 _ d _ ", 145 | "& e | 1 f 1 _ 1 g 1 _ 1 h 1 i 1 j 1 c 1 _ d _ ", 146 | "& e f 1 k 1 _ 1 l 1 _ 1 m 1 n 1 c 1 _ 1 _ d _ ", 147 | "& e o 1 p 1 q 1 r 1 s t u 1 v 1 0 1 _ 1 _ d _ ", 148 | "& w x 1 y 1 z 1 A 1 B 1 C 1 D 1 E 1 F 1 _ d _ ", 149 | "& G H 1 : 1 _ 1 I 1 _ 1 J 1 K 1 L 1 F 1 _ d _ ", 150 | "& G g 1 : 1 _ 1 M 1 _ _ N 1 O 1 P 1 F 1 _ d _ ", 151 | "& Q 0 1 R 1 _ 1 S 1 _ _ T 1 U 1 V 1 W 1 _ d _ ", 152 | "+ X Y 1 1 1 Z 1 1 1 ` ...1 1 1 _ 1 1 1 [ d +.", 153 | "@.{ #.$.%.&.a *.=.-.F .Y ;.>.,.'.).!.+._ ~._ ", 154 | ", { {.6 ].^.{.{.^./.(._.:.<.[.}.|.1.2.3.4.5._ ", 155 | "# 6.7.7.7.3 8.9.7.0.a.7.b.c.d.c | e._ _ _ _ [ "}; 156 | -------------------------------------------------------------------------------- /design/package/wcldsgn.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | -------------------------------------------------------------------------------- /design/package/wcldsgn.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit WCLDsgn; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | BtnCtrls, DataGrid, DttCtrls, NumCtrls, WebCtrls, Pas2JS_IDE_Descriptor, 12 | websocket, LazarusPackageIntf; 13 | 14 | implementation 15 | 16 | procedure Register; 17 | begin 18 | RegisterUnit('WebCtrls', @WebCtrls.Register); 19 | RegisterUnit('Pas2JS_IDE_Descriptor', @Pas2JS_IDE_Descriptor.Register); 20 | end; 21 | 22 | initialization 23 | RegisterPackage('WCLDsgn', @Register); 24 | end. 25 | -------------------------------------------------------------------------------- /design/source/btnctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit BtnCtrls; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Graphics, 34 | Controls, 35 | StdCtrls; 36 | 37 | type 38 | 39 | { TCustomFileButton } 40 | 41 | TCustomFileButton = class(TCustomButton) 42 | private 43 | FFilter: string; 44 | FOnChange: TNotifyEvent; 45 | procedure SetFilter(AValue: string); 46 | protected 47 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 48 | public 49 | constructor Create(AOwner: TComponent); override; 50 | property Filter: string read FFilter write SetFilter; 51 | end; 52 | 53 | implementation 54 | 55 | { TCustomFileButton } 56 | 57 | procedure TCustomFileButton.SetFilter(AValue: string); 58 | begin 59 | if (FFilter <> AValue) then 60 | begin 61 | FFilter:= AValue; 62 | end; 63 | end; 64 | 65 | constructor TCustomFileButton.Create(AOwner: TComponent); 66 | begin 67 | inherited Create(AOwner); 68 | FFilter:= ''; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /design/source/datagrid.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit DataGrid; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | Graphics, 35 | Controls; 36 | 37 | type 38 | 39 | /// Forward declaration 40 | TCustomDataGrid = class; 41 | 42 | TColumnFormat = (cfBoolean, cfDataTime, cfNumber, cfString); 43 | 44 | { TDataColumn } 45 | 46 | TDataColumn = class(TCollectionItem) 47 | private 48 | FAlignment: TAlignment; 49 | FColor: TColor; 50 | FDisplayMask: string; 51 | FFont: TFont; 52 | FFormat: TColumnFormat; 53 | FHint: string; 54 | FName: string; 55 | FTag: integer; 56 | FTitle: string; 57 | FUpdateCount: NativeInt; 58 | FValueChecked: string; 59 | FValueUnchecked: string; 60 | FVisible: boolean; 61 | FWidth: NativeInt; 62 | function GetGrid: TCustomDataGrid; 63 | procedure SetAlignment(AValue: TAlignment); 64 | procedure SetColor(AValue: TColor); 65 | procedure SetDisplayMask(AValue: string); 66 | procedure SetFont(AValue: TFont); 67 | procedure SetFormat(AValue: TColumnFormat); 68 | procedure SetName(AValue: string); 69 | procedure SetTitle(AValue: string); 70 | procedure SetValueChecked(AValue: string); 71 | procedure SetValueUnchecked(AValue: string); 72 | procedure SetVisible(AValue: boolean); 73 | procedure SetWidth(AValue: NativeInt); 74 | protected 75 | procedure ColumnChanged; virtual; 76 | function GetDisplayName: string; override; 77 | procedure FillDefaultFont; virtual; 78 | procedure FontChanged(Sender: TObject); virtual; 79 | function GetDefaultValueChecked: string; virtual; 80 | function GetDefaultValueUnchecked: string; virtual; 81 | public 82 | constructor Create(ACollection: TCollection); override; 83 | destructor Destroy; override; 84 | procedure Assign(Source: TPersistent); override; 85 | procedure BeginUpdate; virtual; 86 | procedure EndUpdate; virtual; 87 | property Grid: TCustomDataGrid read GetGrid; 88 | published 89 | property Alignment: TAlignment read FAlignment write SetAlignment; 90 | property Color: TColor read FColor write SetColor; 91 | property DisplayMask: string read FDisplayMask write SetDisplayMask; 92 | property Font: TFont read FFont write SetFont; 93 | property Format: TColumnFormat read FFormat write SetFormat; 94 | property Hint: string read FHint write FHint; 95 | property Name: string read FName write SetName; 96 | property Tag: integer read FTag write FTag; 97 | property Title: string read FTitle write SetTitle; 98 | property ValueChecked: string read FValueChecked write SetValueChecked; 99 | property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked; 100 | property Visible: boolean read FVisible write SetVisible; 101 | property Width: NativeInt read FWidth write SetWidth; 102 | end; 103 | 104 | { TDataColumns } 105 | 106 | TDataColumns = class(TCollection) 107 | private 108 | FGrid: TCustomDataGrid; 109 | function GetColumn(AIndex: NativeInt): TDataColumn; 110 | procedure SetColumn(AIndex: NativeInt; AValue: TDataColumn); 111 | protected 112 | function GetOwner: TPersistent; override; 113 | procedure Update(AItem: TCollectionItem); override; 114 | public 115 | constructor Create(AGrid: TCustomDataGrid); reintroduce; 116 | function Add: TDataColumn; reintroduce; 117 | function HasIndex(const AIndex: integer): boolean; 118 | property Grid: TCustomDataGrid read FGrid; 119 | property Items[AIndex: NativeInt]: TDataColumn read GetColumn write SetColumn; default; 120 | end; 121 | 122 | TSortOrder = (soAscending, soDescending); 123 | 124 | TOnClickEvent = procedure(ASender: TObject; ACol, ARow: NativeInt) of object; 125 | TOnHeaderClick = procedure(ASender: TObject; ACol: NativeInt) of object; 126 | 127 | { TCustomDataGrid } 128 | 129 | TCustomDataGrid = class(TCustomControl) 130 | private 131 | FAutoCreateColumns: boolean; 132 | FColumnClickSorts: boolean; 133 | FColumns: TDataColumns; 134 | FDefColWidth: NativeInt; 135 | FDefRowHeight: NativeInt; 136 | FShowHeader: boolean; 137 | FSortColumn: NativeInt; 138 | FSortOrder: TSortOrder; 139 | FOnCellClick: TOnClickEvent; 140 | FOnHeaderClick: TOnHeaderClick; 141 | procedure SetColumnClickSorts(AValue: boolean); 142 | procedure SetColumns(AValue: TDataColumns); 143 | procedure SetDefColWidth(AValue: NativeInt); 144 | procedure SetDefRowHeight(AValue: NativeInt); 145 | procedure SetShowHeader(AValue: boolean); 146 | protected 147 | procedure VisualChange; virtual; 148 | procedure ColumnsChanged({%H-}AColumn: TDataColumn); virtual; 149 | function CalcDefaultRowHeight: NativeInt; virtual; 150 | procedure Paint; override; 151 | protected 152 | class function GetControlClassDefaultSize: TSize; override; 153 | public 154 | constructor Create(AOwner: TComponent); override; 155 | destructor Destroy; override; 156 | property AutoCreateColumns: boolean read FAutoCreateColumns write FAutoCreateColumns; 157 | property Columns: TDataColumns read FColumns write SetColumns; 158 | property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts; 159 | property DefaultColWidth: NativeInt read FDefColWidth write SetDefColWidth; 160 | property DefaultRowHeight: NativeInt read FDefRowHeight write SetDefRowHeight; 161 | property SortColumn: NativeInt read FSortColumn; 162 | property SortOrder: TSortOrder read FSortOrder; 163 | property ShowHeader: boolean read FShowHeader write SetShowHeader; 164 | property OnCellClick: TOnClickEvent read FOnCellClick write FOnCellClick; 165 | property OnHeaderClick: TOnHeaderClick read FOnHeaderClick write FOnHeaderClick; 166 | end; 167 | 168 | TOnPageEvent = procedure(ASender: TObject; APage: NativeInt) of object; 169 | 170 | { TCustomPagination } 171 | 172 | TCustomPagination = class(TCustomControl) 173 | { TODO: Add keys navigations } 174 | private 175 | FCurrentPage: NativeInt; 176 | FOnPageClick: TOnPageEvent; 177 | FRecordsPerPage: NativeInt; 178 | FTotalPages: NativeInt; 179 | FTotalRecords: NativeInt; 180 | procedure SetCurrentPage(AValue: NativeInt); 181 | procedure SetRecordsPerPage(AValue: NativeInt); 182 | procedure SetTotalRecords(AValue: NativeInt); 183 | protected 184 | procedure Changed; virtual; 185 | procedure CalculatePages; virtual; 186 | procedure Paint; override; 187 | protected 188 | class function GetControlClassDefaultSize: TSize; override; 189 | public 190 | constructor Create(AOwner: TComponent); override; 191 | property CurrentPage: NativeInt read FCurrentPage write SetCurrentPage; 192 | property RecordsPerPage: NativeInt read FRecordsPerPage write SetRecordsPerPage; 193 | property TotalPages: NativeInt read FTotalPages; 194 | property TotalRecords: NativeInt read FTotalRecords write SetTotalRecords; 195 | property OnPageClick: TOnPageEvent read FOnPageClick write FOnPageClick; 196 | end; 197 | 198 | implementation 199 | 200 | uses 201 | Math; 202 | 203 | { TDataColumn } 204 | 205 | function TDataColumn.GetGrid: TCustomDataGrid; 206 | begin 207 | if (Collection is TDataColumns) then 208 | begin 209 | Result := TDataColumns(Collection).Grid; 210 | end 211 | else 212 | begin 213 | Result := nil; 214 | end; 215 | end; 216 | 217 | procedure TDataColumn.SetAlignment(AValue: TAlignment); 218 | begin 219 | if (FAlignment <> AValue) then 220 | begin 221 | FAlignment := AValue; 222 | ColumnChanged; 223 | end; 224 | end; 225 | 226 | procedure TDataColumn.SetColor(AValue: TColor); 227 | begin 228 | if (FColor <> AValue) then 229 | begin 230 | FColor := AValue; 231 | ColumnChanged; 232 | end; 233 | end; 234 | 235 | procedure TDataColumn.SetDisplayMask(AValue: string); 236 | begin 237 | if (FDisplayMask <> AValue) then 238 | begin 239 | FDisplayMask := AValue; 240 | ColumnChanged; 241 | end; 242 | end; 243 | 244 | procedure TDataColumn.SetFont(AValue: TFont); 245 | begin 246 | if (not FFont.IsEqual(AValue)) then 247 | begin 248 | FFont.Assign(AValue); 249 | end; 250 | end; 251 | 252 | procedure TDataColumn.SetFormat(AValue: TColumnFormat); 253 | begin 254 | if (FFormat <> AValue) then 255 | begin 256 | FFormat := AValue; 257 | ColumnChanged; 258 | end; 259 | end; 260 | 261 | procedure TDataColumn.SetName(AValue: string); 262 | begin 263 | if (FName <> AValue) then 264 | begin 265 | FName := AValue; 266 | ColumnChanged; 267 | end; 268 | end; 269 | 270 | procedure TDataColumn.SetTitle(AValue: string); 271 | begin 272 | if (FTitle <> AValue) then 273 | begin 274 | FTitle := AValue; 275 | ColumnChanged; 276 | end; 277 | end; 278 | 279 | procedure TDataColumn.SetValueChecked(AValue: string); 280 | begin 281 | if (FValueChecked <> AValue) then 282 | begin 283 | FValueChecked := AValue; 284 | ColumnChanged; 285 | end; 286 | end; 287 | 288 | procedure TDataColumn.SetValueUnchecked(AValue: string); 289 | begin 290 | if (FValueUnchecked <> AValue) then 291 | begin 292 | FValueUnchecked := AValue; 293 | ColumnChanged; 294 | end; 295 | end; 296 | 297 | procedure TDataColumn.SetVisible(AValue: boolean); 298 | begin 299 | if (FVisible <> AValue) then 300 | begin 301 | FVisible := AValue; 302 | ColumnChanged; 303 | end; 304 | end; 305 | 306 | procedure TDataColumn.SetWidth(AValue: NativeInt); 307 | begin 308 | if (FWidth <> AValue) then 309 | begin 310 | FWidth := AValue; 311 | ColumnChanged; 312 | end; 313 | end; 314 | 315 | procedure TDataColumn.ColumnChanged; 316 | begin 317 | if (FUpdateCount = 0) then 318 | begin 319 | Changed(False); 320 | end; 321 | end; 322 | 323 | function TDataColumn.GetDisplayName: string; 324 | begin 325 | if (FTitle <> '') then 326 | begin 327 | Result := FTitle; 328 | end 329 | else 330 | begin 331 | Result := 'Column ' + IntToStr(Index); 332 | end; 333 | end; 334 | 335 | procedure TDataColumn.FillDefaultFont; 336 | begin 337 | if (Assigned(Grid)) then 338 | begin 339 | FFont.Assign(Grid.Font); 340 | end; 341 | end; 342 | 343 | procedure TDataColumn.FontChanged(Sender: TObject); 344 | begin 345 | ColumnChanged; 346 | end; 347 | 348 | function TDataColumn.GetDefaultValueChecked: string; 349 | begin 350 | Result := '1'; 351 | end; 352 | 353 | function TDataColumn.GetDefaultValueUnchecked: string; 354 | begin 355 | Result := '0'; 356 | end; 357 | 358 | constructor TDataColumn.Create(ACollection: TCollection); 359 | begin 360 | inherited Create(ACollection); 361 | FFont := TFont.Create; 362 | FFont.OnChange := @FontChanged; 363 | FAlignment := taLeftJustify; 364 | FColor := clWhite; 365 | FDisplayMask := ''; 366 | FFormat := cfString; 367 | FHint := ''; 368 | FName := ''; 369 | FTag := 0; 370 | FTitle := ''; 371 | FUpdateCount := 0; 372 | FValueChecked := GetDefaultValueChecked; 373 | FValueUnchecked := GetDefaultValueUnchecked; 374 | FVisible := True; 375 | FWidth := 0; 376 | FillDefaultFont; 377 | end; 378 | 379 | destructor TDataColumn.Destroy; 380 | begin 381 | FFont.Destroy; 382 | FFont := nil; 383 | inherited Destroy; 384 | end; 385 | 386 | procedure TDataColumn.Assign(Source: TPersistent); 387 | var 388 | VColumn: TDataColumn; 389 | begin 390 | if (Assigned(Source)) and (Source is TDataColumn) then 391 | begin 392 | BeginUpdate; 393 | try 394 | VColumn := TDataColumn(Source); 395 | FAlignment := VColumn.Alignment; 396 | FColor := VColumn.Color; 397 | FDisplayMask := VColumn.DisplayMask; 398 | FFont.Assign(VColumn.FFont); 399 | FFormat := VColumn.Format; 400 | FHint := VColumn.Hint; 401 | FName := VColumn.Name; 402 | FTag := VColumn.Tag; 403 | FTitle := VColumn.Title; 404 | FValueChecked := VColumn.ValueChecked; 405 | FValueUnchecked := VColumn.ValueUnchecked; 406 | FVisible := VColumn.Visible; 407 | FWidth := VColumn.Width; 408 | finally 409 | EndUpdate; 410 | end; 411 | end 412 | else 413 | begin 414 | inherited Assign(Source); 415 | end; 416 | end; 417 | 418 | procedure TDataColumn.BeginUpdate; 419 | begin 420 | Inc(FUpdateCount); 421 | end; 422 | 423 | procedure TDataColumn.EndUpdate; 424 | begin 425 | if (FUpdateCount > 0) then 426 | begin 427 | Dec(FUpdateCount); 428 | if (FUpdateCount = 0) then 429 | begin 430 | ColumnChanged; 431 | end; 432 | end; 433 | end; 434 | 435 | { TDataColumns } 436 | 437 | function TDataColumns.GetColumn(AIndex: NativeInt): TDataColumn; 438 | begin 439 | Result := TDataColumn(inherited Items[AIndex]); 440 | end; 441 | 442 | procedure TDataColumns.SetColumn(AIndex: NativeInt; AValue: TDataColumn); 443 | begin 444 | Items[AIndex].Assign(AValue); 445 | end; 446 | 447 | function TDataColumns.GetOwner: TPersistent; 448 | begin 449 | Result := FGrid; 450 | end; 451 | 452 | procedure TDataColumns.Update(AItem: TCollectionItem); 453 | begin 454 | FGrid.ColumnsChanged(TDataColumn(AItem)); 455 | end; 456 | 457 | constructor TDataColumns.Create(AGrid: TCustomDataGrid); 458 | begin 459 | inherited Create(TDataColumn); 460 | FGrid := AGrid; 461 | end; 462 | 463 | function TDataColumns.Add: TDataColumn; 464 | begin 465 | Result := TDataColumn(inherited Add); 466 | end; 467 | 468 | function TDataColumns.HasIndex(const AIndex: integer): boolean; 469 | begin 470 | Result := (Aindex > -1) and (AIndex < Count); 471 | end; 472 | 473 | 474 | { TCustomDataGrid } 475 | 476 | procedure TCustomDataGrid.SetColumnClickSorts(AValue: boolean); 477 | begin 478 | if (FColumnClickSorts <> AValue) then 479 | begin 480 | FColumnClickSorts := AValue; 481 | end; 482 | end; 483 | 484 | procedure TCustomDataGrid.SetColumns(AValue: TDataColumns); 485 | begin 486 | FColumns.Assign(AValue); 487 | end; 488 | 489 | procedure TCustomDataGrid.SetDefColWidth(AValue: NativeInt); 490 | begin 491 | if (FDefColWidth <> AValue) then 492 | begin 493 | FDefColWidth := AValue; 494 | end; 495 | end; 496 | 497 | procedure TCustomDataGrid.SetDefRowHeight(AValue: NativeInt); 498 | begin 499 | if (FDefRowHeight <> AValue) then 500 | begin 501 | FDefRowHeight := AValue; 502 | end; 503 | end; 504 | 505 | procedure TCustomDataGrid.SetShowHeader(AValue: boolean); 506 | begin 507 | if (FShowHeader <> AValue) then 508 | begin 509 | FShowHeader := AValue; 510 | end; 511 | end; 512 | 513 | procedure TCustomDataGrid.VisualChange; 514 | begin 515 | Invalidate; 516 | end; 517 | 518 | procedure TCustomDataGrid.ColumnsChanged(AColumn: TDataColumn); 519 | begin 520 | if (csDestroying in ComponentState) then 521 | begin 522 | exit; 523 | end; 524 | VisualChange; 525 | end; 526 | 527 | function TCustomDataGrid.CalcDefaultRowHeight: NativeInt; 528 | begin 529 | Result := Font.GetTextHeight('Fj') + 10; 530 | end; 531 | 532 | procedure TCustomDataGrid.Paint; 533 | begin 534 | inherited Paint; 535 | if csDesigning in ComponentState then 536 | begin 537 | Canvas.Brush.Color := Color; 538 | with Canvas do 539 | begin 540 | Pen.Style := psSolid; 541 | Pen.Color := clBlack; 542 | Brush.Style := bsClear; 543 | Rectangle(0, 0, Self.Width - 1, Self.Height - 1); 544 | Line(0, 0, Self.Width - 1, Self.Height - 1); 545 | Line(Self.Width - 1, 0, 0, Self.Height - 1); 546 | end; 547 | Exit; 548 | end; 549 | end; 550 | 551 | class function TCustomDataGrid.GetControlClassDefaultSize: TSize; 552 | begin 553 | Result.Cx := 200; 554 | Result.Cy := 100; 555 | end; 556 | 557 | constructor TCustomDataGrid.Create(AOwner: TComponent); 558 | begin 559 | inherited Create(AOwner); 560 | ControlStyle := ControlStyle - [csAcceptsControls]; 561 | with GetControlClassDefaultSize do 562 | begin 563 | SetInitialBounds(0, 0, CX, CY); 564 | end; 565 | FAutoCreateColumns := True; 566 | FColumns := TDataColumns.Create(Self); 567 | FColumnClickSorts := True; 568 | FDefColWidth := -1; 569 | FDefRowHeight := -1; 570 | FShowHeader := True; 571 | end; 572 | 573 | destructor TCustomDataGrid.Destroy; 574 | begin 575 | FColumns.Destroy; 576 | FColumns := nil; 577 | inherited Destroy; 578 | end; 579 | 580 | { TCustomPagination } 581 | 582 | procedure TCustomPagination.SetCurrentPage(AValue: NativeInt); 583 | begin 584 | if (FCurrentPage <> AValue) then 585 | begin 586 | FCurrentPage := AValue; 587 | Changed; 588 | end; 589 | end; 590 | 591 | procedure TCustomPagination.SetRecordsPerPage(AValue: NativeInt); 592 | begin 593 | if (FRecordsPerPage <> AValue) then 594 | begin 595 | FRecordsPerPage := AValue; 596 | Changed; 597 | end; 598 | end; 599 | 600 | procedure TCustomPagination.SetTotalRecords(AValue: NativeInt); 601 | begin 602 | if (FTotalRecords <> AValue) then 603 | begin 604 | FTotalRecords := AValue; 605 | Changed; 606 | end; 607 | end; 608 | 609 | procedure TCustomPagination.Changed; 610 | begin 611 | CalculatePages; 612 | end; 613 | 614 | procedure TCustomPagination.CalculatePages; 615 | begin 616 | FTotalPages := Ceil64(FTotalRecords / FRecordsPerPage); 617 | end; 618 | 619 | procedure TCustomPagination.Paint; 620 | begin 621 | inherited Paint; 622 | if csDesigning in ComponentState then 623 | begin 624 | Canvas.Brush.Color := Color; 625 | with Canvas do 626 | begin 627 | Pen.Style := psSolid; 628 | Pen.Color := clBlack; 629 | Brush.Style := bsClear; 630 | Rectangle(0, 0, Self.Width - 1, Self.Height - 1); 631 | Line(0, 0, Self.Width - 1, Self.Height - 1); 632 | Line(Self.Width - 1, 0, 0, Self.Height - 1); 633 | end; 634 | Exit; 635 | end; 636 | end; 637 | 638 | class function TCustomPagination.GetControlClassDefaultSize: TSize; 639 | begin 640 | Result.Cx := 150; 641 | Result.Cy := 30; 642 | end; 643 | 644 | constructor TCustomPagination.Create(AOwner: TComponent); 645 | begin 646 | inherited Create(AOwner); 647 | ControlStyle := ControlStyle - [csAcceptsControls]; 648 | with GetControlClassDefaultSize do 649 | begin 650 | SetInitialBounds(0, 0, CX, CY); 651 | end; 652 | FCurrentPage := 1; 653 | FRecordsPerPage := 10; 654 | FTotalPages := 0; 655 | FTotalRecords := 0; 656 | end; 657 | 658 | end. 659 | -------------------------------------------------------------------------------- /design/source/dttctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit DttCtrls; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Graphics, 34 | Controls, 35 | StdCtrls; 36 | 37 | type 38 | 39 | { TCustomDateTimeEdit } 40 | 41 | TCustomDateTimeEdit = class(TCustomEdit) 42 | protected 43 | procedure DoEnter; override; 44 | procedure DoExit; override; 45 | end; 46 | 47 | implementation 48 | 49 | { TCustomDateTimeEdit } 50 | 51 | procedure TCustomDateTimeEdit.DoEnter; 52 | begin 53 | inherited DoEnter; 54 | RealSetText(RealGetText); 55 | end; 56 | 57 | procedure TCustomDateTimeEdit.DoExit; 58 | begin 59 | inherited DoExit; 60 | RealSetText(RealGetText); 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /design/source/numctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit NumCtrls; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | uses 30 | Classes, 31 | SysUtils, 32 | Graphics, 33 | Controls, 34 | StdCtrls; 35 | 36 | type 37 | 38 | { TCustomNumericEdit } 39 | 40 | TCustomNumericEdit = class(TCustomEdit) 41 | { TODO: Max Min value } 42 | { TODO: Add spin } 43 | private 44 | FDecimals: NativeInt; 45 | protected 46 | procedure DoEnter; override; 47 | procedure DoExit; override; 48 | procedure KeyPress(var Key: char); override; 49 | public 50 | constructor Create(AOwner: TComponent); override; 51 | property DecimalPlaces: NativeInt read FDecimals write FDecimals; 52 | end; 53 | 54 | implementation 55 | 56 | { TCustomNumericEdit } 57 | 58 | procedure TCustomNumericEdit.DoEnter; 59 | begin 60 | inherited DoEnter; 61 | RealSetText(RealGetText); 62 | end; 63 | 64 | procedure TCustomNumericEdit.DoExit; 65 | begin 66 | inherited DoExit; 67 | RealSetText(RealGetText); 68 | end; 69 | 70 | procedure TCustomNumericEdit.KeyPress(var Key: char); 71 | begin 72 | inherited KeyPress(Key); 73 | if (Key = DefaultFormatSettings.DecimalSeparator) then 74 | begin 75 | if (FDecimals = 0) then 76 | begin 77 | Key := #0; 78 | end; 79 | if (Pos(Key, RealGetText) > 0) then 80 | begin 81 | Key := #0; 82 | end; 83 | end; 84 | if (not (Key in ['0'..'9', DefaultFormatSettings.DecimalSeparator])) then 85 | begin 86 | Key:= #0; 87 | end; 88 | end; 89 | 90 | constructor TCustomNumericEdit.Create(AOwner: TComponent); 91 | begin 92 | inherited Create(AOwner); 93 | Alignment := taRightJustify; 94 | FDecimals := 2; 95 | end; 96 | 97 | end. 98 | -------------------------------------------------------------------------------- /design/source/pas2js_ide_descriptor.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit Pas2JS_IDE_Descriptor; 25 | 26 | {$mode objfpc}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Forms, 34 | Controls, 35 | LazIDEIntf, 36 | ProjectIntf, 37 | CompOptsIntf, 38 | FormEditingIntf, 39 | PropEdits; 40 | 41 | type 42 | 43 | { TPas2JSProject } 44 | 45 | TPas2JSProject = class(TProjectDescriptor) 46 | private 47 | FPas2JSBuilder: string; 48 | FPas2JSJSON: string; 49 | public 50 | constructor Create; override; 51 | function GetLocalizedName: string; override; 52 | function GetLocalizedDescription: string; override; 53 | function InitProject(AProject: TLazProject): TModalResult; override; 54 | function CreateStartFiles({%H-}AProject: TLazProject): TModalResult; override; 55 | end; 56 | 57 | { TPas2JSWForm } 58 | 59 | TPas2JSWForm = class(TFileDescPascalUnitWithResource) 60 | public 61 | constructor Create; override; 62 | function GetInterfaceUsesSection: string; override; 63 | function GetInterfaceSource(const {%H-}Filename, {%H-}SourceName, ResourceName: string): string; override; 64 | function GetLocalizedName: string; override; 65 | function GetLocalizedDescription: string; override; 66 | end; 67 | 68 | { TPas2JSWFrame } 69 | 70 | TPas2JSWFrame = class(TFileDescPascalUnitWithResource) 71 | public 72 | constructor Create; override; 73 | function GetInterfaceUsesSection: string; override; 74 | function GetInterfaceSource(const {%H-}Filename, {%H-}SourceName, ResourceName: string): string; override; 75 | function GetLocalizedName: string; override; 76 | function GetLocalizedDescription: string; override; 77 | end; 78 | 79 | { TPas2JSWDataModule } 80 | 81 | TPas2JSWDataModule = class(TFileDescPascalUnitWithResource) 82 | public 83 | constructor Create; override; 84 | function GetInterfaceUsesSection: string; override; 85 | function GetInterfaceSource(const {%H-}Filename, {%H-}SourceName, ResourceName: string): string; override; 86 | function GetLocalizedName: string; override; 87 | function GetLocalizedDescription: string; override; 88 | end; 89 | 90 | procedure Register; 91 | 92 | var 93 | VPas2JSProject: TPas2JSProject; 94 | VPas2JSWForm: TPas2JSWForm; 95 | VPas2JSWFrame: TPas2JSWFrame; 96 | VPas2JSWDataModule: TPas2JSWDataModule; 97 | 98 | implementation 99 | 100 | uses 101 | TypInfo, 102 | FileUtil, 103 | WebCtrls, 104 | FPJSON, 105 | ComponentEditors; 106 | 107 | { TPas2JSProject } 108 | 109 | constructor TPas2JSProject.Create; 110 | begin 111 | inherited Create; 112 | FPas2JSBuilder := ''; 113 | FPas2JSJSON := ''; 114 | Name := 'Web GUI Application (Pas2JS)'; 115 | end; 116 | 117 | function TPas2JSProject.GetLocalizedName: string; 118 | begin 119 | Result := 'Web GUI Application (Pas2JS)'; 120 | end; 121 | 122 | function TPas2JSProject.GetLocalizedDescription: string; 123 | begin 124 | Result := 'Create a Pas2JS Web GUI application'; 125 | end; 126 | 127 | function TPas2JSProject.InitProject(AProject: TLazProject): TModalResult; 128 | 129 | function Project: TLazProjectFile; 130 | 131 | function Source: string; 132 | const 133 | LE = LineEnding; 134 | begin 135 | Result := 136 | 'program Project1; ' + LE + 137 | '' + LE + 138 | '{$mode delphi}{$H+}' + LE + 139 | '' + LE + 140 | 'uses' + LE + 141 | ' Interfaces, Forms;' + LE + 142 | '' + LE + 143 | 'begin' + LE + 144 | ' Application.Initialize;' + LE + 145 | ' Application.Run;' + LE + 146 | 'end.'; 147 | end; 148 | 149 | begin 150 | Result := AProject.CreateProjectFile('project1.lpr'); 151 | Result.IsPartOfProject := True; 152 | Result.SetSourceText(Source, True); 153 | end; 154 | 155 | function HTMLFile: TLazProjectFile; 156 | const 157 | TemplateHTMLSource = 158 | ''+LineEnding 159 | +''+LineEnding 160 | +''+LineEnding 161 | +' '+LineEnding 162 | +' '+LineEnding 163 | +' Project1'+LineEnding 164 | +' '+LineEnding 165 | +''+LineEnding 166 | +''+LineEnding 167 | +' '+LineEnding 170 | +''+LineEnding 171 | +''+LineEnding; 172 | begin 173 | Result := AProject.CreateProjectFile('project1.html'); 174 | Result.IsPartOfProject := True; 175 | AProject.CustomData.Values['PasJSHTMLFile'] := Result.Filename; 176 | AProject.CustomData['PasJSWebBrowserProject'] := '1'; 177 | Result.CustomData['PasJSIsProjectHTMLFile'] := '1'; 178 | Result.CustomData.Values['MaintainHTML'] := '1'; 179 | Result.SetSourceText(TemplateHTMLSource); 180 | 181 | end; 182 | 183 | var 184 | CompOpts: TLazCompilerOptions; 185 | begin 186 | Result := inherited InitProject(AProject); 187 | AProject.AddFile(Project, False); 188 | AProject.AddFile(HTMLFile, True); 189 | 190 | AProject.AddPackageDependency('pas2js_rtl'); 191 | AProject.AddPackageDependency('WCL'); 192 | AProject.Flags := AProject.Flags - [pfRunnable]; 193 | AProject.LoadDefaultIcon; 194 | AProject.MainFileID := 0; 195 | AProject.LazCompilerOptions.TargetFilename := 'project1'; 196 | CompOpts := AProject.LazCompilerOptions; 197 | CompOpts.TargetOS:='Browser'; 198 | CompOpts.GenerateDebugInfo := False; 199 | CompOpts.CompilerPath := '$(pas2js)'; 200 | CompOpts.CustomOptions := '-Jeutf-8 -Jirtl.js -Jc -Jminclude -JRjs'; 201 | end; 202 | 203 | function TPas2JSProject.CreateStartFiles(AProject: TLazProject): TModalResult; 204 | begin 205 | LazarusIDE.DoOpenEditorFile('project1.html', -1, -1, [ofProjectLoading,ofRegularFile]); 206 | LazarusIDE.DoNewEditorFile(VPas2JSWForm, '', '', [nfIsPartOfProject, nfOpenInEditor, nfCreateDefaultSrc]); 207 | Result := mrOk; 208 | end; 209 | 210 | { TPas2JSWForm } 211 | 212 | constructor TPas2JSWForm.Create; 213 | begin 214 | inherited Create; 215 | Name := 'WForm'; 216 | ResourceClass := TWForm; 217 | UseCreateFormStatements := True; 218 | end; 219 | 220 | function TPas2JSWForm.GetInterfaceUsesSection: string; 221 | begin 222 | Result := 'JS, Classes, SysUtils, Graphics, Controls, Forms, Dialogs, WebCtrls'; 223 | end; 224 | 225 | function TPas2JSWForm.GetInterfaceSource(const Filename, SourceName, ResourceName: string): string; 226 | const 227 | LE = LineEnding; 228 | begin 229 | Result := 230 | 'type' + LE + 231 | ' T' + ResourceName + ' = class(' + ResourceClass.ClassName + ')' + LE + 232 | ' private' + LE + LE + 233 | ' public' + LE + LE + 234 | ' end;' + LE + LE; 235 | 236 | if (DeclareClassVariable) then 237 | begin 238 | Result := Result + 239 | 'var' + LE + 240 | ' ' + ResourceName + ': T' + ResourceName + ';' + LE + LE; 241 | end; 242 | end; 243 | 244 | function TPas2JSWForm.GetLocalizedName: string; 245 | begin 246 | Result := 'Web Form (Pas2JS)'; 247 | end; 248 | 249 | function TPas2JSWForm.GetLocalizedDescription: string; 250 | begin 251 | Result := 'Create a Pas2JS Web Form'; 252 | end; 253 | 254 | { TPas2JSWFrame } 255 | 256 | constructor TPas2JSWFrame.Create; 257 | begin 258 | inherited Create; 259 | Name := 'WFrame'; 260 | ResourceClass := TWFrame; 261 | UseCreateFormStatements := False; 262 | end; 263 | 264 | function TPas2JSWFrame.GetInterfaceUsesSection: string; 265 | begin 266 | Result := 'JS, Classes, SysUtils, Graphics, Controls, Forms, Dialogs, WebCtrls'; 267 | end; 268 | 269 | function TPas2JSWFrame.GetInterfaceSource(const Filename, SourceName, ResourceName: string): string; 270 | const 271 | LE = LineEnding; 272 | begin 273 | Result := 274 | 'type' + LE + 275 | ' T' + ResourceName + ' = class(' + ResourceClass.ClassName + ')' + LE + 276 | ' private' + LE + LE + 277 | ' public' + LE + LE + 278 | ' end;' + LE + LE; 279 | end; 280 | 281 | function TPas2JSWFrame.GetLocalizedName: string; 282 | begin 283 | Result := 'Web Frame (Pas2JS)'; 284 | end; 285 | 286 | function TPas2JSWFrame.GetLocalizedDescription: string; 287 | begin 288 | Result := 'Create a Pas2JS Web Fram'; 289 | end; 290 | 291 | { TPas2JSWDataModule } 292 | 293 | constructor TPas2JSWDataModule.Create; 294 | begin 295 | inherited Create; 296 | Name := 'WDataModule'; 297 | ResourceClass := TWDataModule; 298 | UseCreateFormStatements := True; 299 | end; 300 | 301 | function TPas2JSWDataModule.GetInterfaceUsesSection: string; 302 | begin 303 | Result := 'JS, Classes, SysUtils, Graphics, Controls, Forms, Dialogs, WebCtrls'; 304 | end; 305 | 306 | function TPas2JSWDataModule.GetInterfaceSource(const Filename, SourceName, ResourceName: string): string; 307 | const 308 | LE = LineEnding; 309 | begin 310 | Result := 311 | 'type' + LE + 312 | ' T' + ResourceName + ' = class(' + ResourceClass.ClassName + ')' + LE + 313 | ' private' + LE + LE + 314 | ' public' + LE + LE + 315 | ' end;' + LE + LE; 316 | 317 | if (DeclareClassVariable) then 318 | begin 319 | Result := Result + 320 | 'var' + LE + 321 | ' ' + ResourceName + ': T' + ResourceName + ';' + LE + LE; 322 | end; 323 | end; 324 | 325 | function TPas2JSWDataModule.GetLocalizedName: string; 326 | begin 327 | Result := 'Web Data Module (Pas2JS)'; 328 | end; 329 | 330 | function TPas2JSWDataModule.GetLocalizedDescription: string; 331 | begin 332 | Result := 'Create a Pas2JS Web Data Module'; 333 | end; 334 | 335 | {$IF declared(TComponentRequirements)} 336 | 337 | type 338 | TPas2JSWidgetsRequirements = class(TComponentRequirements) 339 | public 340 | procedure RequiredUnits(aUnits: TStrings); override; 341 | procedure RequiredPkgs(aPkgs: TStrings); override; 342 | end; 343 | 344 | { TPas2JSWidgetsRequirements } 345 | 346 | procedure TPas2JSWidgetsRequirements.RequiredUnits(aUnits: TStrings); 347 | begin 348 | if ComponentClass.ClassType = TWStringGrid then begin 349 | aUnits.Clear; 350 | aUnits.Add('Grids'); 351 | end; 352 | end; 353 | 354 | procedure TPas2JSWidgetsRequirements.RequiredPkgs(aPkgs: TStrings); 355 | begin 356 | aPkgs.Clear; 357 | aPkgs.Add('Pas2JS_Widget'); 358 | end; 359 | 360 | {$ENDIF} 361 | 362 | procedure Register; 363 | begin 364 | VPas2JSWForm := TPas2JSWForm.Create; 365 | VPas2JSWFrame := TPas2JSWFrame.Create; 366 | VPas2JSWDataModule := TPas2JSWDataModule.Create; 367 | 368 | RegisterProjectFileDescriptor(VPas2JSWForm); 369 | RegisterProjectFileDescriptor(VPas2JSWFrame); 370 | RegisterProjectFileDescriptor(VPas2JSWDataModule); 371 | 372 | {$if declared(TPas2JSWidgetsRequirements)} 373 | RegisterComponentRequirements([TWButton, TWCheckbox, TWComboBox, TWDataGrid, TWDateEditBox, 374 | TWEdit, TWFileButton, TWFloatEdit, TWImage, TWIntegerEdit, TWLabel, TWMemo, TWPageControl, 375 | TWPagination, TWPanel, TWRadioButton, TWTimeEditBox, TWStringGrid, TWListBox, TWImage, TWTimer, 376 | TWDateEditBox, TWWebSocketClient], TPas2JSWidgetsRequirements); 377 | {$endif} 378 | 379 | FormEditingHook.RegisterDesignerBaseClass(TWForm); 380 | FormEditingHook.RegisterDesignerBaseClass(TWFrame); 381 | FormEditingHook.RegisterDesignerBaseClass(TWDataModule); 382 | //FormEditingHook.StandardDesignerBaseClasses[3{DesignerBaseClassId_TForm}] := TWForm; 383 | //FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TFrame] := TWFrame; 384 | //FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TDataModule] := TWDataModule; 385 | 386 | VPas2JSProject := TPas2JSProject.Create; 387 | RegisterProjectDescriptor(VPas2JSProject); 388 | end; 389 | 390 | end. 391 | -------------------------------------------------------------------------------- /design/source/websocket.pas: -------------------------------------------------------------------------------- 1 | { 2 | /*************************************************************************** 3 | websocket.pas 4 | ------------- 5 | 6 | Initial Revision : Wed Apr 20 CST 2021 7 | 8 | ***************************************************************************/ 9 | 10 | ***************************************************************************** 11 | This file is part of the Web Component Library (WCL) 12 | 13 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 | for details about the license. 15 | ***************************************************************************** 16 | } 17 | unit websocket; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils; 25 | 26 | type 27 | 28 | TNotifyWebSocketMessage = procedure(aSender: TObject; aData: String) of object; 29 | TNotifyWebSocketBinaryMessage = procedure(aSender: TObject; aData: TBytes) of object; 30 | TNotifyWebSocketClose = procedure(aSender: TObject; aCode: Cardinal; aReason: String) of object; 31 | 32 | { TCustomWebSocketClient } 33 | 34 | TCustomWebSocketClient = class(TComponent) 35 | private 36 | fOnBinaryMessage: TNotifyWebSocketBinaryMessage; 37 | fOnClose: TNotifyWebSocketClose; 38 | fOnError: TNotifyEvent; 39 | fOnMessage: TNotifyWebSocketMessage; 40 | fOnOpen: TNotifyEvent; 41 | fUrl: String; 42 | public 43 | property Url: String read fUrl write fUrl; 44 | property OnBinaryMessage: TNotifyWebSocketBinaryMessage read fOnBinaryMessage write fOnBinaryMessage; 45 | property OnClose: TNotifyWebSocketClose read fOnClose write fOnClose; 46 | property OnError: TNotifyEvent read fOnError write fOnError; 47 | property OnMessage: TNotifyWebSocketMessage read fOnMessage write fOnMessage; 48 | property OnOpen: TNotifyEvent read fOnOpen write fOnOpen; 49 | end; 50 | 51 | implementation 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /widgets/btnctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit BtnCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | Web, 35 | Graphics, 36 | Controls, 37 | StdCtrls; 38 | 39 | type 40 | 41 | { TCustomFileButton } 42 | 43 | TCustomFileButton = class(TWinControl) 44 | private 45 | FFileSelect: TJSHTMLFile; 46 | FFilter: string; 47 | FOnChange: TNotifyEvent; 48 | FOpendDialogElement: TJSHTMLInputElement; 49 | procedure SetFilter(AValue: string); 50 | protected 51 | procedure Change; virtual; 52 | protected 53 | property OpendDialogElement: TJSHTMLInputElement read FOpendDialogElement; 54 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 55 | protected 56 | function HandleClick(AEvent: TJSMouseEvent): boolean; override; 57 | function HandleChange(AEvent: TEventListenerEvent): boolean; virtual; 58 | protected 59 | procedure Changed; override; 60 | function CreateHandleElement: TJSHTMLElement; override; 61 | function CreateOpendDialogElement: TJSHTMLInputElement; virtual; 62 | function CheckChildClassAllowed(AChildClass: TClass): boolean; override; 63 | protected 64 | class function GetControlClassDefaultSize: TSize; override; 65 | public 66 | constructor Create(AOwner: TComponent); override; 67 | destructor Destroy; override; 68 | procedure AdjustSize; override; 69 | property FileSelected: TJSHTMLFile read FFileSelect; 70 | property Filter: string read FFilter write SetFilter; 71 | end; 72 | 73 | implementation 74 | 75 | uses 76 | WCLStrConsts; 77 | 78 | { TCustomFileButton } 79 | 80 | procedure TCustomFileButton.SetFilter(AValue: string); 81 | begin 82 | if (FFilter <> AValue) then 83 | begin 84 | FFilter := AValue; 85 | Changed; 86 | end; 87 | end; 88 | 89 | procedure TCustomFileButton.Change; 90 | begin 91 | if (Assigned(FOnChange)) then 92 | begin 93 | FOnChange(Self); 94 | end; 95 | end; 96 | 97 | function TCustomFileButton.HandleClick(AEvent: TJSMouseEvent): boolean; 98 | begin 99 | Result := inherited HandleClick(AEvent); 100 | if (Assigned(OpendDialogElement)) then 101 | begin 102 | OpendDialogElement.Click; 103 | end; 104 | end; 105 | 106 | function TCustomFileButton.HandleChange(AEvent: TEventListenerEvent): boolean; 107 | var 108 | VFile: TJSHTMLFile; 109 | VList: TJSHTMLFileList; 110 | begin 111 | if (AEvent.Target is TJSHTMLInputElement) then 112 | begin 113 | VList := TJSHTMLInputElement(AEvent.Target).Files; 114 | if (VList.Length = 0) then 115 | begin 116 | FFileSelect := nil; 117 | Caption := rsFileButtonNoFileSelected; 118 | Changed; 119 | Exit(False); 120 | end; 121 | VFile := VList[0]; 122 | FFileSelect := VFile; 123 | Caption := VFile.Name; 124 | Hint:= VFile.Name; 125 | Changed; 126 | Change; 127 | Result := True; 128 | end; 129 | end; 130 | 131 | procedure TCustomFileButton.Changed; 132 | begin 133 | inherited Changed; 134 | if (not IsUpdating) and not (csLoading in ComponentState) then 135 | begin 136 | with HandleElement do 137 | begin 138 | /// Normalize 139 | Style.SetProperty('padding', '0'); 140 | /// Caption 141 | InnerHTML := Self.Caption; 142 | end; 143 | /// OpendDialog 144 | if (Assigned(OpendDialogElement)) then 145 | begin 146 | with OpendDialogElement do 147 | begin 148 | /// Filter 149 | Accept := FFilter; 150 | /// Type 151 | _Type := 'file'; 152 | end; 153 | end; 154 | end; 155 | end; 156 | 157 | function TCustomFileButton.CreateHandleElement: TJSHTMLElement; 158 | begin 159 | Result := TJSHTMLElement(Document.CreateElement('button')); 160 | end; 161 | 162 | function TCustomFileButton.CreateOpendDialogElement: TJSHTMLInputElement; 163 | begin 164 | Result := TJSHTMLInputElement(HandleElement.AppendChild(Document.CreateElement('input'))); 165 | end; 166 | 167 | {$push} 168 | {$hints off} 169 | 170 | function TCustomFileButton.CheckChildClassAllowed(AChildClass: TClass): boolean; 171 | begin 172 | Result := False; 173 | end; 174 | 175 | {$pop} 176 | 177 | class function TCustomFileButton.GetControlClassDefaultSize: TSize; 178 | begin 179 | Result.Cx := 80; 180 | Result.Cy := 25; 181 | end; 182 | 183 | constructor TCustomFileButton.Create(AOwner: TComponent); 184 | begin 185 | inherited Create(AOwner); 186 | FOpendDialogElement := CreateOpendDialogElement; 187 | FOpendDialogElement.AddEventListener('change', @HandleChange); 188 | FFilter := ''; 189 | FFileSelect := nil; 190 | BeginUpdate; 191 | try 192 | Caption := rsFileButtonNoFileSelected; 193 | Hint := Caption; 194 | with GetControlClassDefaultSize do 195 | begin 196 | SetBounds(0, 0, Cx, Cy); 197 | end; 198 | finally 199 | EndUpdate; 200 | end; 201 | end; 202 | 203 | destructor TCustomFileButton.Destroy; 204 | begin 205 | if (Assigned(OpendDialogElement)) then 206 | begin 207 | OpendDialogElement.RemoveEventListener('change', @HandleChange); 208 | end; 209 | inherited Destroy; 210 | end; 211 | 212 | procedure TCustomFileButton.AdjustSize; 213 | var 214 | VSize: TSize; 215 | begin 216 | inherited AdjustSize; 217 | VSize := Font.TextExtent(Caption); 218 | SetBounds(Left, Top, VSize.Cx, VSize.Cy); 219 | end; 220 | 221 | end. 222 | 223 | 224 | -------------------------------------------------------------------------------- /widgets/comctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit ComCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | JS, 35 | Web, 36 | Graphics, 37 | Controls; 38 | 39 | type 40 | /// Forward declaration 41 | TCustomPageControl = class; 42 | 43 | TTabPosition = (tpTop, tpBottom, tpLeft, tpRight); 44 | 45 | { TCustomTabSheet } 46 | 47 | TCustomTabSheet = class(TWinControl) 48 | private 49 | FTabVisible: boolean; 50 | function GetPageControl: TCustomPageControl; 51 | function GetPageIndex: NativeInt; 52 | procedure SetPageControl(AValue: TCustomPageControl); 53 | protected 54 | procedure Changed; override; 55 | function CreateHandleElement: TJSHTMLElement; override; 56 | public 57 | constructor Create(AOwner: TComponent); override; 58 | property PageIndex: NativeInt read GetPageIndex; 59 | property PageControl: TCustomPageControl read GetPageControl write SetPageControl; 60 | property TabVisible: boolean read FTabVisible write FTabVisible; 61 | end; 62 | 63 | { TTabSheet } 64 | 65 | TTabSheet = class(TCustomTabSheet) 66 | published 67 | property Caption; 68 | property ClientHeight; 69 | property ClientWidth; 70 | property Color; 71 | property Enabled; 72 | property Font; 73 | property Height; 74 | property Left; 75 | property PageIndex; 76 | property ParentFont; 77 | property ParentShowHint; 78 | property ShowHint; 79 | property TabVisible; 80 | property Top; 81 | property Width; 82 | property OnEnter; 83 | property OnExit; 84 | property OnMouseDown; 85 | property OnMouseEnter; 86 | property OnMouseLeave; 87 | property OnMouseMove; 88 | property OnMouseUp; 89 | property OnMouseWheel; 90 | end; 91 | 92 | { TCustomPageControl } 93 | 94 | TCustomPageControl = class(TWinControl) 95 | { TODO: Add event on show page } 96 | private 97 | FMultiLine: boolean; 98 | FPageIndex: NativeInt; 99 | FPages: TJSArray; 100 | FShowTabs: boolean; 101 | FTabContainerElement: TJSHTMLElement; 102 | FTabHeight: smallint; 103 | FTabPosition: TTabPosition; 104 | FTabWidth: smallint; 105 | function GetActivePage: TCustomTabSheet; 106 | function GetPage(const AIndex: NativeInt): TCustomTabSheet; 107 | function GetPageCount: NativeInt; 108 | procedure SetActivePage(AValue: TCustomTabSheet); 109 | procedure SetMultiLine(AValue: boolean); 110 | procedure SetPageIndex(AValue: NativeInt); 111 | procedure SetShowTabs(AValue: boolean); 112 | procedure SetTabHeight(AValue: smallint); 113 | procedure SetTabPosition(AValue: TTabPosition); 114 | procedure SetTabWidth(AValue: smallint); 115 | protected 116 | property TabIndex: NativeInt read FPageIndex write SetPageIndex; 117 | protected 118 | procedure Changed; override; 119 | function CreateHandleElement: TJSHTMLElement; override; 120 | function CreateTabContainerElement: TJSHTMLElement; virtual; 121 | procedure RegisterChild(AControl: TControl); override; 122 | procedure UnRegisterChild(AControl: TControl); override; 123 | function CalcTabHeight: NativeInt; virtual; 124 | function CalcTabWidth(const AText: string): NativeInt; virtual; 125 | function CalcMaxTabWidth: NativeInt; virtual; 126 | function CalcSumTabsWidth: NativeInt; virtual; 127 | function IndexOfTab(const ACaption: string): NativeInt; 128 | function RenderTab(const ACaption: string; const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; virtual; 129 | function RenderTabActive(const ACaption: string; const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; virtual; 130 | function RenderTabLeft(const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; virtual; 131 | function RenderTabRight(const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; virtual; 132 | procedure RenderTabs; virtual; 133 | procedure TabClick(AEvent: TJSMouseEvent); virtual; 134 | procedure TabLeftClick(AEvent: TJSMouseEvent); virtual; 135 | procedure TabRightClick(AEvent: TJSMouseEvent); virtual; 136 | procedure UpdatePages; virtual; 137 | protected 138 | class function GetControlClassDefaultSize: TSize; override; 139 | public 140 | constructor Create(AOwner: TComponent); override; 141 | destructor Destroy; override; 142 | function AddTabSheet: TCustomTabSheet; 143 | function IndexOf(APage: TCustomTabSheet): NativeInt; virtual; 144 | property PageCount: NativeInt read GetPageCount; 145 | property Pages[const AIndex: NativeInt]: TCustomTabSheet read GetPage; 146 | public 147 | property ActivePage: TCustomTabSheet read GetActivePage write SetActivePage; 148 | property MultiLine: boolean read FMultiLine write SetMultiLine; 149 | property ShowTabs: boolean read FShowTabs write SetShowTabs; 150 | property TabHeight: smallint read FTabHeight write SetTabHeight; 151 | property TabPosition: TTabPosition read FTabPosition write SetTabPosition; 152 | property TabWidth: smallint read FTabWidth write SetTabWidth; 153 | end; 154 | 155 | implementation 156 | 157 | uses 158 | Forms; 159 | 160 | { TCustomTabSheet } 161 | 162 | function TCustomTabSheet.GetPageControl: TCustomPageControl; 163 | begin 164 | if (Parent is TCustomPageControl) then 165 | begin 166 | Result := TCustomPageControl(Parent); 167 | end 168 | else 169 | begin 170 | Result := nil; 171 | end; 172 | end; 173 | 174 | function TCustomTabSheet.GetPageIndex: NativeInt; 175 | begin 176 | if (Parent is TCustomPageControl) then 177 | begin 178 | Result := TCustomPageControl(Parent).IndexOf(Self); 179 | end 180 | else 181 | begin 182 | Result := -1; 183 | end; 184 | end; 185 | 186 | procedure TCustomTabSheet.SetPageControl(AValue: TCustomPageControl); 187 | begin 188 | if (PageControl = AValue) then 189 | begin 190 | Parent := AValue; 191 | end; 192 | end; 193 | 194 | procedure TCustomTabSheet.Changed; 195 | begin 196 | inherited Changed; 197 | if (not IsUpdating) and not (csLoading in ComponentState) then 198 | begin 199 | with HandleElement do 200 | begin 201 | /// Color 202 | Style.SetProperty('background-color', '#fff'); 203 | /// Focus highlight 204 | Style.SetProperty('outline', 'none'); 205 | /// Borders 206 | Style.SetProperty('border', '1px solid #c9c3ba'); 207 | Style.SetProperty('border-top', '0px'); 208 | end; 209 | end; 210 | end; 211 | 212 | function TCustomTabSheet.CreateHandleElement: TJSHTMLElement; 213 | begin 214 | Result := TJSHTMLElement(Document.CreateElement('span')); 215 | end; 216 | 217 | constructor TCustomTabSheet.Create(AOwner: TComponent); 218 | begin 219 | inherited Create(AOwner); 220 | FTabVisible := True; 221 | BeginUpdate; 222 | try 223 | Visible := False; 224 | finally 225 | EndUpdate; 226 | end; 227 | end; 228 | 229 | { TCustomPageControl } 230 | 231 | function TCustomPageControl.GetActivePage: TCustomTabSheet; 232 | begin 233 | Result := GetPage(FPageIndex); 234 | end; 235 | 236 | function TCustomPageControl.GetPage(const AIndex: NativeInt): TCustomTabSheet; 237 | begin 238 | if (AIndex >= 0) and (AIndex < FPages.Length) then 239 | begin 240 | Result := TCustomTabSheet(FPages[AIndex]); 241 | end 242 | else 243 | begin 244 | Result := nil; 245 | end; 246 | end; 247 | 248 | function TCustomPageControl.GetPageCount: NativeInt; 249 | begin 250 | Result := FPages.Length; 251 | end; 252 | 253 | procedure TCustomPageControl.SetActivePage(AValue: TCustomTabSheet); 254 | begin 255 | SetPageIndex(FPages.IndexOf(AValue)); 256 | end; 257 | 258 | procedure TCustomPageControl.SetMultiLine(AValue: boolean); 259 | begin 260 | if (FMultiLine <> AValue) then 261 | begin 262 | FMultiLine := AValue; 263 | end; 264 | end; 265 | 266 | procedure TCustomPageControl.SetPageIndex(AValue: NativeInt); 267 | begin 268 | if (AValue < 0) or (AValue >= FPages.Length) then 269 | begin 270 | AValue := 0; 271 | end; 272 | if (AValue <> FPageIndex) then 273 | begin 274 | FPageIndex := AValue; 275 | Changed; 276 | end; 277 | end; 278 | 279 | procedure TCustomPageControl.SetShowTabs(AValue: boolean); 280 | begin 281 | if (FShowTabs <> AValue) then 282 | begin 283 | FShowTabs := AValue; 284 | Changed; 285 | end; 286 | end; 287 | 288 | procedure TCustomPageControl.SetTabHeight(AValue: smallint); 289 | begin 290 | if (FTabHeight <> AValue) then 291 | begin 292 | FTabHeight := AValue; 293 | Changed; 294 | end; 295 | end; 296 | 297 | procedure TCustomPageControl.SetTabPosition(AValue: TTabPosition); 298 | begin 299 | if (FTabPosition <> AValue) then 300 | begin 301 | FTabPosition := AValue; 302 | end; 303 | end; 304 | 305 | procedure TCustomPageControl.SetTabWidth(AValue: smallint); 306 | begin 307 | if (FTabWidth <> AValue) then 308 | begin 309 | FTabWidth := AValue; 310 | Changed; 311 | end; 312 | end; 313 | 314 | procedure TCustomPageControl.Changed; 315 | begin 316 | inherited Changed; 317 | if (not IsUpdating) and not (csLoading in ComponentState) then 318 | begin 319 | with HandleElement do 320 | begin 321 | /// Focus highlight 322 | Style.SetProperty('outline', 'none'); 323 | end; 324 | RenderTabs; 325 | UpdatePages; 326 | end; 327 | end; 328 | 329 | function TCustomPageControl.CreateHandleElement: TJSHTMLElement; 330 | begin 331 | Result := TJSHTMLElement(Document.CreateElement('div')); 332 | end; 333 | 334 | function TCustomPageControl.CreateTabContainerElement: TJSHTMLElement; 335 | begin 336 | Result := TJSHTMLElement(Document.CreateElement('span')); 337 | HandleElement.AppendChild(Result); 338 | end; 339 | 340 | procedure TCustomPageControl.RegisterChild(AControl: TControl); 341 | var 342 | VIndex: NativeInt; 343 | begin 344 | inherited RegisterChild(AControl); 345 | if (Assigned(AControl)) and (AControl is TCustomTabSheet) then 346 | begin 347 | VIndex := FPages.IndexOf(AControl); 348 | if (VIndex < 0) then 349 | begin 350 | FPages.Push(AControl); 351 | end; 352 | end; 353 | end; 354 | 355 | procedure TCustomPageControl.UnRegisterChild(AControl: TControl); 356 | var 357 | VIndex: NativeInt; 358 | begin 359 | inherited UnRegisterChild(AControl); 360 | if (Assigned(AControl)) and (AControl is TCustomTabSheet) then 361 | begin 362 | VIndex := FPages.IndexOf(AControl); 363 | if (VIndex >= 0) then 364 | begin 365 | FPages.Splice(VIndex, 1); 366 | end; 367 | end; 368 | end; 369 | 370 | function TCustomPageControl.CalcTabHeight: NativeInt; 371 | begin 372 | if (FShowTabs) then 373 | begin 374 | if (FTabHeight > 0) then 375 | begin 376 | Result := FTabHeight; 377 | end 378 | else 379 | begin 380 | Result := Font.TextHeight('Fj') + 10; 381 | end; 382 | end 383 | else 384 | begin 385 | Result := 0; 386 | end; 387 | end; 388 | 389 | function TCustomPageControl.CalcTabWidth(const AText: string): NativeInt; 390 | begin 391 | if (FTabWidth > 0) then 392 | begin 393 | Result := FTabWidth; 394 | end 395 | else 396 | begin 397 | Result := Font.TextWidth(AText) + 10; 398 | end; 399 | end; 400 | 401 | function TCustomPageControl.CalcMaxTabWidth: NativeInt; 402 | var 403 | VPage: TCustomTabSheet; 404 | VIndex: NativeInt; 405 | VWidth: NativeInt; 406 | begin 407 | Result := 0; 408 | if (FTabWidth > 0) then 409 | begin 410 | Result := FTabWidth; 411 | end 412 | else 413 | begin 414 | for VIndex := 0 to (FPages.Length - 1) do 415 | begin 416 | VPage := TCustomTabSheet(FPages[VIndex]); 417 | if (Assigned(VPage)) and (VPage.TabVisible) then 418 | begin 419 | VWidth := CalcTabWidth(VPage.Caption); 420 | if (VWidth > Result) then 421 | begin 422 | Result := VWidth; 423 | end; 424 | end; 425 | end; 426 | end; 427 | end; 428 | 429 | function TCustomPageControl.CalcSumTabsWidth: NativeInt; 430 | var 431 | VIndex: NativeInt; 432 | VPage: TCustomTabSheet; 433 | begin 434 | Result := 0; 435 | for VIndex := 0 to (FPages.Length - 1) do 436 | begin 437 | VPage := TCustomTabSheet(FPages[VIndex]); 438 | if (Assigned(VPage)) and (VPage.TabVisible) then 439 | begin 440 | Result := Result + CalcTabWidth(VPage.Caption); 441 | end; 442 | end; 443 | end; 444 | 445 | function TCustomPageControl.IndexOfTab(const ACaption: string): NativeInt; 446 | var 447 | VIndex: NativeInt; 448 | VPage: TCustomTabSheet; 449 | begin 450 | Result := -1; 451 | for VIndex := 0 to (FPages.Length - 1) do 452 | begin 453 | VPage := TCustomTabSheet(FPages[VIndex]); 454 | if (Assigned(VPage)) and (VPage.TabVisible) and (SameText(VPage.Caption, ACaption)) then 455 | begin 456 | Result := VIndex; 457 | end; 458 | end; 459 | end; 460 | 461 | function TCustomPageControl.RenderTab(const ACaption: string; const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; 462 | begin 463 | Result := TJSHTMLElement(Document.CreateElement('button')); 464 | with Result do 465 | begin 466 | /// Bounds 467 | Style.SetProperty('left', IntToStr(ALeft) + 'px'); 468 | Style.SetProperty('top', IntToStr(ATop) + 'px'); 469 | Style.SetProperty('width', IntToStr(AWidth) + 'px'); 470 | Style.SetProperty('height', IntToStr(AHeight) + 'px'); 471 | /// Border 472 | Style.SetProperty('border', '1px solid #c9c3ba'); 473 | Style.SetProperty('border-top-left-radius', '15px'); 474 | Style.SetProperty('border-top-right-radius', '2px'); 475 | /// Color 476 | Style.SetProperty('background-color', '#dddada'); 477 | /// Font 478 | Style.SetProperty('color', JSColor(Font.Color)); 479 | Style.SetProperty('font', JSFont(Font)); 480 | /// Focus highlight 481 | Style.SetProperty('outline', 'none'); 482 | /// Position 483 | Style.SetProperty('position', 'absolute'); 484 | /// Scroll 485 | Style.SetProperty('overflow', 'hidden'); 486 | /// Normalize caption 487 | Style.SetProperty('padding', '0'); 488 | Style.SetProperty('white-space', 'nowrap'); 489 | /// Click 490 | AddEventListener('click', AEvent); 491 | /// Caption 492 | InnerHTML := ACaption; 493 | end; 494 | end; 495 | 496 | function TCustomPageControl.RenderTabActive(const ACaption: string; const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; 497 | begin 498 | Result := RenderTab(ACaption, ALeft, ATop, AWidth, AHeight, AEvent); 499 | with Result do 500 | begin 501 | /// Border 502 | Style.SetProperty('border-bottom', '0px'); 503 | /// Color 504 | Style.SetProperty('background-color', '#fff'); 505 | end; 506 | end; 507 | 508 | function TCustomPageControl.RenderTabLeft(const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; 509 | begin 510 | Result := RenderTab('‹', ALeft, ATop, AWidth, AHeight, AEvent); 511 | with Result do 512 | begin 513 | /// Color 514 | Style.SetProperty('background-color', '#fff'); 515 | end; 516 | end; 517 | 518 | function TCustomPageControl.RenderTabRight(const ALeft, ATop, AWidth, AHeight: NativeInt; const AEvent: JSValue): TJSHTMLElement; 519 | begin 520 | Result := RenderTab('›', ALeft, ATop, AWidth, AHeight, AEvent); 521 | with Result do 522 | begin 523 | /// Color 524 | Style.SetProperty('background-color', '#fff'); 525 | end; 526 | end; 527 | 528 | procedure TCustomPageControl.RenderTabs; 529 | var 530 | form: TCustomForm; 531 | 532 | function AdjustWithPPI(aValue: Integer): Integer; 533 | begin 534 | if Assigned(form) then 535 | Result := Trunc(96 * aValue / form.DesignTimePPI) 536 | else 537 | Result := aValue; 538 | end; 539 | 540 | function FindParentForm: TCustomForm; 541 | var 542 | p: TWinControl; 543 | begin 544 | p := Parent; 545 | while Assigned(p) and not (p is TCustomForm) do 546 | p := p.Parent; 547 | if p is TCustomForm then 548 | Result := TCustomForm(p) 549 | else 550 | Result := Nil; 551 | end; 552 | 553 | var 554 | VPage: TCustomTabSheet; 555 | VIndex: NativeInt; 556 | VStartIndex: NativeInt; 557 | VEndIndex: NativeInt; 558 | VTabCaption: string; 559 | VTabHeight: NativeInt; 560 | VTabLeft: NativeInt; 561 | VTabWidth: NativeInt; 562 | VSumTabsWidth: NativeInt; 563 | VMaxTabWidth: NativeInt; 564 | VTabsCount: NativeInt; 565 | begin 566 | form := FindParentForm; 567 | VTabHeight := CalcTabHeight; 568 | VSumTabsWidth := CalcSumTabsWidth; 569 | /// Containter 570 | with FTabContainerElement do 571 | begin 572 | /// Clean 573 | InnerHTML := ''; 574 | /// Bounds 575 | Style.SetProperty('left', '0px'); 576 | Style.SetProperty('top', '0px'); 577 | Style.SetProperty('width', IntToStr(AdjustWithPPI(IfThen((VSumTabsWidth > Width), VSumTabsWidth, Width))) + 'px'); 578 | Style.SetProperty('height', IntToStr(AdjustWithPPI(VTabHeight)) + 'px'); 579 | /// Position 580 | Style.SetProperty('position', 'absolute'); 581 | /// Scroll 582 | Style.SetProperty('overflow', 'hidden'); 583 | end; 584 | /// Tabs 585 | if (FPageIndex > -1) and (FPageIndex < FPages.Length) then 586 | begin 587 | /// Quantity of tabs greater than the container 588 | if (VSumTabsWidth > Width) then 589 | begin 590 | VTabLeft := 40; 591 | VMaxTabWidth := CalcMaxTabWidth; 592 | VTabsCount := Trunc((Width - 80) div VMaxTabWidth); 593 | if (VTabsCount = 0) then 594 | begin 595 | VTabsCount := 1; 596 | end; 597 | if ((FPageIndex - VTabsCount) >= 0) then 598 | begin 599 | VStartIndex := (FPageIndex - VTabsCount) + 1; 600 | VEndIndex := FPageIndex; 601 | end 602 | else 603 | begin 604 | VStartIndex := 0; 605 | VEndIndex := VTabsCount - 1; 606 | end; 607 | VMaxTabWidth := Trunc((Width - 80) div VTabsCount); 608 | /// Tab 609 | for VIndex := VStartIndex to VEndIndex do 610 | begin 611 | VPage := TCustomTabSheet(FPages[VIndex]); 612 | if (Assigned(VPage)) and (VPage.TabVisible) then 613 | begin 614 | VTabCaption := VPage.Caption; 615 | VTabWidth := VMaxTabWidth; 616 | if (VIndex = FPageIndex) then 617 | begin 618 | /// Register tab 619 | FTabContainerElement.AppendChild(RenderTabActive(VTabCaption, AdjustWithPPI(VTabLeft), 0, AdjustWithPPI(VTabWidth), AdjustWithPPI(VTabHeight), @TabClick)); 620 | end 621 | else 622 | begin 623 | /// Register tab 624 | FTabContainerElement.AppendChild(RenderTab(VTabCaption, AdjustWithPPI(VTabLeft), 0, AdjustWithPPI(VTabWidth), AdjustWithPPI(VTabHeight), @TabClick)); 625 | end; 626 | /// Calculate the next position of the tab 627 | VTabLeft := VTabLeft + VTabWidth; 628 | end; 629 | end; 630 | /// Register navigation tabs 631 | with FTabContainerElement do // First and Last Tabs 632 | begin 633 | AppendChild(RenderTabLeft(0, 0, 40, AdjustWithPPI(VTabHeight), @TabLeftClick)); 634 | AppendChild(RenderTabRight(AdjustWithPPI(Width - 40), 0, 40, AdjustWithPPI(VTabHeight), @TabRightClick)); 635 | end; 636 | end 637 | else 638 | begin 639 | VTabLeft := 0; 640 | VStartIndex := 0; 641 | VEndIndex := (FPages.Length - 1); 642 | VTabWidth := (Width div FPages.Length); 643 | /// Tab 644 | for VIndex := VStartIndex to VEndIndex do 645 | begin 646 | VPage := TCustomTabSheet(FPages[VIndex]); 647 | if (Assigned(VPage)) and (VPage.TabVisible) then 648 | begin 649 | VTabCaption := VPage.Caption; 650 | if (VIndex = FPageIndex) then 651 | begin 652 | /// Register tab 653 | FTabContainerElement.AppendChild(RenderTabActive(VTabCaption, AdjustWithPPI(VTabLeft), 0, AdjustWithPPI(VTabWidth), AdjustWithPPI(VTabHeight), @TabClick)); 654 | end 655 | else 656 | begin 657 | /// Register tab 658 | FTabContainerElement.AppendChild(RenderTab(VTabCaption, AdjustWithPPI(VTabLeft), 0, AdjustWithPPI(VTabWidth), AdjustWithPPI(VTabHeight), @TabClick)); 659 | end; 660 | /// Calculate the next position of the tab 661 | VTabLeft := VTabLeft + VTabWidth; 662 | end; 663 | end; 664 | end; 665 | end; 666 | end; 667 | 668 | procedure TCustomPageControl.TabClick(AEvent: TJSMouseEvent); 669 | begin 670 | SetPageIndex(IndexOfTab(AEvent.targetElement.InnerHTML)); 671 | end; 672 | 673 | procedure TCustomPageControl.TabLeftClick(AEvent: TJSMouseEvent); 674 | begin 675 | SetPageIndex(FPageIndex - 1); 676 | end; 677 | 678 | procedure TCustomPageControl.TabRightClick(AEvent: TJSMouseEvent); 679 | begin 680 | SetPageIndex(FPageIndex + 1); 681 | end; 682 | 683 | procedure TCustomPageControl.UpdatePages; 684 | var 685 | VIndex: NativeInt; 686 | VPage: TCustomTabSheet; 687 | VTabHeight: NativeInt; 688 | begin 689 | VTabHeight := CalcTabHeight; 690 | for VIndex := 0 to (FPages.Length - 1) do 691 | begin 692 | VPage := TCustomTabSheet(FPages[VIndex]); 693 | if (Assigned(VPage)) and (VPage.TabVisible) then 694 | begin 695 | VPage.BeginUpdate; 696 | try 697 | if (VIndex = FPageIndex) then 698 | begin 699 | VPage.SetBounds(0, VTabHeight, (Width), ((Height) - VTabHeight)); 700 | VPage.Visible := True; 701 | end 702 | else 703 | begin 704 | VPage.Visible := False; 705 | end; 706 | finally 707 | VPage.EndUpdate; 708 | end; 709 | end; 710 | end; 711 | end; 712 | 713 | class function TCustomPageControl.GetControlClassDefaultSize: TSize; 714 | begin 715 | Result.Cx := 200; 716 | Result.Cy := 200; 717 | end; 718 | 719 | constructor TCustomPageControl.Create(AOwner: TComponent); 720 | begin 721 | inherited Create(AOwner); 722 | FTabContainerElement := CreateTabContainerElement; 723 | FPages := TJSArray.New(); 724 | FPageIndex := -1; 725 | FShowTabs := True; 726 | FTabPosition := tpTop; 727 | BeginUpdate; 728 | try 729 | TabStop := False; 730 | with GetControlClassDefaultSize do 731 | begin 732 | SetBounds(0, 0, Cx, Cy); 733 | end; 734 | finally 735 | EndUpdate; 736 | end; 737 | end; 738 | 739 | destructor TCustomPageControl.Destroy; 740 | begin 741 | FPages.Length := 0; 742 | inherited Destroy; 743 | end; 744 | 745 | function TCustomPageControl.AddTabSheet: TCustomTabSheet; 746 | begin 747 | Result := TCustomTabSheet.Create(Self); 748 | Result.PageControl := Self; 749 | end; 750 | 751 | function TCustomPageControl.IndexOf(APage: TCustomTabSheet): NativeInt; 752 | begin 753 | Result := FPages.IndexOf(APage); 754 | end; 755 | 756 | end. 757 | -------------------------------------------------------------------------------- /widgets/dttctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit DttCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | Graphics, 35 | StdCtrls; 36 | 37 | type 38 | 39 | { TCustomDateTimeEdit } 40 | 41 | TCustomDateTimeEdit = class(TCustomEdit) 42 | protected 43 | procedure DoEnter; override; 44 | procedure DoExit; override; 45 | end; 46 | 47 | implementation 48 | 49 | { TCustomDateTimeEdit } 50 | 51 | procedure TCustomDateTimeEdit.DoEnter; 52 | begin 53 | inherited DoEnter; 54 | RealSetText(RealGetText); 55 | end; 56 | 57 | procedure TCustomDateTimeEdit.DoExit; 58 | begin 59 | inherited DoExit; 60 | RealSetText(RealGetText); 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /widgets/extctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit ExtCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | JS, 32 | Classes, 33 | SysUtils, 34 | Types, 35 | Web, 36 | Graphics, 37 | Controls; 38 | 39 | type 40 | 41 | { TCustomImage } 42 | 43 | TCustomImage = class(TCustomControl) 44 | private 45 | FCenter: boolean; 46 | FPicture: TPicture; 47 | FProportional: boolean; 48 | FStretch: boolean; 49 | FOnPictureChanged: TNotifyEvent; 50 | FStretchInEnabled: boolean; 51 | FStretchOutEnabled: boolean; 52 | FTransparent: boolean; 53 | FURL: String; 54 | procedure SetCenter(AValue: boolean); 55 | procedure SetPicture(AValue: TPicture); 56 | procedure SetProportional(AValue: boolean); 57 | procedure SetStretch(AValue: boolean); 58 | procedure SetStretchInEnabled(AValue: boolean); 59 | procedure SetStretchOutEnabled(AValue: boolean); 60 | procedure SetTransparent(AValue: boolean); 61 | procedure SetURL(AValue: String); 62 | protected 63 | procedure Changed; override; 64 | function CreateHandleElement: TJSHTMLElement; override; 65 | function CheckChildClassAllowed(AChildClass: TClass): boolean; override; 66 | procedure PictureChanged(Sender: TObject); virtual; 67 | protected 68 | class function GetControlClassDefaultSize: TSize; override; 69 | public 70 | constructor Create(AOwner: TComponent); override; 71 | public 72 | property Center: boolean read FCenter write SetCenter default False; 73 | property Picture: TPicture read FPicture write SetPicture; 74 | property Proportional: boolean read FProportional write SetProportional default False; 75 | property Stretch: boolean read FStretch write SetStretch default False; 76 | property StretchOutEnabled: boolean read FStretchOutEnabled write SetStretchOutEnabled default True; 77 | property StretchInEnabled: boolean read FStretchInEnabled write SetStretchInEnabled default True; 78 | property Transparent: boolean read FTransparent write SetTransparent default False; 79 | property URL: String read FURL write SetURL; 80 | property OnPictureChanged: TNotifyEvent read FOnPictureChanged write FOnPictureChanged; 81 | end; 82 | 83 | TPanelBevel = TBevelCut; 84 | TBevelWidth = 1..Maxint; 85 | 86 | { TCustomPanel } 87 | 88 | TCustomPanel = class(TCustomControl) 89 | private 90 | FAlignment: TAlignment; 91 | FBevelColor: TColor; 92 | FBevelInner: TPanelBevel; 93 | FBevelOuter: TPanelBevel; 94 | FBevelWidth: TBevelWidth; 95 | FLayout: TTextLayout; 96 | FWordWrap: boolean; 97 | procedure SetAlignment(AValue: TAlignment); 98 | procedure SetBevelColor(AValue: TColor); 99 | procedure SetBevelInner(AValue: TPanelBevel); 100 | procedure SetBevelOuter(AValue: TPanelBevel); 101 | procedure SetBevelWidth(AValue: TBevelWidth); 102 | procedure SetLayout(AValue: TTextLayout); 103 | procedure SetWordWrap(AValue: boolean); 104 | protected 105 | property Layout: TTextLayout read FLayout write SetLayout; 106 | property WordWrap: boolean read FWordWrap write SetWordWrap; 107 | protected 108 | procedure Changed; override; 109 | function CreateHandleElement: TJSHTMLElement; override; 110 | protected 111 | class function GetControlClassDefaultSize: TSize; override; 112 | public 113 | constructor Create(AOwner: TComponent); override; 114 | public 115 | property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; 116 | property BevelColor: TColor read FBevelColor write SetBevelColor default clDefault; 117 | property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone; 118 | property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised; 119 | property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; 120 | end; 121 | 122 | { TCustomTimer } 123 | 124 | TCustomTimer = class(TComponent) 125 | private 126 | FEnabled: Boolean; 127 | FInterval: Cardinal; 128 | FTimerHandle: NativeUInt; 129 | FOnStartTimer: TNotifyEvent; 130 | FOnStopTimer: TNotifyEvent; 131 | FOnTimer: TNotifyEvent; 132 | protected 133 | procedure SetEnabled(AValue: Boolean); virtual; 134 | procedure SetInterval(AValue: Cardinal); virtual; 135 | procedure SetOnTimer(AValue: TNotifyEvent); virtual; 136 | procedure DoOnTimer; virtual; 137 | procedure UpdateTimer; virtual; 138 | procedure KillTimer; virtual; 139 | procedure Loaded; override; 140 | public 141 | constructor Create(AOwner: TComponent); override; 142 | destructor Destroy; override; 143 | property Enabled: Boolean read FEnabled write SetEnabled default True; 144 | property Interval: Cardinal read FInterval write SetInterval default 1000; 145 | property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; 146 | property OnStartTimer: TNotifyEvent read FOnStartTimer write FOnStartTimer; 147 | property OnStopTimer: TNotifyEvent read FOnStopTimer write FOnStopTimer; 148 | end; 149 | 150 | { TCustomWebSocketClient } 151 | TByteArray = TJSUint8Array; 152 | 153 | TNotifyWebSocketMessage = procedure(aSender: TObject; aData: String) of object; 154 | TNotifyWebSocketBinaryMessage = procedure(aSender: TObject; aData: TBytes) of object; 155 | TNotifyWebSocketClose = procedure(aSender: TObject; aCode: Cardinal; aReason: String) of object; 156 | 157 | TCustomWebSocketClient = class(TComponent) 158 | private 159 | fConnected: Boolean; 160 | fOnBinaryMessage: TNotifyWebSocketBinaryMessage; 161 | fOnClose: TNotifyWebSocketClose; 162 | fOnError: TNotifyEvent; 163 | fOnMessage: TNotifyWebSocketMessage; 164 | fOnOpen: TNotifyEvent; 165 | fUrl: String; 166 | fWebSocket: TJSWebSocket; 167 | function WebSocketCloseHandler(aEvent: TEventListenerEvent): Boolean; 168 | function WebSocketErrorHandler(aEvent: TEventListenerEvent): Boolean; 169 | function WebSocketMessageHandler(aEvent: TEventListenerEvent): Boolean; 170 | function WebSocketOpenHandler(aEvent: TEventListenerEvent): Boolean; 171 | function WebSocketReaderHandler(aEvent: TEventListenerEvent): Boolean; 172 | procedure SetUrl(aValue: String); 173 | public 174 | destructor Destroy; override; 175 | procedure Connect; 176 | procedure Close; overload; 177 | procedure Close(aCode: Cardinal); overload; 178 | procedure Close(aCode: Cardinal; aReason: String); overload; 179 | procedure Send(aData: String); 180 | public 181 | property Connected: Boolean read fConnected; 182 | property Url: String read fUrl write SetUrl; 183 | property OnBinaryMessage: TNotifyWebSocketBinaryMessage read fOnBinaryMessage write fOnBinaryMessage; 184 | property OnClose: TNotifyWebSocketClose read fOnClose write fOnClose; 185 | property OnError: TNotifyEvent read fOnError write fOnError; 186 | property OnMessage: TNotifyWebSocketMessage read fOnMessage write fOnMessage; 187 | property OnOpen: TNotifyEvent read fOnOpen write fOnOpen; 188 | end; 189 | 190 | implementation 191 | 192 | uses 193 | WCLStrConsts; 194 | 195 | { TCustomWebSocketClient } 196 | 197 | function TCustomWebSocketClient.WebSocketMessageHandler(aEvent: TEventListenerEvent): Boolean; 198 | var 199 | reader: TJSFileReader; 200 | Data: TJSUint8Array; 201 | begin 202 | if aEvent._type <> 'message' then 203 | Exit; 204 | case GetValueType(TJSMessageEvent(aEvent).Data) of 205 | jvtString: 206 | if Assigned(OnMessage) then 207 | OnMessage(Self, String(TJSMessageEvent(aEvent).Data)); 208 | jvtObject: 209 | if Assigned(OnBinaryMessage) then begin 210 | reader := TJSFileReader.new; 211 | reader.readAsArrayBuffer(TJSBlob(TJSMessageEvent(aEvent).Data)); 212 | reader.addEventListener('loadend', @WebSocketReaderHandler); 213 | end; 214 | end; 215 | end; 216 | 217 | function TCustomWebSocketClient.WebSocketCloseHandler(aEvent: TEventListenerEvent): Boolean; 218 | begin 219 | if Assigned(OnClose) then 220 | OnClose(Self, TJSCloseEvent(aEvent).code, TJSCloseEvent(aEvent).reason); 221 | end; 222 | 223 | function TCustomWebSocketClient.WebSocketErrorHandler(aEvent: TEventListenerEvent): Boolean; 224 | begin 225 | Close; 226 | if Assigned(OnError) then 227 | OnError(Self); 228 | end; 229 | 230 | function TCustomWebSocketClient.WebSocketOpenHandler(aEvent: TEventListenerEvent): Boolean; 231 | begin 232 | fConnected := True; 233 | if Assigned(OnOpen) then 234 | OnOpen(Self); 235 | end; 236 | 237 | function TCustomWebSocketClient.WebSocketReaderHandler(aEvent: TEventListenerEvent): Boolean; 238 | var 239 | Data: TJSUint8Array; 240 | ByteArray: TBytes; 241 | i: Integer; 242 | begin 243 | Data := TJSUint8Array.new(TJSArrayBuffer(TJSFileReader(aEvent.target).Result)); 244 | SetLength(ByteArray, Data.length); 245 | for i := 0 to Data.length - 1 do 246 | ByteArray[i] := Data[i]; 247 | OnBinaryMessage(Self, ByteArray); 248 | end; 249 | 250 | procedure TCustomWebSocketClient.SetUrl(aValue: String); 251 | begin 252 | fConnected := False; 253 | fUrl := aValue; 254 | end; 255 | 256 | destructor TCustomWebSocketClient.Destroy; 257 | begin 258 | Close; 259 | inherited Destroy; 260 | end; 261 | 262 | procedure TCustomWebSocketClient.Connect; 263 | begin 264 | Close; 265 | fWebSocket := TJSWebSocket.new(Url); 266 | fWebSocket.onmessage := @WebSocketMessageHandler; 267 | fWebSocket.onopen := @WebSocketOpenHandler; 268 | fWebSocket.onclose := @WebSocketCloseHandler; 269 | fWebSocket.onerror := @WebSocketErrorHandler; 270 | end; 271 | 272 | procedure TCustomWebSocketClient.Close; 273 | begin 274 | Close(WS_NORMAL_CLOSURE, ''); 275 | end; 276 | 277 | procedure TCustomWebSocketClient.Close(aCode: Cardinal); 278 | begin 279 | Close(aCode, ''); 280 | end; 281 | 282 | procedure TCustomWebSocketClient.Close(aCode: Cardinal; aReason: String); 283 | begin 284 | if Assigned(fWebSocket) then begin 285 | fWebSocket.close(aCode, aReason); 286 | fWebSocket := nil; 287 | end; 288 | fConnected := False; 289 | end; 290 | 291 | 292 | procedure TCustomWebSocketClient.Send(aData: String); 293 | begin 294 | if not Connected then 295 | raise Exception.Create('The WebSocket does not connected'); 296 | fWebSocket.send(aData); 297 | end; 298 | 299 | { TCustomTimer } 300 | 301 | procedure TCustomTimer.SetEnabled(AValue: Boolean); 302 | begin 303 | if FEnabled = AValue then 304 | Exit; 305 | FEnabled := AValue; 306 | UpdateTimer; 307 | end; 308 | 309 | procedure TCustomTimer.SetInterval(AValue: Cardinal); 310 | begin 311 | if FInterval = AValue then 312 | Exit; 313 | FInterval := AValue; 314 | UpdateTimer; 315 | end; 316 | 317 | procedure TCustomTimer.SetOnTimer(AValue: TNotifyEvent); 318 | begin 319 | if FOnTimer = AValue then 320 | Exit; 321 | FOnTimer := AValue; 322 | UpdateTimer; 323 | end; 324 | 325 | procedure TCustomTimer.DoOnTimer; 326 | begin 327 | if Assigned(FOnTimer) then 328 | FOnTimer(Self); 329 | end; 330 | 331 | procedure TCustomTimer.UpdateTimer; 332 | begin 333 | KillTimer; 334 | if FEnabled and (FInterval > 0) and 335 | ([csLoading, csDestroying] * ComponentState = []) and Assigned(FOnTimer) then begin 336 | FTimerHandle := window.setInterval(procedure begin FOnTimer(Self); end, FInterval); 337 | if FTimerHandle = 0 then 338 | raise EOutOfResources.Create(rsNoTimers); 339 | if Assigned(FOnStartTimer) then 340 | FOnStartTimer(Self); 341 | end; 342 | end; 343 | 344 | procedure TCustomTimer.KillTimer; 345 | begin 346 | if FTimerHandle <> 0 then begin 347 | window.clearInterval(FTimerHandle); 348 | if Assigned(FOnStopTimer) then 349 | FOnStopTimer(Self); 350 | end; 351 | end; 352 | 353 | procedure TCustomTimer.Loaded; 354 | begin 355 | inherited Loaded; 356 | UpdateTimer; 357 | end; 358 | 359 | constructor TCustomTimer.Create(AOwner: TComponent); 360 | begin 361 | inherited Create(AOwner); 362 | FEnabled := True; 363 | FInterval := 1000; 364 | FTimerHandle := 0; 365 | end; 366 | 367 | destructor TCustomTimer.Destroy; 368 | begin 369 | KillTimer; 370 | inherited Destroy; 371 | end; 372 | 373 | { TCustomImage } 374 | 375 | procedure TCustomImage.SetCenter(AValue: boolean); 376 | begin 377 | if (FCenter <> AValue) then 378 | begin 379 | FCenter := AValue; 380 | PictureChanged(Self); 381 | end; 382 | end; 383 | 384 | procedure TCustomImage.SetPicture(AValue: TPicture); 385 | begin 386 | if (not FPicture.IsEqual(AValue)) then 387 | begin 388 | FPicture.Assign(AValue); 389 | end; 390 | end; 391 | 392 | procedure TCustomImage.SetProportional(AValue: boolean); 393 | begin 394 | if (FProportional <> AValue) then 395 | begin 396 | FProportional := AValue; 397 | PictureChanged(Self); 398 | end; 399 | end; 400 | 401 | procedure TCustomImage.SetStretch(AValue: boolean); 402 | begin 403 | if (FStretch <> AValue) then 404 | begin 405 | FStretch := AValue; 406 | PictureChanged(Self); 407 | end; 408 | end; 409 | 410 | procedure TCustomImage.SetStretchInEnabled(AValue: boolean); 411 | begin 412 | if (FStretchInEnabled <> AValue) then; 413 | begin 414 | FStretchInEnabled := AValue; 415 | PictureChanged(Self); 416 | end; 417 | end; 418 | 419 | procedure TCustomImage.SetStretchOutEnabled(AValue: boolean); 420 | begin 421 | if (FStretchOutEnabled <> AValue) then 422 | begin 423 | FStretchOutEnabled := AValue; 424 | PictureChanged(Self); 425 | end; 426 | end; 427 | 428 | procedure TCustomImage.SetTransparent(AValue: boolean); 429 | begin 430 | if (FTransparent = AValue) then 431 | begin 432 | FTransparent := AValue; 433 | end; 434 | end; 435 | 436 | procedure TCustomImage.SetURL(AValue: String); 437 | begin 438 | if FURL = AValue then 439 | Exit; 440 | FURL := AValue; 441 | PictureChanged(Self); 442 | end; 443 | 444 | procedure TCustomImage.Changed; 445 | begin 446 | inherited Changed; 447 | if (not IsUpdating) and not (csLoading in ComponentState) then 448 | begin 449 | with HandleElement do 450 | begin 451 | /// Focus highlight 452 | Style.SetProperty('outline', 'none'); 453 | /// Load image 454 | Style.SetProperty('background-image', Format('url(''%s'')', [FURL])); 455 | Style.SetProperty('background-repeat', 'no-repeat'); 456 | /// Center 457 | if (FCenter) then 458 | begin 459 | Style.SetProperty('background-position', 'center center'); 460 | end 461 | else 462 | begin 463 | Style.RemoveProperty('background-position'); 464 | end; 465 | /// Proportional 466 | if (FProportional) then 467 | begin 468 | Style.SetProperty('background-size', 'contain'); 469 | end 470 | else 471 | /// Stretch 472 | if (FStretch) then 473 | begin 474 | if (FStretchInEnabled) and (FStretchOutEnabled) then 475 | begin 476 | Style.SetProperty('background-size', '100% 100%'); 477 | end 478 | else 479 | if (FStretchInEnabled) then 480 | begin 481 | Style.SetProperty('background-size', 'auto 100%'); 482 | end 483 | else 484 | if (FStretchOutEnabled) then 485 | begin 486 | Style.SetProperty('background-size', '100% auto'); 487 | end; 488 | end 489 | else 490 | begin 491 | Style.SetProperty('background-size', 'auto'); 492 | end; 493 | end; 494 | end; 495 | end; 496 | 497 | function TCustomImage.CreateHandleElement: TJSHTMLElement; 498 | begin 499 | Result := TJSHTMLElement(Document.CreateElement('div')); 500 | end; 501 | 502 | {$push} 503 | {$hints off} 504 | 505 | function TCustomImage.CheckChildClassAllowed(AChildClass: TClass): boolean; 506 | begin 507 | Result := False; 508 | end; 509 | 510 | {$pop} 511 | 512 | {$push} 513 | {$hints off} 514 | 515 | procedure TCustomImage.PictureChanged(Sender: TObject); 516 | begin 517 | Changed; 518 | if (Assigned(FOnPictureChanged)) then 519 | begin 520 | FOnPictureChanged(Self); 521 | end; 522 | end; 523 | 524 | {$pop} 525 | 526 | class function TCustomImage.GetControlClassDefaultSize: TSize; 527 | begin 528 | Result.Cx := 90; 529 | Result.Cy := 90; 530 | end; 531 | 532 | constructor TCustomImage.Create(AOwner: TComponent); 533 | begin 534 | inherited Create(AOwner); 535 | FPicture := TPicture.Create; 536 | FPicture.OnChange := @PictureChanged; 537 | FCenter := False; 538 | FProportional := False; 539 | FStretch := False; 540 | FStretchOutEnabled := True; 541 | FStretchInEnabled := True; 542 | FTransparent := False; 543 | BeginUpdate; 544 | try 545 | with GetControlClassDefaultSize do 546 | begin 547 | SetBounds(0, 0, Cx, Cy); 548 | end; 549 | finally 550 | EndUpdate; 551 | end; 552 | end; 553 | 554 | { TCustomPanel } 555 | 556 | procedure TCustomPanel.SetAlignment(AValue: TAlignment); 557 | begin 558 | if (FAlignment <> AValue) then 559 | begin 560 | FAlignment := AValue; 561 | Changed; 562 | end; 563 | end; 564 | 565 | procedure TCustomPanel.SetBevelColor(AValue: TColor); 566 | begin 567 | if (FBevelColor <> AValue) then 568 | begin 569 | FBevelColor := AValue; 570 | Changed; 571 | end; 572 | end; 573 | 574 | procedure TCustomPanel.SetBevelInner(AValue: TPanelBevel); 575 | begin 576 | if (FBevelInner <> AValue) then 577 | begin 578 | FBevelInner := AValue; 579 | Changed; 580 | end; 581 | end; 582 | 583 | procedure TCustomPanel.SetBevelOuter(AValue: TPanelBevel); 584 | begin 585 | if (FBevelOuter <> AValue) then 586 | begin 587 | FBevelOuter := AValue; 588 | Changed; 589 | end; 590 | end; 591 | 592 | procedure TCustomPanel.SetBevelWidth(AValue: TBevelWidth); 593 | begin 594 | if (FBevelWidth <> AValue) then 595 | begin 596 | FBevelWidth := AValue; 597 | Changed; 598 | end; 599 | end; 600 | 601 | procedure TCustomPanel.SetLayout(AValue: TTextLayout); 602 | begin 603 | if (FLayout <> AValue) then 604 | begin 605 | FLayout := AValue; 606 | Changed; 607 | end; 608 | end; 609 | 610 | procedure TCustomPanel.SetWordWrap(AValue: boolean); 611 | begin 612 | if (FWordWrap <> AValue) then 613 | begin 614 | FWordWrap := AValue; 615 | Changed; 616 | end; 617 | end; 618 | 619 | procedure TCustomPanel.Changed; 620 | var 621 | VTopColor: TColor; 622 | VBottomColor: TColor; 623 | begin 624 | inherited Changed; 625 | if (not IsUpdating) and not (csLoading in ComponentState) then 626 | begin 627 | with HandleElement do 628 | begin 629 | /// Bevel/Border 630 | if (FBevelOuter = bvNone) then 631 | begin 632 | Style.RemoveProperty('border-width'); 633 | Style.RemoveProperty('border-left-color'); 634 | Style.RemoveProperty('border-left-style'); 635 | Style.RemoveProperty('border-top-color'); 636 | Style.RemoveProperty('border-top-style'); 637 | Style.RemoveProperty('border-right-color'); 638 | Style.RemoveProperty('border-right-style'); 639 | Style.RemoveProperty('border-bottom-color'); 640 | Style.RemoveProperty('border-bottom-style'); 641 | end 642 | else 643 | begin 644 | if (FBevelColor = clDefault) then 645 | begin 646 | case FBevelOuter of 647 | bvLowered: 648 | begin 649 | VTopColor := clGray; /// dark 650 | VBottomColor := clWhite; 651 | end; 652 | bvRaised: 653 | begin 654 | VTopColor := clWhite; 655 | VBottomColor := clGray; /// dark 656 | end; 657 | else 658 | begin 659 | VTopColor := Self.Color; 660 | VBottomColor := Self.Color; 661 | end; 662 | end; 663 | end 664 | else 665 | begin 666 | VTopColor := FBevelColor; 667 | VBottomColor := FBevelColor; 668 | end; 669 | Style.SetProperty('border-width', IntToStr(FBevelWidth) + 'px'); 670 | Style.SetProperty('border-style', 'solid'); 671 | Style.SetProperty('border-left-color', JSColor(VTopColor)); 672 | Style.SetProperty('border-top-color', JSColor(VTopColor)); 673 | Style.SetProperty('border-right-color', JSColor(VBottomColor)); 674 | Style.SetProperty('border-bottom-color', JSColor(VBottomColor)); 675 | end; 676 | /// Focus highlight 677 | Style.SetProperty('outline', 'none'); 678 | /// Prevent text selection 679 | Style.SetProperty('user-select', 'none'); 680 | Style.SetProperty('-moz-user-select', 'none'); 681 | Style.SetProperty('-ms-user-select', 'none'); 682 | Style.SetProperty('-khtml-user-select', 'none'); 683 | Style.SetProperty('-webkit-user-select', 'none'); 684 | end; 685 | end; 686 | end; 687 | 688 | function TCustomPanel.CreateHandleElement: TJSHTMLElement; 689 | begin 690 | Result := TJSHTMLElement(Document.CreateElement('div')); 691 | end; 692 | 693 | class function TCustomPanel.GetControlClassDefaultSize: TSize; 694 | begin 695 | Result.Cx := 170; 696 | Result.Cy := 50; 697 | end; 698 | 699 | constructor TCustomPanel.Create(AOwner: TComponent); 700 | begin 701 | inherited Create(AOwner); 702 | FAlignment := taCenter; 703 | FBevelColor := clDefault; 704 | FBevelOuter := bvRaised; 705 | FBevelInner := bvNone; 706 | FBevelWidth := 1; 707 | FLayout := tlCenter; 708 | FWordWrap := False; 709 | BeginUpdate; 710 | try 711 | TabStop := False; 712 | with GetControlClassDefaultSize do 713 | begin 714 | SetBounds(0, 0, Cx, Cy); 715 | end; 716 | finally 717 | EndUpdate; 718 | end; 719 | end; 720 | 721 | end. 722 | -------------------------------------------------------------------------------- /widgets/interfaces.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit Interfaces; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils; 33 | 34 | implementation 35 | 36 | end. 37 | 38 | -------------------------------------------------------------------------------- /widgets/maskutils.pas: -------------------------------------------------------------------------------- 1 | { 2 | /*************************************************************************** 3 | maskutils.pas 4 | --------- 5 | 6 | ***************************************************************************/ 7 | 8 | ***************************************************************************** 9 | * * 10 | * This file is part of the Lazarus Component Library (LCL) * 11 | * * 12 | * See the file COPYING.modifiedLGPL, included in this distribution, * 13 | * for details about the copyright. * 14 | * * 15 | * This program is distributed in the hope that it will be useful, * 16 | * but WITHOUT ANY WARRANTY; without even the implied warranty of * 17 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * 18 | * * 19 | ***************************************************************************** 20 | 21 | 22 | Author: Boguslaw Brandys 23 | 24 | Abstract: 25 | FormatMaskText implementation 26 | 27 | } 28 | unit MaskUtils; 29 | 30 | {$mode objfpc}{$H+} 31 | 32 | interface 33 | 34 | uses 35 | Classes, 36 | SysUtils, 37 | JS; 38 | 39 | type 40 | TStepState = 41 | ( 42 | stLeading, //? not used currently 43 | stUpper, //use uppercase 44 | stLower, //use lowercase 45 | stSpecial, //use escape character 46 | stArbitrary //put arbitrary character 47 | ); 48 | TParseState = set of TStepState; 49 | 50 | { TMaskUtils } 51 | 52 | TMaskUtils = class 53 | private 54 | FValue: string; 55 | FSourcePosition: NativeInt; 56 | FPosition: NativeInt; 57 | FEditMask: string; 58 | FMask: string; 59 | FSourceVal: string; 60 | FExitVal: string; 61 | FMatched: boolean; 62 | FMissChar: char; 63 | FState: TParseState; 64 | procedure EvaluateExit; 65 | procedure EvaluateMissing; 66 | procedure DoFillRest; 67 | procedure DoLiteral; 68 | procedure DoLiteralInputMask; 69 | procedure DoToken; 70 | procedure DoTokenInputMask; 71 | procedure DoUpper; 72 | procedure DoLower; 73 | procedure DoNumeric(ARequired: boolean); 74 | procedure DoAlpha(ARequired: boolean); 75 | procedure DoAlphaNumeric(ARequired: boolean); 76 | procedure DoNumericPlusMinus; 77 | procedure DoArbitrary(ARequired: boolean); 78 | procedure DoTime; 79 | procedure DoDate; 80 | function GetInputMask: string; 81 | procedure SetMask(const AValue: string); 82 | procedure SetValue(const AValue: string); 83 | protected 84 | procedure RaiseError; 85 | procedure ExtractMask; 86 | function MaskPtr: char; 87 | function SourcePtr: char; 88 | property Matched: boolean read FMatched write FMatched; 89 | property MissChar: char read FMissChar write FMissChar; 90 | public 91 | function ValidateInput: string; 92 | property Mask: string read FEditMask write SetMask; 93 | property Value: string read FValue write SetValue; 94 | property InputMask: string read GetInputMask; 95 | end; 96 | 97 | function FormatMaskText(const AEditMask: string; const AValue: string): string; 98 | function FormatMaskInput(const AEditMask: string): string; 99 | function MaskDoFormatText(const AEditMask: string; const AValue: string; ABlank: char): string; 100 | 101 | implementation 102 | 103 | resourcestring 104 | exInvalidMaskValue = 'FormatMaskText function failed!'; 105 | 106 | function IsNumeric(const C: char): boolean; 107 | begin 108 | Result := (C in ['0'..'9']); 109 | end; 110 | 111 | function IsAlpha(const C: char): boolean; 112 | begin 113 | Result := (C in ['a'..'z', 'A'..'Z']); 114 | end; 115 | 116 | function IsToken(const C: char): boolean; 117 | begin 118 | Result := C in ['!', '>', '<', '\', 'L', 'l', 'A', 'a', 'C', 'c', '0', '9', '#', ':', '/', ';']; 119 | end; 120 | 121 | function FormatMaskText(const AEditMask: string; const AValue: string): string; 122 | var 123 | VMask: TMaskUtils; 124 | begin 125 | VMask := TMaskUtils.Create; 126 | try 127 | VMask.Mask := AEditMask; 128 | VMask.Value := AValue; 129 | Result := VMask.ValidateInput; 130 | finally 131 | VMask.Free; 132 | end; 133 | end; 134 | 135 | function FormatMaskInput(const AEditMask: string): string; 136 | var 137 | VMask: TMaskUtils; 138 | begin 139 | VMask := TMaskUtils.Create; 140 | try 141 | VMask.Mask := AEditMask; 142 | Result := VMask.ValidateInput; 143 | finally 144 | VMask.Free; 145 | end; 146 | end; 147 | 148 | function MaskDoFormatText(const AEditMask: string; const AValue: string; ABlank: char): string; 149 | var 150 | VMask: TMaskUtils; 151 | begin 152 | VMask := TMaskUtils.Create; 153 | try 154 | VMask.Mask := AEditMask; 155 | VMask.Value := AValue; 156 | VMask.Matched := False; 157 | VMask.MissChar := ABlank; 158 | Result := VMask.ValidateInput; 159 | finally 160 | VMask.Free; 161 | end; 162 | end; 163 | 164 | { TMaskUtils } 165 | 166 | procedure TMaskUtils.EvaluateExit; 167 | begin 168 | if (stUpper in FState) then 169 | begin 170 | FExitVal := FExitVal + UpperCase(SourcePtr); 171 | end 172 | else 173 | if (stLower in FState) then 174 | begin 175 | FExitVal := FExitVal + LowerCase(SourcePtr); 176 | end 177 | else 178 | begin 179 | FExitVal := FExitVal + SourcePtr; 180 | end; 181 | Inc(FSourcePosition); 182 | end; 183 | 184 | procedure TMaskUtils.EvaluateMissing; 185 | begin 186 | FExitVal := FExitVal + MissChar; 187 | Inc(FSourcePosition); 188 | end; 189 | 190 | procedure TMaskUtils.DoFillRest; 191 | var 192 | I: NativeInt; 193 | begin 194 | {Fill rest of exit value because source is longer then mask 195 | and the last mask character permit arbitrary char. 196 | Compatibility with delphi} 197 | if (stArbitrary in FState) then 198 | begin 199 | I := Length(FSourceVal) - Length(FMask); 200 | while I >= 0 do 201 | begin 202 | EvaluateExit; 203 | Dec(I); 204 | end; 205 | end; 206 | end; 207 | 208 | procedure TMaskUtils.DoLiteral; 209 | begin 210 | if (stSpecial in FState) then 211 | begin 212 | Exclude(FState, stSpecial); 213 | end; 214 | if (Matched) and (MaskPtr <> SourcePtr) then 215 | begin 216 | RaiseError; 217 | end; 218 | if (Matched) or not (IsAlpha(SourcePtr) or IsNumeric(SourcePtr)) then 219 | begin 220 | Inc(FSourcePosition); 221 | end; 222 | FExitVal := FExitVal + MaskPtr; 223 | end; 224 | 225 | procedure TMaskUtils.DoLiteralInputMask; 226 | begin 227 | if (stSpecial in FState) then 228 | begin 229 | Exclude(FState, stSpecial); 230 | end; 231 | FExitVal := FExitVal + MaskPtr; 232 | end; 233 | 234 | procedure TMaskUtils.DoToken; 235 | begin 236 | if (stArbitrary in FState) then 237 | begin 238 | Exclude(FState, stArbitrary); 239 | end; 240 | case MaskPtr of 241 | '!': Include(FState, stLeading); 242 | '>': DoUpper; 243 | '<': DoLower; 244 | '\': Include(FState, stSpecial); 245 | 'L': DoAlpha(True); 246 | 'l': DoAlpha(False); 247 | 'A': DoAlphaNumeric(True); 248 | 'a': DoAlphaNumeric(False); 249 | 'C': DoArbitrary(True); 250 | 'c': DoArbitrary(False); 251 | '0': DoNumeric(True); 252 | '9': DoNumeric(False); 253 | '#': DoNumericPlusMinus; 254 | ':': DoTime; 255 | '/': DoDate; 256 | end; 257 | end; 258 | 259 | procedure TMaskUtils.DoTokenInputMask; 260 | begin 261 | case MaskPtr of 262 | '!', 263 | '>', 264 | '<': ;{nothing} 265 | '\': Include(FState, stSpecial); 266 | 'L', 267 | 'l', 268 | 'A', 269 | 'a', 270 | 'C', 271 | 'c', 272 | '0', 273 | '9', 274 | '#': FExitVal := FExitVal + MissChar; 275 | ':': DoTime; 276 | '/': DoDate; 277 | end; 278 | end; 279 | 280 | procedure TMaskUtils.DoUpper; 281 | begin 282 | if (stLower in FState) then 283 | begin 284 | Exclude(FState, stLower); 285 | end 286 | else 287 | begin 288 | Include(FState, stUpper); 289 | end; 290 | {Ugly check for '<>' sequence. Is that required ?} 291 | if (FPosition > 1) and (FMask[FPosition - 1] = '<') then 292 | begin 293 | Exclude(FState, stLower); 294 | Exclude(FState, stUpper); 295 | end; 296 | end; 297 | 298 | procedure TMaskUtils.DoLower; 299 | begin 300 | if (stUpper in FState) then 301 | begin 302 | Exclude(FState, stUpper); 303 | end 304 | else 305 | begin 306 | Include(FState, stLower); 307 | end; 308 | end; 309 | 310 | procedure TMaskUtils.DoNumeric(ARequired: boolean); 311 | begin 312 | if (ARequired) then 313 | begin 314 | if (IsNumeric(SourcePtr)) then 315 | begin 316 | EvaluateExit; 317 | end 318 | else 319 | begin 320 | RaiseError; 321 | end; 322 | end 323 | else 324 | begin 325 | if (IsNumeric(SourcePtr)) then 326 | begin 327 | EvaluateExit; 328 | end 329 | else 330 | begin 331 | EvaluateMissing; 332 | end; 333 | end; 334 | end; 335 | 336 | procedure TMaskUtils.DoAlpha(ARequired: boolean); 337 | begin 338 | if (ARequired) then 339 | begin 340 | if IsAlpha(SourcePtr) then 341 | begin 342 | EvaluateExit; 343 | end 344 | else 345 | begin 346 | RaiseError; 347 | end; 348 | end 349 | else 350 | begin 351 | if (IsAlpha(SourcePtr)) then 352 | begin 353 | EvaluateExit; 354 | end 355 | else 356 | begin 357 | EvaluateMissing; 358 | end; 359 | end; 360 | end; 361 | 362 | procedure TMaskUtils.DoAlphaNumeric(ARequired: boolean); 363 | begin 364 | if (ARequired) then 365 | begin 366 | if (IsAlpha(SourcePtr) or IsNumeric(SourcePtr)) then 367 | begin 368 | EvaluateExit; 369 | end 370 | else 371 | begin 372 | RaiseError; 373 | end; 374 | end 375 | else 376 | begin 377 | if (IsAlpha(SourcePtr) or IsNumeric(SourcePtr)) then 378 | begin 379 | EvaluateExit; 380 | end 381 | else 382 | begin 383 | EvaluateMissing; 384 | end; 385 | end; 386 | end; 387 | 388 | procedure TMaskUtils.DoNumericPlusMinus; 389 | begin 390 | if (IsNumeric(SourcePtr)) or 391 | (SourcePtr = '+') or 392 | (SourcePtr = '-') then 393 | begin 394 | EvaluateExit; 395 | end 396 | else 397 | begin 398 | EvaluateMissing; 399 | end; 400 | end; 401 | 402 | procedure TMaskUtils.DoArbitrary(ARequired: boolean); 403 | begin 404 | Include(FState, stArbitrary); 405 | if (ARequired) then 406 | begin 407 | if (FPosition > Length(FSourceVal)) then 408 | begin 409 | RaiseError; 410 | end; 411 | end 412 | else 413 | begin 414 | if (FPosition > Length(FSourceVal)) then 415 | begin 416 | EvaluateMissing; 417 | end 418 | else 419 | begin 420 | EvaluateExit; 421 | end; 422 | end; 423 | end; 424 | 425 | procedure TMaskUtils.DoTime; 426 | begin 427 | FExitVal := FExitVal + TimeSeparator; 428 | end; 429 | 430 | procedure TMaskUtils.DoDate; 431 | begin 432 | FExitVal := FExitVal + DateSeparator; 433 | end; 434 | 435 | function TMaskUtils.GetInputMask: string; 436 | begin 437 | /// 438 | FExitVal := ''; 439 | FPosition := 1; 440 | FState := []; 441 | 442 | /// Process} 443 | while (FPosition <= Length(FMask)) do 444 | begin 445 | if (IsToken(MaskPtr) and not (stSpecial in FState)) then 446 | begin 447 | DoTokenInputMask; 448 | end 449 | else 450 | begin 451 | DoLiteralInputMask; 452 | end; 453 | Inc(FPosition); 454 | end; 455 | Result := FExitVal; 456 | end; 457 | 458 | procedure TMaskUtils.SetMask(const AValue: string); 459 | begin 460 | if (FEditMask <> AValue) then 461 | begin 462 | FEditMask := AValue; 463 | ExtractMask; 464 | end; 465 | end; 466 | 467 | procedure TMaskUtils.SetValue(const AValue: string); 468 | begin 469 | if (FSourceVal <> AValue) then 470 | begin 471 | FSourceVal := AValue; 472 | end; 473 | end; 474 | 475 | procedure TMaskUtils.RaiseError; 476 | begin 477 | if (FSourcePosition > Length(FSourceVal)) then 478 | begin 479 | EvaluateMissing; 480 | end 481 | else 482 | begin 483 | raise TJSError.New(exInvalidMaskValue); 484 | end; 485 | end; 486 | 487 | procedure TMaskUtils.ExtractMask; 488 | var 489 | P: NativeInt; 490 | S: string; 491 | begin 492 | FMissChar := #32; 493 | FMatched := False; 494 | S := Copy(FEditMask, 1, Length(FEditMask)); 495 | P := (TJSString(S).LastIndexOf(';') + 1); 496 | if (P = 0) then 497 | begin 498 | FMask := S; 499 | end 500 | else 501 | begin 502 | FMissChar := Copy(s, P + 1, 1)[1]; 503 | Delete(S, P, 2); 504 | P := (TJSString(S).LastIndexOf(';') + 1); 505 | FMatched := (Copy(s, P + 1, 1) <> '0'); 506 | Delete(S, P, 2); 507 | FMask := S; 508 | end; 509 | end; 510 | 511 | function TMaskUtils.MaskPtr: char; 512 | begin 513 | Result := FMask[FPosition]; 514 | end; 515 | 516 | function TMaskUtils.SourcePtr: char; 517 | begin 518 | if (FSourcePosition <= Length(FSourceVal)) then 519 | begin 520 | Result := FSourceVal[FSourcePosition]; 521 | end 522 | else 523 | begin 524 | Result := #0; 525 | end; 526 | end; 527 | 528 | function TMaskUtils.ValidateInput: string; 529 | begin 530 | /// Prepare 531 | FExitVal := ''; 532 | FPosition := 1; 533 | FSourcePosition := 1; 534 | FState := []; 535 | 536 | /// Process 537 | while (FPosition <= Length(FMask)) do 538 | begin 539 | if (IsToken(MaskPtr) and not (stSpecial in FState)) then 540 | begin 541 | DoToken; 542 | end 543 | else 544 | begin 545 | DoLiteral; 546 | end; 547 | Inc(FPosition); 548 | end; 549 | DoFillRest; 550 | Result := FExitVal; 551 | end; 552 | 553 | 554 | end. 555 | -------------------------------------------------------------------------------- /widgets/numctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit NumCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | Graphics, 35 | Controls, 36 | StdCtrls, 37 | Web; 38 | 39 | type 40 | 41 | { TCustomNumericEdit } 42 | 43 | TCustomNumericEdit = class(TCustomEdit) 44 | { TODO: Max Min value } 45 | { TODO: Add spin } 46 | private 47 | FDecimals: NativeInt; 48 | protected 49 | procedure DoEnter; override; 50 | procedure DoExit; override; 51 | procedure DoInput(ANewValue: string); override; 52 | protected 53 | procedure Changed; override; 54 | public 55 | constructor Create(AOwner: TComponent); override; 56 | property DecimalPlaces: NativeInt read FDecimals write FDecimals default 2; 57 | end; 58 | 59 | implementation 60 | 61 | { TCustomNumericEdit } 62 | 63 | procedure TCustomNumericEdit.DoEnter; 64 | begin 65 | inherited DoEnter; 66 | RealSetText(RealGetText); 67 | end; 68 | 69 | procedure TCustomNumericEdit.DoExit; 70 | begin 71 | inherited DoExit; 72 | RealSetText(RealGetText); 73 | end; 74 | 75 | procedure TCustomNumericEdit.DoInput(ANewValue: string); 76 | var 77 | VDiff: string; 78 | VOldValue: string; 79 | begin 80 | VOldValue := RealGetText; 81 | if (Length(ANewValue) >= Length(VOldValue)) then 82 | begin 83 | VDiff := StringReplace(ANewValue, VOldValue, '', []); 84 | if (VDiff = DecimalSeparator) then 85 | begin 86 | if (FDecimals = 0) then 87 | begin 88 | VDiff := ''; 89 | end; 90 | if (Pos(VDiff, VOldValue) > 0) then 91 | begin 92 | VDiff := ''; 93 | end; 94 | end; 95 | if (not (VDiff[1] in ['0'..'9', DecimalSeparator])) then 96 | begin 97 | TJSHTMLInputElement(HandleElement).Value := VOldValue; 98 | ANewValue := VOldValue; 99 | end; 100 | end; 101 | inherited DoInput(ANewValue); 102 | end; 103 | 104 | procedure TCustomNumericEdit.Changed; 105 | begin 106 | inherited Changed; 107 | if (not IsUpdating) and not (csLoading in ComponentState) then 108 | begin 109 | with TJSHTMLInputElement(HandleElement) do 110 | begin 111 | InputMode := 'numeric'; 112 | end; 113 | end; 114 | end; 115 | 116 | constructor TCustomNumericEdit.Create(AOwner: TComponent); 117 | begin 118 | inherited Create(AOwner); 119 | FDecimals := 2; 120 | BeginUpdate; 121 | try 122 | Alignment := taRightJustify; 123 | finally 124 | EndUpdate; 125 | end; 126 | end; 127 | 128 | end. 129 | -------------------------------------------------------------------------------- /widgets/pas2js_widget.inc: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Helio Ribeiro and 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {$mode delphi} 25 | {$modeswitch externalclass} 26 | {$H+} 27 | {$Define lang_en} 28 | {off_$Define lang_pt} 29 | 30 | {$Define BROWSER} 31 | -------------------------------------------------------------------------------- /widgets/wcl.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | -------------------------------------------------------------------------------- /widgets/wcl.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit WCL; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | WebExtra, MaskUtils, Interfaces, Graphics, Controls, Forms, StdCtrls, 12 | ExtCtrls, ComCtrls, NumCtrls, DttCtrls, BtnCtrls, DataGrid, Dialogs, 13 | WebCtrls, WCLStrConsts, WResources, Grids; 14 | 15 | implementation 16 | 17 | end. 18 | -------------------------------------------------------------------------------- /widgets/wclstrconsts.pas: -------------------------------------------------------------------------------- 1 | { 2 | /*************************************************************************** 3 | wclstrconsts.pas 4 | ---------------- 5 | 6 | Initial Revision : Mon Jan 13 CST 2020 7 | 8 | ***************************************************************************/ 9 | 10 | ***************************************************************************** 11 | This file is part of the Web Component Library (WCL) 12 | 13 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 | for details about the license. 15 | ***************************************************************************** 16 | } 17 | unit WCLStrConsts; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | const 24 | // Constants for WebSocket close codes 25 | WS_NORMAL_CLOSURE = 1000; 26 | WS_GOING_AWAY = 1001; 27 | WS_PROTOCOL_ERROR = 1002; 28 | WS_UNSUPPORTED_DATA = 1003; 29 | WS_NO_STATUS_RECEIVED = 1005; 30 | WS_ABNORMAL_CLOSURE = 1006; 31 | WS_INVALID_FRAME_PAYLOAD = 1007; 32 | WS_POLICY_VIOLATION = 1008; 33 | WS_MESSAGE_TOO_BIG = 1009; 34 | WS_MANDATORY_EXT = 1010; 35 | WS_INTERNAL_SERVER_ERROR = 1011; 36 | WS_BAD_TLS_HANDSHAKE = 1015; 37 | 38 | resourcestring 39 | rsFormResourceSNotFoundForResourcelessFormsCreateNew = 'Form resource %s ' 40 | +'not found. For resourceless forms CreateNew constructor must be used.'; 41 | rsFormStreamingError = 'Form streaming "%s" error: %s'; 42 | rsFileButtonNoFileSelected = 'No file selected'; 43 | rsResourceNotFound = 'Resource not found: %s'; 44 | rsErrUncaughtException = 'Uncaught exception of type %s: ' + LineEnding + LineEnding + '%s'; 45 | rsErrUncaughtObject = 'Uncaught exception of type %s.'; 46 | rsNoTimers = 'No more timers available.'; 47 | 48 | rsFixedColsTooBig = 'Too many fixed columns.'; 49 | rsFixedRowsTooBig = 'Too many fixed rows.'; 50 | // String constants for WebSocket close codes 51 | wsNormalClosure = 'Normal Closure'; 52 | wsGoingAway = 'Going Away'; 53 | wsProtocolError = 'Protocol error'; 54 | wsUnsupportedData = 'Unsupported Data'; 55 | wsNoStatusRcvd = 'No Status Rcvd'; 56 | wsAbnormalClosure = 'Abnormal Closure'; 57 | wsInvalidFramePayload = 'Invalid frame payload data'; 58 | wsPolicyViolation = 'Policy Violation'; 59 | wsMessageTooBig = 'Message Too Big'; 60 | wsMandatoryExt = 'Mandatory Ext.'; 61 | wsInternalServerErorr = 'Internal Server Error'; 62 | wsTLSHandshake = 'TLS handshake'; 63 | 64 | implementation 65 | 66 | end. 67 | 68 | -------------------------------------------------------------------------------- /widgets/webctrls.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit WebCtrls; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | Classes, 32 | SysUtils, 33 | Types, 34 | Graphics, 35 | Controls, 36 | Forms, 37 | StdCtrls, 38 | ExtCtrls, 39 | ComCtrls, 40 | NumCtrls, 41 | DttCtrls, 42 | BtnCtrls, 43 | DataGrid; 44 | 45 | type 46 | 47 | { TWDataModule } 48 | 49 | TWDataModule = class(TCustomDataModule) 50 | private 51 | FHorizontalOffset: LongInt; 52 | FPPI: LongInt; 53 | FVerticalOffset: LongInt; 54 | published 55 | property OnCreate; 56 | property OnDestroy; 57 | property OldCreateOrder; 58 | published 59 | /// Fake 60 | property HorizontalOffset: LongInt read FHorizontalOffset write FHorizontalOffset; 61 | property VerticalOffset: LongInt read FVerticalOffset write FVerticalOffset; 62 | property PPI: LongInt read FPPI write FPPI; 63 | end; 64 | TWDataModuleClass = class of TWDataModule; 65 | 66 | { TWComboBox } 67 | 68 | TWComboBox = class(TCustomComboBox) 69 | published 70 | property Align; 71 | property Anchors; 72 | property AutoSize; 73 | property BorderSpacing; 74 | property BorderStyle; 75 | property Color; 76 | property Enabled; 77 | property Font; 78 | property HandleClass; 79 | property HandleID; 80 | property ItemHeight; 81 | property ItemIndex; 82 | property Items; 83 | property ParentColor; 84 | property ParentFont; 85 | property ParentShowHint; 86 | property ShowHint; 87 | property TabOrder; 88 | property TabStop; 89 | property Text; 90 | property Visible; 91 | property OnChange; 92 | property OnClick; 93 | property OnDblClick; 94 | property OnEnter; 95 | property OnExit; 96 | property OnKeyDown; 97 | property OnKeyPress; 98 | property OnKeyUp; 99 | property OnMouseDown; 100 | property OnMouseEnter; 101 | property OnMouseLeave; 102 | property OnMouseMove; 103 | property OnMouseUp; 104 | property OnMouseWheel; 105 | end; 106 | 107 | { TWListBox } 108 | 109 | TWListBox = class(TCustomListBox) 110 | published 111 | property Align; 112 | property Anchors; 113 | property AutoSize; 114 | property BorderSpacing; 115 | property BorderStyle; 116 | property Color; 117 | property Enabled; 118 | property Font; 119 | property HandleClass; 120 | property HandleID; 121 | property ItemHeight; 122 | property ItemIndex; 123 | property Items; 124 | property MultiSelect; 125 | property ParentColor; 126 | property ParentFont; 127 | property ParentShowHint; 128 | property ShowHint; 129 | property TabOrder; 130 | property TabStop; 131 | property Visible; 132 | property OnClick; 133 | property OnDblClick; 134 | property OnEnter; 135 | property OnExit; 136 | property OnKeyDown; 137 | property OnKeyPress; 138 | property OnKeyUp; 139 | property OnMouseDown; 140 | property OnMouseEnter; 141 | property OnMouseLeave; 142 | property OnMouseMove; 143 | property OnMouseUp; 144 | property OnMouseWheel; 145 | property OnSelectionChange; 146 | end; 147 | 148 | { TWEdit } 149 | 150 | TWEdit = class(TCustomEdit) 151 | published 152 | property Align; 153 | property Anchors; 154 | property Alignment; 155 | property AutoSize; 156 | property BorderSpacing; 157 | property BorderStyle; 158 | property CharCase; 159 | property Color; 160 | property Enabled; 161 | property Font; 162 | property HandleClass; 163 | property HandleId; 164 | property MaxLength; 165 | property ParentColor; 166 | property ParentFont; 167 | property ParentShowHint; 168 | property PasswordChar; 169 | property ReadOnly; 170 | property ShowHint; 171 | property TabStop; 172 | property TabOrder; 173 | property Text; 174 | property TextHint; 175 | property Visible; 176 | property OnChange; 177 | property OnClick; 178 | property OnDblClick; 179 | property OnEnter; 180 | property OnExit; 181 | property OnKeyDown; 182 | property OnKeyPress; 183 | property OnKeyUp; 184 | property OnMouseDown; 185 | property OnMouseEnter; 186 | property OnMouseLeave; 187 | property OnMouseMove; 188 | property OnMouseUp; 189 | property OnMouseWheel; 190 | property OnResize; 191 | end; 192 | 193 | { TWMemo } 194 | 195 | TWMemo = class(TCustomMemo) 196 | published 197 | property Align; 198 | property Anchors; 199 | property Alignment; 200 | property BorderSpacing; 201 | property BorderStyle; 202 | property CharCase; 203 | property Color; 204 | property Enabled; 205 | property Font; 206 | property HandleClass; 207 | property HandleId; 208 | property Lines; 209 | property MaxLength; 210 | property ParentColor; 211 | property ParentFont; 212 | property ParentShowHint; 213 | property ReadOnly; 214 | property ShowHint; 215 | property TabOrder; 216 | property TabStop; 217 | property TextHint; 218 | property Visible; 219 | property WantReturns; 220 | property WantTabs; 221 | property WordWrap; 222 | property OnChange; 223 | property OnClick; 224 | property OnDblClick; 225 | property OnEnter; 226 | property OnExit; 227 | property OnKeyDown; 228 | property OnKeyPress; 229 | property OnKeyUp; 230 | property OnMouseDown; 231 | property OnMouseEnter; 232 | property OnMouseLeave; 233 | property OnMouseMove; 234 | property OnMouseUp; 235 | property OnMouseWheel; 236 | property OnResize; 237 | end; 238 | 239 | { TWButton } 240 | 241 | TWButton = class(TCustomButton) 242 | published 243 | property Align; 244 | property Anchors; 245 | property AutoSize; 246 | property BorderSpacing; 247 | property Caption; 248 | property Color; 249 | property Enabled; 250 | property Font; 251 | property HandleClass; 252 | property HandleId; 253 | property Hint; 254 | property ModalResult; 255 | property ParentFont; 256 | property ParentShowHint; 257 | property ShowHint; 258 | property TabOrder; 259 | property TabStop; 260 | property Visible; 261 | property OnClick; 262 | property OnEnter; 263 | property OnExit; 264 | property OnKeyDown; 265 | property OnKeyPress; 266 | property OnKeyUp; 267 | property OnMouseDown; 268 | property OnMouseEnter; 269 | property OnMouseLeave; 270 | property OnMouseMove; 271 | property OnMouseUp; 272 | property OnMouseWheel; 273 | property OnResize; 274 | end; 275 | 276 | { TWCheckbox } 277 | 278 | TWCheckbox = class(TCustomCheckbox) 279 | published 280 | property Align; 281 | property Alignment; 282 | /// property AllowGrayed; 283 | property Anchors; 284 | property AutoSize; 285 | property BorderSpacing; 286 | property Caption; 287 | property Checked; 288 | property Color; 289 | property Enabled; 290 | property Font; 291 | property HandleClass; 292 | property HandleId; 293 | property ParentColor; 294 | property ParentFont; 295 | property ParentShowHint; 296 | property ShowHint; 297 | property State; 298 | property TabOrder; 299 | property TabStop; 300 | property Visible; 301 | property OnChange; 302 | property OnClick; 303 | property OnEnter; 304 | property OnExit; 305 | property OnKeyPress; 306 | property OnKeyDown; 307 | property OnKeyUp; 308 | property OnMouseDown; 309 | property OnMouseEnter; 310 | property OnMouseLeave; 311 | property OnMouseMove; 312 | property OnMouseUp; 313 | property OnMouseWheel; 314 | property OnResize; 315 | end; 316 | 317 | { TWRadioButton } 318 | 319 | TWRadioButton = class(TCustomRadioButton) 320 | published 321 | property Align; 322 | property Anchors; 323 | property AutoSize default True; 324 | property BorderSpacing; 325 | property Caption; 326 | property Checked; 327 | property Color; 328 | property Enabled; 329 | property Font; 330 | property Hint; 331 | property OnChange; 332 | property OnClick; 333 | property OnEnter; 334 | property OnExit; 335 | property OnKeyDown; 336 | property OnKeyPress; 337 | property OnKeyUp; 338 | property OnMouseDown; 339 | property OnMouseEnter; 340 | property OnMouseLeave; 341 | property OnMouseMove; 342 | property OnMouseUp; 343 | property OnMouseWheel; 344 | property OnResize; 345 | property ParentColor; 346 | property ParentFont; 347 | property ParentShowHint; 348 | property ShowHint; 349 | property TabOrder; 350 | property TabStop default False; 351 | property Visible; 352 | end; 353 | 354 | { TWLabel } 355 | 356 | TWLabel = class(TCustomLabel) 357 | published 358 | property Align; 359 | property Alignment; 360 | property Anchors; 361 | property AutoSize; 362 | property BorderSpacing; 363 | property Caption; 364 | property Color; 365 | property Enabled; 366 | property FocusControl; 367 | property Font; 368 | property HandleClass; 369 | property HandleId; 370 | property Layout; 371 | property ParentColor; 372 | property ParentFont; 373 | property ParentShowHint; 374 | property ShowHint; 375 | property Transparent; 376 | property Visible; 377 | property WordWrap; 378 | property OnClick; 379 | property OnDblClick; 380 | property OnMouseDown; 381 | property OnMouseEnter; 382 | property OnMouseLeave; 383 | property OnMouseMove; 384 | property OnMouseUp; 385 | property OnMouseWheel; 386 | property OnResize; 387 | end; 388 | 389 | { TWImage } 390 | 391 | TWImage = class(TCustomImage) 392 | published 393 | property Align; 394 | property Anchors; 395 | property AutoSize; 396 | property BorderSpacing; 397 | property Center; 398 | property Enabled; 399 | property HandleClass; 400 | property HandleId; 401 | property ParentShowHint; 402 | property Proportional; 403 | property ShowHint; 404 | property Stretch; 405 | property StretchOutEnabled; 406 | property StretchInEnabled; 407 | property Transparent; 408 | property URL; 409 | property Visible; 410 | property OnClick; 411 | property OnDblClick; 412 | property OnMouseDown; 413 | property OnMouseEnter; 414 | property OnMouseLeave; 415 | property OnMouseMove; 416 | property OnMouseUp; 417 | property OnMouseWheel; 418 | property OnPaint; 419 | property OnPictureChanged; 420 | property OnResize; 421 | end; 422 | 423 | { TWPanel } 424 | 425 | TWPanel = class(TCustomPanel) 426 | published 427 | property Align; 428 | property Alignment; 429 | property Anchors; 430 | property AutoSize; 431 | property BevelColor; 432 | property BevelInner; 433 | property BevelOuter; 434 | property BevelWidth; 435 | property BorderSpacing; 436 | property Caption; 437 | property ClientHeight; 438 | property ClientWidth; 439 | property Color; 440 | property Enabled; 441 | property Font; 442 | property HandleClass; 443 | property HandleId; 444 | property ParentColor; 445 | property ParentFont; 446 | property ParentShowHint; 447 | property ShowHint; 448 | property TabOrder; 449 | property TabStop; 450 | property Visible; 451 | property Wordwrap; 452 | property OnClick; 453 | property OnDblClick; 454 | property OnEnter; 455 | property OnExit; 456 | property OnMouseDown; 457 | property OnMouseEnter; 458 | property OnMouseLeave; 459 | property OnMouseMove; 460 | property OnMouseUp; 461 | property OnMouseWheel; 462 | property OnPaint; 463 | property OnResize; 464 | end; 465 | 466 | { TWTimer } 467 | 468 | TWTimer = class(TCustomTimer) 469 | published 470 | property Enabled; 471 | property Interval; 472 | property OnTimer; 473 | property OnStartTimer; 474 | property OnStopTimer; 475 | end; 476 | 477 | { TWWebSocketClient } 478 | 479 | TWWebSocketClient = class(TCustomWebSocketClient) 480 | published 481 | property Url; 482 | property OnBinaryMessage; 483 | property OnClose; 484 | property OnError; 485 | property OnMessage; 486 | property OnOpen; 487 | end; 488 | 489 | { TWPageControl } 490 | 491 | TWPageControl = class(TCustomPageControl) 492 | published 493 | property ActivePage; 494 | property Align; 495 | property Anchors; 496 | property BorderSpacing; 497 | property Enabled; 498 | property Font; 499 | property HandleClass; 500 | property HandleId; 501 | property ParentFont; 502 | property ParentShowHint; 503 | property ShowHint; 504 | property ShowTabs; 505 | property TabHeight; 506 | property TabIndex; 507 | property TabPosition; 508 | property TabOrder; 509 | property TabStop; 510 | property TabWidth; 511 | property Visible; 512 | property OnEnter; 513 | property OnExit; 514 | property OnMouseDown; 515 | property OnMouseEnter; 516 | property OnMouseLeave; 517 | property OnMouseMove; 518 | property OnMouseUp; 519 | property OnMouseWheel; 520 | end; 521 | 522 | { TWFloatEdit } 523 | 524 | TWFloatEdit = class(TCustomNumericEdit) 525 | private 526 | function GetValue: double; 527 | procedure SetValue(AValue: double); 528 | protected 529 | procedure RealSetText(const AValue: string); override; 530 | published 531 | property Align; 532 | property Alignment; 533 | property Anchors; 534 | property AutoSize; 535 | property BorderSpacing; 536 | property BorderStyle; 537 | property Color; 538 | property DecimalPlaces; 539 | property Enabled; 540 | property Font; 541 | property HandleClass; 542 | property HandleId; 543 | property ParentColor; 544 | property ParentFont; 545 | property ParentShowHint; 546 | property PasswordChar; 547 | property ReadOnly; 548 | property ShowHint; 549 | property TabStop; 550 | property TabOrder; 551 | property Text; 552 | property TextHint; 553 | property Value: double read GetValue write SetValue; 554 | property Visible; 555 | property OnChange; 556 | property OnClick; 557 | property OnDblClick; 558 | property OnEnter; 559 | property OnExit; 560 | property OnKeyDown; 561 | property OnKeyPress; 562 | property OnKeyUp; 563 | property OnMouseDown; 564 | property OnMouseEnter; 565 | property OnMouseLeave; 566 | property OnMouseMove; 567 | property OnMouseUp; 568 | property OnMouseWheel; 569 | property OnResize; 570 | end; 571 | 572 | { TWIntegerEdit } 573 | 574 | TWIntegerEdit = class(TCustomNumericEdit) 575 | private 576 | function GetValue: NativeInt; 577 | procedure SetValue(AValue: NativeInt); 578 | protected 579 | procedure RealSetText(const AValue: string); override; 580 | public 581 | constructor Create(AOwner: TComponent); override; 582 | published 583 | property Align; 584 | property Alignment; 585 | property Anchors; 586 | property AutoSize; 587 | property BorderSpacing; 588 | property BorderStyle; 589 | property Color; 590 | property Enabled; 591 | property Font; 592 | property HandleClass; 593 | property HandleId; 594 | property ParentColor; 595 | property ParentFont; 596 | property ParentShowHint; 597 | property PasswordChar; 598 | property ReadOnly; 599 | property ShowHint; 600 | property TabStop; 601 | property TabOrder; 602 | property Text; 603 | property TextHint; 604 | property Value: NativeInt read GetValue write SetValue; 605 | property Visible; 606 | property OnChange; 607 | property OnClick; 608 | property OnDblClick; 609 | property OnEnter; 610 | property OnExit; 611 | property OnKeyDown; 612 | property OnKeyPress; 613 | property OnKeyUp; 614 | property OnMouseDown; 615 | property OnMouseEnter; 616 | property OnMouseLeave; 617 | property OnMouseMove; 618 | property OnMouseUp; 619 | property OnMouseWheel; 620 | property OnResize; 621 | end; 622 | 623 | { TWDateEditBox } 624 | 625 | TWDateEditBox = class(TCustomDateTimeEdit) 626 | private 627 | function GetValue: TDate; 628 | procedure SetValue(AValue: TDate); 629 | protected 630 | function InputType: string; override; 631 | procedure RealSetText(const AValue: string); override; 632 | published 633 | property Align; 634 | property Alignment; 635 | property Anchors; 636 | property AutoSize; 637 | property BorderSpacing; 638 | property BorderStyle; 639 | property Color; 640 | property Enabled; 641 | property Font; 642 | property HandleClass; 643 | property HandleId; 644 | property ParentColor; 645 | property ParentFont; 646 | property ParentShowHint; 647 | property PasswordChar; 648 | property ReadOnly; 649 | property ShowHint; 650 | property TabStop; 651 | property TabOrder; 652 | property Text; 653 | property TextHint; 654 | property Value: TDate read GetValue write SetValue; 655 | property Visible; 656 | property OnChange; 657 | property OnClick; 658 | property OnDblClick; 659 | property OnEnter; 660 | property OnExit; 661 | property OnKeyDown; 662 | property OnKeyPress; 663 | property OnKeyUp; 664 | property OnMouseDown; 665 | property OnMouseEnter; 666 | property OnMouseLeave; 667 | property OnMouseMove; 668 | property OnMouseUp; 669 | property OnMouseWheel; 670 | property OnResize; 671 | end; 672 | 673 | { TWTimeEditBox } 674 | 675 | TWTimeEditBox = class(TCustomDateTimeEdit) 676 | private 677 | function GetValue: TTime; 678 | procedure SetValue(AValue: TTime); 679 | protected 680 | function InputType: string; override; 681 | procedure RealSetText(const AValue: string); override; 682 | published 683 | property Align; 684 | property Alignment; 685 | property Anchors; 686 | property AutoSize; 687 | property BorderSpacing; 688 | property BorderStyle; 689 | property Color; 690 | property Enabled; 691 | property Font; 692 | property HandleClass; 693 | property HandleId; 694 | property ParentColor; 695 | property ParentFont; 696 | property ParentShowHint; 697 | property PasswordChar; 698 | property ReadOnly; 699 | property ShowHint; 700 | property TabStop; 701 | property TabOrder; 702 | property Text; 703 | property TextHint; 704 | property Value: TTime read GetValue write SetValue; 705 | property Visible; 706 | property OnChange; 707 | property OnClick; 708 | property OnDblClick; 709 | property OnEnter; 710 | property OnExit; 711 | property OnKeyDown; 712 | property OnKeyPress; 713 | property OnKeyUp; 714 | property OnMouseDown; 715 | property OnMouseEnter; 716 | property OnMouseLeave; 717 | property OnMouseMove; 718 | property OnMouseUp; 719 | property OnMouseWheel; 720 | property OnResize; 721 | end; 722 | 723 | { TWFileButton } 724 | 725 | TWFileButton = class(TCustomFileButton) 726 | published 727 | property Align; 728 | property Anchors; 729 | property AutoSize; 730 | property BorderSpacing; 731 | property Caption; 732 | property Color; 733 | property Enabled; 734 | property Filter; 735 | property Font; 736 | property HandleClass; 737 | property HandleId; 738 | //property ModalResult; 739 | property ParentFont; 740 | property ParentShowHint; 741 | property ShowHint; 742 | property TabOrder; 743 | property TabStop; 744 | property Visible; 745 | property OnChange; 746 | property OnClick; 747 | property OnEnter; 748 | property OnExit; 749 | property OnKeyDown; 750 | property OnKeyPress; 751 | property OnKeyUp; 752 | property OnMouseDown; 753 | property OnMouseEnter; 754 | property OnMouseLeave; 755 | property OnMouseMove; 756 | property OnMouseUp; 757 | property OnMouseWheel; 758 | property OnResize; 759 | end; 760 | 761 | { TWDataGrid } 762 | 763 | TWDataGrid = class(TCustomDataGrid) 764 | published 765 | property Align; 766 | property Anchors; 767 | property BorderSpacing; 768 | property Columns; 769 | property ColumnClickSorts; 770 | property DefaultColWidth; 771 | property DefaultRowHeight; 772 | property Enabled; 773 | property Font; 774 | property HandleClass; 775 | property HandleId; 776 | property ParentFont; 777 | property ParentShowHint; 778 | property ShowHint; 779 | property SortOrder; 780 | property ShowHeader; 781 | property TabOrder; 782 | property TabStop; 783 | property Visible; 784 | property OnCellClick; 785 | property OnEnter; 786 | property OnExit; 787 | property OnHeaderClick; 788 | property OnKeyDown; 789 | property OnKeyPress; 790 | property OnKeyUp; 791 | property OnMouseDown; 792 | property OnMouseEnter; 793 | property OnMouseLeave; 794 | property OnMouseMove; 795 | property OnMouseUp; 796 | property OnMouseWheel; 797 | end; 798 | 799 | { TWPagination } 800 | 801 | TWPagination = class(TCustomPagination) 802 | published 803 | property Align; 804 | property Anchors; 805 | property BorderSpacing; 806 | property CurrentPage; 807 | property Enabled; 808 | property Font; 809 | property HandleClass; 810 | property HandleId; 811 | property ParentFont; 812 | property ParentShowHint; 813 | property RecordsPerPage; 814 | property ShowHint; 815 | property TabOrder; 816 | property TabStop; 817 | property TotalPages; 818 | property TotalRecords; 819 | property Visible; 820 | property OnKeyDown; 821 | property OnKeyPress; 822 | property OnKeyUp; 823 | property OnMouseDown; 824 | property OnMouseEnter; 825 | property OnMouseLeave; 826 | property OnMouseMove; 827 | property OnMouseUp; 828 | property OnMouseWheel; 829 | property OnPageClick; 830 | end; 831 | 832 | implementation 833 | 834 | { TWFloatEdit } 835 | 836 | function TWFloatEdit.GetValue: double; 837 | begin 838 | Result := StrToFloatDef(RealGetText, 0); 839 | end; 840 | 841 | procedure TWFloatEdit.SetValue(AValue: double); 842 | begin 843 | RealSetText(FloatToStrF(AValue, ffFixed, 20, DecimalPlaces)); 844 | end; 845 | 846 | procedure TWFloatEdit.RealSetText(const AValue: string); 847 | begin 848 | inherited RealSetText(FloatToStrF(StrToFloatDef(AValue, 0), ffFixed, 20, DecimalPlaces)); 849 | end; 850 | 851 | { TWIntegerEdit } 852 | 853 | function TWIntegerEdit.GetValue: NativeInt; 854 | begin 855 | Result := StrToIntDef(RealGetText, 0); 856 | end; 857 | 858 | procedure TWIntegerEdit.SetValue(AValue: NativeInt); 859 | begin 860 | RealSetText(FloatToStrF(AValue, ffFixed, 20, DecimalPlaces)); 861 | end; 862 | 863 | procedure TWIntegerEdit.RealSetText(const AValue: string); 864 | begin 865 | inherited RealSetText(FloatToStrF(StrToFloatDef(AValue, 0), ffFixed, 20, DecimalPlaces)); 866 | end; 867 | 868 | constructor TWIntegerEdit.Create(AOwner: TComponent); 869 | begin 870 | inherited Create(AOwner); 871 | BeginUpdate; 872 | try 873 | DecimalPlaces := 0; 874 | finally 875 | EndUpdate; 876 | end; 877 | end; 878 | 879 | { TWDateEditBox } 880 | 881 | function TWDateEditBox.GetValue: TDate; 882 | begin 883 | Result := StrToDateDef(RealGetText, 0); 884 | end; 885 | 886 | procedure TWDateEditBox.SetValue(AValue: TDate); 887 | begin 888 | RealSetText(DateToStr(AValue)); 889 | end; 890 | 891 | function TWDateEditBox.InputType: string; 892 | begin 893 | Result := 'date'; 894 | end; 895 | 896 | procedure TWDateEditBox.RealSetText(const AValue: string); 897 | begin 898 | inherited RealSetText(FormatDateTime(ShortDateFormat, StrToDateDef(AValue, 0))); 899 | end; 900 | 901 | { TWTimeEditBox } 902 | 903 | function TWTimeEditBox.GetValue: TTime; 904 | begin 905 | Result := StrToTimeDef(RealGetText, 0, FormatSettings.TimeSeparator); 906 | end; 907 | 908 | procedure TWTimeEditBox.SetValue(AValue: TTime); 909 | begin 910 | RealSetText(TimeToStr(AValue)); 911 | end; 912 | 913 | function TWTimeEditBox.InputType: string; 914 | begin 915 | Result := 'time'; 916 | end; 917 | 918 | procedure TWTimeEditBox.RealSetText(const AValue: string); 919 | begin 920 | inherited RealSetText(FormatDateTime(ShortTimeFormat, StrToTimeDef(AValue, 0, FormatSettings.TimeSeparator))); 921 | end; 922 | 923 | end. 924 | -------------------------------------------------------------------------------- /widgets/webextra.pas: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2018 Hélio S. Ribeiro and Anderson J. Gado da Silva 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | unit WebExtra; 25 | 26 | {$I pas2js_widget.inc} 27 | 28 | interface 29 | 30 | uses 31 | JS, 32 | Classes, 33 | SysUtils, 34 | Web; 35 | 36 | type 37 | 38 | { TJSFileReader } 39 | 40 | TJSFileReader = class external name 'FileReader' (TJSEventTarget) 41 | public 42 | const 43 | EMPTY: NativeInt = 0; 44 | LOADING: NativeInt = 1; 45 | DONE: NativeInt = 2; 46 | public 47 | error: TJSEventHandler; 48 | readyState: NativeInt; 49 | result: JSValue; 50 | onabort: TJSEventHandler; 51 | onerror: TJSEventHandler; 52 | onload: TJSEventHandler; 53 | onloadstart: TJSEventHandler; 54 | onloadend: TJSEventHandler; 55 | onprogress: TJSEventHandler; 56 | constructor New; 57 | procedure readAsArrayBuffer(blob: TJSBlob); 58 | procedure readAsArrayBinaryString(blob: TJSBlob); 59 | procedure readAsText(blob: TJSBlob); 60 | procedure readAsDataURL(blob: TJSBlob); 61 | procedure abort; 62 | end; 63 | 64 | { TJSHTMLTextAreaElement } 65 | 66 | TJSHTMLTextAreaElement = class external name 'HTMLTextAreaElement' (TJSHTMLElement) 67 | private 68 | FForm: TJSHTMLFormElement; external name 'form'; 69 | FLabels: TJSNodeList; external name 'labels'; 70 | FValidationmMessage: string; external name 'validationMessage'; 71 | FValidity: TJSValidityState; external name 'validity'; 72 | FWillValidate: boolean; external name 'willValidate'; 73 | Public 74 | function checkValidity : Boolean; 75 | procedure select; 76 | procedure setCustomValidity(aText : string); 77 | procedure setRangeText(aText : string; selectionStart, selectionEnd: NativeInt) ; overload; 78 | procedure setRangeText(aText : string; selectionStart, selectionEnd: NativeInt; Direction : string) ; overload; 79 | procedure setSelectionRange(selectionStart, selectionEnd: NativeInt) ; overload; 80 | procedure setSelectionRange(selectionStart, selectionEnd: NativeInt; Direction : string) ; overload; 81 | public 82 | autocapitalize : string; 83 | autocomplete : string; 84 | autofocus : boolean; 85 | cols: NativeInt; 86 | defaultValue : string; 87 | disabled : boolean; 88 | inputMode : string; 89 | maxLength : NativeInt; 90 | placeholder : string; 91 | readOnly : boolean; 92 | required : boolean; 93 | rows: NativeInt; 94 | selectionDirection : string; 95 | selectionEnd : NativeInt; 96 | selectionStart : NativeInt; 97 | textLength: NativeInt; 98 | _type : string; external name 'type'; 99 | value : string; 100 | wrap: String; 101 | property form : TJSHTMLFormElement read FForm; 102 | property labels : TJSNodeList read FLabels; 103 | property validationMessage : string read FValidationmMessage; 104 | property validity : TJSValidityState read FValidity; 105 | property willValidate : boolean read FWillValidate; 106 | end; 107 | 108 | implementation 109 | 110 | end. 111 | -------------------------------------------------------------------------------- /widgets/wresources.pas: -------------------------------------------------------------------------------- 1 | { 2 | /*************************************************************************** 3 | wresources.pas 4 | -------------- 5 | 6 | Initial Revision : Mon Jan 13 CST 2020 7 | 8 | ***************************************************************************/ 9 | 10 | ***************************************************************************** 11 | This file is part of the Web Component Library (WCL) 12 | 13 | See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 | for details about the license. 15 | ***************************************************************************** 16 | } 17 | unit WResources; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes; 25 | 26 | function InitResourceComponent(Instance: TComponent; 27 | RootAncestor: TClass):Boolean; 28 | 29 | implementation 30 | 31 | uses 32 | Web, SysUtils, p2jsres, 33 | WCLStrConsts; 34 | 35 | function InitResourceComponent(Instance: TComponent; RootAncestor: TClass 36 | ): Boolean; 37 | 38 | function InitComponent(ClassType: TClass): Boolean; 39 | var 40 | data, ResName: String; 41 | Stream: TStream; 42 | BinStream: TMemoryStream; 43 | Reader: TReader; 44 | info: TResourceInfo; 45 | begin 46 | Result := False; 47 | if (ClassType = TComponent) or (ClassType = RootAncestor) then 48 | Exit; 49 | if Assigned(ClassType.ClassParent) then 50 | Result := InitComponent(ClassType.ClassParent); 51 | 52 | Stream := nil; 53 | //ResName := ClassType.ClassName; 54 | ResName := ClassType.UnitName; 55 | 56 | if not GetResourceInfo(ResName, info) then 57 | Exit; 58 | 59 | data := window.atob(info.data); 60 | if data <> '' then 61 | Stream := TStringStream.Create(data); 62 | 63 | if not Assigned(Stream) then 64 | Exit; 65 | 66 | try 67 | try 68 | BinStream := TMemoryStream.Create; 69 | try 70 | ObjectTextToBinary(Stream, BinStream); 71 | 72 | BinStream.Position := 0; 73 | 74 | Reader := TReader.Create(BinStream); 75 | try 76 | Reader.ReadRootComponent(Instance); 77 | finally 78 | Reader.Free; 79 | end; 80 | finally 81 | BinStream.Free; 82 | end; 83 | except 84 | on E: Exception do begin 85 | Writeln(Format(rsFormStreamingError,[ClassType.ClassName,E.Message])); 86 | raise; 87 | end; 88 | end; 89 | finally 90 | Stream.Free; 91 | end; 92 | Result := True; 93 | end; 94 | 95 | begin 96 | if Instance.ComponentState * [csLoading, csInline] <> [] then begin 97 | // global loading not needed 98 | Result := InitComponent(Instance.ClassType); 99 | end else 100 | try 101 | //BeginGlobalLoading; 102 | Result := InitComponent(Instance.ClassType); 103 | //NotifyGlobalLoading; 104 | finally 105 | //EndGlobalLoading; 106 | end; 107 | end; 108 | 109 | initialization 110 | RegisterInitComponentHandler(TComponent, @InitResourceComponent); 111 | end. 112 | 113 | --------------------------------------------------------------------------------