liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: liujianjun:60749c0d9305585b3074efe49264a0433b7a2352
Branches Tags
liujianjun:main
...
compare: liujianjun:db909b5520309f7c45b36759913e46486841201b
Branches Tags
liujianjun:main

2 Commits
60749c0d93 ... db909b5520

Author SHA1 Message Date
liujianjun db909b5520 跟新 2025-07-22 17:28:43 +08:00
liujianjun e4d6b23680 修改资源文件tfm位置 2025-05-19 15:28:51 +08:00
67 changed files with 4509 additions and 2356 deletions
Show Stats Expand all files Collapse all files

BIN
Help/designerUserGuid.CHM
View File

Binary file not shown.

BIN
MathKrnl.dll
View File

Binary file not shown.

BIN
TSLInterp.dll
View File

Binary file not shown.

0
d_examples/ListBox/resource.tfm/e_listboxmain.tfm → d_examples/ListBox/e_listboxmain.tfm
View File

0
d_examples/ListView/resource.tfm/e_listviewmain.tfm → d_examples/ListView/e_listviewmain.tfm
View File

0
d_examples/TreeView/resource.tfm/e_treeviewmain.tfm → d_examples/TreeView/e_treeviewmain.tfm
View File

0
d_examples/action/resource.tfm/e_actionmain.tfm → d_examples/action/e_actionmain.tfm
View File

103
d_examples/menu/e_menumain.tfm Normal file
View File

@ -0,0 +1,103 @@
object e_menumain1:e_menumain
caption="²Ëµ¥·¶Àý"
height=392
left=488
mainmenu=mainmenu1
onclose=e_menumain1_close
popupmenu=popupmenu1
top=220
width=375
object mainmenu1:tmainmenu
left=58
top=73
height=30
width=30
object menu1:tmenu
caption="menu1"
object menu3:tmenu
caption="²Ëµ¥3"
onclick=menuclick
end
object menu4:tmenu
caption="menu4"
object menu5:tmenu
caption="menu5"
onclick=menuclick
end
end
end
object menu2:tmenu
caption="menu2"
onclick=menuclick
end
end
object popupmenu1:tpopupmenu
left=172
top=98
height=30
width=30
caption="popupmenu1"
object menu6:tmenu
bitmap={ 900200000000000000020000000200000001000000480300003C0000000000000
004000000040000000400000008000000030000000B0000000103000074797065
64617461696D6789504E470D0A1A0A0000000D494844520000002000000020080
6000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F
0BFC6105000000097048597300000EC300000EC301C76FA864000002964944415
45847ED964B68135114865D894BC1951BE946A42B752356505C54042D882E846A
5BA13B6B151491D295B4882B2D08E293D6422D55918AF5416AC5A22008BAD085D
45A6D9A986812E3249989B1769263FEDB7BAF379957122DA5900F0EC99C398F7F
E69E99B9CB689159FA02326F5FD3B7CE760AECAF67BFC6D8437EA634FE49803E3
A4293B5AB6862CDF2020B1F3BC423BCF114103BDF455AFF2532E331EEF9CBCCBE
EDACE174FD061687C64284F1CCC7A3DC2910F0BDA79B12B76EF0A379444158A07
127690357C94CFC60E770DBD17C76F23D3B065F5AF7B2D868F729EE71470A885F
BF201B850E37CAA210E56FA893E784059A765162A897B27A8AC509D098D5686FE
61E77A480ACA153B0A54136800895F4AB17143DDB49D33B36CA1866352B2898BF
EAE4DD01CAFD4C33C1F063494AC13203C6D347ECD6A65F8E738F15E3F918454E9
FA0CFDB6A0BC47C58B792426D0728393C48B95F191EED8EE7107A618CFBE86B47
1B4D6DAA2910F371FD6A0A1F6FA5D4C81D22738E475B910252F786D8731CE93AC
93DE5A3E7DF01688AE6AA18888348FDC903A25C8E47CF2305A80973A120F75A31
6311FECF1DDD779FC2475BD8B2A8B5B16CEA7C48017883C52F9FCBDFD251EEB1F
23BE867457035E5907A3C4CA12307D9C0223F71BB9F9F71980134FAB465ADE551
C260A20086B45250437D746D05884630153701D1331DB6F3632635CABC7BC38FA
CFC3701221E312AFEDD9B995F7D5BAA2CB80027BFA02AA02AA02A606909C8EA49
B9FF2B061B98E24D0CA848C0ECD4844CC477A152C4C70BE6F43AB6150066F66C6
589F12B3DDC533EC81502C446B6184701DACD6B32195F46AC7B39861C91EFF6F9
761400B0D6A248A5A6F55DE4D5EC711500B08ED840408C9D61176C67C829657E3
C052C348B2C80E80FBF5E212863E9B00A0000000049454E44AE426082 }
caption="menu6"
onclick=menuclick
end
object menu7:tmenu
bitmap={ 9002000000000000000200000002000000010000008C0300003C0000000000000
004000000040000000400000008000000030000000B0000004503000074797065
64617461696D6789504E470D0A1A0A0000000D494844520000002000000020080
6000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F
0BFC6105000000097048597300000EC300000EC301C76FA864000002DA4944415
45847C597BD6A54411886BD066BADD45E11BC01116C6C142F402C2CAC44112C94
947A031606B7515288918022A8202EF107D42A0988C4D5603624EBAE68B2C6282
A9FFB8CE73D993D993973768DF8C040767EDF39F3CDFB4DB6D87F66200193CDAF
76A6FEC1F6DF7C6FBBAFCDD9B6D1866DEF95BDD7E7ECE0AD79BBF0B46D77DF7DB
1C5D59FD9883449012BDF7FD995A94F6ED1AD97672B9791671DEBACA585940AB8
F8BC637B7A3BF527DE596BD8A189A69D7BDCB61BAF576C7CB66B23BD9D1FB9BD6
0BB6A6FFBFAEE1B9BB3B157CBD96C61A2022EBDF8D837D9F9276D9BEE7CCB5AE3
CCF4FA9CAEB7FAC69E7CD8CA5A37121470F4CE423E78C7D586D5E757B396EAD46
6965D7C681EE60CB141006A35E8C483A5AC76780EF78E46F371A445FA04705EEA
CCC014A71EB55C49C14662227201442C4143273E5D8A63F716F349F93B0547495
F829A9B2572015C1B4DC8F995E12FAE9212411CA92FD75A380118871A89E03242
8BABA4447093E887A7082700F7D2245CA318FEE2136FBAC1BFCB44708DD50F570
527000BA5122389515C1CF41BAA8AC0C8E883A58313808F53899B85082D0EAA13
5544E0A2B4EB189C00920995586A11DF17FCC541F53EBE88900362E1B491CCC00
99063E1EB451045E7E2E2A0858A48446843E40FDAC8A4E004F02326A08C988032
24405EE304B0432A438ACB1846808E8063072740B93E1684318611A02024F0C10
99041945DC310C308D0353C3BE95DC3974B6BF964654654645001BE1129DE9C00
3830FEC70B5256EC33A8007D694AB3FBC3D5E50248106A4C2523A1FE55F093118
94FE40248917AFF5549C7308800A56352BEFF58CD05008F054D5AE54142445352
F80F92A2D7F40980E3F7D77D7FB39F64A3539FB3DA75360800DD55CA663D4A635
F2A280050ABC194BF7996F35563440500E7A577A2CA20FF9810D4A197B04FA900
2062FDF7629582A770ADFDC7678CA4008171B05B2C141F279970C664529219F98
463C25507A1B2807F83D96FD95753C0FE2C3C9B0000000049454E44AE426082 }
caption="menu7"
onclick=menuclick
end
end
end

101
d_examples/menu/resource.tfm/e_menumain.tfm
View File

@ -1,101 +0,0 @@
object e_menumain1:e_menumain
caption="²Ëµ¥·¶Àý"
height=392
left=488
mainmenu=mainmenu1
onclose=e_menumain1_close
popupmenu=popupmenu1
top=220
width=375
object mainmenu1:tmainmenu
left=58
top=73
height=30
width=30
object menu1:tmenu
caption="menu1"
object menu3:tmenu
caption="²Ëµ¥3"
onclick=menuclick
end
object menu4:tmenu
caption="menu4"
object menu5:tmenu
caption="menu5"
onclick=menuclick
end
end
end
object menu2:tmenu
caption="menu2"
onclick=menuclick
end
end
object popupmenu1:tpopupmenu
left=172
top=98
height=30
width=30
caption="popupmenu1"
object menu6:tmenu
bitmap={ 0502000000060400000074797065000203000000696D670006040000006461746
100020103000089504E470D0A1A0A0000000D4948445200000020000000200806
000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000029649444154
5847ED964B68135114865D894BC1951BE946A42B752356505C54042D882E846A5
BA13B6B151491D295B4882B2D08E293D6422D55918AF5416AC5A22008BAD085D4
5A6D9A986812E3249989B1769263FEDB7BAF379957122DA5900F0EC99C398F7FE
69E99B9CB689159FA02326F5FD3B7CE760AECAF67BFC6D8437EA634FE49803E3A
4293B5AB6862CDF2020B1F3BC423BCF114103BDF455AFF2532E331EEF9CBCCBEE
DACE174FD061687C64284F1CCC7A3DC2910F0BDA79B12B76EF0A379444158A071
27690357C94CFC60E770DBD17C76F23D3B065F5AF7B2D868F729EE71470A885FB
F201B850E37CAA210E56FA893E784059A765162A897B27A8AC509D098D5686FE6
1E77A480ACA153B0A54136800895F4AB17143DDB49D33B36CA1866352B2898BFE
AE4DD01CAFD4C33C1F063494AC13203C6D347ECD6A65F8E738F15E3F918454E9F
A0CFDB6A0BC47C58B792426D0728393C48B95F191EED8EE7107A618CFBE86B471
B4D6DAA2910F371FD6A0A1F6FA5D4C81D22738E475B910252F786D8731CE93AC9
3DE5A3E7DF01688AE6AA18888348FDC903A25C8E47CF2305A80973A120F75A316
311FECF1DDD779FC2475BD8B2A8B5B16CEA7C48017883C52F9FCBDFD251EEB1F2
3BE867457035E5907A3C4CA12307D9C0223F71BB9F9F71980134FAB465ADE551C
260A20086B45250437D746D05884630153701D1331DB6F3632635CABC7BC38FAC
FC3701221E312AFEDD9B995F7D5BAA2CB80027BFA02AA02AA02A606909C8EA49B
9FF2B061B98E24D0CA848C0ECD4844CC477A152C4C70BE6F43AB6150066F66C65
89F12B3DDC533EC81502C446B6184701DACD6B32195F46AC7B39861C91EFF6F97
61400B0D6A248A5A6F55DE4D5EC711500B08ED840408C9D61176C67C829657E3C
052C348B2C80E80FBF5E212863E9B00A0000000049454E44AE42608200 }
caption="menu6"
onclick=menuclick
end
object menu7:tmenu
bitmap={ 0502000000060400000074797065000203000000696D670006040000006461746
100024503000089504E470D0A1A0A0000000D4948445200000020000000200806
000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000002DA49444154
5847C597BD6A54411886BD066BADD45E11BC01116C6C142F402C2CAC44112C949
47A031606B7515288918022A8202EF107D42A0988C4D5603624EBAE68B2C6282A
9FFB8CE73D993D993973768DF8C040767EDF39F3CDFB4DB6D87F66200193CDAF7
6A6FEC1F6DF7C6FBBAFCDD9B6D1866DEF95BDD7E7ECE0AD79BBF0B46D77DF7DB1
C5D59FD9883449012BDF7FD995A94F6ED1AD97672B9791671DEBACA585940AB8F
8BC637B7A3BF527DE596BD8A189A69D7BDCB61BAF576C7CB66B23BD9D1FB9BD60
BB6A6FFBFAEE1B9BB3B157CBD96C61A2022EBDF8D837D9F9276D9BEE7CCB5AE3C
CF4FA9CAEB7FAC69E7CD8CA5A37121470F4CE423E78C7D586D5E757B396EAD466
965D7C681EE60CB141006A35E8C483A5AC76780EF78E46F371A445FA04705EEAC
CC014A71EB55C49C14662227201442C4143273E5D8A63F716F349F93B0547495F
829A9B2572015C1B4DC8F995E12FAE9212411CA92FD75A380118871A89E032428
BABA4447093E887A7082700F7D2245CA318FEE2136FBAC1BFCB44708DD50F5705
27000BA5122389515C1CF41BAA8AC0C8E883A58313808F53899B85082D0EAA135
544E0A2B4EB189C00920995586A11DF17FCC541F53EBE88900362E1B491CCC009
9063E1EB451045E7E2E2A0858A48446843E40FDAC8A4E004F02326A08C9880322
4405EE304B0432A438ACB1846808E8063072740B93E1684318611A02024F0C109
9041945DC310C308D0353C3BE95DC3974B6BF964654654645001BE1129DE9C003
830FEC70B5256EC33A8007D694AB3FBC3D5E50248106A4C2523A1FE55F0931189
4FE40248917AFF5549C7308800A56352BEFF58CD05008F054D5AE54142445352F
80F92A2D7F40980E3F7D77D7FB39F64A3539FB3DA75360800DD55CA663D4A635F
2A280050ABC194BF7996F35563440500E7A577A2CA20FF9810D4A197B04FA9002
062FDF7629582A770ADFDC7678CA4008171B05B2C141F279970C664529219F984
63C25507A1B2807F83D96FD95753C0FE2C3C9B0000000049454E44AE42608200 }
caption="menu7"
onclick=menuclick
end
end
end

167
d_examples/toolbar/e_toolbarmain.tfm Normal file
View File

@ -0,0 +1,167 @@
object e_toolbarmain1:e_toolbarmain
caption="묏야으렀절"
height=520.0
left=429
onclose=e_toolbarmain1_close
top=236
width=664
object toolbar1:ttoolbar
caption="toolbar1"
height=29
imagelist=controlimagelist1
width=648
object toolbutton1:ttoolbutton
caption="객큐1"
imageid=0
onclick=toolbaritemclick
end
object toolbutton2:ttoolbutton
caption="객큐2"
imageid=1
onclick=toolbaritemclick
end
object toolbutton3:ttoolbutton
caption="객큐3"
imageid=2
onclick=toolbaritemclick
end
object toolbutton4:ttoolbutton
caption="toolbutton4"
imageid=4
onclick=toolbaritemclick
end
object toolbutton5:ttoolbutton
caption="toolbutton5"
imageid=3
onclick=toolbaritemclick
end
end
object controlimagelist1:tcontrolimagelist
left=84
top=114
images={ 900200000000000000020000000000000000000000B40F00003E0000000000000
0040000000400000005000000020900000004000000050D000000690F00007479
70656974656D73626D70739005000000020000000000000002000000020000006
80F00007E00000000000000040000000400000004000000020208000000030000
000B0000009F020000AA02000003000000AD020000D3030000800600000300000
083060000DB0200005E0900000300000061090000F8020000590C000003000000
5C0C00008E0200007479706564617461696D6789504E470D0A1A0A0000000D494
8445200000020000000200806000000737A7AF4000000017352474200AECE1CE9
0000000467414D410000B18F0BFC6105000000097048597300000EC300000EC30
1C76FA86400000234494441545847ED96CDCB69511487EF5F6BC25061A048C940
9181C840182829C554664AEFC04C0C0C64A0440626C8E0DC9E75D73E6DC7E1E55
EEE3BF1D41A9CB5D6DEFB77F6C7DAFB97F3C37C047C045C08C866B34E201078DA
686768341ABE39582C1693B8CD4B056CB75BDFB8D77ABD9EE4C34B9760381CCA0
0D56A553D97CC663389472211F5BC588099C16EB7AB9E4BCEE7B3C483C1A07A3C
0268C83A91F4B7964C269DC3E1A03D5EB2DFEF25271C0EABC712C0BA783B7BD6C
AE5B233994CB4C76BD6EBB5E4C5E371F55802581782ACD3BB582C1632463A9D56
8F2520140A49F0743AA9E7F54CA753192397CBA9C712108D4625B8DBEDD4F3185
F5F5FCE6834D2AFFB8CC76319A3542AA9C712904AA524B85C2ED5F318DFED7C1B
734C6BB59A7A2C01F97C5E82F736911FABD5CA4924120F89E8F7FB92D76AB5D46
309A8542A12644A6FC1F16293FA99116157392FE6A4D9425D01CD66538283C140
3DD79829FCCE10E4077F4E9C9930B802FCD479A1D613B78D7658A15090F6C5625
1B3AF61EDC9E1470CAE00FE9C2033F12CF57A5DDAB28F8EC7A37AAF61F793C769
30B802587B82EC8567E8743AD22E93C948A9BD07E79F5CEA81C115C0EE377FF12
8F3F95CDA50FF379B8D7A6F4305249F8A68700570FE09520F9E816378EBF2F1C2
1DC018DC0906570015902015F15D700B3286BD54AE00EE0082DC09EF82770063F
02E30B802E09D37227DD2B7FD1A820B019C6B92DE69ED765B47FBC3850040C4BF
BE8AFC8C3E79B078B912F0BFF908F861018EF31BE3A64DABEA577256000000004
9454E44AE426082696D6789504E470D0A1A0A0000000D49484452000000300000
003008060000005702F987000000017352474200AECE1CE90000000467414D410
000B18F0BFC6105000000097048597300000EC300000EC301C76FA86400000368
494441546843ED98DB4B14511CC7FB837AEB35287A080A8A1E844088EA2108C94
8222822BAA0629682742122C9D0BC84B5A246E135EFBAAEAB99AD46522A5B5E48
2C5371E7F66DCECE6FDCD9F1CCECCD7194F6035FD839F33D737EDFD939672E7BB
0CB4907709B74002EBF2781BA1380AF981A9CC39900A3CF80B2BD9A825DD4E80C
D60116C781F76781E6F3407B0ED07915E8BD050CE40383F701FF03400E91D904E
BA70718794C8D26E687D4639400DE42A03F0FE8BE01745C01DAB281A6735ADBCA
2C99ADB10E507B3852044FC38FC8C8C118C0CEC74E8EF198668D9591D11AEB00B
C031AB530A2F9E687B5B3CCC48A653207304BE75369F431CD327A2D482E407D06
9954DE66F23D769A6ED6FA2E06F8FB753916C0B8BAD41CE47BEC345E499D553CC
7F81E26C702B009AE136BAEF0642CCC5BC0F7303912C0739C0CC4DF2030EB4D4C
46D8366F1C266702A87FF95632DDC21F87C99100E5FBB4FB81F9AC26A3892AE0F
511FE384C8ECD81ED523A80DB4A07705BE900B1F4EA90F640C65B22EDE4BDCB3F
9E598E07E8CB257312189F58ADE47880EEEB644E106175870460626F506CA0441
4EF2338F3C6E03F9FC44E2B1D201EB117733650228A670233316F0C520BD0758D
CC49102B04BB57C4416A01D87B41B2D8050854904943595A53975E99B6A249FD1
2B25B46F5CF2D66597D0FAADA0FCCB453012A7FD621167E4028A31CA153D5106B
E8538E819D33891B4F024B5F69700DB1C2AF156F90DC33457B35764600F6E992D
D9D09A92100B1A43BFC5B2CEE8C0A209CA98132F92BBC8FE17E005F110DA8A228
109F0E6C142B95F9A02CAC40C8AE8B0A2116755207B7034C54D3606AED3F9721D
C6E8E2A9489FD1BF2F08F4DED3AEE04A83E0004B54B84C10A14B23C9B8AD425F7
4D43F28C6D6C4BE57EEAE95680858F34885AFCBB2F51C572755ABDEE3FCF417CD
803E9C510F5D4D8FE006F8ED200EA65E30B42BCD9145E1EB9851B245CAA8732B3
443D236C7F00C34B9058EA8570B911CAE22AC47B1DDCC299C4DC56286B02F58AC
6850077680035405EAB56A05A3C96D7C361CCC54B4FFAC9CDC73A40DB457E01A9
AA258B0600421722CBA3F4D20F796C0EA1CCCA485BED2839ADB10EC0E0BD906F8
508BD505D72D77708EA9C608F0D72C73772D9631FC061E4DE2948CF072116B443
C8698090590531BF0D72609E1CB17135C056900EE036BB3C00F00FB4FD2774447
C293D0000000049454E44AE426082696D6789504E470D0A1A0A0000000D494844
5200000020000000200806000000737A7AF4000000017352474200AECE1CE9000
0000467414D410000B18F0BFC6105000000097048597300000EC300000EC301C7
6FA86400000270494441545847D596CB6A2A411086CF0BBA72A3A851541414043
722EE44111782BAF182260441B7826F6188E015DCB81111172AC4B55087BFE89E
8CE3CCD8E6C484F341914A55F7F43F5D3DD5FEA15FE6FF13301C0EA95AAD92C7E
32197CB45D1689452A914F5FB7DDA6EB762943ACA0276BB1D65B35972381CB656
2814E870388859B7511230994C281C0EF3028944823A9D0EAD562B91253A1E8FD
4EBF5C8EFF7F398582C46F3F95C64EDB92960B3D9F076E3C1E572993E3E3E44E6
1A942097CB69BBB15C2E45C69A9B02506F3CAC56AB89C86DBADD2ECF29954A226
28DAD80E974CA0F72BBDDBC13AAA024B21CEFEFEF226A8EAD80F57A4DF1789CDF
E85E702620A05EAFF3FFFBFD9E4EA713FB7A940EE13D542A150A8542D46AB5584
02693E15D808F9731F2ED02DAED362F260DE583C137DB495301AFAFAF6C5F452F
C2E974F25F7C41665C09188D46DA64F85F65301868CF49A7D3743E9F45E6922B0
1B27630F8FFC2DBDB1B6F3BBAA8155702D0DBA500F88FE642C0783CE6859F9E9E
D8E023F6482E04BCBCBCF0A2CD66930D3E62F780CF0EF3A4A121E5F37991BDE64
280BC707091C0E023760FFAC58D66862660369BF1A060302822C43E62C8A9625C
0CDD54DE0DC56251443FD1043C3F3F6B938D869C2A728E1E79A7F87C3E11F9441
3100804B4C946434E153947CF4D018BC582074422110EEA410C398C51C1280025
9017936509E489470B3522DB2AC6A820059899D9D7C002BC5E2F0F306BBDB2356
38C0AFA05AD4C0F0BC0AFDA46A3C1013392C9247FDF2A982D02ACBE06ED107E17
560280D961FC5101D805E4D01D253F26006F2F4BA03F8C0F1360677ABE5D80F13
29286BADBB6E2DFE2970510FD05E1AD4F7F1B5448FE0000000049454E44AE4260
82696D6789504E470D0A1A0A0000000D494844520000002000000020080600000
0737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0BFC61
05000000097048597300000EC300000EC301C76FA8640000028D494441545847C
5973D6814411480B7B25050045B259D8595A0A5550AB5B00A626163255A5A5B28
B676E92C14091A8B84E01F88281844A208FE8128722268E7DE9D5E363197E4923
CF79B9BB7EEE6CE9DD9BDD3FD608ED937F3E6BD9B7DF3DE6C209EB456D665E273
5BC69EB464FFDDA6EC996AC8D61BA169F4919D989D9799AFCB12AD6E582D374E0
73EB43A72F679243B26EB125CFF6EDA968950764FD5E5C0BDA669F491E9F8CEC9
D0E8A0EB22D781F3AF1765FBCDAEE1C38F7ECA85370B3217AEDAD15E5E353A72F
9FD2F3912CF45075DD6C8E3AF0E1C9F6D9945F6CE34E46AAD6DA5FEA0832E6B1C
7AF0C34A7BE9EBC0C87457F14CBC8DF5F6BA9516075DFD23BB6E85569AA5C7012
6A2C0760F8B934FE7CD9AFCB1CD641C60AB9888C2B0E10FB1363B9226718060E9
376198F04AB1910E4CE300C7858825680679E72E581B1BD8D2236A1CE0CCE259D
1683FF73232AD08D8C0163621206B91388EC667B7282C442B0A3985C446760D48
9D2C32FE71C90EFB53D6818B6FBBF1466A0FC8DF3CD4A2353BEC4F5907C8A6E85
157028AC8B6B8A094A1AC0340EDC0764025EB97207C18C4010A18B603CAE9C1FB
4D2B2EC6200E5045B16D1CE0218F53CF22B34BD76AD940EDE70073988B4E1E890
36C03DB9187462DEDD2BB5416DBE400632A73D592E415100804848B2B9F9692C5
4FCFD924629F01993E33D74512847A0CB94CB8B8F36DD9242DE61F7BDCBD74A4F
B8C31C745E6186A22E226E3C38B7A47F6DD8E3DB7C6B52163CC07AD8C2611692A
E61AE5CB978535197DF86707E823F325938A119429468B9D0DF3DE69F47DE9294
6FC545E8EA1D20B8952E9954CA9F452AA3011854AAEE58A2A123445AF6A800EBA
AC51F8C3442158885816F9EF9F660AC785335BC9C7699A7FF3792EF21B1F1CB3C
87955C3470000000049454E44AE426082696D6789504E470D0A1A0A0000000D49
48445200000020000000200806000000737A7AF4000000017352474200AECE1CE
90000000467414D410000B18F0BFC6105000000097048597300000EC300000EC3
01C76FA86400000223494441545847ED972DAB024114860D824D2C7693C560103
409FA038C62B008828A3FC0EA57B268320882980D822206838A4530F80BC42236
ABC570EE3D7BE7EC9DFD9A9D5D96850BF78117768ECE996757775603204920108
0CD66C34662B2D92C9CCF673612232DF07ABD20994CB2D10FEFF71B2E970B7C3E
1F56F9A1DFEFB3237BA4059056AB05F3F91CDAED36643219E5AA6082C120A4D36
9A8D7EB50AD56E1F97CB219F6480BDCEF77A8542AEAA256894422301C0ED92C7B
A404F6FBBDE962A2148B45365B8CADC0E974825028A4344DA552301E8F0D8BF1E
16565246C054AA592DA1005ECAE06BE1E0E87D5F16432619DCC110ADC6E37F5EC
DD06A5450805F01B6FD6D4691E8F07EB684428D068344C1B3A8D6853D208D0AD8
69F2372381C6C733C1EA582E0FE81E1D108C46231D57A3A9D42A7D3D19C89DBE0
09E11D41E372B9CC56E404F4DFEE5C2E07BD5E4F53731BB33B87F04560B7DB196
A84A5403E9FF74C60BBDD1A6A842F02EBF5DA50237C11582E97861A2114E876BB
9A9ADB2C160B438DF04560B55A196A842F02FADE184228E0E546A4AF11BF47DFE
0938BDE8093BC14A8D56AEA188F098DC0F57A85D168A44C4070DFE61BB90DF6C3
E7CC6C365382C78446408F9702560805F08A98357492783CCEBA99231440D01E9
F0B187D73AAEB5FA3DA6030605DACB115E0E117C11028C9D7717159FE05FE9600
36365B04FF0BF202FADF7D221C09E0CE98482494E81769369B108D46A15028B08
A0C005F1ECEF59244AA69250000000049454E44AE426082 }
end
end

168
d_examples/toolbar/resource.tfm/e_toolbarmain.tfm
View File

@ -1,168 +0,0 @@
object e_toolbarmain1:e_toolbarmain
caption="묏야으렀절"
height=520.0
left=429
onclose=e_toolbarmain1_close
top=236
width=664
object toolbar1:ttoolbar
caption="toolbar1"
height=29
imagelist=controlimagelist1
width=648
object toolbutton1:ttoolbutton
caption="객큐1"
imageid=0
onclick=toolbaritemclick
end
object toolbutton2:ttoolbutton
caption="객큐2"
imageid=1
onclick=toolbaritemclick
end
object toolbutton3:ttoolbutton
caption="객큐3"
imageid=2
onclick=toolbaritemclick
end
object toolbutton4:ttoolbutton
caption="toolbutton4"
imageid=4
onclick=toolbaritemclick
end
object toolbutton5:ttoolbutton
caption="toolbutton5"
imageid=3
onclick=toolbaritemclick
end
end
object controlimagelist1:tcontrolimagelist
left=84
top=114
images={ 0502000000060400000074797065000204000000626D707300060500000069746
56D73000505000000000000000005020000000604000000747970650002030000
00696D670006040000006461746100029F02000089504E470D0A1A0A0000000D4
948445200000020000000200806000000737A7AF4000000017352474200AECE1C
E90000000467414D410000B18F0BFC6105000000097048597300000EC300000EC
301C76FA86400000234494441545847ED96CDCB69511487EF5F6BC25061A048C9
409181C840182829C554664AEFC04C0C0C64A0440626C8E0DC9E75D73E6DC7E1E
55EEE3BF1D41A9CB5D6DEFB77F6C7DAFB97F3C37C047C045C08C866B34E201078
DA686768341ABE39582C1693B8CD4B056CB75BDFB8D77ABD9EE4C34B9760381CC
A00D56A553D97CC663389472211F5BC588099C16EB7AB9E4BCEE7B3C483C1A07A
3C0268C83A91F4B7964C269DC3E1A03D5EB2DFEF25271C0EABC712C0BA783B7BD
6CAE5B233994CB4C76BD6EBB5E4C5E371F55802581782ACD3BB582C1632463A9D
568F2520140A49F0743AA9E7F54CA753192397CBA9C712108D4625B8DBEDD4F31
85F5F5FCE6834D2AFFB8CC76319A3542AA9C712904AA524B85C2ED5F318DFED7C
1B734C6BB59A7A2C01F97C5E82F736911FABD5CA4924120F89E8F7FB92D76AB5D
46309A8542A12644A6FC1F16293FA99116157392FE6A4D9425D01CD66538283C1
403DD79829FCCE10E4077F4E9C9930B802FCD479A1D613B78D7658A15090F6C56
251B3AF61EDC9E1470CAE00FE9C2033F12CF57A5DDAB28F8EC7A37AAF61F793C7
6930B802587B82EC8567E8743AD22E93C948A9BD07E79F5CEA81C115C0EE377FF
128F3F95CDA50FF379B8D7A6F4305249F8A68700570FE09520F9E816378EBF2F1
C21DC018DC0906570015902015F15D700B3286BD54AE00EE0082DC09EF8277006
3F02E30B802E09D37227DD2B7FD1A820B019C6B92DE69ED765B47FBC3850040C4
BFBE8AFC8C3E79B078B912F0BFF908F861018EF31BE3A64DABEA5772560000000
049454E44AE426082000001000000050200000006040000007479706500020300
0000696D67000604000000646174610002D303000089504E470D0A1A0A0000000
D49484452000000300000003008060000005702F987000000017352474200AECE
1CE90000000467414D410000B18F0BFC6105000000097048597300000EC300000
EC301C76FA86400000368494441546843ED98DB4B14511CC7FB837AEB35287A08
0A8A1E844088EA2108C948222822BAA0629682742122C9D0BC84B5A246E135EFB
AAEAB99AD46522A5B5E482C5371E7F66DCECE6FDCD9F1CCECCD7194F6035FD839
F33D737EDFD939672E7BB0CB4907709B74002EBF2781BA1380AF981A9CC39900A
3CF80B2BD9A825DD4E80CD60116C781F76781E6F3407B0ED07915E8BD050CE403
83F701FF03400E91D904EBA70718794C8D26E687D4639400DE42A03F0FE8BE017
45C01DAB281A6735ADBCA2C99ADB10E507B3852044FC38FC8C8C118C0CEC74E8E
F198668D9591D11AEB00BC031AB530A2F9E687B5B3CCC48A653207304BE75369F
431CD327A2D482E407D069954DE66F23D769A6ED6FA2E06F8FB753916C0B8BAD4
1CE47BEC345E499D553CC7F81E26C702B009AE136BAEF0642CCC5BC0F7303912C
0739C0CC4DF2030EB4D4C46D8366F1C266702A87FF95632DDC21F87C99100E5FB
B4FB81F9AC26A3892AE0F511FE384C8ECD81ED523A80DB4A07705BE900B1F4EA9
0F640C65B22EDE4BDCB3F9E598E07E8CB257312189F58ADE47880EEEB644E1061
75870460626F506CA04414EF2338F3C6E03F9FC44E2B1D201EB117733650228A6
70233316F0C520BD0758DCC49102B04BB57C4416A01D87B41B2D8050854904943
595A53975E99B6A249FD12B25B46F5CF2D66597D0FAADA0FCCB453012A7FD6211
67E4028A31CA153D5106BE8538E819D33891B4F024B5F69700DB1C2AF156F90DC
33457B35764600F6E992DD9D09A92100B1A43BFC5B2CEE8C0A209CA98132F92BB
C8FE17E005F110DA8A228109F0E6C142B95F9A02CAC40C8AE8B0A2116755207B7
034C54D3606AED3F9721DC6E8E2A9489FD1BF2F08F4DED3AEE04A83E0004B54B8
4C10A14B23C9B8AD425F74D43F28C6D6C4BE57EEAE95680858F34885AFCBB2F51
C572755ABDEE3FCF417CD803E9C510F5D4D8FE006F8ED200EA65E30B42BCD9145
E1EB9851B245CAA8732B3443D236C7F00C34B9058EA8570B911CAE22AC47B1DDC
C299C4DC56286B02F58AC6850077680035405EAB56A05A3C96D7C361CCC54B4FF
AC9CDC73A40DB457E01A9AA258B0600421722CBA3F4D20F796C0EA1CCCA485BED
2839ADB10EC0E0BD906F8508BD505D72D77708EA9C608F0D72C73772D9631FC06
1E4DE2948CF072116B443C8698090590531BF0D72609E1CB17135C056900EE036
BB3C00F00FB4FD2774447C293D0000000049454E44AE426082000002000000050
2000000060400000074797065000203000000696D670006040000006461746100
02DB02000089504E470D0A1A0A0000000D4948445200000020000000200806000
000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0BFC
6105000000097048597300000EC300000EC301C76FA8640000027049444154584
7D596CB6A2A411086CF0BBA72A3A851541414043722EE44111782BAF182260441
B7826F6188E015DCB81111172AC4B55087BFE89E8CE3CCD8E6C484F341914A55F
7F43F5D3DD5FEA15FE6FF13301C0EA95AAD92C7E32197CB45D1689452A914F5FB
7DDA6EB762943ACA0276BB1D65B35972381CB6562814E870388859B7511230994
C281C0EF3028944823A9D0EAD562B91253A1E8FD4EBF5C8EFF7F398582C46F3F9
5C64EDB92960B3D9F076E3C1E572993E3E3E44E61A942097CB69BBB15C2E45C69
A9B02506F3CAC56AB89C86DBADD2ECF29954A22628DAD80E974CA0F72BBDDBC13
AAA024B21CEFEFEF226A8EAD80F57A4DF1789CDFE85E702620A05EAFF3FFFBFD9
E4EA713FB7A940EE13D542A150A8542D46AB558402693E15D808F9731F2ED02DA
ED362F260DE583C137DB495301AFAFAF6C5F452FC2E974F25F7C41665C09188D4
6DA64F85F65301868CF49A7D3743E9F45E6922B01B27630F8FFC2DBDB1B6F3BBA
A8155702D0DBA500F88FE642C0783CE6859F9E9ED8E023F6482E04BCBCBCF0A2C
D66930D3E62F780CF0EF3A4A121E5F37991BDE64280BC707091C0E023760FFAC5
8D66862660369BF1A060302822C43E62C8A9625C0CDD54DE0DC56251443FD1043
C3F3F6B938D869C2A728E1E79A7F87C3E11F94413100804B4C946434E153947CF
4D018BC582074422110EEA410C398C51C12800259017936509E489470B3522DB2
AC6A820059899D9D7C002BC5E2F0F306BBDB235638C0AFA05AD4C0F0BC0AFDA46
A3C1013392C9247FDF2A982D02ACBE06ED107E17560280D961FC5101D805E4D01
D253F26006F2F4BA03F8C0F1360677ABE5D80F1329286BADBB6E2DFE2970510FD
05E1AD4F7F1B5448FE0000000049454E44AE42608200000300000005020000000
60400000074797065000203000000696D67000604000000646174610002F80200
0089504E470D0A1A0A0000000D4948445200000020000000200806000000737A7
AF4000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000
00097048597300000EC300000EC301C76FA8640000028D494441545847C5973D6
814411480B7B25050045B259D8595A0A5550AB5B00A626163255A5A5B28B676E9
2C14091A8B84E01F88281844A208FE8128722268E7DE9D5E363197E4923CF79B9
BB7EEE6CE9DD9BDD3FD608ED937F3E6BD9B7DF3DE6C209EB456D665E2735BC69E
B464FFDDA6EC996AC8D61BA169F4919D989D9799AFCB12AD6E582D374E073EB43
A72F679243B26EB125CFF6EDA968950764FD5E5C0BDA669F491E9F8CEC9D0E8A0
EB22D781F3AF1765FBCDAEE1C38F7ECA85370B3217AEDAD15E5E353A72F9FD2F3
912CF45075DD6C8E3AF0E1C9F6D9945F6CE34E46AAD6DA5FEA0832E6B1C7AF0C3
4A7BE9EBC0C87457F14CBC8DF5F6BA9516075DFD23BB6E85569AA5C70126A2C07
60F8B934FE7CD9AFCB1CD641C60AB9888C2B0E10FB1363B9226718060E9376198
F04AB1910E4CE300C7858825680679E72E581B1BD8D2236A1CE0CCE259D1683FF
73232AD08D8C0163621206B91388EC667B7282C442B0A3985C446760D489D2C32
FE71C90EFB53D6818B6FBBF1466A0FC8DF3CD4A2353BEC4F5907C8A6E85157028
AC8B6B8A094A1AC0340EDC0764025EB97207C18C4010A18B603CAE9C1FB4D2B2E
C6200E5045B16D1CE0218F53CF22B34BD76AD940EDE70073988B4E1E89036C03D
B9187462DEDD2BB5416DBE400632A73D592E415100804848B2B9F9692C54FCFD9
24629F01993E33D74512847A0CB94CB8B8F36DD9242DE61F7BDCBD74A4FB8C31C
745E6186A22E226E3C38B7A47F6DD8E3DB7C6B52163CC07AD8C2611692AE61AE5
CB978535197DF86707E823F325938A119429468B9D0DF3DE69F47DE92946FC545
E8EA1D20B8952E9954CA9F452AA3011854AAEE58A2A123445AF6A800EBAAC51F8
C3442158885816F9EF9F660AC785335BC9C7699A7FF3792EF21B1F1CB3C87955C
3470000000049454E44AE42608200000400000005020000000604000000747970
65000203000000696D670006040000006461746100028E02000089504E470D0A1
A0A0000000D4948445200000020000000200806000000737A7AF4000000017352
474200AECE1CE90000000467414D410000B18F0BFC61050000000970485973000
00EC300000EC301C76FA86400000223494441545847ED972DAB024114860D824D
2C7693C560103409FA038C62B008828A3FC0EA57B268320882980D822206838A4
530F80BC42236ABC570EE3D7BE7EC9DFD9A9D5D96850BF78117768ECE99675777
56032049201080CD66C34662B2D92C9CCF673612232DF07ABD20994CB2D10FEFF
71B2E970B7C3E1F56F9A1DFEFB3237BA4059056AB05F3F91CDAED36643219E5AA
6082C120A4D369A8D7EB50AD56E1F97CB219F6480BDCEF77A8542AEAA25689442
2301C0ED92C7BA404F6FBBDE962A2148B45365B8CADC0E974825028A4344DA552
301E8F0D8BF1E16565246C054AA592DA1005ECAE06BE1E0E87D5F16432619DCC1
10ADC6E37F5ECDD06A5450805F01B6FD6D4691E8F07EB684428D068344C1B3A8D
6853D208D0AD869F2372381C6C733C1EA582E0FE81E1D108C46231D57A3A9D42A
7D3D19C89DBE009E11D41E372B9CC56E404F4DFEE5C2E07BD5E4F53731BB33B87
F04560B7DB196A84A5403E9FF74C60BBDD1A6A842F02EBF5DA50237C11582E978
61A2114E876BB9A9ADB2C160B438DF04560B55A196A842F02FADE184228E0E546
A4AF11BF47DFE0938BDE8093BC14A8D56AEA188F098DC0F57A85D168A44C4070D
FE61BB90DF6C3E7CC6C365382C78446408F9702560805F08A98357492783CCEBA
99231440D01E9F0B187D73AAEB5FA3DA6030605DACB115E0E117C11028C9D7717
159FE05FE960036365B04FF0BF202FADF7D221C09E0CE98482494E81769369B10
8D46A15028B08A0C005F1ECEF59244AA69250000000049454E44AE42608200 }
end
end

368
designer/ctl_mgr/resource.tfm/t_compile_config.tfm
View File

@ -1,368 +0,0 @@
object ed_script:t_compile_config
caption="编译选项设置"
height=681
left=618
minmaxbox=false
onclose=compile_config_close
top=180
width=502
wssizebox=true
object bt_ok:tbtn
caption="确定"
height=31
left=405
onclick=bt_ok_clk
parentcolor=false
top=582
width=55
end
object gp_dir:tgroupbox
caption="输入目录"
height=87
left=24
parentcolor=true
top=181
width=442
object bt_f_dir:tbtn
caption=".."
height=23
left=408
onclick=bt_f_dir_clk
top=20
width=24
end
object bt_s_dir:tbtn
caption="..."
height=23
left=408
onclick=bt_s_dir_clk
top=51
width=24
end
object label1:tlabel
left=14
top=20
width=68
height=23
caption="函数目录"
end
object ed_f_dirs:tedit
caption="edit1"
height=22
left=87
top=21
width=312
end
object label2:tlabel
left=13
top=51
width=60
height=23
caption="资源目录"
end
object ed_s_dirs:tedit
caption="edit2"
height=23
left=87
top=51
width=311
end
end
object gp_filter:tgroupbox
caption="筛选"
height=164
left=27
parentcolor=true
top=269
width=437
object lb_s_type:tlabel
left=11
top=20
width=92
height=25
caption="资源文件后缀"
end
object ed_s_type:tedit
caption="edit2"
height=27
left=112
text="*.tfm,*.ini"
top=20
width=290
end
object bt_i_f:tbtn
caption="..."
height=22
left=408
onclick=bt_i_f_clk
top=83
width=21
end
object bt_d_f:tbtn
caption="..."
height=21
left=408
onclick=bt_d_f_clk
top=136
width=21
end
object bt_i_s:tbtn
caption="..."
height=22
left=408
onclick=bt_i_s_clk
top=54
width=21
end
object label3:tlabel
left=13
top=51
width=61
height=25
caption="指定资源"
end
object ed_include_s:tedit
caption="edit1"
height=25
left=84
top=52
width=317
end
object label4:tlabel
left=11
top=83
width=63
height=25
caption="指定函数"
end
object ed_include_f:tedit
caption=""
height=23
left=84
top=83
width=317
end
object label5:tlabel
left=12
top=133
width=61
height=25
caption="排除函数"
end
object ed_exclude_f:tedit
caption=""
height=22
left=84
top=136
width=317
end
object lb_tsg:tlabel
left=11
top=106
width=63
height=25
caption="tsg库"
end
object ed_tsg:tedit
caption="edit1"
height=22
left=84
top=111
width=318
end
object bt_tsgadd:tbtn
caption="..."
height=21
left=408
onclick=bt_tsgadd_clk
top=111
width=21
end
end
object gp_out:tgroupbox
caption="输出"
height=123
left=27
parentcolor=true
top=48
width=433
object lb_ype:tlabel
left=14
top=17
width=53
height=25
caption="类型"
end
object cb_type:tcombobox
caption="combobox1"
height=23
itemindex=0
items=["执行程序" "动态库" tsg ]
left=79
onselchanged=cb_type_sel
top=18
width=131
end
object lb_output:tlabel
left=13
top=45
width=46
height=25
caption="输出"
end
object ed_output:tedit
caption="edit1"
height=25
left=79
placeholder="输出文件"
top=48
width=320
end
object bt_output:tbtn
caption="..."
enabled=false
height=23
left=404
onclick=bt_output_clk
top=86
width=22
end
object bt_outputname:tbtn
caption="..."
height=25
left=404
onclick=bt_outputname_clk
top=48
width=22
end
object lb_output_f:tlabel
left=14
top=83
width=60
height=25
caption="输出函数"
end
object ed_out_f:tedit
caption="edit1"
height=25
left=79
top=86
width=320
end
end
object bt_cancel:tbtn
caption="取消"
height=31
left=332
onclick=bt_cancel_clk
top=582
width=55
end
object gp_other:tgroupbox
caption="其他"
height=129
left=27
parentcolor=true
top=440
width=437
object ck_gui:tcheckbtn
caption="gui"
height=25
left=17
top=25
width=75
end
object ck_strong:tcheckbtn
caption="强引用函数"
height=25
left=122
onclick=checkbtn2_clk
top=25
width=98
end
object ck_s_rp:tcheckbtn
caption="资源文件保留相对路径"
enabled=false
height=25
left=253
top=25
width=173
end
object lb_ico:tlabel
left=17
top=59
width=66
height=25
caption=" 图 标:"
end
object ed_ico:tedit
caption="edit3"
height=25
left=94
top=58
width=277
end
object bt_ico:tbtn
caption="..."
height=25
left=386
onclick=bt_ico_clk
top=58
width=22
end
object l_namespace:tlabel
left=17
top=93
width=75
height=25
caption="namespace:"
end
object e_namespace:tedit
caption="edit1"
height=25
left=94
top=93
width=278
end
end
object f_op:topenfileadlg
left=15
top=575
height=30
width=30
caption="openfileadlg1"
filter=<
"ico图标"="*.ico"
>
end
object lb_input:tlabel
left=32
top=16
width=63
height=25
caption="主程序"
end
object e_script:tedit
caption="edit1"
height=25
left=98
top=16
width=331
end
object bt_script:tbtn
caption="..."
height=25
left=437
onclick=bt_script_clk
top=16
width=22
end
object bt_cmd:tbtn
caption="命令行"
height=31
left=208
onclick=bt_cmd_clk
top=582
width=92
end
end

18
designer/ctl_mgr/resource.tfm/t_bconfig_cmd_shower.tfm → designer/ctl_mgr/t_bconfig_cmd_shower.tfm
View File

@ -1,23 +1,23 @@
object bconfig_cmd_shower:t_bconfig_cmd_shower
caption="ÃüÁîÐÐ"
height=250
height=263
left=610
minmaxbox=false
onclose=bconfig_cmd_shower_close
top=406
width=508
width=546
object panel1:tpanel
align=albottom
caption="panel1"
height=45
left=0
parentcolor=true
top=166
width=492
top=179
width=530
wsdlgmodalframe=false
object bt_ok:tbtn
caption="Íê³É"
height=26
height=33
left=406
onclick=btn1_clk
top=8
@ -25,8 +25,8 @@ object bconfig_cmd_shower:t_bconfig_cmd_shower
end
object bt_copy:tbtn
caption="¸´ÖÆ"
height=26
left=291
height=33
left=253
onclick=bt_copy_clk
top=8
width=94
@ -36,11 +36,11 @@ object bconfig_cmd_shower:t_bconfig_cmd_shower
align=alclient
autogutterwidth=true
caption="memo1"
height=211
height=179
left=0
readonly=true
top=0
width=492
width=530
end
object cpbord:tclipboard
left=211

122
designer/ctl_mgr/t_code_format_mgr.tfm Normal file
View File

@ -0,0 +1,122 @@
object codeformateditor:t_code_format_mgr
autosize=true
caption="tsl代码格式化参数"
childsizing=<
layout=1
controlsperline=2
horizontalspacing=10
verticalspacing=10
leftrightspacing=20
topbottomspacing=10
>
font=<
height=19
width=9
escapement=0
orientation=0
weight=400
italic=0
underline=0
strikeout=0
charset=134
outprecision=3
clipprecision=2
quality=1
pitchandfamily=49
facename="新宋体"
color=0
>
height=90
left=547
minmaxbox=false
onclose=tformatinfownd1_close
parentfont=false
top=277
width=449
wssizebox=false
object label1:tlabel
left=20
top=10
width=128
height=22
autosize=true
caption="多行注释对齐"
end
object faligncmt:tcheckbtn
autosize=false
caption=""
height=22
left=158
parentcolor=true
top=10
width=110
end
object label3:tlabel
left=20
top=42
width=128
height=22
autosize=true
caption="array格式化"
end
object farraytype:tcombobox
autosize=true
height=22
itemindex=1
items=["默认" "普通" "宽松" ]
left=158
top=42
width=110
end
object label4:tlabel
left=20
top=74
width=128
height=22
autosize=true
caption="语法检查"
end
object fsyncheck:tcheckbtn
caption=""
checked=true
height=22
left=158
parentcolor=true
top=74
width=110
end
object label5:tlabel
left=20
top=106
width=128
height=22
autosize=true
caption="格式化选择区域"
end
object fselectcheck:tcheckbtn
caption=""
height=22
left=158
parentcolor=true
top=106
width=110
end
object label2:tlabel
left=20
top=138
width=128
height=22
caption=""
end
object btn1:tbtn
autosize=true
caption="确定"
height=22
left=158
onclick=dookclick
top=138
width=110
end
end

62
designer/ctl_mgr/t_code_format_mgr.tsf Normal file
View File

@ -0,0 +1,62 @@
type t_code_format_mgr=class(tdcreateform)
uses tslvcl;
label1:tlabel;
label2:tlabel;
label3:tlabel;
label4:tlabel;
label5:tlabel;
faligncmt:tcombobox;
fcharct:tcombobox;
farraytype:tcombobox;
fsyncheck:tcheckbtn;
fselectcheck:tcheckbtn;
btn1:tbtn;
function Create(AOwner);override;//构造
begin
inherited;
end
function DoOKClick(o;e);virtual;
begin
calldatafunction(FOnOkClick,self,e);
end
function tformatinfownd1_close(o;e);virtual;
begin
e.skip := true;
o.Visible := false;
end
function Recycling();override;//回收变量
begin
inherited;
ci := self.classinfo();
//将成员变量赋值为nil避免循环引用
for i,v in ci["members"]do
begin
invoke(self,v["name"],nil);
end
end
function GetData();
begin
r := array();
r["cmt"]:= faligncmt.Checked;
r["arraytype"]:= array("普通":1,"默认":0,"宽松":3)[farraytype.getCurrentItemText()];
r["syn"]:= fsyncheck.checked;
r["sel"]:= fselectcheck.checked;
return r;
end
function SetData(d);
begin
//"50" "80" "100" "130"
// "50" "100" "130" "150" "200" "250" "300"
//"默认" "普通" "宽松"
if ifarray(d) then
begin
faligncmt.Checked := (d["cmt"]=1);
farraytype.ItemIndex := (array(0:0,1:1,3:2))[d["arraytype"]];
fsyncheck.Checked := d["syn"];
fselectcheck.Checked := d["sel"];
end
end
property OnOkClicked read FOnOkClick write FOnOkClick;
private
[weakref] FOnOkClick;
end

556
designer/ctl_mgr/t_compile_config.tfm Normal file
View File

@ -0,0 +1,556 @@
object ed_script:t_compile_config
autosize=true
caption="编译选项设置"
childsizing=<
layout=2
controlsperline=10
horizontalspacing=10
verticalspacing=10
leftrightspacing=10
topbottomspacing=10
>
height=562
left=638
minmaxbox=false
onclose=compile_config_close
top=208
width=488
wssizebox=true
object panel1:tpanel
autosize=true
caption="panel1"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=2
leftrightspacing=2
topbottomspacing=2
>
height=25
left=10
top=10
width=452
wsdlgmodalframe=false
object lb_input:tlabel
left=2
top=2
width=44
height=21
autosize=true
caption="主程序"
end
object e_script:tedit
autosize=true
caption="edit1"
height=21
left=48
top=2
width=331
end
object bt_script:tbtn
autosize=true
caption=".."
height=21
left=381
onclick=bt_script_clk
top=2
width=28
end
end
object gp_out:tgroupbox
autosize=true
caption="输出"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=10
leftrightspacing=2
topbottomspacing=2
>
height=94
left=10
parentcolor=true
top=45
width=452
object lb_ype:tlabel
left=6
top=21
width=58
height=21
autosize=true
caption="类型"
textalign=al9_centerright
end
object cb_type:tcombobox
autosize=true
caption="combobox1"
height=21
itemindex=0
items=["执行程序" "动态库" tsg ]
left=74
onselchanged=cb_type_sel
top=21
width=324
end
object label6:tlabel
left=408
top=21
width=28
height=21
autosize=true
caption=""
end
object lb_output:tlabel
left=6
top=44
width=58
height=21
autosize=true
caption="输出"
textalign=al9_centerright
end
object ed_output:tedit
autosize=true
caption="edit1"
height=21
left=74
placeholder="输出文件"
top=44
width=324
end
object bt_outputname:tbtn
autosize=true
caption=".."
height=21
left=408
onclick=bt_outputname_clk
top=44
width=28
end
object lb_output_f:tlabel
left=6
top=67
width=58
height=21
autosize=true
caption="输出函数"
textalign=al9_centerright
end
object ed_out_f:tedit
autosize=true
caption="edit1"
height=21
left=74
top=67
width=324
end
object bt_output:tbtn
autosize=true
caption=".."
enabled=false
height=21
left=408
onclick=bt_output_clk
top=67
width=28
end
end
object gp_dir:tgroupbox
autosize=true
caption="输入目录"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=2
leftrightspacing=2
topbottomspacing=2
>
height=73
left=10
parentcolor=true
top=149
width=452
object label1:tlabel
left=6
top=21
width=58
height=23
autosize=true
caption="函数目录"
end
object ed_f_dirs:tedit
autosize=true
caption="edit1"
height=23
left=66
top=21
width=312
end
object bt_f_dir:tbtn
autosize=true
caption=".."
height=23
left=380
onclick=bt_f_dir_clk
top=21
width=28
end
object label2:tlabel
left=6
top=46
width=58
height=21
autosize=true
caption="资源目录"
end
object ed_s_dirs:tedit
autosize=true
caption="edit2"
height=21
left=66
top=46
width=312
end
object bt_s_dir:tbtn
autosize=true
caption=".."
height=21
left=380
onclick=bt_s_dir_clk
top=46
width=28
end
end
object gp_filter:tgroupbox
autosize=true
caption="筛选"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=2
leftrightspacing=2
topbottomspacing=2
>
height=139
left=10
parentcolor=true
top=232
width=452
object lb_s_type:tlabel
left=6
top=21
width=86
height=20
autosize=true
caption="资源文件后缀"
end
object ed_s_type:tedit
autosize=true
caption="edit2"
height=20
left=94
text="*.tfm,*.ini"
top=21
width=322
end
object label7:tlabel
left=418
top=21
width=28
height=20
autosize=true
caption=""
end
object label3:tlabel
left=6
top=43
width=86
height=21
autosize=true
caption="指定资源"
textalign=al9_centerright
end
object ed_include_s:tedit
autosize=true
caption="edit1"
height=21
left=94
top=43
width=322
end
object bt_i_s:tbtn
autosize=true
caption=".."
height=21
left=418
onclick=bt_i_s_clk
top=43
width=28
end
object label4:tlabel
left=6
top=66
width=86
height=21
autosize=true
caption="指定函数"
textalign=al9_centerright
end
object ed_include_f:tedit
autosize=true
caption=""
height=21
left=94
top=66
width=322
end
object bt_i_f:tbtn
autosize=true
caption=".."
height=21
left=418
onclick=bt_i_f_clk
top=66
width=28
end
object lb_tsg:tlabel
left=6
top=89
width=86
height=21
autosize=true
caption="tsg库"
textalign=al9_centerright
end
object ed_tsg:tedit
autosize=true
caption="edit1"
height=21
left=94
top=89
width=322
end
object bt_tsgadd:tbtn
autosize=true
caption=".."
height=21
left=418
onclick=bt_tsgadd_clk
top=89
width=28
end
object label5:tlabel
left=6
top=112
width=86
height=21
autosize=true
caption="排除函数"
textalign=al9_centerright
end
object ed_exclude_f:tedit
autosize=true
caption=""
height=21
left=94
top=112
width=322
end
object bt_d_f:tbtn
autosize=true
caption=".."
height=21
left=418
onclick=bt_d_f_clk
top=112
width=28
end
end
object gp_other:tgroupbox
autosize=true
caption="其他"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=2
leftrightspacing=2
topbottomspacing=2
>
height=97
left=10
parentcolor=true
top=381
width=452
object label9:tlabel
left=6
top=21
width=65
height=25
autosize=true
caption=""
end
object panel3:tpanel
autosize=true
caption="panel3"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=2
leftrightspacing=2
topbottomspacing=2
>
height=25
left=73
top=21
width=316
wsdlgmodalframe=false
object ck_gui:tcheckbtn
autosize=true
caption="gui"
height=21
left=2
top=2
width=56
end
object ck_strong:tcheckbtn
autosize=true
caption="强引用函数"
height=21
left=60
onclick=checkbtn2_clk
top=2
width=105
end
object ck_s_rp:tcheckbtn
autosize=true
caption="资源保留相对路径"
enabled=false
height=21
left=167
top=2
visible=false
width=147
end
end
object label10:tlabel
left=391
top=21
width=28
height=25
autosize=true
caption=""
end
object lb_ico:tlabel
left=6
top=48
width=65
height=21
autosize=true
caption="图标"
textalign=al9_centerright
end
object ed_ico:tedit
autosize=true
caption="edit3"
height=21
left=73
top=48
width=316
end
object bt_ico:tbtn
autosize=true
caption=".."
height=21
left=391
onclick=bt_ico_clk
top=48
width=28
end
object l_namespace:tlabel
left=6
top=71
width=65
height=20
autosize=true
caption="namespace"
end
object e_namespace:tedit
autosize=true
caption="edit1"
height=20
left=73
top=71
width=316
end
object label8:tlabel
left=391
top=71
width=28
height=20
autosize=true
caption=""
end
end
object f_op:topenfileadlg
left=473
top=14
height=30
width=30
caption="openfileadlg1"
filter=<
"ico图标"="*.ico"
>
end
object panel2:tpanel
autosize=true
caption="panel2"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=2
verticalspacing=50
leftrightspacing=50
topbottomspacing=2
>
height=25
left=10
top=488
width=452
wsdlgmodalframe=false
object bt_cmd:tbtn
autosize=true
caption="命令行"
height=21
left=50
onclick=bt_cmd_clk
top=2
width=56
end
object bt_cancel:tbtn
autosize=true
caption="取消"
height=21
left=156
onclick=bt_cancel_clk
top=2
width=42
end
object bt_ok:tbtn
autosize=true
caption="确定"
height=21
left=248
onclick=bt_ok_clk
parentcolor=false
top=2
width=42
end
end
end

58
designer/ctl_mgr/t_compile_config.tsf
View File

@ -1,6 +1,6 @@
type t_compile_config=class(tdcreateform)
uses tslvcl;
bt_ok:tbtn;
gp_dir:tgroupbox;
bt_f_dir:tbtn;
bt_s_dir:tbtn;
@ -14,20 +14,20 @@ type t_compile_config=class(tdcreateform)
cb_type:tcombobox;
lb_output:tlabel;
ed_output:tedit;
bt_cancel:tbtn;
gp_other:tgroupbox;
ck_gui:tcheckbtn;
ck_strong:tcheckbtn;
ck_s_rp:tcheckbtn;
bt_i_s:tbtn;
lb_ico:tlabel;
ed_ico:tedit;
bt_ico:tbtn;
bt_output:tbtn;
f_op:topenfileadlg;
lb_input:tlabel;
e_script:tedit;
bt_script:tbtn;
bt_outputname:tbtn;
lb_output_f:tlabel;
ed_out_f:tedit;
@ -44,9 +44,26 @@ type t_compile_config=class(tdcreateform)
lb_tsg:tlabel;
ed_tsg:tedit;
bt_tsgadd:tbtn;
bt_cmd:tbtn;
l_namespace:tlabel;
e_namespace:tedit;
panel1:tpanel;
lb_input:tlabel;
e_script:tedit;
bt_script:tbtn;
panel2:tpanel;
bt_cmd:tbtn;
bt_cancel:tbtn;
bt_ok:tbtn;
label6:tlabel;
label7:tlabel;
panel3:tpanel;
ck_gui:tcheckbtn;
ck_strong:tcheckbtn;
ck_s_rp:tcheckbtn;
label8:tlabel;
label9:tlabel;
label10:tlabel;
function Create(AOwner);override; //¹¹Ôì
begin
f_sep := iofileseparator();
@ -78,7 +95,7 @@ type t_compile_config=class(tdcreateform)
function bt_tsgadd_clk(o;e);virtual;
begin
tp := array("tsg¿â":"*.tsg");
if show_dir_list(s_to_array(ed_tsg.text,true),tp)then
if show_dir_list(s_to_array(ed_tsg.text,true),tp,"tsg库目录")then
begin
ed_tsg.text := array_to_s(dir_list.get_dirs(),true);
end
@ -166,6 +183,7 @@ type t_compile_config=class(tdcreateform)
function bt_outputname_clk(o;e);virtual;
begin
f_op.filter := array(get_type():"*"+get_type());
f_op.Caption := "输出文件名";
if f_op.OpenDlg()then
begin
ed_output.text :=relative_path( f_op.filename);
@ -184,6 +202,7 @@ type t_compile_config=class(tdcreateform)
function bt_script_clk(o;e);virtual;
begin
f_op.filter := array("tsl½Å±¾":"*.tsf;*.tsl");
f_op.Caption := "入口脚本";
if f_op.OpenDlg()then
begin
e_script.text := relative_path( f_op.filename);
@ -193,6 +212,7 @@ type t_compile_config=class(tdcreateform)
function bt_ico_clk(o;e);virtual;
begin
f_op.filter := array("icoͼ±ê":"*.ico");
f_op.Caption := "图标文件";
if f_op.OpenDlg()then
begin
ed_ico.text := relative_path( f_op.filename);
@ -200,28 +220,28 @@ type t_compile_config=class(tdcreateform)
end
function bt_d_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_exclude_f.text))then
if show_m_editor(s_to_array(ed_exclude_f.text),"排除函数")then
begin
ed_exclude_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_f.text))then
if show_m_editor(s_to_array(ed_include_f.text),"指定函数")then
begin
ed_include_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_s_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_s.text))then
if show_m_editor(s_to_array(ed_include_s.text),"指定资源")then
begin
ed_include_s.text := array_to_s(m_list_editor.get_data());
end
end
function bt_output_clk(o;e);
begin
if show_m_editor(s_to_array(ed_out_f.text))then
if show_m_editor(s_to_array(ed_out_f.text),"输出函数")then
begin
ed_out_f.text := array_to_s(m_list_editor.get_data());
end
@ -229,14 +249,14 @@ type t_compile_config=class(tdcreateform)
function bt_s_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_s_dirs.text,true))then
if show_dir_list(s_to_array(ed_s_dirs.text,true),nil,"资源目录")then
begin
ed_s_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
end
function bt_f_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_f_dirs.text,true))then
if show_dir_list(s_to_array(ed_f_dirs.text,true),nil,"函数目录")then
begin
ed_f_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
@ -257,19 +277,21 @@ type t_compile_config=class(tdcreateform)
invoke(self,v["name"],nil);
end
end
function show_dir_list(data,filetype);
function show_dir_list(data,filetype,cp);
begin
dir_list.Left := Left-20;
dir_list.top := top+50;
dir_list.set_dirs(data);
dir_list.fopentype := filetype;
if ifstring(cp) then dir_list.Caption := cp;
return dir_list.ShowModal();
end
function show_m_editor(data);
function show_m_editor(data,cp);
begin
m_list_editor.Left := Left-20;
m_list_editor.top := top+50;
m_list_editor.set_data(data);
if ifstring(cp) then m_list_editor.Caption := cp;
return m_list_editor.ShowModal();
end
function enabled_script_input(f);

12
designer/ctl_mgr/resource.tfm/t_dir_list.tfm → designer/ctl_mgr/t_dir_list.tfm
View File

@ -1,12 +1,12 @@
object dir_list:t_dir_list
caption="Ŀ¼¹ÜÀí"
height=228
height=239
left=513
minmaxbox=false
onclose=dir_list_close
top=475
visible=false
width=615
width=643
object lst_dir:tlistbox
caption="listbox1"
height=176
@ -16,7 +16,7 @@ object dir_list:t_dir_list
end
object btn_add:tbtn
caption="Ìí¼Ó"
height=31
height=36
left=496
onclick=btn_add_clk
top=5
@ -24,7 +24,7 @@ object dir_list:t_dir_list
end
object btn_del:tbtn
caption="ɾ³ý"
height=31
height=35
left=496
onclick=btn_del_clk
top=50
@ -32,10 +32,10 @@ object dir_list:t_dir_list
end
object btn_ok:tbtn
caption="Íê³É"
height=31
height=40
left=496
onclick=btn_ok_clk
top=146
top=137
width=86
end
object f_d:tfolderchooseadlg

16
designer/ctl_mgr/resource.tfm/t_editor_color_mgr.tfm → designer/ctl_mgr/t_editor_color_mgr.tfm
View File

@ -19,7 +19,7 @@ object ditor_color_mgr:t_editor_color_mgr
color=0
>
height=382
height=385
left=645
minmaxbox=false
onclose=edtcolormain1_close
@ -35,6 +35,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox1_onselchanged
top=18
width=132
parentfont=false
end
object listbox1:tlistbox
caption="listbox1"
@ -55,6 +56,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox2_onselchanged
top=18
width=177
parentfont=false
end
object openfileadlg1:topenfileadlg
left=314
@ -78,7 +80,7 @@ object ditor_color_mgr:t_editor_color_mgr
leftrightspacing=20
topbottomspacing=10
>
height=39
height=42
left=5
top=304
width=352
@ -86,7 +88,7 @@ object ditor_color_mgr:t_editor_color_mgr
object btn4:tbtn
autosize=true
caption="导入"
height=19
height=22
left=20
onclick=import_clk
top=10
@ -95,7 +97,7 @@ object ditor_color_mgr:t_editor_color_mgr
object btn5:tbtn
autosize=true
caption="导出"
height=19
height=22
left=78
onclick=export_clk
top=10
@ -104,7 +106,7 @@ object ditor_color_mgr:t_editor_color_mgr
object btn3:tbtn
autosize=true
caption="还原默认"
height=19
height=22
left=136
onclick=btn3_clk
top=10
@ -113,7 +115,7 @@ object ditor_color_mgr:t_editor_color_mgr
object btn1:tbtn
autosize=true
caption="取消"
height=19
height=22
left=226
onclick=btn1_clk
top=10
@ -122,7 +124,7 @@ object ditor_color_mgr:t_editor_color_mgr
object btn2:tbtn
autosize=true
caption="确定"
height=19
height=22
left=284
onclick=btn2_clk
top=10

6
designer/ctl_mgr/t_editor_color_mgr.tsf
View File

@ -21,6 +21,7 @@ type t_editor_color_mgr=class(tdcreateform)
listbox1.Items := fcolorindexname;
listbox1.ItemIndex := 1;
listbox1.SelBkColor := listbox1.Color;
listbox1.onfontchanged := thisfunction(lfchanged);
end
function edtcolormain1_close(o;e);virtual;
begin
@ -64,7 +65,10 @@ type t_editor_color_mgr=class(tdcreateform)
listbox1.InvalidateRect(nil,false);
end
end
function lfchanged();
begin
listbox1.ItemHeight := font.Height+5;
end
function btn1_clk(o;e);virtual;
begin
EndModal(0);

10
designer/ctl_mgr/resource.tfm/t_editor_config.tfm → designer/ctl_mgr/t_editor_config.tfm
View File

@ -114,7 +114,7 @@ object editor_config:t_editor_config
leftrightspacing=10
topbottomspacing=10
>
height=126
height=124
left=10
parentcolor=true
top=177
@ -176,7 +176,7 @@ object editor_config:t_editor_config
left=14
top=89
width=30
height=23
height=21
autosize=true
caption=""
end
@ -184,7 +184,7 @@ object editor_config:t_editor_config
left=54
top=89
width=41
height=23
height=21
autosize=true
caption=""
end
@ -192,7 +192,7 @@ object editor_config:t_editor_config
autosize=true
caption="´ÓÍ·Æ¥Åä"
checked=true
height=23
height=21
left=105
top=89
width=105
@ -202,7 +202,7 @@ object editor_config:t_editor_config
caption="panel1"
height=39
left=10
top=313
top=311
width=285
wsdlgmodalframe=false
object bt_ok:tbtn

18
designer/ctl_mgr/resource.tfm/t_function_finder.tfm → designer/ctl_mgr/t_function_finder.tfm
View File

@ -29,7 +29,7 @@ object functionfinder:t_function_finder
align=altop
autosize=true
caption="panel1"
height=35
height=41
left=0
top=0
width=804
@ -46,18 +46,18 @@ object functionfinder:t_function_finder
object btfind:tbtn
autosize=true
caption="ɸѡ"
height=22
left=281
height=25
left=284
onclick=btfind_clk
top=7
top=6
width=54
end
object ck_prev:tcheckbtn
autosize=true
caption="´ÓÍ·Æ¥Åä"
height=22
left=370
top=7
height=27
left=371
top=8
visible=true
width=111
end
@ -82,11 +82,11 @@ object functionfinder:t_function_finder
text="º¯Êý"
>
]
height=572
height=566
left=0
ondblclick=listfunc_ondblclick
popupmenu=popupmenu1
top=35
top=41
width=804
end
object popupmenu1:tpopupmenu

6
designer/ctl_mgr/resource.tfm/t_m_list_editor.tfm → designer/ctl_mgr/t_m_list_editor.tfm
View File

@ -11,14 +11,14 @@ object m_list_editor:t_m_list_editor
left=7
top=2
width=325
height=25
height=31
caption="采用换行分割"
end
object m_list:tmemo
caption="memo1"
height=378
height=371
left=9
top=31
top=38
width=328
end
object bt_cancel:tbtn

4
designer/ctl_mgr/resource.tfm/t_shortcut_keys_view.tfm → designer/ctl_mgr/t_shortcut_keys_view.tfm
View File

@ -19,11 +19,11 @@ object shortcut_keys_view:t_shortcut_keys_view
>
height=684
left=711
left=420
minmaxbox=false
onclose=shortcut_keys_view_close
parentfont=false
top=459
top=217
visible=false
width=590
object panel1:tpanel

32
designer/ctl_mgr/resource.tfm/textcompclassadder.tfm → designer/ctl_mgr/textcompclassadder.tfm
View File

@ -10,16 +10,16 @@ object extcompclassadder:textcompclassadder
object e_classname:tedit
caption="edit1"
height=25
left=91
left=99
readonly=true
top=28
width=255
width=247
end
object label1:tlabel
left=20
top=28
width=50
height=25
top=21
width=72
height=32
caption="控件类"
end
object b_classfile:tbtn
@ -33,41 +33,41 @@ object extcompclassadder:textcompclassadder
object label2:tlabel
left=20
top=72
width=64
height=25
width=65
height=33
caption="图标"
end
object p_imgshow:tpanel
caption="img"
height=187
height=195
left=91
top=120
top=107
width=245
wsdlgmodalframe=false
end
object b_img:tbtn
caption="添加图标"
height=25
left=91
left=100
onclick=b_img_clk
top=73
width=94
top=72
width=176
end
object b_ok:tbtn
caption="确定"
enabled=true
height=31
left=133
left=134
onclick=b_ok_clk
top=317
top=306
width=72
end
object b_cancel:tbtn
caption="取消"
height=31
left=283
left=271
onclick=b_cancel_clk
top=317
top=306
width=73
end
object f_open:topenfileadlg

18
designer/ctl_mgr/resource.tfm/textcompclassmgr.tfm → designer/ctl_mgr/textcompclassmgr.tfm
View File

@ -5,14 +5,14 @@ object extcompclassmgr:textcompclassmgr
minmaxbox=false
onclose=extcompclassmgr_close
top=272
width=477
width=484
wssizebox=true
object listbox1:tlistbox
caption="listbox1"
height=345
height=339
left=4
onselchanged=listbox1_sel
top=38
top=44
width=344
end
object b_del:tbtn
@ -21,7 +21,7 @@ object extcompclassmgr:textcompclassmgr
height=31
left=364
onclick=b_del_clk
top=248
top=224
width=88
end
object b_add:tbtn
@ -29,7 +29,7 @@ object extcompclassmgr:textcompclassmgr
height=31
left=364
onclick=b_add_clk
top=299
top=279
width=88
end
object b_ok:tbtn
@ -52,13 +52,13 @@ object extcompclassmgr:textcompclassmgr
]
left=0
top=403
width=461
width=468
end
object label1:tlabel
left=8
top=10
width=80
height=25
top=5
width=176
height=36
caption="¿Ø¼þÁбí"
end
end

30
designer/ctl_mgr/resource.tfm/tfm_inheritedwnd.tfm → designer/ctl_mgr/tfm_inheritedwnd.tfm
View File

@ -1,6 +1,6 @@
object fm_inheritedwnd:tfm_inheritedwnd
caption="通过继承构造窗口"
height=543
height=550
left=526
minmaxbox=false
onclose=fm_inheritedwnd_close
@ -11,7 +11,7 @@ object fm_inheritedwnd:tfm_inheritedwnd
caption="statusbar1"
height=25
left=0
top=479
top=486
width=417
end
object panel2:tpanel
@ -19,7 +19,7 @@ object fm_inheritedwnd:tfm_inheritedwnd
caption="panel2"
height=31
left=0
top=448
top=455
width=417
wsdlgmodalframe=false
object label1:tlabel
@ -27,8 +27,8 @@ object fm_inheritedwnd:tfm_inheritedwnd
top=0
width=18
height=31
caption=""
align=alright
caption=""
end
object ed_ok:tbtn
align=alright
@ -45,8 +45,8 @@ object fm_inheritedwnd:tfm_inheritedwnd
top=0
width=25
height=31
caption=" "
align=alright
caption=" "
end
object bt_cancel:tbtn
align=alright
@ -69,21 +69,21 @@ object fm_inheritedwnd:tfm_inheritedwnd
object label3:tlabel
left=0
top=0
width=85
width=149
height=27
caption="可以继承:"
align=alleft
caption="可以继承:"
end
object ed_search:tedit
align=alclient
caption="edit1"
height=27
left=85
left=149
onchanged=ed_search_onchanged
onkeyup=ed_search_keyup
placeholder="搜索"
top=0
width=332
width=268
end
end
object panel3:tpanel
@ -91,31 +91,31 @@ object fm_inheritedwnd:tfm_inheritedwnd
caption="panel1"
height=35
left=0
top=413
top=420
width=417
wsdlgmodalframe=false
object label4:tlabel
left=0
top=0
width=85
width=104
height=35
caption=" 名称:"
align=alleft
caption="名称:"
end
object ed_name:tedit
align=alclient
caption="edit1"
height=35
left=85
left=104
placeholder="名称"
top=0
width=332
width=313
end
end
object lbx_pal:tlistbox
align=alclient
caption="listbox1"
height=386
height=393
left=0
onselchanged=lbx_pal_sel
top=27

2
designer/gettsleditorstart.tsf
View File

@ -1,7 +1,6 @@
//启动tsl编辑器
//20230421 整理代码
uses tslvcl;
setprocessdpiawareness(2);
deletefuncacheini(); //清空缓存
ops := ""; //待打开文件
GLobal G_OpenHostory;
@ -92,6 +91,7 @@ begin
global g_dotsavehistory; //是否保存打开的历史记录
g_dotsavehistory := true;
end
setprocessdpiawareness(2);
app := initializeapplication();
app.createform(class(TRunEditorForm),fm);
fm.OpenAndGotoFileByName(ops);

38
designer/gettslvcldesignerstart.tsf
View File

@ -2,32 +2,46 @@
tsl界面设计器启动程序
}
uses tslvcl,utslvclDesigner;
setprocessdpiawareness(2);
deletefuncacheini();
oldlib := sysgettsllibpath();
isdebug := false;
willopen := "";
for i:= 0 to sysparamcount() do
i := 0;
ct := sysparamcount();
while i<=ct do
begin
if wait_filename then
begin
willopen := sysparamstr(i);
wait_filename := 0;
end else
if ("-tpj"=sysparamstr(i)) then
if ("-tpj"=sysparamstr(i)) then //´ò¿ª¹¤³Ì
begin
wait_filename := true;
i++;
if i<=ct then willopen := sysparamstr(i);
end else
if ("-DEBUGSERVER" = sysparamstr(i)) then
begin
isdebug := true;
break;
end
end else
if ("-libpath" = sysparamstr(i)) then //ÉèÖÃlibpahth
begin
i++;
if i<=ct then
begin
ph := sysparamstr(i);
if oldlib<>ph then
begin
try
syssettsllibpath(ph);
except
end;
end
end
end
i++;
end
deletefuncacheini();
h := FindWindowA("tsluidesigner_a_a_1",nil); //查找唯一窗口
if not(isdebug) and h then
begin
return PostMessageA(h,0x400,303,10);
end
setprocessdpiawareness(2);
app := InitializeApplication();
app.createform(class(TVclDesignerStart),Desginer);
Desginer.Show();

267
designer/teditorform.tsf
View File

@ -46,7 +46,8 @@ type teditorform = class(TVCform) //
const c_m_help = "帮助";
const c_m_manu = "使用手册";
const c_m_tsl_help = "tsl语言帮助";
const c_m_about = "关于";
const c_m_about = "关于";
const c_m_font = "字体图标大小";
function WMACTIVATE(o,e):WM_ACTIVATE;override; //激活
begin
inherited;
@ -97,6 +98,7 @@ type teditorform = class(TVCform) //
Fexefilepath := basepath+"editer"+sp+"tslfile.tsm";
FOpendpaths := basepath+"editer"+sp+"openedpaths.tsm";
FTabWidthpath := basepath+"editer"+sp+"tabwidpath.tsm";
Fsysfontpath := basepath+"editer"+sp+"sysfont.tsm";
FexefileCmds := basepath+"editer"+sp+"cmds.tsm";
FHistoryPath := basepath+"editer"+sp+"HistoryPath.tsm";
FCodeblockPath := basepath+"editer"+sp+"BlockManager.tsm";
@ -267,13 +269,16 @@ type teditorform = class(TVCform) //
FCodeBlockMenu.Parent := FTslLangMenu;
FTslFormatMenu.Parent := FTslLangMenu;
tbwidth := 4;
if importfile(ftstream(),"",FTabWidthpath,d)=1 and ( d>0 ) then
if importfile(ftstream(),"",FTabWidthpath,d)=1 and ( d>0 ) then //tab宽度
begin
tbwidth := d;
end
FMTabContain :=new TMenu(self);
fmshowhltediter :=new TMenu(self);
fmshowhltediter.caption := c_m_edit_color;
fmsysfont :=new TMenu(self);
fmsysfont.caption := c_m_font;
FMTabs := array();
FMTabContain.Caption := c_m_tab_config;
for i:= 0 to 6 do
@ -289,9 +294,13 @@ type teditorform = class(TVCform) //
end
FMTabContain.parent := FMenuSet;
fmshowhltediter.Parent := FMenuSet;
fmsysfont.Parent := FMenuSet;
fmshowhltediter.OnClick := function(o,e)begin
FEdter.showhltcolor();
end
fmsysfont.OnClick := function(o,e)begin
FEdter.modifysyssize();
end
mainmenu := m;
FmTool.parent := m;
FEnCodeMenu.parent := m;
@ -311,8 +320,7 @@ type teditorform = class(TVCform) //
FCloseMenu := new tmenu(self);
FCloseMenu.Caption:=c_m_close_min;
//FCloseMenu.Checked := true;
FCloseMenu.parent := FMenuSet;
//FCloseMenu.parent := FMenuSet;
FCloseMenu.OnClick := function(o,e)
begin
FCloseMenu.Checked := not(FCloseMenu.Checked);
@ -415,15 +423,18 @@ type teditorform = class(TVCform) //
FEdter.OnPageItemSelChanged := thisfunction(PageItemSelChanged);
FEdter.OnPageEditerChanged := thisfunction(PageEditerChanged);
FEdter.TslExe := tslexefile;
FEdter.align := alClient;
FEdter.align := alClient;
if (importfile(ftstream(),"",feditorglobalpath,ginfo)=1) and ifarray(ginfo) then
begin
global g_editer_font_size := ginfo["font"];
//FEdter.getpage().font := ginfo["font"];
//FEdter.getcodemap().font := ginfo["font"];
global editorglobalinfo ;
editorglobalinfo := ginfo;
if ifarray(ginfo) then
begin
app := initializeapplication();
app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
NotifyComponent(self,ginfo);
end
//Fdirview.addrootdirs(dirs);
end
if importfile(ftstream(),"",fdirspath,dirs)=1 then
begin
@ -708,11 +719,11 @@ type teditorform = class(TVCform) //
if ifarray(d) and d then
begin
Exportfile(ftstream(),"",Fhighlightpath,d);
end
global g_editer_font_size;
if ifarray(g_editer_font_size) and g_editer_font_size then
end
global editorglobalinfo ;
if ifarray(editorglobalinfo) and editorglobalinfo then
begin
Exportfile(ftstream(),"",feditorglobalpath,array("font":g_editer_font_size));
Exportfile(ftstream(),"",feditorglobalpath,editorglobalinfo);
end
save_opend_file_name();
FEdter.CloseAllPageItems();
@ -848,156 +859,7 @@ type teditorform = class(TVCform) //
return array();
end
protected
type TSerlogerSimpleWnd=class(tdcreateform)
uses tslvcl;
label1:tlabel;
furl:tedit;
label2:tlabel;
fport:tedit;
label3:tlabel;
fusr:tedit;
label4:tlabel;
fpwd:tpassword;
flogout:tbtn;
flogin:tbtn;
[weakref]cancel_clk;
[weakref]save_clk;
function Create(AOwner);override; //构造
begin
inherited;
Loader.LoadFromTfmScript(self,getinfo());
flogout.OnClick := function(o,e)begin
calldatafunction(cancel_clk,self,e);
end
flogin.OnClick := function(o,e)begin
calldatafunction(save_clk,self,e);
end
end
function setdata(d);
begin
if not ifarray(d) then return ;
furl.text := d["addr"];
fport.text := d["port"];
fusr.text := d["usr"];
fpwd.text := d["pwd"];
end
function getdata();
begin
r := array();
r["addr"] := furl.text;
r["port"] := fport.text;
r["usr"] := fusr.text;
r["pwd"] := fpwd.text;
return r;
end
function tserlogersimplewnd1_close(o;e);virtual;
begin
Visible := false;
e.skip := true;
end
function Recycling();override; //回收变量
begin
inherited;
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
for i,v in ci["members"] do
begin
if v["static"]then continue;
invoke(self,v["name"],nil);
end
end
private
function getinfo();
begin
return %%
object tserlogersimplewnd1:tserlogersimplewnd
caption="远程连接信息"
color=0xFFFFFF
height=211
minmaxbox=false
onclose=tserlogersimplewnd1_close
width=422
wsdlgmodalframe=true
wssizebox=true
object label1:tlabel
left=4
top=3
width=80
height=25
caption="服务器地址"
end
object furl:tedit
height=25
left=88
tabstop=true
top=3
width=204
end
object label2:tlabel
left=296
top=3
width=34
height=25
caption="端口"
end
object fport:tedit
height=25
left=333
tabstop=true
top=3
width=62
end
object label3:tlabel
left=2
top=38
width=80
height=25
caption=" 用户名"
end
object fusr:tedit
height=25
left=88
tabstop=true
top=38
width=244
end
object label4:tlabel
left=2
top=72
width=80
height=25
caption=" 密 码"
end
object fpwd:tpassword
height=25
left=88
tabstop=true
top=72
width=245
end
object flogout:tbtn
anchors=[akright akbottom]
caption="取消"
height=23
left=149
tabstop=true
top=130
width=74
end
object flogin:tbtn
anchors=[akright akbottom]
caption="保存"
height=23
left=259
tabstop=true
top=130
width=74
end
end
%%;
end
end
type TBlockEditer = class(TPanel)
uses TSLVCL,UtslCodeEditor;
function Create(AOwner);override;
@ -1010,6 +872,7 @@ end
li := new TLabel(self);
li.caption := v;
FLabels[i] := li;
li.TextAlign := AL9_CENTERRIGHT;
li.parent := self;
end
FEditers := array();
@ -1046,27 +909,31 @@ end
begin
if FLabels and FEditers and FBtn and FCoder and FChecked then
begin
ft := font;
fh := ft.height+5;
fw := ft.width;
r := ClientRect;
lr := array(5,10,45,35);
FChecked.SetBoundsRect(array(52,10,72,30));
nx := 5+5+fw*7; //标签截止位置
lr := array(5,10,nx,10+fh);
FChecked.SetBoundsRect(array(nx+5,10,nx+25,30));
for i,v in FLabels do
begin
v.SetBoundsRect(lr);
lr[1]+=25;
lr[3]+=25;
lr[1]+=fh;
lr[3]+=fh;
end
w := r[2]-r[0];
lr := array(52,10+25,w-48,35+25);
lr := array(nx+5,10+fh+1,w-5,10+fh+fh-1);
for i,v in FEditers do
begin
v.SetBoundsRect(lr);
lr[1]+=25;
lr[3]+=25;
lr[1]+=fh+1;
lr[3]+=fh-1;
end
lr[3] := r[3]-35;
lr[3] := r[3]-fh-10;
FCoder.SetBoundsRect(lr);
lr := array(lr[2]-100,lr[3]+5,lr[2],r[3]-5);
lr := array(lr[2]-fw*6,lr[3]+5,lr[2],r[3]-5);
FBtn.SetBoundsRect(lr);
end
end
@ -1099,6 +966,18 @@ end
end
type TBlockManager=class(TVCForm)
uses TSLVCL;
function ftchanged(o,e);
begin
if not flist then return ;
ft := font;
if not ft then return ;
fh := ft.height;
fw := ft.width;
FList.ItemHeight := fh+5;
flist.ColumnWidth(0) := fw*6;
flist.ColumnWidth(1) := fw*6;
flist.ColumnWidth(2) := fw*11;
end
function Create(AOwner);override;
begin
inherited;
@ -1154,25 +1033,28 @@ type TBlockManager=class(TVCForm)
class(UtslCodeEditor).move_popwnd_to_center2(FEditer);
FEditer.showmodal();
end
OnFontChanged := thisfunction(ftchanged);
end
function DoControlAlign();override;
begin
if FList and FBtns then
begin
ft := font;
fw := ft.width;
fh := ft.height;
R := ClientRect;
R1 := R;
R1[3]-=30;
R1[3]-=(fh+10);
FList.SetBoundsRect(R1);
rc := R;
RC[1] := R[3]-28;
RC[1] := R[3]-(fh+5);
RC[3] := R[3]-2;
for i,v in Fbtns do
begin
rc1 := RC;
rc1[0] := R[2]-(I+1)*130;
rc1[2] := RC1[0]+95;
rc1[0] := R[2]-(I+1)*(fw*8);
rc1[2] := RC1[0]+fw*6;
V.SetBoundsRect(rc1);
end
end
@ -1256,8 +1138,8 @@ type tsearchdir = class(TCustomControl)
function Create(AOwner);override;
begin
inherited;
ParentFont := false;
font := array("width":10,"height":20);
//ParentFont := false;
//font := array("width":10,"height":20);
fcopyer := new TClipBoard(self);
caption := "函数搜索目录:左侧为别名,右侧为-libpath目录....";
fcpmenu := new TPopupmenu(self);
@ -1275,7 +1157,7 @@ type tsearchdir = class(TCustomControl)
FFolder.parent := self;
FLists := array();
FBtns := array();
for i,v in array(array(2,28,220,430),array(248,2,700,430)) do
for i,v in array(array(2,38,220,430),array(248,2,700,430)) do
begin
ls := new tdirlistbox(self);
ls.SetBoundsRect(v);
@ -1299,6 +1181,7 @@ type tsearchdir = class(TCustomControl)
for i,v in array("+","-","+","-","确定") do
begin
bt := new tbtn(self);
if i<4 then bt.ParentFont := false;
bt.caption := v;
bt.SetBoundsRect(btrecs[i]);
bt.parent := self;
@ -1311,7 +1194,8 @@ type tsearchdir = class(TCustomControl)
FBtns[4].autosize := true;
/////////////////////////////////
FEdit := new tedit(self);
FEdit.SetBoundsRect(array(2,2,220,26));
FEdit.SetBoundsRect(array(2,2,220,26));
FEdit.autosize := true;
FEdit.parent := self;
FEdit.onkeyup := thisfunction(editkeyup);
FEdit.placeholder := "查找or添加";
@ -1535,6 +1419,7 @@ end
flastopend;
FOpendpaths;
FTabWidthpath;
Fsysfontpath;
FFileopen;
FexefileCmds;
FCodeblockPath;
@ -1659,6 +1544,13 @@ type tdirviewer = class(tcustomcontrol)
end
end
selnowork();
ftree.OnFontChanged := function(o,e)begin
ft := font;
if ft then
begin
ftree.ItemHeight := ft.height+6;
end
end
end
function treenodeselchanged(o,e);
begin
@ -1716,6 +1608,17 @@ type tdirviewer = class(tcustomcontrol)
end
ftb.ImageList := fimgs;
ftb.parent := self;
ftb.autosize := true;
onnotification := thisfunction(wftchanged);
end
function wftchanged(o,e);
begin
if not fimgs then return ;
d := e.msg;
if ifarray(d) and d["imgsize"]>0 then
begin
fimgs.imgsize := d["imgsize"];
end
end
function toolclick(o,e); //工具栏事件
begin

232
designer/udesignerproject.tsf
View File

@ -4,7 +4,7 @@ interface
@param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
@date(20220518)
**}
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
uses utslvclauxiliary,utslvcldcomponents,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
function SetWndPostWithMouse(wnd,lft);
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
function Create(AOwner);override;
@ -144,10 +144,10 @@ type TProjectManagerForm = class(TVCForm) //
if findfunction(n)or findclass(n)then return "和现有的函数重名";
cprojpath := p+fio;
fn := f;
CreateDirWithFileName(cprojpath+"resource.tfm"+fio+"abc.tfm"); //构建窗口信息文件
//CreateDirWithFileName(cprojpath+"resource.tfm"+fio+"abc.tfm"); //构建窗口信息文件
info := array();
info["name"]:= n;
info["version"]:= "1.2.0";
info["version"]:= "1.1.0";
info["dir"]:= array();
mfn := n+"main";
info["files"]:= array(
@ -175,7 +175,8 @@ end
%%,n,n+"main");
ReWriteString(cprojpath+n+".tsl",r);
ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
ReWriteString(cprojpath+n+"main.tfm",CreateAtfm(n+"main",n+"main"));
//ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
//写入缓存
FProjectCoder.AddProject(n,f);
//添加到list 中
@ -206,6 +207,7 @@ type TProjectView = class(TVCForm) //
FFilterList;
FFilterNodes;
Fhighlightpath;
feditorglobalpath;
function ShowFilterList(d);
begin
if not FFilterList.visible then
@ -342,7 +344,7 @@ type TProjectView = class(TVCForm) //
rc := _wapi.GetScreenRect();
left := 20;
top := 150;
width := 360; //350
width := 330; //350
height := max(400,rc[3]-200);
FInput := new TNameInput(self);
finheritedinput := new tfm_inheritedwnd(self);
@ -350,6 +352,9 @@ type TProjectView = class(TVCForm) //
FInput.visible := false;
FInput.parent := self;
FTslEditer := new TTslEditer(AOwner);
FTslEditer.ParentFont := false;
FTslEditer.dbclkcreate := false;
FTslEditer.Notification(FTslEditer,"change_editor_keys");
FTslEditer.FExecuteEditer.cannotadd := true;
FTslEditer.FExecuteEditer.onsaveclk := function(o,e)
begin
@ -361,6 +366,7 @@ type TProjectView = class(TVCForm) //
FTslEditer.TslCacheDir := bpath+"designer"+fio+"cmpCaches";
FCodeblockPath := bpath+"editer"+fio+"BlockManager.tsm";
Fhighlightpath := bpath+"editer"+fio+"highlight.tsm";
feditorglobalpath := bpath+"editer"+fio+"feditorglobalpath.tsm";
if 1=importfile(ftstream(),"",FCodeblockPath,blockd)and blockd and ifarray(blockd)then
begin
class(TTSLCompletion).FCodeBlocks := blockd;
@ -382,14 +388,33 @@ type TProjectView = class(TVCForm) //
nd := FTree.CurrentNode;
if nd and (nd["type"] in array("panel","form")) then FDesigner.EditerCodeChanged(nd);
end
imgs := New TControlImageList(self);
imgs.onnotification := function(o,e)begin
d := e.msg;
if ifarray(d) and d["imgsize"]>0 then
begin
o.imgsize := d["imgsize"];
end
end
if (importfile(ftstream(),"",feditorglobalpath,ginfo)=1) and ifarray(ginfo) then
begin
global editorglobalinfo ;
editorglobalinfo := ginfo;
if ifarray(ginfo) then
begin
app := initializeapplication();
app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
FTslEditer.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
NotifyComponent(self,ginfo);
end
end
//FTslEditer.Parent := AOwner;
FTmfParser := new TTmfParser();
FTslParser := new ttslscripparser();
FTreeTool := new TToolBar(self);
FTreeTool.autosize := true;
FTreeTool.parent := self;
imgs := New TControlImageList(self);
imgs.width := 24;
imgs.height := 24;
imgs.DrawBmpFirst := true;
EditToolBmps := array();
for i,v in GetToolBtns() do
@ -411,6 +436,7 @@ type TProjectView = class(TVCForm) //
FTreeTool.ImageList := imgs;
//**************目录树筛选功能***********************************
FFilter := new TEdit(self);
FFilter.autosize := true;
FFilterList := new TListBox(self);
FFilterList.color := 0xdcF8ff;
FFilterList.visible := false;
@ -522,6 +548,7 @@ type TProjectView = class(TVCForm) //
it.parent := fnewmenu;
it.OnClick := thisfunction(newadd);
end
return;
end
function setnodesel(nd);
@ -529,6 +556,11 @@ type TProjectView = class(TVCForm) //
if fopenbuzy then return ;
ftree.setsel(nd);
end
function getall_class_tsf();//列表
begin
ls := FTree.get_leaf_nodes();
return ls;
end
function OpenTreeNode(); //打开当前节点
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@ -871,8 +903,11 @@ type TProjectView = class(TVCForm) //
function ShowEditor(); //显示函数编辑
begin
FTslEditer.Show(SW_SHOWNOACTIVATE); //
//FTslEditer.Show(SW_SHOWNOACTIVATE); //
FTslEditer.Show(); //
_wapi.bringWindowToTop(FTslEditer.Handle);
it := FTslEditer.GetCurrentEditer();
if it then return it.SetFocus();
end
function hiddeneditor(rc);//隐藏
begin
@ -891,6 +926,10 @@ type TProjectView = class(TVCForm) //
if r then FTslEditer.OpenAndGotoFileByName(r);
ShowEditor();
end
function opensysfontmgr();
begin
FTslEditer.modifysyssize();
end
function ShowCurrenttfm();
begin
if FCurrentOpend then r := FCurrentOpend.gettmfname();
@ -937,9 +976,10 @@ type TProjectView = class(TVCForm) //
return r;
end
end
function GoToAFunction(n); //跳转到函数
function GoToAFunction(n,fn); //跳转到函数
begin
fn := FCurrentOpend.gettsfname();
if not fn then
fn := FCurrentOpend.gettsfname();
r := FTslEditer.GoToFunction(fn,n);
saveformcode(fn);
ShowEditor();
@ -1002,7 +1042,6 @@ type TProjectView = class(TVCForm) //
it := FTslEditer.OpenAndGoLineByName(tfm);
if it then
begin
//FTmfParser.ScriptPath := FCurrentOpend.gettmfname();
sc := it.FEditer.text;
FTmfParser.Script := sc;
FCurrentOpend.ftfmscript := sc;
@ -1010,9 +1049,13 @@ type TProjectView = class(TVCForm) //
//FTfmComponets := array();
//FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged(FCurrentOpend);
end else //缺少tfm文件
begin
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
ShowEditor();
end
fopenbuzy := false;
end else
@ -1135,6 +1178,7 @@ type TProjectView = class(TVCForm) //
FExecEntry := d["entryscript"];
end
FTslEditer.setExecuteEditerSetcmdline(d["commandline"]);
move_tfm_to_tsf(p);
OpenMainForm(); //打开主窗口
end
@ -1285,6 +1329,8 @@ end %%,fn);
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
tfm := ph;
tfm[(length(tfm)-3):length(tfm)] := ".tfm";
if not(FileExists("",ph))then
begin
r := format(%%
@ -1300,8 +1346,9 @@ end
%%,n,nd.Fname,us);
ReWriteString(ph,r);
FTmfParser.ScriptPath := nd.gettmfname();
r := FTmfParser.inheritedcoy(n+"1",n,nd.Fname);
ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
r := FTmfParser.inheritedcopy(n+"1",n,nd.Fname);
ReWriteString(tfm,r);
//ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else
begin
FTslParser.ScriptPath := ph;
@ -1332,7 +1379,8 @@ end
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
tfm := FCProjectPath+"resource.tfm"+fio+n+".tfm";
tfm := ph;
tfm[(length(tfm)-3):length(tfm)] := ".tfm";
if not(FileExists("",ph))then
begin
r := CreateAForm(n);
@ -1378,7 +1426,9 @@ end
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
tfm := (FCProjectPath+"resource.tfm"+fio+n+".tfm");
//tfm := (FCProjectPath+"resource.tfm"+fio+n+".tfm");
tfm := ph;
tfm[(length(tfm)-3):length(tfm)] := ".tfm";
if not FileExists("",ph)then
begin
r := CreateAPanel(n);
@ -1763,6 +1813,11 @@ end
begin
exportfile(ftstream(),"",Fhighlightpath,d);
end
global editorglobalinfo ;
if ifarray(editorglobalinfo) and editorglobalinfo then
begin
Exportfile(ftstream(),"",feditorglobalpath,editorglobalinfo);
end
end
private
FMoveMnus;
@ -1833,6 +1888,10 @@ end
CreateDirWithFileName(FCProjectPath+ndr+fio+d["name"]+"."+ft);
if 1=filerename("",FCProjectPath+ml+d["name"]+"."+ft,FCProjectPath+ndr+d["name"]+"."+ft) then
begin
if FileExists("",(FCProjectPath+ml+d["name"]+".tfm")) then
begin
filerename("",FCProjectPath+ml+d["name"]+".tfm",FCProjectPath+ndr+d["name"]+".tfm");
end
nd.Recycling();
SaveProjInfo();
//移动成功
@ -2163,7 +2222,7 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
function GoToFunction(fn,n);
begin
it := OpenAndGotoFileByName(fn);
if it then it.GotoFunction(n);
if it then return it.GotoFunction(n);
end
function AddFunction(n,fn,finfo); //添加函数
begin
@ -2338,16 +2397,34 @@ type TFileTree = class(TTreeCtl)
if FFType in array( "form","panel") then
begin
if not(ifstring(nn) and nn) then nn := Fname;
return Owner.fprojectpath+"resource.tfm"+fio+nn+".tfm";
return Owner.fprojectpath+FPath2()+nn+".tfm";
//return Owner.fprojectpath+"resource.tfm"+fio+nn+".tfm";
end
end
function gettmfdirs();//获得tmfdir
begin
if FFType in array( "form","panel") then
begin
return array( Owner.fprojectpath+"resource.tfm"+fio);
//return array( Owner.fprojectpath+"resource.tfm"+fio);
return listdirs(Owner.fprojectpath);
end
end
function listdirs(dir);
begin
r := array();
fio := dir[length(dir)];
r[0] := dir;
for i,v in FileList("",dir+"*") do
begin
vn := v["FileName"];
if vn="." or vn=".." then continue;
if pos("D",v["Attr"]) then
begin
r union=listdirs(dir+vn+fio);
end
end
return r;
end
property FFileInfo read FFFileInfo write setfileinfo;
fio;
fdtree;
@ -2368,6 +2445,12 @@ type TFileTree = class(TTreeCtl)
end
fprojectpath;
fio;
function get_leaf_nodes();
begin
leafs := array();
GetNodeLeafs(FPNode,leafs);
return leafs;
end
function GetInfo(dir,files); //获得信息
begin
leafs := array();
@ -2957,6 +3040,11 @@ type TNameInput=class(TCustomControl) //
FBtn.Click();
end
end
autosize := true;
FEidt.autosize := true;
FLabel.autosize := true;
FBtn.autosize := true;
childsizing := array("layout":1);
end
function sellAllText();
begin
@ -3048,6 +3136,57 @@ type TProjectAddDlg=class(TCustomControl) //
FBtn;
FOnBtnClk;
end
////////////////////////////////////////////////////////////////
function move_tfm_to_tsf(dir);
begin
if not(FileList("",dir+iofileseparator()+"resource.tfm"+iofileseparator()+"*.tfm")) then return ;
tsfs := array();
tfms := array();
find_tsf_tfm(dir,tsfs,tfms);
fs := iofileseparator();
for i,v in tsfs do
begin
tfmi := tfms[i];
if tfmi then
begin
sf := tfmi[0];
df := v+fs+tfmi[1];
if sf<>df then
begin
if filecopy("",sf,"",df) then
begin
filedelete("",sf);
end
end
end
end
if not(FileList("",dir+iofileseparator()+"resource.tfm"+iofileseparator()+"*.tfm")) then removedir("",dir+iofileseparator()+"resource.tfm");
end
function find_tsf_tfm(dir,tsfs,tfms);
begin
fs := iofileseparator();
for i,v in filelist("",dir+fs+"*") do
begin
vn := v["FileName"];
if vn="." or vn=".." then continue;
if pos("D",v["Attr"]) then //??
begin
find_tsf_tfm(dir+fs+vn,tsfs,tfms) ;
end else
begin
if parseregexpr("(.+)\\.tsf",vn,"i",mr,mp,ml)=1 then
begin
tsfs[lowercase(mr[0,1])] := dir;
end else
if parseregexpr("(.+)\\.tfm",vn,"i",mr,mp,ml)=1 then
begin
fn := dir+fs+vn;
tfms[lowercase(mr[0,1])] := array(fn,vn);
end
end
end
end
/////////////////////////////////////////////////////////////////
function ReWriteString(fn,d);
begin
if not ifstring(d)then return 0;
@ -3084,24 +3223,6 @@ r := format(%% type %s=class(tdcreatepanel)
begin
inherited;
end
function DoControlAlign();override;//对齐子控件
begin
//当窗口大小改变时,该函数会被调用,
//可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
//如果自己处理了子控件的对齐,就可以去掉 inherited
inherited;
end
function Recycling();override;
begin
inherited;
ci := self.classinfo();
for i,v in ci["members"] do
begin
if v["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
end
%%,n);
return r;
@ -3150,41 +3271,6 @@ function LegalFolderName(n); //Ŀ¼
begin
return ifstring(n) and n and (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl)) and (lowercase(n)<>"con");
end
function createtslfunction(f);//构造函数
begin
n := f["name"];
p := f["param"];
b := f["body"];
ps := "";
if ifarray(p)then
begin
len := length(p);
for i := 0 to len-1 do
begin
v := p[i];
if ifstring(v)then ps += v;
if i<len-1 then ps += ";";
end
end
hs := nil;
vt := "";
if f["virtual"] then vt := "virtual;";
if ifstring(n) and ifstring(b)then
begin
//hs := "\r\nfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
bs := str2array(b,"\r\n");
bs2 := "";
for i,v in bs do
begin
if not v then continue;
bs2 += " "+v+"\r\n";
end
hs := "\r\n\ function "+n+"("+ps+");"+vt+"\r\n\ begin\r\n"+bs2+"\r\n\ end\r\n";
end
//hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
return hs;
end
function SetWndPostWithMouse(wnd,lft);
begin
{**

601
designer/utslcodeeditor.tsf
View File

File diff suppressed because it is too large Load Diff

3
designer/utslcodeformat.tsf
View File

@ -133,6 +133,9 @@ type TFormatParser = class
"%%","(*","//","#!",
"<?tslx>",
"?>",
"...",
":>",":<",":<>", ":==",":>=",":<=",
"::>","::<","::<>", "::==","::>=","::<=",
//"0x","0O","0b",
);
TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",);

17
designer/utslsynmemo.tsf
View File

@ -1013,9 +1013,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
tvi := s[idx];
if tvi=" " or tvi="\t" then
begin
begin
SetTToken(tokens,const ccs,idx-1,array("%%"));
return ParserTokenLines(s,idx+1,e,ccs,tokens);
end
@ -1023,7 +1021,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
end else
begin
SetTToken(tokens,"%",idx-1);
SetTToken(tokens,"%",idx-1);
idx--;
end
end
@ -1053,6 +1051,13 @@ type TTslSynHighLighter = class(TSynHighLighter)
SetTToken(tokens,"<",idx);
end
end else
if vi="." and (idx<e-2) and s[idx+1]="." and s[idx+2]="." then //////////¼ÓÈë´¦Àí ...
begin
if ttk then
SetTToken(tokens,ttk,idx-1);
SetTToken(tokens,"...",idx+2);
idx+=2;
end else
if pos(vi,"`~@#$^&*)+-;,.?:[]|\\=><%/") then
begin
if ttk then
@ -1248,8 +1253,8 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then
return FTokens[idx];
if idx<FSatesCount then return FTokens[idx];
return nil;
end
private
function FindRightChar(c,s,b,e,zy); //²éÕÒ·â±ÕµÄ×Ö·û

1065
designer/utslvcldcomponents.tsf
View File

File diff suppressed because it is too large Load Diff

481
designer/utslvcldebuger.tsf
View File

@ -686,7 +686,7 @@ type TTslDebuga=class(TCustomControl)
function Create(AOwner);
begin
inherited;
init_item_height := 30;
//init_item_height := 30;
fscriptbrks := array();
//Frundirect := false;
FCmdHistory := array();
@ -698,14 +698,15 @@ type TTslDebuga=class(TCustomControl)
dbwnd.Align := alClient;
dbwnd.Parent := self;
FStackList := new TListView(self); // new TListBox(self); //new tmemo(self);//
FStackList.ItemHeight := init_item_height;
//FStackList.ItemHeight := init_item_height;
FStackList.Columns := array(("text":"line","width":80),
("text":"function","width":250) //,("text":"type","width":70)
);
FStackList.Border := true;
FVaraiblesList := new TGroupGridA(self);
FVaraiblesList.Border := false;
FVaraiblesList.ItemHeight := init_item_height;
//FVaraiblesList.ItemHeight := init_item_height;
FVaraiblesList.Columns := array(("text":"name","width":105),
("text":"value","width":135),
("text":"type","width":80)
@ -713,7 +714,7 @@ type TTslDebuga=class(TCustomControl)
FCommandtext := new TEdit(self);
FCommandtext.autosize := true;
FCommandtext.placeholder := "命令输入框";
FCommandtext.Height := init_item_height;
//FCommandtext.Height := init_item_height;
FCommandtext.onkeyup := thisfunction(cmdkeyup);
FShowText := new tmemo(self);
FShowText.ReadOnly := true;
@ -754,20 +755,18 @@ type TTslDebuga=class(TCustomControl)
begin
return 1;
end
onnotification := function(o,e)begin
if not (FStackList and FVaraiblesList) then return ;
ms := e.message;
if ifarray(ms) and ms[0] ="font" then
begin
ft := ms[1];
FStackList.font := ft;
FStackList.ItemHeight := ft["height"]+6;
FVaraiblesList.font := ft;
FVaraiblesList.ItemHeight := ft["height"]+6;
//font := ms[1];
end
end
self.onfontchanged := function(o,e)begin
if (FVaraiblesList and FStackList) then
begin
ft := o.font;
if ft then
begin
ht := ft.Height;
FVaraiblesList.ItemHeight := ht+6;
FStackList.ItemHeight := ht+6;
end
end
end
end
function addbreak(item,idx,n); //添加断点
begin
@ -1944,38 +1943,43 @@ type ttempclass = class()
end
type tdbgselwnd=class(tdcreateform)
uses tslvcl;
fdiag:tfolderchooseadlg;
flist:tlistview;
cancel_clk;
save_clk;
dbg_clk;
fhistorydir;
panel3:tpanel;
label1:tlabel;
portpal:tpanel;
furl:tedit;
label2:tlabel;
fport:tedit;
label3:tlabel;
fusr:tedit;
label4:tlabel;
label5:tlabel;
fpwd:tpassword;
fdir:tedit;
fdiag:tfolderchooseadlg;
flist:tlistview;
fcbtn:tbtn;
label6:tlabel;
panel2:tpanel;
flogout:tbtn;
flogin:tbtn;
label5:tlabel;
panel1:tpanel;
fdir:tedit;
fcbtn:tbtn;
panel4:tpanel;
fdbg:tbtn;
cancel_clk;
save_clk;
dbg_clk;
fhistorydir;
function Create(AOwner);override; //构造
begin
inherited;
Visible := false;
ParentFont := false;
//ParentFont := false;
Loader.LoadFromTfmScript(self,getinfo());
flist.Columns := array(
("text":"ID号","width":150),
("text":"信息","width":300),
("text":"创建时间","width":100)
flist.Columns := array(("text":"ID号","width":150)
,("text":"信息","width":300)
,("text":"创建时间","width":100)
);
flogout.top := 140;
//flogout.top := 140;
flogout.OnClick := function(o,e)
begin
calldatafunction(cancel_clk,self,e);
@ -1995,15 +1999,56 @@ type tdbgselwnd=class(tdcreateform)
calldatafunction(dbg_clk,self,e);
end
setlist();
onfontchanged := thisfunction(ftchanged);
end
function ftchanged(o,e);
begin
ft := font;
if flist and ft then
begin
flist.ItemHeight := ft.Height+6;
end
end
function panel1_gprefsize(o;e);virtual;
begin
ft := font;
if not ft then return;
fh := ft.Height;
fw := ft.Width;
e.width := 400; //宽度
e.height := fh+10; //高度
end
function flist_gprefsize(o;e);
begin
{**
@explan(说明) 获取最佳的尺寸 %%
@param(o)(tcontrol)控件 %%
@param(e)(tmmeasuresize) 消息对象 %%
**}
e.width := 600; //宽度
e.height := 400; //高度
end
function fusr_gprefsize(o;e);
begin
ft := font;
if not ft then return;
fh := ft.Height;
fw := ft.Width;
e.width := 400; //宽度
e.height := fh+5; //高度
end
function setattachwait(flg); //设置登陆样式
begin
if flg then
begin
Height := 210;
//Height := 210;
flist.Visible := false;
panel4.Visible := false;
end else
begin
Height := 550;
//Height := 550;
flist.Visible := true;
panel4.Visible := true;
end
end
function loaddata(); //导入数据
@ -2088,132 +2133,243 @@ type tdbgselwnd=class(tdcreateform)
begin
return %%
object tserlogersimplewnd1:tserlogersimplewnd
caption="远程调试"
color=0xFFFFFF
top=100
height=550
minmaxbox=false
onclose=tserlogersimplewnd1_close
width=580
wsdlgmodalframe=true
wssizebox=false
object label1:tlabel
left=4
top=3
width=80
height=25
caption="服务器地址"
end
object furl:tedit
height=25
left=88
tabstop=true
top=3
width=204
end
object label2:tlabel
left=296
top=3
width=34
height=25
caption="端口"
end
object fport:tedit
height=25
left=333
tabstop=true
top=3
width=62
end
object label3:tlabel
left=2
top=38
width=80
height=25
caption=" 用户名"
end
object fusr:tedit
height=25
left=88
tabstop=true
top=38
width=300
end
object label4:tlabel
left=2
top=72
width=80
height=25
caption=" 密 码"
end
object label5:tlabel
left=2
top=100
width=80
height=25
caption=" 脚本目录"
end
object fpwd:tpassword
height=25
left=88
tabstop=true
top=72
width=300
end
object fdir:tedit
height=25
left=88
tabstop=true
top=100
width=300
end
object fcbtn:tbtn
caption="..."
height=25
left=390
tabstop=true
top=100
width=22
onclick=getdir
end
object flogout:tbtn
an1chors=[akright akbottom]
caption="取消"
height=23ff
left=375
tabstop=true
top=480
width=74
end
object fdbg:tbtn
an1chors=[akright akbottom]
caption="调试"
height=23
left=470
tabstop=true
top=480
width=74
end
object flogin:tbtn
caption="连接"
height=23
left=470
tabstop=true
top=140
width=74
end
object flist:tlistview
anch1ors=[akTop akright akLeft akBottom]
height=290
left=2
top=180
width=560
end
object fdiag:tfolderchooseadlg
caption="执行目录"
end
autosize=true
caption="远程调试"
childsizing=<
layout=2
controlsperline=4
horizontalspacing=10
verticalspacing=10
leftrightspacing=10
topbottomspacing=10
>
color=0xFFFFFF
height=636
left=700
minmaxbox=false
onclose=tserlogersimplewnd1_close
top=271
width=452
wsdlgmodalframe=true
wssizebox=false
object fdiag:tfolderchooseadlg
left=501
top=34
height=30
width=30
caption="执行目录"
end
object panel3:tpanel
autosize=true
caption="panel3"
childsizing=<
layout=1
controlsperline=2
horizontalspacing=5
verticalspacing=5
leftrightspacing=5
topbottomspacing=5
>
height=136
left=10
top=10
width=416
wsdlgmodalframe=false
object label1:tlabel
left=5
top=5
width=58
height=22
autosize=true
caption="服务地址"
textalign=al9_centerright
end
object portpal:tpanel
autosize=true
caption="panel1"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=0
verticalspacing=1
leftrightspacing=0
topbottomspacing=1
>
height=22
left=68
top=5
width=343
wsdlgmodalframe=false
object furl:tedit
caption="edit1"
height=20
left=0
tabstop=true
top=1
width=204
end
object label2:tlabel
left=205
top=1
width=30
height=20
autosize=true
caption="端口"
end
object fport:tedit
caption="edit1"
height=20
left=236
tabstop=true
top=1
width=62
end
end
object label3:tlabel
left=5
top=32
width=58
height=20
autosize=true
caption="用户名"
textalign=al9_centerright
end
object fusr:tedit
caption="edit1"
height=20
left=68
ongetpreferredsize=fusr_gprefsize
tabstop=true
top=32
width=343
end
object label4:tlabel
left=5
top=57
width=58
height=20
autosize=true
caption="密码"
textalign=al9_centerright
end
object fpwd:tpassword
caption="password1"
height=20
left=68
ongetpreferredsize=fusr_gprefsize
tabstop=true
top=57
width=343
end
object label5:tlabel
left=5
top=82
width=58
height=21
autosize=true
caption="脚本目录"
textalign=al9_centerright
end
object panel1:tpanel
autosize=true
caption="panel1"
childsizing=<
layout=1
controlsperline=2
horizontalspacing=0
verticalspacing=3
leftrightspacing=1
topbottomspacing=0
>
height=21
left=68
ongetpreferredsize=panel1_gprefsize
top=82
width=343
wsdlgmodalframe=false
object fdir:tedit
caption="edit1"
height=21
left=1
tabstop=true
top=0
width=300
end
object fcbtn:tbtn
caption="..."
height=21
left=304
onclick=getdir
tabstop=true
top=0
width=35
end
end
object label6:tlabel
left=5
top=108
width=58
height=23
autosize=true
caption=""
end
object panel2:tpanel
autosize=true
caption="panel2"
height=23
left=68
top=108
width=343
wsdlgmodalframe=false
object flogout:tbtn
autosize=true
caption="取消"
height=21
left=147
tabstop=true
top=0
width=42
end
object flogin:tbtn
autosize=true
caption="连接"
height=21
left=300
tabstop=true
top=0
width=42
end
end
end
object flist:tlistview
height=400
left=10
ongetpreferredsize=flist_gprefsize
top=156
width=416
end
object panel4:tpanel
autosize=true
caption="panel4"
height=21
left=10
top=566
width=416
wsdlgmodalframe=false
object fdbg:tbtn
align=alright
anchors=[aktop akleft]
autosize=true
caption="调试"
height=21
left=374
tabstop=true
top=0
width=42
end
end
end
%%;
end
private
@ -2561,6 +2717,11 @@ type tdbgvalueshowgrid=class(TDrawGrid)
end
end
PopupMenu := mu;
onfontchanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.Height+4;
end
end
function DoDrawSubItem(o,e);override;
begin

197
designer/utslvcldesigner.tsf
View File

@ -41,6 +41,7 @@ type TVclDesigner = class(tvcform)
FStopMenu;
FProjectsManager;
FProjectManager;
FTslParser;//解析器
//***************************
function WrapProjectTo(); //打包当前
begin
@ -116,7 +117,7 @@ type TVclDesigner = class(tvcform)
height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
end
function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
function TreeNode2tfmsub(lib,node,itemnames,nd,bshow);//tmf文件字符串
begin
if not(node) then
begin
@ -128,7 +129,7 @@ type TVclDesigner = class(tvcform)
if not tr then return ;
it := tr.RootItem;
node := (it.items)[0];
ifnit := true;
ifnit := true;
end
if not ifarray(itemnames) then itemnames := array();
if not ifarray(lib) then lib := array();
@ -145,7 +146,7 @@ type TVclDesigner = class(tvcform)
begin
tcname := tc.name;
tcclassname := tc.dclassname;
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then return " ";//raise "错误!"$" "$tcname$" "$tcclassname$"<<<<";
oorinh := (tc.isinherited)?"inherited ":"object ";
ihp := "";
if tc.isinherited then
@ -153,8 +154,9 @@ type TVclDesigner = class(tvcform)
if ifstring(tc.inheritedparent) then
begin
ihp := "("+tc.inheritedparent+")";
bshow := true;
end
end
end else bshow := true;
r+= oorinh + tcname +":"+tcclassname+ihp+"\r\n";
itemnames[length(itemnames)] := array(tcname,tcclassname);
cr := tc.GetChangedPublish();
@ -163,10 +165,18 @@ type TVclDesigner = class(tvcform)
if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
r+=tab;
r+= i + "=" + v +"\r\n";
bshow := true;
end
for i := 0 to node.ItemCount-1 do
begin
r += tablelines( TreeNode2tfmsub(lib,(node.items)[i],itemnames),tab);
ibshow := false;
rri := TreeNode2tfmsub(lib,(node.items)[i],itemnames,nil,ibshow);
if ibshow then
begin
rr := tablelines( rri,tab);
r += rr;
bshow := true;
end
end
r += "end";
end
@ -469,12 +479,12 @@ type TVclDesigner = class(tvcform)
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
e.skip := true;
return ;
end
SC_MINIMIZE:
begin
e.skip := true;
return ;
//e.skip := true;
end
SC_DEFAULT:
begin
@ -487,6 +497,8 @@ type TVclDesigner = class(tvcform)
end
SC_RESTORE:
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
end
end;
@ -503,7 +515,7 @@ type TVclDesigner = class(tvcform)
begin
if e.wparam = 123 and e.lparam=123 then
begin
if o.height>Foh then
if {o.height>Foh}true then
begin
o.height := Foh; //gtk 逻辑正确但是设置无效
end
@ -513,6 +525,10 @@ type TVclDesigner = class(tvcform)
begin
FProjectManager.ShowCurrentFormCode();//ShowEditor();
end
function opensysfontmgr();
begin
FProjectManager.opensysfontmgr();
end
function opentfm(); //打开资源文件
begin
FProjectManager.ShowCurrenttfm();
@ -574,9 +590,11 @@ type TVclDesigner = class(tvcform)
)),
("type":"menu","caption":"工具","items":(
("type":"menu","caption":"设计器目录","checked":0,"onclick":thisfunction(open_tsl_dir)),
("type":"menu","caption":"控件管理","checked":0,"onclick":thisfunction(mgr_control)),
("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap)),
("type":"menu","caption":"编辑器颜色","checked":0,"onclick":thisfunction(showhltcolor))
("type":"menu","caption":"编辑器颜色","checked":0,"onclick":thisfunction(showhltcolor)),
("type":"menu","caption":"字体图标大小","onclick":thisfunction(opensysfontmgr))
)),
("type":"menu","caption":"帮助","items":(
("type":"menu","caption":"关于","onclick":thisfunction(openabout)),
@ -905,8 +923,46 @@ type TVclDesigner = class(tvcform)
end
end else
begin
FProjectManager.GoToAFunction(dv);
return ;
inh := FProjectManager.GoToAFunction(dv);
if not ifstring(inh) then return ;
////////////////父类中查找////////////////////////////////////////////
flg := true;
fs := FProjectManager.getall_class_tsf();
while flg and inh do //循环查找父类
begin
fn := 0;
for i,v in fs do //查找父类文件
begin
if v.fname=inh and v.FType<>"tsl" then
begin
fn := v.gettsfname();
break;
end
end
if not fn then break;//没找到文件退出
FTslParser.ScriptPath := fn;
ci := FTslParser.GetClassInfo();
for i,vf in ci["funcs"] do //对比函数名
begin
if dv=vf then
begin
flg := false;
break;
end
end
if flg then //没找到函数,继续找上一级父类
begin
inh := ci["inherited",0] ;
end else //找到函数,提示跳转
begin
if messageboxa("函数:"$dv$"在父类:"$inh$"中,是否打开","打开提示!",1,self)=IDOK then
begin
return FProjectManager.GoToAFunction(dv,v.gettsfname());
end
end
end
//////////////////////////////////////////////////////////////////
end
end
end
@ -963,6 +1019,7 @@ type TVclDesigner = class(tvcform)
{**
@explan(说明) 组件被点击 %%
**}
uses utslvclevent;
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
@ -971,6 +1028,20 @@ type TVclDesigner = class(tvcform)
FProjectManager.setnodesel(wnd);
return ;//
end
///////////////////特殊处理page控件///////////////////////////////////////////
if (o is class(TPageControl)) and (e is class(TMMouse)) then
begin
d := o.hittabat(e.pos);
if ifarray(d) then
begin
pid := d["idx"];
if (pid>=0) then
begin
o.SetPublish("cursel",pid,1);
end
end
end
///////////////////////////////////////////
if fselctlnode<> nd then
begin
//wd := o;//nd.Component.Cwnd;
@ -1039,7 +1110,8 @@ type TVclDesigner = class(tvcform)
@explan(说明) 选择工具按钮 %%
**}
cct := o._tag;
FComponentCreater := cct;
FComponentCreater := cct;
//if FProjectManager then FProjectManager.hiddeneditor();
end
function CloseShowForm(o,e); //主窗口关闭
@ -1427,8 +1499,8 @@ type TVclDesigner = class(tvcform)
{$endif}
compcwnd.Handle;
end
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.isinherited := d["inherited"];
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
@ -1498,14 +1570,14 @@ type TVclDesigner = class(tvcform)
function create(AOwner);
begin
inherited;
ParentFont := false;
Font := array("width":10,"height":20);
//ParentFont := false;
//Font := array("width":10,"height":20);
top := 10;
left := 10;
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
height := 180;
height := 190;
//calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);
@ -1557,19 +1629,36 @@ type TVclDesigner = class(tvcform)
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
//FTree.parent := tparent;
/////////////////属性筛选////////////////////////////////
fsearch := new tedit(self);
fsearch.placeholder := "筛选";
fsearch.Align := alTop;
fsearch.autosize := true;
fsearch.parent := pparent;
fsearch.OnChange := function(o,e)begin
if FPropGrid then FPropGrid.searchidex := o.text;
if FEventGrid then FEventGrid.searchidex := o.text;
end
////////////////////////////////////////////////
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
FEvent.parent := pedits;
FPropGrid.align := alclient;
FEventGrid.align := alclient;
FPropGrid.parent := FProp;
FEventGrid.parent := FEvent;
Mobjinspect();
FEventGrid.parent := FEvent;
onactivate := thisfunction(OnDesignerActivate);
fdimagelist := new TDesigImageList(self);
global editorglobalinfo ;
if ifarray(editorglobalinfo) and editorglobalinfo then
begin
fdimagelist.imgsize := editorglobalinfo["imgsize"];
sz := editorglobalinfo["fontsize"] ;
if sz>5 then FObjInspector.width :=sz*34+20;
end
Mobjinspect();
//FTree.Imagelist := fdimagelist;
fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent);
//******************toolbar ***************
@ -1608,9 +1697,6 @@ type TVclDesigner = class(tvcform)
FToolBars := new TDesignertoolbars(self);
FToolBars.Imagelist := fdimagelist;
FToolBars.Font.width := 10;
FToolBars.Font.height := 20;
FToolBars.linkimagelist := FProjectManager.FTslEditer.gettoolbarimglist();
addtoolbuttons();
FToolBars.Align := alClient;
FToolBars.parent := self;
@ -1631,6 +1717,14 @@ type TVclDesigner = class(tvcform)
FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
FProjectManager.newmenu.parent := ffilemenu;//
FProjectManager.goformmenu.parent := fviewmenu;//
FToolBars.onnotification := function(o,e)begin
d := e.msg;
if ifarray(d) and d["imgsize"]>0 then
begin
fdimagelist.imgsize := d["imgsize"];
end
end ;
FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
//OnChange
//fnewmenu
end
@ -1640,6 +1734,10 @@ type TVclDesigner = class(tvcform)
begin
FProjectManager.showhltcolor();
end
function open_tsl_dir();
begin
_Wapi.openresourcemanager(sysexecname());
end
function mgr_control();
begin
if not fmgr_ctl then
@ -1969,42 +2067,41 @@ type TPropEditGrid = class(TPropGrid) //
function SetComponent(v);override;
begin
if v=FComponent then exit;
ocls := Columns;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishProperties();
TSLData := getneedpublished(v);//
end else
begin
TSLData := array();//array(NIL);
end
inherited;
if ocls then
begin
w := ocls[1,"width"];
if w>0 then
begin
i := 1;
self.ColumnWidth(1) := w;
end
end
end
public
function Create(AOwner);
begin
inherited;
FobjProptype := p_properys;
end
end
function getneedpublished(v);virtual;
begin
return v.GetPublishProperties();
end
end
type TEventEditGrid = class(TPropGrid) //事件编辑器
type TEventEditGrid = class(TPropEditGrid) //事件编辑器
{**
@explan(说明) 事件编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishEvents();
//echo tostn(TSLData);
end else
begin
TSLData := array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
@ -2012,6 +2109,10 @@ type TEventEditGrid = class(TPropGrid) //
FobjProptype := p_evnets;
OndblClick := thisfunction(GridCellDblClick);
end
function getneedpublished(v);override;
begin
return v.GetPublishEvents();
end
function GridCellDblClick(o,e);override;//双击处理
begin
i := e.iitem;
@ -2096,19 +2197,10 @@ type TDesignertoolbars = class(TPageControl) //
[weakref]ftoolbars;
FLabels ;
[weakref]fimg;
[weakref]flinkimagelist;
function SetImageList(im);
begin
fimg := im;
end
function SetlinkeImageList(img);
begin
flinkimagelist := img;
if flinkimagelist then
begin
flinkimagelist.onchange := thisfunction(changedimg);
end
end
public
function changedimg(o,e);
begin
@ -2120,7 +2212,7 @@ type TDesignertoolbars = class(TPageControl) //
FToolsheets := array();
ftoolbars := array();
inherited;
ParentFont := false;
//ParentFont := false;
align := alClient;
@ -2176,7 +2268,6 @@ type TDesignertoolbars = class(TPageControl) //
end
end
property ImageList write SetImageList;
property linkimagelist write SetlinkeImageList;
private
[weakref]ftbs;

111
designer/utslvcldpropertytypes.tsf
View File

@ -55,7 +55,7 @@ type TGridPropertyRender = class(TGCellRender) //
inherited;
Owner := AOwner;
end
Owner ;
[weakref]Owner ;
end
type TGridCellEditWithButton = class(TGridPropertyRender) //带按钮的单元格编辑
{**
@ -387,7 +387,6 @@ type TListVariable = class(TGridList)
SetColumnWidth(0,Width-11);
end
end
function create(AOwner);override;
begin
inherited;
@ -397,6 +396,11 @@ type TListVariable = class(TGridList)
Columns := array(
("text":"variable","width":180)
);
OnFontChanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.height+6;
end
end
function SetSelectedByValue(v_);override;
begin
@ -458,7 +462,7 @@ type TListStr = class(TListVariable)
function create(AOwner);override;
begin
inherited;
Columns := array(("text":"´ò¿ª±à¼­Æ÷","width":160));
Columns := array(("text":"±à¼­Æ÷","width":160));
end
function additem(v);override;
begin
@ -855,6 +859,12 @@ type TPropGrid = class(TTSLDataGrid)
OnMouseWheel := function(o,e)begin
currentLeave();
end
onfontchanged := function(o,e)begin
ft := font;
if not ft then return ;
fh := ft.height;
itemheight := fh+6;
end
end
function Recycling();override;
begin
@ -907,7 +917,7 @@ type TTSLDataGrid=class(TDrawGrid)
@explan(说明)TSL数组和对象展示 %%
**}
private
fsearchidex;
FCols;
Fdata;
FObjectData;
@ -916,7 +926,7 @@ type TTSLDataGrid=class(TDrawGrid)
FRows;
FShowTwo;
FCControls;
FColumnWidth;
FdfColumnWidth;
FRowHeader;
static FGCellRender;
FCanEditStr;
@ -986,6 +996,14 @@ type TTSLDataGrid=class(TDrawGrid)
return FGCellRender[n];
end
private
function setsearchidex(s);
begin
if fsearchidex<>s and ifstring(s) then
begin
fsearchidex := s;
InvalidateRect(nil,false);
end
end
function SetRowHeader(v);
begin
nv := v?true:false;
@ -1032,23 +1050,24 @@ type TTSLDataGrid=class(TDrawGrid)
if ifstring(v)then
begin
wd := max(wd,length(v) * ftwidth+3);
if wd>200 then break;
if wd>500 then break;
end
end
if RowHeader then
begin
fcs[0]:= array("text":" ","width":min(200,wd));
fcs[0]:= array("text":" ","width":min(500,wd));
end
cw := 15* ftwidth;
if FCL and allFCL and FShowTwo then
begin
FCols := FCl;
for i,v in FCols do
begin
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD);
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":cw);
end
end else
begin
fcs[length(fcs)]:= array("text":" ","width":ColumnWidth>20?ColumnWidth:100);
fcs[length(fcs)]:= array("text":" ","width":fdfColumnWidth>20?fdfColumnWidth:cw);
end
Columns := fcs;
ItemCount := length(FRows);
@ -1140,6 +1159,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
public
property searchidex read fsearchidex write setsearchidex;
function create(AOwner);override;
begin
inherited;
@ -1156,7 +1176,7 @@ type TTSLDataGrid=class(TDrawGrid)
FStringAlign := AL9_CENTERLEFT;
FDefAlign := AL9_CENTER;
end
function InitializeWnd();override;
begin
inherited;
@ -1236,6 +1256,10 @@ type TTSLDataGrid=class(TDrawGrid)
begin
ds := d;
//dc.drawtext(ds,src);
if j=0 and fsearchidex and pos(lowercase(fsearchidex),lowercase(d)) then
begin
dc.font.color := 0xff;
end
class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
end else
if ifobj(d)then
@ -1261,12 +1285,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
dc := e.canvas;
rc := e.rcitem;
{if SelectedRow = e.id then
if ifnumber(SelectRowColor) then dc.brush.color := SelectRowColor;
else
dc.brush.color := rgb(150,150,150);
else }
if color then dc.brush.color := color; //
c := color;
if c then dc.brush.color := c; //
else dc.brush.color := rgb(255,255,255);
dc.fillrect(rc);
inherited;
@ -1309,9 +1329,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
if d["type"]="object" then
begin
rd := GetCellRender(d["class"]);
if r then return r.CelldbClick(o,e,d);
rd := GetCellRender(d["class"]);
if rd then return rd.CelldbClick(o,e,d); ///////////
end
getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs);
end else
@ -1356,24 +1375,6 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
return r;
idx := "FData";
for i,v in index do
begin
if ifnumber(v)then idx += format("[%d]",v);
else if ifstring(v)then
begin
idx += format('["%s"]',v);
end
end
if length(idx)>5 then
begin
vals := idx+":="+tostn(val)+";"; //FData["c"]["value"]:=0;
try
eval(&vals);
except
//echo "===errr";
end;
end
end
function ControlIndexs(dx);
begin
@ -1454,7 +1455,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
property Twodimensional:bool read FShowTwo write SetTwoD;
property TSLdata:variable read GetTSLData write SetData;
property ColumnWidth:integer read FColumnWidth write FColumnWidth;
property dfColumnWidth:integer read FdfColumnWidth write FdfColumnWidth;
property RowHeader:bool read FRowHeader write SetRowHeader;
property CanEditStr:bool read FCanEditStr write FCanEditStr;
property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign;
@ -3045,6 +3046,7 @@ private
public
function create(aOwner);override;begin
inherited;
ParentFont := false;
caption:="TreeViewEditor";
left:=300;
top:=300;
@ -3250,13 +3252,15 @@ type TMultiSelList = class(TCustomControl)
function Create(AOwner);
begin
inherited;
FBtnWidth := 80;
border := true;
FList := new TListBox(self);
FList.checkbox := true;
FList.Multisel := 2;
//FList.Appenditems(array("a","b","c"));
FList.setCurrentSelection(array(0,1));
FList.parent := self;
FOkBtn := new TBTN(self);
FBtnWidth := 80;
FOkBtn := new TBTN(self);
FOkBtn.width := FBtnWidth;
FOkBtn.caption := "确定";
FOkBtn.parent := self;
@ -3266,7 +3270,20 @@ type TMultiSelList = class(TCustomControl)
FCanceBtn.parent := self;
FCanceBtn.onclick := thisfunction(CancelClick);
FOkBtn.onclick := thisfunction(okClick);
OnFontChanged := thisfunction(DoControlAlign);
end
{function FontChanged(o);override;
begin
ft := font;
if not ft then return ;
inherited;
FBtnWidth := 5*ft.width;
FOkBtn.height := ft.height+5;
Fokbtn.width := FBtnWidth;
FCanceBtn.height := ft.height+5;
FCanceBtn.width := FCanceBtn;
end }
function GetSelectdata();
begin
idx := FList.getSelectedIndexes();
@ -3313,18 +3330,24 @@ type TMultiSelList = class(TCustomControl)
end
function DoControlAlign();override;
begin
if FList and FOkBtn AND FCanceBtn then
ft := font;
if ft and FList and FOkBtn AND FCanceBtn then
begin
r := ClientRect;
h := FOkBtn.height;
h :=ft.height+4;
w :=ft.width*5;
c := r;
c[3]-=h+4;
FList.SetBoundsRect(c);
bt := r[3]-h-1;
FOkBtn.height := h;
FOkBtn.width := w;
FOkBtn.Top := bt;
FOkBtn.Left := r[2]-FBtnWidth-5;
FOkBtn.Left := r[2]-w-5;
FCanceBtn.top := bt;
FCanceBtn.Left := r[2]-FBtnWidth-FBtnWidth-10;
FCanceBtn.height := h;
FCanceBtn.width := w;
FCanceBtn.Left := r[2]-w*2-10;
end
end
function CancelClick(o,e);

6
designer/utslvclsyntaxparser.tsf
View File

@ -958,6 +958,12 @@ type tsltoken = class(tslparserbase) //
vf := 1;
setdata(FTokens,nk,v,"»Ø³µ",pos,hh);
end else
if v="." and (pos< len-2) and str[pos+1]="." and str[pos+2]="." then
begin
if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);
setdata(FTokens,nk,"...","Óï¾ä",pos,3);
pos+=2;
end else
if v in array(",",";",".","]","[",":","=","!")then
begin
if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);

BIN
editor-install.exe
View File

Binary file not shown.

38
funcext/tvclib/tcomponent.tsf
View File

@ -248,7 +248,7 @@ private
if op=opRemove or op=opInsert then return 0;
if fonnotification then
begin
e := new tuieventbase(op,0,0,0);
e := new unit(utslvclevent).tmnotif(op);
e.sender := a;
CallMessgeFunction(fonnotification,self(true),e);
return e.skip;
@ -258,7 +258,7 @@ private
begin
if foninqurequit then
begin
e := new tuieventbase(0,0,0,0);
e := new unit(utslvclevent).tminqurequit();//tuieventbase(0,0,0,0);
CallMessgeFunction(foninqurequit,self(true),e);
return e.skip;
end
@ -335,12 +335,6 @@ public //
FEventsProperties := array();
FVariableProperties := array();
FComponentCreated := true;
return;
If AOwner is class(tcomponent)then
begin
FOwner := AOwner;
AOwner.InsertComponent(Self);
end
end
function set_loadstate(v); //设置loading状态
begin
@ -519,30 +513,6 @@ public //
FChangedinheritedProperties;
FChangedProperties;
FVariableProperties;
{function GetPublishInfo();//属性获取
begin
r := publishs();
rr := array();
ri := 0;
for i,v in r do
begin
if ifstring(v) then rr[ri++] := lowercase(v);
end
return rr;
end }
{function OrderPublish(r,od); //排序发布的东西
begin
if od then
begin
r1 := array();
for i,v in od do
begin
vi := r[v];
if vi then r1[v]:= vi;
end
r := r1;
end
end}
public //设计器属性设置相关
function GetPublishproperties();virtual; //获得属性信息
begin
@ -551,7 +521,6 @@ public //
**}
ps := GetPropInfo();
r := array();
//pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
@ -561,7 +530,6 @@ public //
if otype then
begin
n := v["name"];
//if pps and not(n in pps)then continue;
if typ in array("variable","popupmenu","syscursor","tmainmenu")then
begin
r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
@ -676,7 +644,6 @@ public //
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
//if FChangedProperties[n]=vi then continue; //没有改变
if FChangedProperties[n]=iv then continue; //没有改变
SetChangedPublish(n,iv,pp); //保存
if n="visible" or n="wspopup" or n="enabled" then
@ -724,7 +691,6 @@ public //
@param(ComponentStyle)() 样式结合 %%
@param(ComponentCreated)(bool) 样式结合 %%
**}
//property DesignInfo read FDesignInfo write FDesignInfo;
property ComponentCreated read FComponentCreated;
property Components read FComponents;
property ComponentState read FComponentState write SetComponentState;

100
funcext/tvclib/tcontrol.tsf
View File

@ -441,42 +441,66 @@ type tcontrol = class(tcomponent)
{**
@explan(说明)根据消息参数构造消息对象;
**}
if message in array(WM_MOUSEMOVE,WM_LBUTTONDOWN,
case message of
WM_CLOSE :
begin
r := new tmclose(message,wparam,lparam,hwnd);
end
WM_MOUSEMOVE :
begin
r := new tmm_move(message,wparam,lparam,hwnd);
end
WM_CONTEXTMENU :
begin
r := new tmcontextpop(message,wparam,lparam,hwnd);
end
WM_LBUTTONDOWN,
WM_RBUTTONDOWN,WM_LBUTTONUP,
WM_RBUTTONUP,WM_LBUTTONDBLCLK,
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK)then
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end else
if message=WM_MENUSELECT then
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end else
if message=WM_MEASUREITEM then
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end else
if message in array(WM_KEYDOWN,WM_KEYUP,WM_CHAR,WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP)THEN
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end else
if message=WM_DRAWITEM then
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end else
if message=WM_NOTIFY then
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end else
if message=WM_MOUSEWHEEL then
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end else
if message=WM_STYLECHANGED or message=WM_STYLECHANGING then
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end else
r := new tuieventbase(message,wparam,lparam,hwnd);
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK :
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end
WM_MENUSELECT :
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end
WM_MEASUREITEM :
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end
WM_ACTIVATE :
begin
r := new tmactivate(message,wparam,lparam,hwnd);
end
WM_KEYDOWN,WM_KEYUP,
WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP :
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end
WM_CHAR:
begin
r := new tmk_press(message,wparam,lparam,hwnd);
end
WM_DRAWITEM :
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end
WM_NOTIFY :
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end
WM_MOUSEWHEEL :
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end
WM_STYLECHANGED ,WM_STYLECHANGING :
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end
else
r := new tuieventbase(message,wparam,lparam,hwnd);
end ;
return r;
//return new tuieventbase(message,wparam,lparam,hwnd);
end
@ -1014,7 +1038,7 @@ type tcontrol = class(tcomponent)
function WMMove(o,e):LM_MOVE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnMove,o,e);
CallMessgeFunction(fOnMove,o,e);
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
@ -1029,7 +1053,7 @@ type tcontrol = class(tcomponent)
function WMSize(o,e):LM_SIZE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
CallMessgeFunction(fOnSize,o,e);
DoWMSIZE(o,e);
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
@ -1524,7 +1548,7 @@ type tcontrol = class(tcomponent)
info := fonGetPreferredSize.functioninfo();
fn := info["functionname"];
if ifstring(info["classname"]) then fn := info["classname"] $ "." $ fn;
fn := "onGetPreferredSize call: "$fn $" err!";
fn := "onGetPreferredSize call: "$fn $" err!" $ exceptobject.errinfo;
except
fn := "onGetPreferredSize is not function";
end ;
@ -1580,7 +1604,7 @@ type tcontrol = class(tcomponent)
@param(Cursor)(tcursor 通过 member of TSystemCursor 设置) 系统鼠标 %%
**}
property Font:font read GetControlFont write SetControlFont;//write SetFont;
property OnMouseWheel read FOnMouseWheel write FOnMouseWheel;
property OnMouseWheel:eventhandler read FOnMouseWheel write FOnMouseWheel;
{**
@param(Caption)(string) 控件标题 %%
@param(Enabled)(bool) 控件是否有效 %%

1
funcext/tvclib/tcustomcontrol.tsf
View File

@ -18,6 +18,7 @@ type tcustomcontrol=class(TWinControl)
cvs.rcpaint := PAINTSTRUCT().rcpaint();
try
Paint();
inherited;
finally
cvs.Handle := 0;
end;

2
funcext/tvclib/tgraphiccontrol.tsf
View File

@ -74,6 +74,7 @@ type tgraphiccontrol = class(TControl)
p := Parent;
if(p is class(TWinControl))and p.HandleAllocated()then
begin
if p.autosize and (p.childsizing.layout<>0) then return p.AdjustSize();
if Align <> alNone then return p.DoControlAlign();
end
//////////////////
@ -182,6 +183,7 @@ type tgraphiccontrol = class(TControl)
inherited;
if NewParent is class(TWinControl)then
begin
if NewParent.autosize or (NewParent.childsizing.layout<>0) then NewParent.AdjustSize();
InvalidateRect();
end
end

46
funcext/tvclib/tslvcl.tsf
View File

@ -33,10 +33,10 @@ function ExitMessageLoop(); //
function NotifyComponent(Sender,Act,ToComponent); //notfiy
//////////////////////操作/////////////////////
Function tslcstructure(data,dsize,pack,ptr);
//function CompareRect(orect,nrect);
function calldatafunction();
function CallMessgeFunction(f,o,e);
function CallMessageFunction(f,o,e); //执行消息回调
//////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err); //检查tsl语法
@ -1276,6 +1276,7 @@ type TpanelForm=class(tpanel) //
protected
function SetWsPopUp(v);override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
end else
@ -1285,6 +1286,7 @@ type TpanelForm=class(tpanel) //
end
function GetWsPopUp();override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
return true;
@ -1317,7 +1319,7 @@ type TpanelForm=class(tpanel) //
end
function SetDesigning(f,fc);override;
begin
if f then wspopup := true;
if f and (self(true).classinfo()["classname"]="tdcreatepanel") then wspopup := true;
inherited;
end
end
@ -1489,8 +1491,13 @@ type tmemo = class(TSynMemoNorm) //
function DoTextChanged(p);override;//文本改变
begin
inherited;
if Fonchange then
calldatafunction(Fonchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonchange,self(true));
end
function GetPreferredSize(w,h);override;
begin
if onGetPreferredSize then return inherited;
w := Width;
h := Height;
end
function MouseUp(o,e);override;
begin
@ -1594,11 +1601,17 @@ type twrapmemo = class(TScrollingWinControl)
end
end
end
function GetPreferredSize(w,h);override;
begin
if onGetPreferredSize then return inherited;
w := Width;
h := Height;
end
function FontChanged(o);override;
begin
if HandleAllocated() then doControlALign();
end
protected
protected
function GetXScrollDelta();override; //x间隔
begin
return FCharwidth;
@ -3579,8 +3592,7 @@ type TListView = class(TDrawGrid)
end
function CallSelChanged();
begin
if OnSelChanged then
return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FSelectedChanged,self(true));
end
function SetCanSelected(v);
begin
@ -5191,7 +5203,7 @@ type TQuotations=class(tcomponent)
**}
if not ifarray(d)then exit;
FData := d;
calldatafunction(FOncallBack,self(true));
CallMessgeFunction(FOncallBack,self(true));
end
public
function create(AOwner);override;
@ -5784,7 +5796,11 @@ type Ttfm2Component = class(TTmfParser)
end
function hastfmresource(o,cn);
begin
data := get_resource_by_name(cn+".tfm");
////////////根据新特性处理/////////
ci := o.classinfo();
data := ci["tfm"];
///////////////////////////////////////
if not data then data := get_resource_by_name(cn+".tfm");
if data then
begin
LoadFromTfmScript(o,data);
@ -5844,20 +5860,22 @@ type Ttfm2Component = class(TTmfParser)
function GetReSourcetfmdir(p,rp);
begin
if not ifarray(rp) then rp := array();
rp[length(rp)] := p;
iofp := ioFileseparator();
for ii,vv in filelist("",p+"*") do
begin
fn := vv["FileName"];
if fn="." or fn=".." then continue;
if Pos("D",vv["Attr"]) then
begin
if lowercase(fn)="resource.tfm" then
begin
GetReSourcetfmdir(p+fn+iofp,rp);
{if lowercase(fn)="resource.tfm" then
begin
rp[length(rp)] := p+"resource.tfm"+iofp;
end else
begin
GetReSourcetfmdir(p+fn+iofp,rp);
end
end }
end
end
end
@ -6512,6 +6530,10 @@ function GetTextWidthAndHeightWidthFont(s,f,mul);//
begin
return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
end
function CallMessageFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
end
function CallMessgeFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);

5
funcext/tvclib/tuieventbase.tsf
View File

@ -64,6 +64,11 @@ type tuieventbase=class(TSLUICONST)
Lparam := l;
Hwnd := h;
end
function expandinfo();virtual; //作为函数参数展开
begin
//返回二维数组,字段 name ,var,alias,type
return array();
end
function hilparam();
begin
{**

96
funcext/tvclib/twincontrol.tsf
View File

@ -62,6 +62,7 @@ type TWinControl = class(tcontrol)
FWsDlgModalFrame;
private //模态相关
//*******showmodal******************
fmodalcenter;//模态居中
FModaling;
FModalCode;
FMinWidth;
@ -129,6 +130,7 @@ type TWinControl = class(tcontrol)
FMSG := new TTagMSG();
msg := FMSG._getptr_;
//显示自己
center_self();
_wapi.ShowWindow(hWnd,SW_SHOW);
_wapi.BringWindowToTop(hWnd);
//disable掉父窗口
@ -590,9 +592,14 @@ type TWinControl = class(tcontrol)
if v=SW_SHOWNOACTIVATE then return ;
}
_wapi.ShowWindow(FHandle,v?SW_SHOW:SW_HIDE);
if(Parent is class(TWinControl))and parent.HandleAllocated()then
p := parent;
if(p is class(TWinControl))and p.HandleAllocated()then
begin
if Align <> alNone then Parent.DoControlAlign();
if (p.autosize or (p.childsizing.layout<>0) ) then
begin
p.AdjustSize();
end else
if Align <> alNone then p.DoControlAlign();
end
{if V then
begin
@ -913,7 +920,7 @@ type TWinControl = class(tcontrol)
function WMACTIVATE(o,e):WM_ACTIVATE;virtual;
begin
factivated := e.wparam;
CallMessgeFunction(OnActivate,o,e);
CallMessgeFunction(fOnActivate,o,e);
if e.skip then return ;
defaulthandler(e);
if factivated and ContainsControl(factivecontrol) then
@ -1552,6 +1559,27 @@ type TWinControl = class(tcontrol)
end
procedure PaintWindow(DC:HDC);virtual;
begin
///////////////////设计器中选中绘制/////////////////////////////////////////////
if (csDesigning in ComponentState) and FDesignSelect then //选中
begin
c := getwndclientrect();
x := (c[0]+c[2])/2;
y := (c[1]+c[3])/2;
ps := array(
(x,c[1]),
(c[0],y),
(c[2],y),
(x,c[3])
);
cvs := Canvas;
cvs.Brush.color := sys_complementar_color(Color);
sz := 4;
for i,v in ps do
begin
cvs.draw_rect().rect(array(v[0]-sz,v[1]-sz,v[0]+sz,v[1]+sz)).draw();
end
end
////////////////////////////////////////////////////
end
function SetTempCursor(Value);override;
begin
@ -1787,6 +1815,7 @@ type TWinControl = class(tcontrol)
hParentWnd := hParentWndt;
end
end
Visible := false; //20250508 添加处理关闭按钮
return EndModalCode;
end
function UpdateWindow();
@ -1940,6 +1969,7 @@ type TWinControl = class(tcontrol)
end
function create(aowner);override; //type_twinctrol
begin
fmodalcenter := true;
inherited;
fchildsizing := new t_children_sizer(self(true));
//fbordercolor := rgb(190,190,190);
@ -2067,17 +2097,20 @@ type TWinControl = class(tcontrol)
dy := 20;
x := 0;
y := 0;
c := 0;
c := sys_complementar_color(color);
bbc := cv.brush.color;
cv.brush.color := c;
while y<rc[3] do
begin
y+=dx;
x := 0;
while x<rc[2] do
begin
x+=dx;
cv.SetPixel(array(x,y),c);
x+=dx;
cv.FillRect(array(x-1,y-1,x+1,y+1));
end
end
cv.brush.color := bbc;
ctls := controls;
rcs := array();
sel := -1;
@ -2106,7 +2139,7 @@ type TWinControl = class(tcontrol)
pct := cv.pen.style;
pcw := cv.pen.width;
cv.pen.Style := PS_DOT;
cv.pen.color := 0x3f3f3f;
cv.pen.color := c;//0x3f3f3f;
for i := 0 to len do
begin
if i=sel then continue;
@ -2288,6 +2321,14 @@ type TWinControl = class(tcontrol)
end
end
private //绘制相关成员
function sys_complementar_color(c);
begin
if (c .& 0xff000000) then
begin
return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
end
return complementary_color(c);
end
FPaintRects;
FUpDateCount;
public
@ -2547,7 +2588,7 @@ type TWinControl = class(tcontrol)
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(OnDesignClick,self(true),e);
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
@ -2556,11 +2597,11 @@ type TWinControl = class(tcontrol)
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(OnDesignDBLClick,self(true),e);
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(OnDesignRClick,self(true),e);
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end else
if msg = WM_USER then
begin
@ -2896,11 +2937,11 @@ type TWinControl = class(tcontrol)
property OnActivate:eventhandler read FOnActivate write FOnActivate;
property OnClose:eventhandler read FOnClose write FOnClose;
property OnKeyDown:eventhandler read FOnKeyDown write FOnKeyDown;
property OnsysKeyDown:eventhandler read FOnsysKeyDown write FOnsysKeyDown;
property OnsysKeyDown read FOnsysKeyDown write FOnsysKeyDown;
property OnKeyUp:eventhandler read FOnKeyUp write FOnKeyUp;
property OnsysKeyUp:eventhandler read FOnsysKeyUp write FOnsysKeyUp;
property OnsysKeyUp read FOnsysKeyUp write FOnsysKeyUp;
property OnKeyPress:eventhandler read FOnKeyPress write FOnKeyPress;
property OnSysKeyPress:eventhandler read FOnSysKeyPress write FOnSysKeyPress;
property OnSysKeyPress read FOnSysKeyPress write FOnSysKeyPress;
property OnDesignClick read FOnDesinedsel write FOnDesinedsel;
property OnDesignDBLClick read FOnDesigDBLClick write FOnDesigDBLClick;
property OnDesignRClick read FOnDesinedRclick write FOnDesinedRclick;
@ -2917,7 +2958,34 @@ type TWinControl = class(tcontrol)
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
property childsizing:tchildsizing read fchildsizing write setchildsizing;
property modalcenter read fmodalcenter write fmodalcenter; //模态时候居中
private //模态相关
function center_self();
begin
////////////////////窗口居中处理/////////////////////////////////
////////////////////wnd待居中的窗口/////////////////////////////////
////////////////////pwnd父窗口/////////////////////////////////
if not fmodalcenter then return ;
wnd := self(true);
pd := wnd.parent;
if pd and pd.Visible then
begin
while not(pd.wspopup) do
begin
npd := pd.parent;
if npd then pd := npd;
else break;
end
r := pd.ClientRect;
xy := pd.clienttoscreen(r[0],r[1]);
end else
begin
xy := array(0,0);
r := wnd._wapi.GetScreenRect();
end
wnd.Left := max(0,xy[0]+(r[2]-r[0]-wnd.width)/2) ;
wnd.top := max(0,xy[1]+(r[3]-r[1]-wnd.Height)/2);
end
property Modaling read FModaling;
{**
@param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@ -2927,7 +2995,7 @@ type TWinControl = class(tcontrol)
@param(OnClose)(function[TWincontrol,tuieventbase]) 窗口关闭消息回调 %%
@param(OnKeyDown)(function[TWincontrol,TMKEY]) 按键按下回调 %%
@param(OnKeyUp)(function[TWincontrol,TMKEY]) 按键松开 %%
@param(OnKeyPress)(function[TWincontrol,TMKEY]) ×Ö·ûÏûÏ¢ %%
@param(OnKeyPress)(function[TWincontrol,tmk_press]) 字符消息 %%
**}
private //ShortCut
function dispatchshortcut(c,st); //快捷键分发

36
funcext/tvclib/ugtkinterface.tsf
View File

@ -1062,6 +1062,16 @@ type tsgtkapi = class(tgtkapis)
end
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;
begin
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
fmt := (fmt>0 or fmt<0)?fmt:0;
dfs := (fmt .& DT_SINGLELINE) = DT_SINGLELINE;
slen := length( txt);
if slen<1 then return ;
ft := gtk_object_get_data(hdc,"font");
@ -1082,23 +1092,19 @@ type tsgtkapi = class(tgtkapis)
if vi="\r" then continue;
if vi="\n" then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
if not dfs then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
end
continue;
end
rl++;
end
if dfs then slen := rl;
ht := ht*rs;
mxl := max(mxl,rl);
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
//DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
mxl := max(mxl,rl);
rw := rec[2]-rec[0];
nlen := min(len, min(integer(rw/wd),mxl));
sx := rec[0];
@ -1140,7 +1146,11 @@ type tsgtkapi = class(tgtkapis)
y := 0;//gtk_object_get_data(hdc,"viewport.y");
reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
cairo_clip_rec(hdc,reci);
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
if dfs then
begin
r := TextOutexA(hdc,sx,sy-dht,replacetext(replacetext(txt,"\r",""),"\n",""),slen);
end else
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
cairo_restore(hdc);
return r;
end

141
funcext/tvclib/utslmemo.tsf
View File

@ -456,7 +456,9 @@ type TCustomMemoCmd=class() //
static const ecPrevBlock=0x2BE;static const ecNextJumpOut=0x2BF;static const ecPrevJumpOut=0x2C0;
static const ecUserFirst=0x3E9;static const ecFind=0x3EA;static const ecReplace=0x3EB;
static const ecSearchAgain=0x3EC;static const ecFindAll=0x3ED;static const ecString=0x3EE;
static const ecSearchUpAgain=0x3EF;
static const ecSearchUpAgain=0x3EF;
//////////////////////选择模式/////////////////////////////////
static const smNormal = 0;static const smLine = 1;static const smColumn = 2;
end
type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //编辑器基类
@ -518,10 +520,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
static const crUnindent = 7;
static const crSilentDelete = 8;
static const crSilentDeleteAfterCursor = 9;
static const crNothing = 10;
static const smNormal = 0;
static const smLine = 1;
static const smColumn = 2;
static const crNothing = 10;
//****************
protected
@ -693,9 +692,42 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
cvs.Brush.Color := fselectbkcolor;//rgb(192,192,192);
src := r;
if FSelectionMode=smLine then
if FSelectionMode=smLine then //行选择
begin
end else
if FSelectionMode=smColumn then //块选择
begin
if bb[0]=ee[0] then
begin
src[0]+= fCharWidth *(bb[1]-1);
src[2]:= src[0]+fCharWidth *(ee[1]-bb[1]);
end
else
begin
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
s := FLines.GetStringByIndex(i);
ls := length(s);
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
src[0]+= fCharWidth *(bb[1]);
dx := -1;
end
else src[0]+= fCharWidth *(bb[1]-1);
end ;
case bytetype(s,ee[1]-1) of
1:src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+1+dx));
else src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+dx));
end ;
end
end else
begin
if bb[0]=ee[0]then //同一行
begin
@ -729,8 +761,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
if bytetype(dtx,i)<> 0 then
begin
bn := ft.charset;
ft.charset := 134;
//bn := ft.charset;
//ft.charset := 134;
break;
end
end
@ -747,8 +779,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
if bytetype(dtx,i)<> 0 then
begin
bn := ft.charset;
ft.charset := 134;
//bn := ft.charset;
//ft.charset := 134;
break;
end
end
@ -757,10 +789,10 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
r[2]:= r[0]+ct * FCharWidth;
cvs.DrawText(dtx2,r,DT_NOPREFIX);
end
if bn <> 100000 then
{if bn <> 100000 then
begin
ft.charset := bn;
end
end}
end
function paintlinestext(RC,FirstLine,LastLine,FirstCol,LastCol);virtual;
@ -1027,7 +1059,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if ftmemlockv.locked then return ;
if e.skip then return;
c := e.wparam;
if ReadOnly then return;
if ReadOnly or (FSelectionMode=smColumn) then return;
if c=13 then return CharInput("\r\n");
if c<32 and not(c in array(9))then return;
cc := e.char;
@ -1139,7 +1171,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function CharInput(c);virtual;//插入字符
begin
if not ReadOnly then return InsertChars(c);
if not(ReadOnly or (FSelectionMode=smColumn)) then return InsertChars(c);
end
function ExecuteCommand(cmd,data);override;//执行命令
begin
@ -1801,7 +1833,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function SetSelectionMode(v);
begin
if(v <> FSelectionMode)and(v in array(smNormal,smLine))then FSelectionMode := v;
if(v <> FSelectionMode)and(v in array(smNormal,smLine,smColumn))then FSelectionMode := v;
end
function MoveCaretHorz(stp,sel);
begin
@ -2236,7 +2268,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
function GetBlockEnd();
begin
if GetSelAvail()then
begin
begin
if fBlockEnd[0]<fBlockBegin[0]or(fBlockEnd[0]=fBlockBegin[0]and fBlockEnd[1]<fBlockBegin[1])then return fBlockBegin;
else return fBlockEnd;
end
@ -2297,6 +2329,52 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if i<len then r += "\r\n";
end
end else
if sm=smColumn then
begin
if bb[0]=ee[0]then
begin
s := fLines[bb[0]-1].FStr;
if not s then return "";
bg := min(bb[1],ee[1]);
ed := max(bb[1],ee[1]);
if bg<ed then return s[bg:(ed-1)]; //2023078 出错
return "";
end else
begin
//第一行
r += "";
//中间
for i := bb[0]-1 to ee[0]-1 do
begin
s := fLines[i].FStr;
ls := length(s);
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
if bb[1]<=ls then
begin
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
bx := bb[1]+1;
dx := -1;
end
else bx := bb[1];
end ;
case bytetype(s,ee[1]-1) of
1: ex := min(ee[1],ls);
else ex:= min(ee[1]-1,ls);
end ;
if bx<=ex then r += s[bx:ex];
end
if i<ee[0]-1 then r += "\r\n";
end
//最后一行
end
end else
begin
if bb[0]=ee[0]then
begin
@ -2958,7 +3036,7 @@ type TSynHighLighter = class(TComponent) //
r := FCacheTokens[ridx];
if r then return r;
s := Flines.GetSTringByIndex(ridx);
if not ifstring(s) then return;
if not ifstring(s) then return nil;
idx := 1;
len := length(s);
tks := array();
@ -3199,6 +3277,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then return FTokens[idx];
return nil;
end
function SetTToken(tokens,ttk,idx,ext);override; //设置token
begin
@ -3766,7 +3845,7 @@ type TSynCustomMemo = class(TCustomMemo)
end
function CharInput(c);override; //字符输入
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
if c="\r\n" then
begin
if FinishCompletion() then //确定键
@ -4061,28 +4140,28 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
ord("V"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecPaste);
end
ord("X"):
begin
//if (ssAlt in e.shiftstate) then return ExecuteCommand(ecRedo);
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecCut);
end
ord("Y"),ord("L"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecDeleteLine);
end
ord("Z"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecUndo);
end
ord("U"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecRedo);
end
VK_LEFT:
@ -4115,7 +4194,7 @@ type TSynMemoNorm = class(TsynCustomMemo) //
VK_TAB:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
FSheetTabFlage := true;
return ExecuteCommand(ecShifttab,array(TabChar,"\t"," "));
end
@ -4182,13 +4261,13 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
VK_DELETE:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteChar);
return CancelCompletion();
end
VK_BACK :
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteLastChar,1);
return CancelCompletion();
end
@ -4216,23 +4295,23 @@ type TSynMemoNorm = class(TsynCustomMemo) //
begin
if fw>7 then
begin
if fw=18 then
{if fw=18 then
begin
fw := 17;
hw := 34;
end
end }
flg := true;
font := array("width":fw-1,"height":hw-2);
end
end else
begin
if fw<18 then
if fw<44 then
begin
if fw=16 then
{if fw=16 then
begin
fw := 17;
hw := 34;
end
end }
flg := true;
font := array("width":fw+1,"height":hw+2);
end

3
funcext/tvclib/utslvclaction.tsf
View File

@ -82,8 +82,7 @@ type TBasicAction=class(TComponent)
if csDesigning in ComponentState then return ;
if FOnExecute then
begin
e := new tuieventbase(0,0,0,0);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true));
return true;
end
return false;

137
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -615,7 +615,7 @@ type tarray1dlk=class //
function dochanged(info);
begin
if onchangelock then return ;
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
end
function SwapNoCheck(i,j);
begin
@ -910,7 +910,7 @@ type tstrindexarray = class() //
begin
{**
@explan(˵Ã÷) »ñµÃtsl array %%
@param(n)(bool) false 返回小写下标，true 返回原始下标 %%
@param(n)(bool) true 返回小写下标，false 返回原始下标 %%
**}
r := array();
for i,v in FData do
@ -3450,8 +3450,9 @@ end;
//////////////////////////////////////
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return fn and ifobj(fn);
//return fn and ifobj(fn);
end
function includestate(u,s);
begin
@ -4039,12 +4040,136 @@ begin
if m in array(1,3,5,7,8,10,12) then return 31;
return 30;
end
function CallMessgeFunction2(f,o,e);
begin
{**
@ignore(忽略)
**}
if iffuncptr(f) then return call(f,o,e);
end
function get_evt_expand(e,n); //展开形式
begin
if (n=0 or n>2) and (e is class(tuieventbase)) then
begin
ps := e.expandinfo();
//echo e.Classinfo()["classname"],"\r\n";
if ps and ifarray(ps) then
begin
r := ps[0:(n-3)];
len := length(r);
n := len+2;
return r;
end
end
n := min(n,2);
return array();
end
function CallMessgeFunction(f,o,e);
begin
{**
{**
@ignore(ºöÂÔ)
**}
if iffuncptr(f) then return call(f,o,e);
**}
if not iffuncptr(f) then return ;
//////////////事件信息处理//////////////
ff := f.functioninfo();
ffp := ff["parameter"];
plen := length(ffp);
ex := get_evt_expand(e,plen);
//////////////////////////////////
case plen of
1:
begin
r := call(f,o);
end
3:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
r := call(f,o,e,x0);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
end
4:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
r := call(f,o,e,x0,x1);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
end
5:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
r := call(f,o,e,x0,x1,x2);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
end
6:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
r := call(f,o,e,x0,x1,x2,x3);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
end
7:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
end
8:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
end
9:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
if ifstring(ex[6,"name"]) then x6 := invoke(e,ex[6,"name"]); else x6 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5,x6);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
if ex[6,"var"] then invoke(e,ex[6,"name"],1,x6);
end else
begin
r := call(f,o,e);
end
end ;
return r;
end
function CheckArrayIsNumbers(Value,n);
begin

151
funcext/tvclib/utslvclevent.tsf
View File

@ -74,6 +74,13 @@ type tmmeasuresize = class(tuieventbase)
width := -1;
height := -1;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"width","alias":"wd","type":"integer","var":true);
r[1] := array("name":"height","alias":"ht","type":"integer","var":true);
return r;
end
width;
height;
end
@ -106,8 +113,17 @@ type TMKEY=class(tuieventbase)
function create(m,w,l,h);override;
begin
inherited;
FChar := chr(w);
if w>0 then
FChar := chr(w);
else FChar := chr(0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"charcode","alias":"key","type":"word");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
return r;
end
property char read FChar;
property CharCode read wparam;
property shiftstate read getshiftsate;
@ -117,6 +133,22 @@ type TMKEY=class(tuieventbase)
@param(shiftstate)(arry of TShiftStateEnum member ) ascii码 %%
**}
end
type tmk_press=class(TMKEY)
{**
@param(说明) 按键输入
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"char","alias":"key","type":"string");
return r;
end
end
Type TtageDrawItem=class(tslcstructureobj)
private
@ -265,7 +297,7 @@ type TSIFTSTATE = class(TSLUICONST)
end;
end
type TMMOUSEWHEEL=class(tuieventbase)
type tmmousewheel=class(tuieventbase)
{**
@explan(说明)鼠标滚动消息类 %%
**}
@ -288,12 +320,26 @@ type TMMOUSEWHEEL=class(tuieventbase)
property delta read hiwparamsigned;
property ypos read hilparamsigned;
property xpos read lolparamsigned;
property pos read getpos;
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[i++] := array("name":"delta","alias":"delta","type":"integer");
r[i++] := array("name":"pos","alias":"mousepos","type":"array of integer");
return r;
end
{**
@param(ypos)(integer)鼠标的y坐标 %%
@param(xpos)(integer)鼠标的x坐标 %%
@param(delta)(integer)运动距离 %%
**}
private
function getpos();
begin
return array(xpos,ypos);
end
FKeyState;
end
type TMMouse=class(tuieventbase)
@ -370,9 +416,110 @@ type TMMouse=class(tuieventbase)
shiftstate();
return(ssDouble in FKeyState);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"button","alias":"button","type":"tmousebutton");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[2] := array("name":"xpos","alias":"x","type":"integer");
r[3] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
private
FKeyState;
end
type tmm_move=class(TMMouse)
{**
@explan(说明) 鼠标移动消息类 %%
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[1] := array("name":"xpos","alias":"x","type":"integer");
r[2] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
end
type tmcontextpop = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property mousepos read getpos; //鼠标位置
function expandinfo();override;
begin
r := array();
r[0] := array("name":"mousepos","alias":"mousepos","type":"array of integer");
return r;
end
private
function getpos();
begin
return array(lolparamsigned(),hilparamsigned());
end
end
type tmnotif = class(tuieventbase) //通知消息
function create(op);
begin
inherited create(op,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"msg","alias":"msg");
r[1] := array("name":"skip","alias":"stopnotify","type":"bool","var":true);
return r;
end
end
type tmclose = class(tuieventbase) //窗口关闭
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopclose","type":"bool","var":true);
return r;
end
end
type tminqurequit = class(tuieventbase) //退出询问
function create();
begin
inherited create(0,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopquit","type":"bool","var":true);
return r;
end
end
type tmactivate = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property deactivate read getdeactivate;
function expandinfo();override;
begin
r := array();
r[0] := array("name":"deactivate","alias":"deactivate","type":"bool");
return r;
end
private
function getdeactivate();
begin
return Wparam=0;
end
end
type TMSTYLECHANG=class(tuieventbase)
{**
@explan(说明)窗口样式改变消息 %%

11
funcext/tvclib/utslvclgdi.tsf
View File

@ -256,11 +256,11 @@ type Tcustomfont = class(tgdi)
end
function Setcharset(v)
begin
if ifnumber(v)and v <> Fcharset then
{if ifnumber(v) and v <> Fcharset then
begin
Fcharset := v;
onchange();
end
end}
end
function Setoutprecision(v)
begin
@ -329,7 +329,7 @@ type Tcustomfont = class(tgdi)
begin
s += invoke(self,"f"+v0);
end else
vvi := invoke(self,"f"+v0);
vvi := invoke(self,"f"+v0);
if ifnumber(vvi)then s += inttostr(vvi);
else s += "0";
s += ";";
@ -427,12 +427,10 @@ type Tcustomfont = class(tgdi)
continue;
end
{$endif}
if v0="charset" then continue;
if not ifnil(vsv)then
begin
ovi := invoke(self,"f"+v0);
{$ifdef linux}{$else}
if (vsv=17 and v0="width") or (vsv=34 and v0="height") then continue;
{$endif}
if (ovi <> vsv) then
begin
invoke(self,"f"+v0,1,vsv);
@ -456,6 +454,7 @@ type Tcustomfont = class(tgdi)
if FWidth>0 then return FWidth;
return abs(FHeight)/2;
end
//property constmembers read fconstmembers write setconstmembers
property height read Fheight write Setheight;
property width read Fwidth write Setwidth;
property escapement read Fescapement write Setescapement;

52
funcext/tvclib/utslvclgrid.tsf
View File

@ -67,6 +67,18 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
// begin
// DoControlAlign();
// end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
if ongetpreferredsize then return inherited;
w := Width;
h := Height;
end
function DoControlAlign();override;
begin
if(IsUpDating())then
@ -816,7 +828,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
begin
if fonhitcellsizer then
begin
e := new tuieventbase(0,r,i,0);
e := new triddragsize(0,r,i,0);
CallMessgeFunction(fonhitcellsizer,self(true),e);
return e.skip;
end
@ -1169,11 +1181,47 @@ type tgriddrawcellevent = class(tuieventbase)
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
idx := 0;
r[idx++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[idx++] := array("name":"row","alias":"rowidx","type":"integer");
r[idx++] := array("name":"col","alias":"colidx","type":"integer");
r[idx++] := array("name":"rec","alias":"arec");
return r;
end
row;
col;
rec;
canvas;
end
end
type triddragsize=class(tuieventbase)
function create(a,b,c,d);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"r_or_c","alias":"r_or_c","type":"integer");
r[i++] := array("name":"skip","alias":"stopact","type":"bool","var":true);
return r;
end
property idx read getidx;
property r_or_c read getrc;
private
function getidx();
begin
return lparam;
end
function getrc();
begin
return wparam;
end
end
implementation
type TPAINTCOUNT=class()//»æÖƱê¼Ç
function create(v);

23
funcext/tvclib/utslvclmemstruct.tsf
View File

@ -1501,6 +1501,29 @@ type TMONITORINFO=class(tslcstructureobj)
property rcwork index "rcwork" read _getvalue_ write _setvalue_;
property dwflags index "dwflags" read _getvalue_ write _setvalue_;
end
type tagTRACKMOUSEEVENT=class(tslcstructureobj)
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("cbsize","int",0),
("dwflags","int",0),
("hwndtrack","pointer",),
("dwhovertime","int",200)));
return SSTRUCT;
end
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
cbsize := _size_();
end
property cbsize index "cbsize" read _getvalue_ write _setvalue_;
property dwFlags index "dwflags" read _getvalue_ write _setvalue_;
property hwndtrack index "hwndtrack" read _getvalue_ write _setvalue_;
property dwhovertime index "dwhovertime" read _getvalue_ write _setvalue_;
end
implementation
(*

193
funcext/tvclib/utslvclpage.tsf
View File

@ -1,4 +1,5 @@
unit utslvclpage;
/////////20250710 tab控件添加inert_tab方法//////////////////////////////////
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabsheet = class(TCustomControl) //控件页面
@ -71,15 +72,13 @@ type tcustomtabcontrol = class(TCustomControl)
begin
if FCurrentid<>-1 and fOnSelChanging then
begin
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
e := new tmtabselchanging(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
end
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
//InvalidateRect(nil,false);
//DoControlAlign();
DoControlAlign();
if FOnSelChanged then
begin
@ -92,43 +91,6 @@ type tcustomtabcontrol = class(TCustomControl)
FCurrentid := -1;
end
end
function RemovePageTab(id);//移除sheet
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
//CalcTabs();
//InvalidateRect(nil,false);
end
function CreateTableItem(cp);
begin
r := new tcustomtabitem();
@ -148,7 +110,7 @@ type tcustomtabcontrol = class(TCustomControl)
FTabHeight := fh+8;
end
FTabItemswidth := array();
e := new tuieventbase(0,0,0,0);
e := new tmtabmeasure(0,-1);
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i];
@ -400,7 +362,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
FirstViewIndex-- ;
DoControlAlign();//CalcTabs();
//InvalidateRect(nil,false);
end
end
function scrollnext(); //滚动到上一个
@ -419,8 +380,6 @@ type tcustomtabcontrol = class(TCustomControl)
end
end ;
FirstViewIndex++ ;
//CalcTabs();
//InvalidateRect(nil,false);
DoControlAlign();
end
end
@ -619,7 +578,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
it.Caption := Value;
DoControlAlign();
//InvalidateRect(nil,false);
end
end
function SetTabIndex(AIndex,AIndexnew);
@ -646,6 +604,59 @@ type tcustomtabcontrol = class(TCustomControl)
//InvalidateRect(nil,false);
end
end
function remove_tab_byidx(id);virtual;//移除tab
begin
{**
@explan(说明) 移除标签 %%
@param(idx)(integer) 序号 %%
**}
if not(id>=0 and id<FTabItems.length()) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
end
function insert_tab(c,idx);virtual; //插入tab
begin
{**
@explan(说明) 插入标签 %%
@param(c)(string) 标签 %%
@param(idx)(integer) 位置,默认为尾部 %%
**}
if not ifstring(c) then return 0;
cp := CreateTableItem(c);
if idx>=0 or idx<0 then FTabItems.splice(integer(idx),0,cp);
else FTabItems.Push(cp);
DoControlAlign();
return 1;
end
function Recycling();override;
begin
FOnSelChanged := nil;
@ -656,7 +667,7 @@ type tcustomtabcontrol = class(TCustomControl)
{**
@param(cursel)(integer) 当前选中序号 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanged)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
@ -790,6 +801,11 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if not (page is class(TWinControl)) then CalcTabs();
InvalidateRect(nil,false);
end
end
protected
function remove_tab_byidx(id);override;
begin
return inherited;
end
public
function GetPreferredSize(w,h);override;
@ -837,7 +853,7 @@ type tcustompagecontrol = class(tcustomtabcontrol)
begin
if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
id := GetPageID(AControl);
RemovePageTab(id);
remove_tab_byidx(id);
//fcoolbands.deleteitem(AControl,true);
end
Function SetCurSel(id);override; //设置当前序号
@ -946,6 +962,10 @@ type tcustompagecontrol = class(tcustomtabcontrol)
tabs;
faccepttype;
private
function insert_tab(c,idx);override; //插入tab
begin
end
function isacceptsheettype(c);
begin
for i,v in faccepttype do
@ -953,6 +973,64 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if c is v then return true;
end
end
end
type tmtabselchanging = class(tuieventbase) //改变
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"lparam","alias":"nselidx","type":"integer");
r[1] := array("name":"skip","alias":"stopchange","type":"bool","var":true);
return r;
end
end
type tmtabmeasure = class(tuieventbase)
function create(i,w);
begin
inherited create(nil,w,i,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"idx","alias":"idx","type":"integer");
r[1] := array("name":"width","alias":"wid","type":"integer","var":true);
return r;
end
property idx read wparam ; //序号
property width read lparam write lparam;//宽度
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"arec","type":"array of integer");
return r;
end
idx;
sel;
rec;
canvas;
end
implementation
type tcustomtabitem = class() //
@ -990,27 +1068,6 @@ type tcustomtabitem = class() //
property PageSheet read FPageSheet Write FPageSheet;
_tag;
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)单元格绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
idx;
sel;
rec;
canvas;
end
initialization
end.

188
funcext/tvclib/utslvclstdctl.tsf
View File

@ -502,7 +502,7 @@ type tcustombtn = class(TCustomControl) //
3: df := DT_RIGHT
4: df := DT_LEFT .| DT_VCENTER;
6: df := DT_RIGHT .| DT_VCENTER;
7: d := DT_BOTTOM .| DT_LEFT;
7: df := DT_BOTTOM .| DT_LEFT;
8: df := DT_BOTTOM .|DT_CENTER;
9: df := DT_BOTTOM .| DT_RIGHT;
else
@ -530,12 +530,46 @@ type tcustombtn = class(TCustomControl) //
end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
dw := (bs[2]-bs[0])-(cs[2]-cs[0]);
c := caption;lc := length(c);
ft := font;
fw := ft.Width;
fh := ft.Height;
if FtextPosition=0 then
begin
w := fw*(lc+2);
h := fh+4;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen)+2);
h := fh*rs+4;
end
w += dw;
h += dh;
end
function FontChanged(o);override; //字体改变
begin
@ -624,12 +658,11 @@ type tcustombtn = class(TCustomControl) //
end
function setTextPosition(n);
begin
if not ifnumber(n) or n<0 or n>9 then
n:=0;
else
n:=integer(n);
if not(n>=0 and n<=9) then return ;
n:=integer(n);
if FtextPosition=n then return ;
FtextPosition:=n;
AdjustSize();
InvalidateRect(nil,false);
end
function judgestate(o,e);
@ -684,7 +717,10 @@ type tcustomcheckbtn=class(tcustombtn) //checkbtn
function GetPreferredSize(w,h);override;
begin
inherited;
w+=20+1;
//w+=20+1;
c := caption;
if c then w+=21;
else w := 21;
end
published
property checked:bool read FcheckState write setChecked;
@ -2555,6 +2591,7 @@ type TcustomLabel = class(TGraphicControl)
if v <> FTextAlign then
begin
FTextAlign := v;
AdjustSize();
InvalidateRect(nil,true);
end
end
@ -2578,6 +2615,47 @@ type TcustomLabel = class(TGraphicControl)
set_Preferre_size();
inherited;
end
function GetPreferredSize(w,h);override;
begin
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
ft := font;
if not ft then return ;
fw := ft.Width;
fh := ft.Height;
c := caption;lc := length(c);
if FTextAlign=0 then
begin
w := fw*(lc)+2;
h := fh+3;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen))+2;
h := fh*rs+3;
end
bd := Border;
w += bd;
h += bd;
end
function FontChanged(o);override;
begin
inherited;
@ -2768,7 +2846,7 @@ type tcustomedit=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@ -2802,16 +2880,13 @@ type tcustomedit=class(TCustomControl)
inherited;
end
function doonmaxtext();
begin
if FOnMaxText then
CallMessgeFunction(FOnMaxText,self(true),new tuieventbase(0,0,0,0));
begin
CallMessgeFunction(FOnMaxText,self(true));
end
function DoChanged();
begin
if FOnChange then
CallMessgeFunction(FOnChange,self(true),new tuieventbase(0,0,0,0));
if FOnUpdate then
CallMessgeFunction(FOnUpdate,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FOnChange,self(true));
CallMessgeFunction(FOnUpdate,self(true));
end
function FontChanged(sender);override;
begin
@ -3479,6 +3554,16 @@ type TCustomListBoxbase=class(TCustomScrollControl)
begin
return FItemCount;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published
property ItemCount read GetItemCount write SetItemCount;
property ItemHeight read GetYScrollDelta;
@ -3530,6 +3615,15 @@ type tlistdrawevent = class(tuieventbase)
rec := r;
Canvas := c;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"ARect","type":"array of integer");
return r;
end
rec;
idx;
sel;
@ -3590,7 +3684,11 @@ type TcustomListBox=class(TCustomListBoxbase)
end
2:
begin
selchange := 1;
if FMultisel3Data[-1] then //ÐÞÕýÑ¡ÖиıäµÄÎÊÌâ20250430
begin
Reindex(FMultisel3Data,array(-1:nil));
end else
selchange := 1;
end
end;
if selchange then calllistselchengd();
@ -3703,7 +3801,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function PaintIdexText(idx,rc,cvs);virtual;
begin
if fownerdraw and Fondrawlist then
if fownerdraw and iffuncptr( Fondrawlist) then
begin
e := new tlistdrawevent(idx,rc[4],rc,cvs);
CallMessgeFunction(Fondrawlist,self(true),e);
@ -3768,7 +3866,12 @@ type TcustomListBox=class(TCustomListBoxbase)
FSelEnd := n2;
flg := true;
end
end
end else
if (FSelBegin>=0) and (n=-1) then
begin
FSelBegin := FSelEnd := -1;
flg := true;
end
if flg then
begin
InvalidateRect(nil,false);
@ -3801,7 +3904,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
return;
end
if not(isValidIndex2(n)) or n=FSelBegin then return;
if not(isValidIndex2(n) or n=-1) or n=FSelBegin then return;
SelRange(false);
FSelBegin := FSelEnd := n;
SelRange(true);
@ -4254,7 +4357,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function calllistselchengd();
begin
if FselectionChange then CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FselectionChange,self(true));
end
private
fselbkcolor;
@ -4307,7 +4410,7 @@ type TCustomComboBoxbase=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if onGetPreferredSize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@ -4589,6 +4692,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
end
function DoControlAlign();override;
begin
if not FEdit then return ;
rc := ClientRect;
rc[2]-= 20;
FEdit.SetBoundsRect(rc);
@ -5144,7 +5248,7 @@ type TcustomToolBar=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then return class(tcontrol).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h);
ftw := ft.Width;
fth := ft.Height;
brec := BoundsRect;
@ -6010,7 +6114,7 @@ type TcustomStatusBar=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@ -6068,6 +6172,7 @@ type TcustomStatusBar=class(TCustomControl)
{**
@explan(说明) 设置多个项目 %%
**}
if Fitems=its then return ;
Fitems := array();
for i,v in its do
begin
@ -6437,7 +6542,7 @@ type TCustomSpinEdit = class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
ft := Font;
if not ft then return ;
h := ft.Height+4;
@ -7017,7 +7122,7 @@ type tcustomipaddr = class(TCustomControl)
end
function DoIpChanged();
begin
return CallMessgeFunction(onAddrChange,self(true),new tuieventbase(0,0,0,0));
return CallMessgeFunction(FaddrChange,self(true));
end
function cleanAddr();
begin
@ -7121,7 +7226,7 @@ type tcustomipaddr = class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@ -7667,9 +7772,8 @@ type tcustomtimepicker = class(tthreeEntry)
ti := strtointdef(t,0);
if ti<0 then p.text := "24";
else if ti>24 then p.text := "0";
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true));
end
end
end
@ -7837,9 +7941,8 @@ type tcustomdatetimepicker = class(tthreeEntry)
ct := getmonthdates(y,m);
if d>ct then es[2].text := inttostr(ct);
end
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true)) ;
end
"dtadate":
begin
@ -7851,18 +7954,15 @@ type tcustomdatetimepicker = class(tthreeEntry)
es[0].text := inttostr(y);
es[1].text := inttostr(m);
es[2].text := inttostr(d);
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonselectchange,self(true));
end else
begin
y := strtointdef(es[0].text,2021);
m := strtointdef(es[1].text,1);
d := strtointdef(es[2].text,1);
return array(y,m,d);
end
end
end
end
end
end
function ShowDropDown(f);virtual;
@ -7976,8 +8076,7 @@ type tcustommonthcalendar = class(TCustomControl)
r := FCalender.ExecuteCommand("meselbypos",e.pos);
if std=3 or r="today" then
begin
if FonSelect then
CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelect,self(true));
end
end
end
@ -8025,8 +8124,7 @@ type tcustommonthcalendar = class(TCustomControl)
end
function DoDatechanged();
begin
if FonSelectChange then
CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelectChange,self(true));
end
function recycling();override;
begin

99
funcext/tvclib/utslvcltree.tsf
View File

@ -114,8 +114,8 @@ type ttreelistwnd = class(TCustomScrollControl)
FItemHeight := font.height+2;
FxClientMax := fColWidth;
FItemMinWidth := FxClientMax;
height := 400;
width := 300;
height := 150;
width := 250;
border := true;
autoscroll := 3;
ThumbTrack := true;
@ -453,6 +453,16 @@ type ttreelistwnd = class(TCustomScrollControl)
end
return r;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published //属性
property Items read GetItems;
property ItemCount read GetItemCount;
@ -574,23 +584,65 @@ type ttreelistwnd = class(TCustomScrollControl)
end
end
type TTreeSelCHngedEvent=class(tuieventbase)
type tm_nodeseling=class(tuieventbase)
{**
@explan(说明) 导航选择改变消息%%
@explan(说明) 节点选择正在改变%%
**}
function create(m,w,l,h);override;
function create(m,ito,itn,h);override;
begin
inherited;
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"itemold","alias":"node","type":"tcustomtreectlnode");
r[i++] := array("name":"itemnew","alias":"nselnode","type":"tcustomtreectlnode");
r[i++] := array("name":"skip","alias":"stopchang","type":"bool","var":true);
return r;
end
ItemOld;
ItemNew;
Item;
end
type tm_nodeseled=class(tm_nodeseling)
{**
@explan(说明) 节点选择成功改变%%
**}
function create(m,ito,itn,h);override;
begin
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := inherited;
r := r[0:length(r)-2];
return r;
end
ItemOld;
ItemNew;
Item;
Item;
end
type tm_nodechang = class(tuieventbase)
{**
@param(ItemOld)(TcustomTreeCtlNode) 旧的节点 %%
@param(ItemNew)(TcustomTreeCtlNode) 新节点 %%
@param(Item)(TcustomTreeCtlNode) 当前节点 %%
@explan(说明) 节点改变消息%%
**}
end
function create(m,w,l,h);
begin
Item := w;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"Item","alias":"node","type":"tcustomtreectlnode");
return r;
end
Item;
end
type TcustomTreeCtlNode = class(tsluibase) //树结点
{**
@explan(说明) 树结点 %%
@ -1617,10 +1669,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
begin
if FonEmptyNodeExapanding then
begin
e := new TTreeSelCHngedEvent(0,0,0,0);
e.item := pm;
e.ItemNew := pm;
e.ItemOld := pm;
e := new tm_nodechang(0,pm,0,0);
CallMessgeFunction(FonEmptyNodeExapanding,self(true),e);
end
end
@ -1832,6 +1881,16 @@ type TcustomTreeCtl = class(ttreelistwnd)
dc.pen.color := rgb(171,173,179);
dc.draw("polyline",ls);
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 100;
h := 125;
return ;
end
return inherited;
end
published //属性
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
@ -1970,12 +2029,14 @@ type TcustomTreeCtl = class(ttreelistwnd)
t1 := FCurrentNode;
//if t1 then InvalidateItem(t1,false);
//InvalidateItem(it,false);
ne := new TTreeSelCHngedEvent(0,0,0,0);
ne.ItemOld := t1;
ne.ItemNew := it;
ne.Item := it;
//ne := new TTreeSelCHngedEvent(0,0,0,0);
//ne.ItemOld := t1;
//ne.ItemNew := it;
//ne.Item := it;
ne := new tm_nodeseling(nil,t1,it);
CallMessgeFunction(FOnSelChanging,self(true),ne);
if ne.Skip then return true;
ne := new tm_nodeseled(nil,t1,it);
FCurrentNode := it;
CallMessgeFunction(FOnSelChanged,self(true),ne);
end

259
funcext/tvclib/utvclgraphics.tsf
View File

@ -207,7 +207,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -234,10 +234,10 @@ type tfm = class(tvcform)
line.lineinfo.color := 0xff0000;
line.markinfo.bkcolor := 0x00ff00;
line.markinfo.color := 0x0000ff;
line.mark_mode := "on";
line.mark_mode := tgc_on;
line.markinfo.size := 30;
line.markinfo.style := line.tgc_mks_pentagram;
line.polyline_style := line.tgc_LS_staircase;
line.markinfo.style := tgc_mks_pentagram;
line.polyline_style := tgc_LS_staircase;
d := array();
idx := 0;
for i:= -pi() to pi() step 0.2 do
@ -256,7 +256,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -280,7 +280,7 @@ type tfm = class(tvcform)
axs.axises(1).lineinfo.color := 0x00ff00;
sf := new tg_my_surf();
sf.lineinfo.color := 0x0000ff;
sf.lineinfo.style := sf.tgc_BS_SOLID;
sf.lineinfo.style := tgc_BS_SOLID;
sf.graph_data := get_surf_data();
sf.parent := axs;
return ;
@ -388,7 +388,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -402,7 +402,7 @@ type tfm = class(tvcform)
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.box := true;
axs.figure := fg.figure;
axs.figure := fg;
axs.title.text := "hello pie ";
axs.axises(1).tics_color := 0x0000ff;
axs.axises(1).fontinfo.size := 8;
@ -421,7 +421,7 @@ type tfm = class(tvcform)
for i,v in args do
begin
line := new tg_Polyline();
line.polyline_style := line.tgc_LS_filled;
line.polyline_style := tgc_LS_filled;
line.closed := true;
c := (i=2)?1.1:1;
line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
@ -459,7 +459,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -504,7 +504,7 @@ type tfm = class(tvcform)
gtx.text := array("按住鼠标左键","移动我");
gtx.data := array(0.3,0.2);
//处理鼠标按下
gtx.addEventListener("mouse_down",function(e)begin
gtx.addEventListener(evt_mouse_down,function(e)begin
fdragtext := e.target;
ftextinitpos := fdragtext.data;
x := e.cvsx;y := e.cvsy;
@ -512,7 +512,7 @@ type tfm = class(tvcform)
fmousedownpos := array(x1,y1);
end);
//移动标签
fg.addEventListener("mouse_move",function(e)begin
fg.addEventListener(evt_mouse_move,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@ -524,7 +524,7 @@ type tfm = class(tvcform)
end
end ,true);
//处理鼠标松开
fg.addEventListener("mouse_up",function(e)begin
fg.addEventListener(evt_mouse_up,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@ -548,12 +548,12 @@ type tfm = class(tvcform)
fhitidx := r;
return r>=0;
end
line.addEventListener("mouse_out",function(e)begin
line.addEventListener(evt_mouse_out,function(e)begin
if e.eventPhase<>2 then return ;
fmovetip.Visible := false;
e.stoppropagation();
end,true);
line.addEventListener("mouse_move",function(e)
line.addEventListener(evt_mouse_move,function(e)
begin
if e.eventPhase<>2 then return ;
e.stoppropagation();
@ -638,18 +638,24 @@ end }
type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
function create(AOwner);
begin
if not(s_flush_interval>9) then
begin
s_flush_interval := 150;
ftgwindows := array();
end
class(tcustomcontrol).create(AOwner);
width := 300;
height := 300;
class(tg_figure_container).create();
fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
fg_timer.Interval := 300;
fg_timer.Interval := s_flush_interval;
fg_timer.Ontimer := thisfunction(figure_need_fresh);
ffigureprepared := false;
ffigure.rec_getter := function()begin
return clientrect;
end
ffigure.fresh_caller := thisfunction(flushfigure);
ftgwindows[length(ftgwindows)] := makeweakref(self(true));
end
function flushfigure();
begin
@ -692,10 +698,35 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
if ffigure then
begin
d := e_2_array(e,evt_mouse_down);
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
SetFocus();
end
//echo "\r\n",functionname(),tostn(array(xy,bt,sh));
end
function KeyDown(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_down);
if ffigure.executecommand(evt_key_down,d)=1 then e.skip := true;
end
end
function keyup(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_up);
if ffigure.executecommand(evt_key_up,d)=1 then e.skip := true;
end
end
function keypress(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_press);
if ffigure.executecommand(evt_key_press,d)=1 then e.skip := true;
end
end
function MouseMove(o,e);override;
begin
if ffigure then
@ -729,16 +760,58 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
function Recycling();override;
begin
ffigure:=nil;
for i := 0 to length(ftgwindows)-1 do
begin
if ftgwindows[i] =self then
begin
deleteindex(ftgwindows,i);
break;
end
end
inherited;
end
class function set_sys_flush_interal(itv); //设置所有窗口的刷新间隔
begin
if itv>9 and itv<>s_flush_interval then
begin
s_flush_interval := itv;
for i,v in ftgwindows do
begin
v.flash_interval := itv;
end
end
end
property flush_interval read get_interval write set_interval; //当前窗口的刷新间隔
private
function get_interval();
begin
return fg_timer.Interval;
end
function set_interval(itv);
begin
return fg_timer.Interval := itv;
end
function figure_need_fresh(o,e); //定时刷新
begin
o.stop();
if not ffigureprepared then return ; //没有准备好
if f_validate_doing then return;
InvalidateRect(nil,false);
InvalidateRect(nil,false);
end
function ek_2_array(e,tp);
begin
d := array();
st := e.shiftstate();
sft := 0x0 in st;
sctl := 0x2 in st;
d := array(
"type":tp,
"shift":sft,
"ctrl":sctl,
"key":e.char,
"keycode":e.CharCode,
);
return d;
end
function e_2_array(e,tp);
begin
@ -757,6 +830,8 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
return d;
end
private
static s_flush_interval;
static ftgwindows;
fmovecnt;
fg_timer;
f_validate_doing;
@ -790,6 +865,18 @@ type tg_figure = class(tg_evet_conainter) //
function executecommand(cmd,p);
begin
case cmd of
evt_key_down:
begin
return cmd_key_event(evt_key_down,p);
end
evt_key_up:
begin
return cmd_key_event(evt_key_up,p);
end
evt_key_press:
begin
return cmd_key_event(evt_key_press,p);
end
"figure_need_fresh":
begin
fresh();
@ -950,7 +1037,24 @@ type tg_figure = class(tg_evet_conainter) //
r[len-i] := v;
end
return r;
end
end
function cmd_key_event(evtname,p) ;
begin
if not fMouseOnOBJ then return ;
d := p;
d["istrusted"] := true;
d["bubbles"] := true;
onds := array();
nnd := fMouseOnOBJ;
while nnd do
begin
onds[length(onds)] := nnd;
nnd := nnd.parent;
end
evt := new tg_evt_key(evtname,d);
dispatchEvent(evt,onds);
return evt.stoppropagationed or evt.defaultPrevented; //是否停止
end
function cmd_mouse_event(evtname,p);
begin
d := p;
@ -987,7 +1091,8 @@ type tg_figure = class(tg_evet_conainter) //
end
fMouseOnOBJ := ninnode;
evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in
dispatchEvent(evt,nds);
dispatchEvent(evt,nds);
return true;
end
end else
begin
@ -1066,7 +1171,7 @@ type tg_axes = class(tg_base) //
f_changed .|= c_g_data_zoombox;
end
end
cmd_node_add_in:
cmd_node_add_in,cmd_node_del_from:
begin
if pm is class(tg_graph_base) then
begin
@ -1176,6 +1281,7 @@ type tg_axes = class(tg_base) //
cvs.axesrec := r;
cvs.axesvector := get_top_outer_points();
//paint(cvs);
cvs.executecommand("painter",self(true));
paint_grid(cvs);
inherited;
cvs.axesunclip();
@ -1217,7 +1323,7 @@ type tg_axes = class(tg_base) //
if (f_changed .& c_g_data_changed)=c_g_data_changed then
begin
tbds := fdata_bounds;
for i,v in get_node_data_bounds(self(true)) do
for i,v in get_node_data_bounds_format(self(true)) do
begin
if not fdata_bounds_locked[i] then
begin
@ -2351,7 +2457,11 @@ type tg_canvas = class(TcustomCanvas) //
ffigurergn.rect := fg.rect();
faxesrgntemp := new TRGNPOLY();//new TRGNRECT();
//ffigurergn.
end
end
function executecommand(cmd,p);override;
begin
if cmd ="painter" then fpainter := p;
end
function axesclip(); //裁剪坐标系范围
begin
if faxesrgn then
@ -2386,6 +2496,23 @@ type tg_canvas = class(TcustomCanvas) //
property figure:tg_figure read ffigure; //绘制区域
property axesvector read faxesvector write set_clip_vector; //坐标系区域
property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域
property painter read fpainter;
////////////绘制相关//////////////////////////////////////////////
function tg_movto(x,y,z);//移动
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return moveto(x0,y0);
end
function tg_lineto(x,y,z);//画线
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return lineto(x0,y0);
end
function tg_trans(a,x,y,z);//旋转
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return trans(a,x0,y0);
end
private
FaxesRec;
faxesvector;
@ -2395,6 +2522,7 @@ type tg_canvas = class(TcustomCanvas) //
faxesrgntemp;
ffigurerect;
[weakref]ffigure;
[weakref]fpainter;
private
function set_clip_rect(rec);
begin
@ -3076,12 +3204,12 @@ type tg_text = class(tg_base)
if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ;
if clip_state=tgc_on or ((p:=parent) and p.clip_state=tgc_on) then
begin
bx := axes.zoom_box;
{bx := axes.zoom_box;
vj := fdata;
if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then
begin
return ;
end
end }
cvs.axesclip();
end
else cvs.axesunclip();
@ -4393,13 +4521,20 @@ type tg_base = class(TNode,tg_evet_conainter) //
end
function paint_pre(cvs);virtual;
begin
begin
cvs.executecommand("painter",self(true));
paint(cvs);
lgns := array();
for i := 0 to NodeCount-1 do
begin
vi := GetNodeByIndex(i);
vi.paint_pre(cvs);
end
if vi is class(tg_legend) then //处理次序问题
begin
lgns[length(lgns)] := vi;
end else
vi.paint_pre(cvs);
end
for i,vi in lgns do vi.paint_pre(cvs);
end
function hit_at(info):bool; //命中处理,鼠标信息
begin
@ -4522,14 +4657,20 @@ type tg_base = class(TNode,tg_evet_conainter) //
function SetParent(V);virtual;
begin
if not check_parent(v) then return ;
if v then ct := v.NodeCount;
r := inherited;
if v then ct2 := v.NodeCount;
if ct2>ct then
p := parent;
r := inherited;
p2 := parent;
if p=p2 then return ;
if p2 then //添加
begin
ax := p2.axes;
if ax then ax.executecommand(cmd_node_add_in,self(true));
end
if p then //移除
begin
ax := axes;
if ax then ax.executecommand(cmd_node_add_in,self(true));
end
ax := p.axes;
if ax then ax.executecommand(cmd_node_del_from,self(true));
end
return r;
end
protected
@ -4685,6 +4826,9 @@ type tg_const = class()
//static const tgc_out_lower_right = "out_lower_right";
//static const tgc_out_lower_left = "out_lower_left";
//////////////
static evt_key_down = "key_down";
static evt_key_up = "key_up";
static evt_key_press = "key_press";
static evt_mouse_down = "mouse_down";
static evt_mouse_wheel = "mouse_wheel";
static evt_mouse_move = "mouse_move";
@ -4699,6 +4843,7 @@ type tg_const = class()
static const cmd_figure_changed = "figure_changed";
static const cmd_data_changed = "data_changed";
static const cmd_node_add_in = "node_add_in";
static const cmd_node_del_from = "node_del_from";
/////////////////////////////////////////////////////////
static const tgc_complementary_color = "complementary_color"; //采用补色
////////////////////////////////
@ -4791,8 +4936,8 @@ type tg_evt_mouse = class(tg_evt_custom) //
fdouble := pms["double"];
fbutton := pms["button"];
fshift := pms["shift"];
fctl := pms["ctrl"];
fctl := pms["fdelta"];
fctrl := pms["ctrl"];
fdelta := pms["fdelta"];
end
end
property cvsx read fcvsx;
@ -4812,6 +4957,28 @@ type tg_evt_mouse = class(tg_evt_custom) //
fctrl;
fbutton;
end
type tg_evt_key = class(tg_evt_custom) //key消息
function create(etyp,pms);
begin
inherited;
if ifarray(pms) then
begin
fshift := pms["shift"];
fctrl := pms["ctrl"];
fkey := pms["key"];
fkeycode := pms["keycode"];
end
end
property key read fkey;
property shift read fshift;
property ctrl read fctrl;
property keycode read fkeycode;
private
fshift;
fctrl;
fkey;
fkeycode;
end
implementation
///////////事件存储对象///////////////////////
@ -5239,7 +5406,7 @@ begin
n++;
return new_bound_factor(a/10,n);
end else
if a<=1 then
if a<1 then
begin
n--;
return new_bound_factor(a*10,n);
@ -5250,6 +5417,7 @@ begin
a_ := a;
b_ := b;
if not(par>=1) then par:=20;//20;
if a=b then return ;
r := new_bound_factor((b-a)/par,n);
if r<>0 then
begin
@ -5272,10 +5440,23 @@ begin
d := bds;
end else
mg_bds(bds,d);
end else
if v is class(tg_axis) then
begin
echo "\r\n axis";
end
end
return d;
end
function get_node_data_bounds_format(nd);
begin
d := get_node_data_bounds(nd);
for i:= 0 to 2 do
begin
if d[i,0]>=d[i,1] then d[i,1] := d[i,0]+1;
end
return d;
end
function modify_text_pos(x_,y_,txtw,txth,al);//修正对齐位置
begin
case al of

3
funcext/tvclib/uvclthreadworker.tsf
View File

@ -172,7 +172,7 @@ type t_worker_host = class(t_worker_base)
{**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程运行错误%%
**}
function terminate();override;
begin
@ -576,6 +576,7 @@ begin
end
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return ifobj(fn);
end

375
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -6,65 +6,39 @@ uses utslvclauxiliary;//,utslvclgdi;
**}
////////////tmf文件相关//////////////////////////////////////////////
/////////////tmf字符串解析///////////////////////
function RegComponentPropertyType(vc);
function RegComponentPropertyType(vc);
function GetComponentPropertyType(n);
type TTmfParserbase = class
{**
@explan(说明) 解析基类,提供基础类型,提供类型常量
目前使用的常量有 TT_NUM,TT_BIN,TT_STR,TT_SYM%%
**}
Static Fsok;
static TT_NUM;//数字
static TT_LLB;//大括号
static TT_RLB;//大括号
static TT_LSB; //(
static TT_RSB; //)
static TT_STR;//字符串
static TT_SYM;//符号
static TT_POI;//点 .
static TT_SIG;// : + - :< > =
static TT_BNK;//空白 \r \n \t
static TT_ITEM;
static TT_RMB;
static TT_LMB;
static TT_SET;
static TT_COLL;
static TT_LIST;
static TT_BIN;
static TT_BOOL;
static TT_IDENT;
static TT_HEX;
static TT_COMP;
static const TT_NUM = 1; //数字
static const TT_LLB = 2; //大括号
static const TT_RLB = 3; //大括号
static const TT_LSB = 4; //(
static const TT_RSB = 5; //)
static const TT_STR = 6; //字符串
static const TT_SYM = 7; //符号
static const TT_POI = 8; //点 .
static const TT_SIG = 9; // : + - :< > =
static const TT_BNK = 10; //空白 \r \n \t
static const TT_ITEM = 11;
static const TT_LMB = 12;
static const TT_RMB = 13;
static const TT_SET = 14;
static const TT_HASH = 15;
static const TT_COLL = 0x10;
static const TT_BIN = 0x11;
static const TT_BOOL = 0x12;
static const TT_LIST = 0x13;
static const TT_IDENT = 0x14;
static const TT_HEX = 0x15;
static const TT_COMP = 0x16;
public
class function sinit();virtual;
begin
if not Fsok then
begin
TT_NUM := 1; //数字
TT_LLB := 2; //大括号
TT_RLB := 3; //大括号
TT_LSB := 4; //(
TT_RSB := 5; //)
TT_STR := 6; //字符串
TT_SYM := 7; //符号
TT_POI := 8; //点 .
TT_SIG := 9; // : + - :< > =
TT_BNK := 10; //空白 \r \n \t
TT_ITEM := 11;
TT_LMB := 12;
TT_RMB := 13;
TT_SET := 14;
TT_HASH := 15;
TT_COLL := 0x10;
TT_BIN := 0x11;
TT_BOOL := 0x12;
TT_LIST := 0x13;
TT_IDENT := 0x14;
TT_HEX := 0x15;
TT_COMP := 0x16;
Fsok := true;
end
end
end
class function PError(msg,lev);
begin
//messagebox(msg,"解析错误",1);
@ -73,7 +47,7 @@ type TTmfParserbase = class
begin
sinit();
end
end
type TTmfParserToken = class(TTmfParserbase)
{**
@ -89,8 +63,6 @@ type TTmfParserToken = class(TTmfParserbase)
FTokens;
FSplitter; //分隔符
FSyms; //符号
FNumberChar;
FHexChar;
Function SetScript(S);//设置文本
begin
IF FScript <> S then
@ -360,9 +332,6 @@ type TTmfParserToken = class(TTmfParserbase)
//Ffloat := FNumbers union array(".");
FSplitter := array(' ','\t',"\r","\n",";",",");
FSyms := array("=",":","(",")","<",">","[","]");
FNumberChar := inttostr(0 -> 9);
FHexChar := FNumberChar union array("a","b","c","d","e","f",
"A","B","C","D","E","F");
end
property Script read FScript write SetScript;
{**
@ -511,26 +480,67 @@ type TTmfParser = class(TTmfParserbase)
end
function gettree2(); //获得继承关系树
begin
tx := mtic;
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
d.initinherited(); //解析继承的数据文件信息
d.addinode(d.finheritednode); //合并继承的信息
getnodelist(d,lst,dlist); //获取冲突的对象
for i,v in dlist do //删除冲突的成员
begin
try
v["p"].fobjects.deleteindex(v["n"]);
except
end;
end
return object2tree2(d);
end
end
function inheritedcoy(n,t,ht);
function getnodelist(d,lst,dlist); //获取排除对象列表,以及冲突的对象
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return d.inheritedstr(n,t,ht,0);
end
return "";
if not ifarray(lst) then lst := array();
if not ifarray(dlist) then dlist := array();
fos := d.fobjects;
for i,v in fos.IndexNames() do
begin
vd := fos[v];
if lst[v] then //父类中的优先级大于最新添加的,因为新加入的不能和原有的重名,如果积累中添加了,子类也应该被删掉
begin
if lst[v,"i"] and not(vd.ifinherited) then //删除当前这个
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited and not(lst[v,"i"]) then //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end else
if not(vd.ifinherited) and not(lst[v,"i"]) then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited<lst[v,"ct"] then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
end else
begin
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
getnodelist(vd,lst,dlist);
end
end
function inheritedcopy(n,t,ht); //构造继承的tfm文本
begin
return inheritedstr(n,t,ht);
end
function object2tree2(t); //获得继承关系
function object2tree2(t); //获得继承关系数组
begin
r := array();
r["inherited"] := t.ifinherited;
@ -551,23 +561,21 @@ type TTmfParser = class(TTmfParserbase)
objs[v] := object2tree2(fos[v]);
end
r["property"] := ps;
r["object"] := objs;
r["object"] := objs;
return r;
end
function gettreeasobject();
function gettreeasobject();//当前tfm对象
begin
if ftreeobj then return ftreeobj;
gettree();
if FTree then
begin
//ttfmnode
ftreeobj := createndeobjects(FTree);
return ftreeobj;
end
return nil;
end
function createndeobjects(d);
function createndeobjects(d);//构造tfm对象树
begin
if ifarray(d) then
begin
@ -661,7 +669,7 @@ type TTmfParser = class(TTmfParserbase)
end
end
end
function createobj();
function createobj(); //解析对象
begin
{**
@explan(说明) 获取对象 %%
@ -672,13 +680,12 @@ type TTmfParser = class(TTmfParserbase)
if (tv="object" or tv="inherited") and(tt <> TT_STR) then
begin
r := getobject();
if tv="inherited" then
r["inherited"] := true;
r["inherited"] := (tv="inherited")?true:false;
return r;
end
end
end
function getobject();
function getobject();//解析对象内容
begin
{**
@explan(说明) 获得对象 %%
@ -710,43 +717,46 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
lx := tt;
{if tv="item" and(tt <> TT_STR)then
if tt<>TT_STR then
begin
lx := TT_ITEM;
val := getabitem();
end else}
if tv="[" and(tt <> TT_STR)then
case tv of
"[":
begin
lx := TT_SET;
val := getset();
end
"<":
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end
"(":
begin
val := getsb();
lx := TT_LIST;
end
"{":
begin
val := getlb();
lx := TT_BIN;
end
"true":
begin
val := true;
lx := TT_NUM;
end
"false":
begin
val := false;
lx := TT_NUM;
end
else val := tv;
end ;
end else
begin
lx := TT_SET;
val := getset();
end else
if tv="<" and(tt <> TT_STR)then
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end else
if tv="(" and(tt <> TT_STR)then
begin
val := getsb();
lx := TT_LIST;
end else
if tv="{" and(tt <> TT_STR)then
begin
val := getlb();
lx := TT_BIN;
end else
if tv="true" and(tt <> TT_STR)then
begin
val := true;
lx := TT_NUM;
end else
if tv="false" and(tt <> TT_STR)then
begin
val := false;
lx := TT_NUM;
end else
val := tv;
val := tv;
end
end
function getmembers();
begin
@ -821,7 +831,6 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
if tv="]" and tt <> TT_STR then return r;
//if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
@ -835,7 +844,6 @@ type TTmfParser = class(TTmfParserbase)
function getabitem(tp,ifitem);
begin
if not ifstring(tp)then endtp := "end";
//else if tp="item" then endtp := "end";
else if tp="<" then endtp := ">";
else PError("dict错误",1);
r := array();
@ -844,7 +852,7 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv=endtp {"end"}and tt <> TT_STR then return r;
if tv=endtp and tt <> TT_STR then return r;
p := tv;
ptt := tt;
ctoken(tv,tt);
@ -854,13 +862,7 @@ type TTmfParser = class(TTmfParserbase)
if ifnil(val)or ifnil(lx)then PError("item无值",1);
r[rl++]:= array("name":p,"value":val,"type":lx);
end else
{if p="item" and ptt <> TT_STR and(length(r)<1)then
begin
ifitem := true;
btoken(2);
return getab();
end else}
PError("item没有=",1);
PError("item没有=",1);
end
end
function getab();
@ -877,10 +879,6 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then
begin
r[rl++]:= getabitem();
end else}
begin
return PError("<>内容错误",1);
end
@ -905,8 +903,7 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else }if tv="<" and tt <> TT_STR then
if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
lx := fff?TT_COLL:TT_ITEM;
@ -2275,11 +2272,67 @@ type ttfmnode = class()
end
function create(t,n);
begin
inheritedcount := 0;
fnodename := n;
fnodetype := t;
fpropertys := new tstrindexarray();
fobjects := new tstrindexarray();
finheritedpaths := array();
end
function addinode(nd);
begin
//if not nd then return ;
if nd and nd.finheritednode then nd.addinode(nd.finheritednode);
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
if ov.ifinherited then //继承的控件
begin
if ifobj(nd) then
begin
fd := nd.getnodebyname(v); //ov.fnodename
if fd then
begin
ov.inheritedcount++;
ov.finheritednode :=fd;
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else
begin
end
end
if nd then
begin
for i,v in nd.getnodenames() do //添加父窗口控件
begin
ov := fobjects[v];
nnd := nd.getnodebyname(v);
if not ov then
begin
fobjects[v] := nnd.copyinh(); //复制属性
end else ov.addinode(nnd); //添加属性
end
end
end
function copyinh();//继承拷贝
begin
r := new ttfmnode(fnodetype,fnodename);
for i,v in fobjects.IndexNames() do
begin
vv := fobjects[v];
vi := vv.copyinh();
r.addobject(vi);
end
r.finheritednode := self;
r.ifinherited := true;
return r;
end
function get_inherited(data);
begin
@ -2290,21 +2343,29 @@ type ttfmnode = class()
begin
nd.setinhertedpaths(finheritedpaths);
nd.initinherited();
finheritednode := nd;
//addinheritednode(nd); 此处屏蔽
end
finheritednode := nd;
addinheritednode(nd);
end
function initinherited();
begin
s := finheritedname;
if s and ifstring(s) then
begin
data := get_resource_by_name( s+".tfm");
//////////根据新特性添加//////////////////////////////////////
o :=findclass(s);
if o then
begin
ci := o.classinfo();
data := ci["tfm"];
end
//////////////////////////////////////////////
if not data then data := get_resource_by_name( s+".tfm");
if data then
begin
return get_inherited(data);
end
end
for i,v in finheritedpaths do
begin
fv := v+s+".tfm";
@ -2323,6 +2384,9 @@ type ttfmnode = class()
end
function addinheritednode(nd); //处理继承的节点
begin
///////////////查找空白/////////////////////////////////////
///////////////////////////////////////////////////////////////
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
@ -2343,8 +2407,15 @@ type ttfmnode = class()
fobjects.deleteindex(v);
end
end
ov.addinheritednode(nd);
end
if fd then
ov.addinheritednode(fd);
end
end
function getnodenames();
begin
return fobjects.IndexNames();
end
function getnodebyname(sb);//获得节点
begin
@ -2427,29 +2498,8 @@ type ttfmnode = class()
r[i] := fpropertys[v];
end
return r;
end
function inheritedstr(n,t,ht,h);
begin
if ifnil(n) then n := fnodename;
if ifnil(t) then t := fnodetype;
ws := "";
if not(h>=0) then h := 0;
for i:= 0 to h-1 do
begin
ws+=" ";
end
r := ws+"inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
for i,v in fobjects.IndexNames() do
begin
vo := fobjects[v];
r+=vo.inheritedstr(nil,nil,nil,h+1);
end
r+="\r\n";
r+=ws+"end\r\n";
return r;
end
end
inheritedcount;
ifinherited;
finheritedname;
finheritednode;
@ -2457,10 +2507,17 @@ type ttfmnode = class()
fnodename;
fobjects;
private
fpropertys;
fpropertys;
finheritedpaths;
end
function inheritedstr(n,t,ht);
begin
r := "inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
r+="end\r\n";
return r;
end
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");

BIN
plugin/TSJSONParser.dll
View File

Binary file not shown.

BIN
plugin/TSLCPLUGIN.DLL
View File

Binary file not shown.

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslkrnl.dll
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.

11
whatsnew.txt
View File

@ -1,3 +1,14 @@
更新日志--------2025-5-7
升级：新增ExportJSONStringMBCS函数提供对中文原码保留。
更新日志--------2025-5-6
修正：profiler等窗口被打开时直接退出关闭会导致报告异常。
升级：支持编译错误行号跳转以及包含文件编译错误的跳转。
修正：板块管理中新建板块导致生成多个用户板块节点的问题。
更新日志--------2025-4-29
升级：为namespace下的调试提供支持。
更新日志--------2025-4-28
修正：客户机检查语法生成代码跳转依赖时，某些错误发生会导致异常的问题。
修正：某些情况下函数编辑器内无法点击断点的问题。