From d4c78d9928a65f21ff1760d44861be0475bb10ab Mon Sep 17 00:00:00 2001 From: JianjunLiu Date: Fri, 11 Nov 2022 17:03:17 +0800 Subject: [PATCH] =?UTF-8?q?=E7=95=8C=E9=9D=A2=E5=BA=93?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 鏁寸悊 --- designer/utslvcldcomponents.tsf | 53 +- designer/utslvcldesignerresource.tsf | 39 +- funcext/tvclib/tslvcl.tsf | 902 +-------------------------- funcext/tvclib/utslvcldlg.tsf | 834 ++++++++++++++++++++++++- funcext/tvclib/utslvclstdctl.tsf | 69 ++ 5 files changed, 916 insertions(+), 981 deletions(-) diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index b446aca..bb9de7f 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -1118,26 +1118,6 @@ type TDFileSaveWindow = class(TDVirutalWindow) return GetSaveFileBitmapInfo(); end end -type TDInputQuerysWindow = class(TDVirutalWindow) -{** - @explan(说明) 文件选择容器 %% -**} - public - function Create(AOwner);override; - begin - inherited; - BindComp := new TInPutQuerys(self);; - end - function GetPublishEvents();override; - begin - return array(); - //return array();//array(1:nil); - end - function bitmapinfo();override; - begin - return GetInputquerysBitmapInfo(); - end -end type TDColorChooseWindow = class(TDVirutalWindow) {** @@ -1600,38 +1580,7 @@ type TDSaveFileADlg = class(TDRootComponent) end //************querys************************************** -type TDInputQuerys = class(TDRootComponent) -{** - @explan(说明) 文件打开控件 %% -**} - function HitTip();override; - begin - return inherited; - return "数据输入对话框"; - end - function bitmapinfo();override; - begin - return GetInputquerysBitmapInfo(); - end - function classification();override; - begin - return "对话框"; - end - function ComponentClass();override; - begin - return class(TInPutQuerys); - end - function WndClass();override; - begin - return Class(TDInputQuerysWindow); // - end - function Create(AOwner);override; - begin - inherited; - fiscontainerdcmp := false; - end -end //***********colorchoose******************************* type TDColorChoose = class(TDRootComponent) @@ -3623,7 +3572,7 @@ begin class(TDImageList), class(TDClipBoard), class(TDMainMenu),class(TDPopUpMenu),class(TDMenu), - class(TDOpenFileADlg),class(TDSaveFileADlg),class(TDInputQuerys), + class(TDOpenFileADlg),class(TDSaveFileADlg), class(TDColorChoose),class(TDFontChoose),class(TDFolderChoose), class(TDcoolBar),class(TDToolBar),class(TDStatusBar),class(TDToolButton), class(TDTray), diff --git a/designer/utslvcldesignerresource.tsf b/designer/utslvcldesignerresource.tsf index b0eec34..8b906a1 100644 --- a/designer/utslvcldesignerresource.tsf +++ b/designer/utslvcldesignerresource.tsf @@ -7,7 +7,6 @@ interface function GetFolderChooseBitmapInfo(); function GetColorChooseBitmapInfo(); function GetFontChooseBitmapInfo(); -function GetInputquerysBitmapInfo(); function GetTsIconBitmapInfo(); function GetOpenFileBitmapInfo(); function GetTrayBitmapInfo(); @@ -326,43 +325,7 @@ EF1CAE15205CAEDE607F07AD4AE59C268BC560329C563F994CF4020AC75DD70D9 5C3E5D670F8783C0E0B5470D58F09E1AABE73B85640E1B4FABF0E95561F1244FE D28FEE00FC02B599AB32671AF3C00000000049454E44AE42608200"; end -function GetInputquerysBitmapInfo(); -begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -100020B04000089504E470D0A1A0A0000000D4948445200000030000000300806 -0000005702F987000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA864000003A049444154 -6843ED995B4F134118867B8DFE0F2FBC3046A31726466FFC05C61310349E1212B -D43241A124550910818D468B840543C444D4C8C070820118D62A0A022B605DA05 -0A2DD0A5F4243D90D7F9B64C335D5AE5B0D9B208C9936FE69D6F76E661D92B4C3 -001464611E8E8E84561E10D4340774D1230D2E539A28489875D030143C0EF3B4F -A0E5DBB4AE4C767CC778E583456769059E7FF2E8C6D4CB56449A3E23925F8E91E -2DB8BCAF87D9B9B5B93056A1BDDBAE129A8468C5D2ABA350FC373672F34130588 -8440C50BA7AE48C5B7E02CAB5D749656E05CBD6408D20A188DD52760949FD52F6 -0B7DB5624FCC26B029962D102269329E90199664D80671CDAACCE8885F4F13955 -0E9F2B9752F5F29C589680887A9DE6F44031E3B958D5B97AAECE399A08281B58C -E1133AA7FEBE395936E2EEE553F9358968098F1F152FBFE3557674B1210E10F51 -67E29C67E9FAA872D43D621F877AC47E62C1022B8D35814CB32690693413700C5 -870F9CE136417DC406ED14DE414D5FC954367AA19557355A40AD9ECDC9CB335C8 -3B7F0B6D1FBFC0294929CF243413385D568FC2BBEF51FEC28C8B8FCD2879DABD7 -49E9851CAEA85475D3871A901365B7FCA3309CD04F6143C42DFE82CE4DFC04400 -980CCEC7ED8BC3D7C7FDF37B085A77B3355F04C8AF6EC1DBB6CE9467129A09EC3 -8F5008E893066636104C351FC8EC4E69845281C273B274F419C530DCE4484FE18 -CBA208B08C9E75B4A211EF3E74A53C93D04C605BFE7D0CBA66109999C5B42F0A7 -F20A6E09D0E2B952ECB331A07827101AA84CF1F532AADFBFC51B62F2E9057FE0E -8D1F7478035B4ED6A37F6C06A1600C1E3982296F54617C22A4409715C71E393CA -F12B447664CB23109E45E6102ED3ABC81CDC7EFC1EA0C419603708EF930C6FE88 -89A11159812E298E5DEC03A0CAC7C4A82BBE8718767A1581ECB2B74C408737B0E -9D83DFC1A0EC1EDF262D0E18134242BD806DC0A7451716C774C62FF81DCC498C3 -F7F50F4E2802074B99801EDFC0C62375E895821896C6D1671983D5E652B058461 -3F0DFB8C5CAE60C1A4B43DEA48CA07DBD3F4714817D256FD0D46E4E7926A199C0 -86C375F8391482B54F4267D720BABBED4998CD2CEBB1A3A7C7111FF32CB1E648E -AEFF86A453010C6DE12FA88757803DB8FDFC6D9DA5E5C7FECC5B587322A1A88A9 -2522B3677850F3CC8FDDA71BD0F9C39AF24C423381D72DEDD87EB412593B4B90B -5AB74D9AC63ACDF7D0957EB5EA53C8FA39940A6F87F04F8C24A65F50A188DD523 -C0FFE3CD03A3911030A6442BFE00B24E924CE37F2F940000000049454E44AE426 -08200"; -end + function GetTsIconBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index f22bba5..bad7bf3 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -643,71 +643,15 @@ type tapplication=class(tcomponent) property MainForm read Fmainform write SetMainForm; end -type TLabel = class(TGraphicControl) +type TLabel = class(TcustomLabel) {** @explan(说明)标签控件 %% - **} - private - FTextAlign; - function SetTextAlign(v); - begin - if v <> FTextAlign then - begin - FTextAlign := v; - InvalidateRect(nil,true); - end - end - protected - function SetControlFont(v);override; - begin - inherited; - //invalidaterect(nil,true); - invalidaterect(nil,false); - end - public - function paint();override; - begin - dc := canvas; - dc.font := font; - rc := ClientRect; - if border then - begin - rc[0]+= 1; - rc[1]+= 1; - rc[2]-= 1; - rc[3]-= 1; - end - CanvasDrawAlignText(dc,rc,self.Caption,FTextAlign); - if border then - begin - dc.Draw("polyline",array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1]))); - end - end + **} function create(AOwner);override; begin inherited; - caption := "label"; - FTextAlign := 0; - //border := true; end - class function CanvasDrawAlignText(dc,rect,txt,al); - begin - {** - @explan(说明) 在指定区域内按照对齐方式绘制文本%% - @param(al)(member of TAlignStyle9) 对齐方式 %% - **} - if not(dc is class(TCustomcanvas))then exit; - als := array(36,0,33 - ,2,36 - ,37 - ,38,40 - ,41 - ,42); - val := als[al]; - if ifnil(val)then val := 36; - return dc.drawtext(txt,rect,val .| DT_NOPREFIX); - end - property TextAlign:AlignStyle9 read FTextAlign write SetTextAlign; + function publishs();override; begin return array("name","action","align","anchors","caption","enabled","font", @@ -7131,842 +7075,20 @@ type TMyArrayB = class(tnumindexarray) inherited; end end -type TInputEditor=class - {** - @ignore(忽略) %% - @explan(说明)输入框注册控件基类 %% - **} - class function ClassType(); +type TTipMessageButton = class(TcustomTipMessageButton) + function create(AOwner); begin - {** - @explan(说明) 类型名字 %% - @return(string) 名字 %% - **} - return ""; - end - function OnNextKeyPress(o,e);virtual; - begin - {** - @explan(说明) key值判断 %% - **} - if e.CharCode=0x9 then FocusNext(); - end - function FocusNext();virtual; - begin - {** - @explan(说明) 设置下一个获得焦点 %% - **} - if NextCtrl is class(TWinControl)then - begin - NextCtrl.SetFocus(); - end - end - function SetInfo(info);virtual; - begin - {** - @explan(说明) 设置额外信息 %% - @param(info)(array) 信息 %% - **} - end - property NextCtrl read FNextCtrl Write FNextCtrl; - property Value read GetValue write SetValue; - {** - @param(NextCtrl)(TInputEditor) 下一个控件 %% - @param(Value)(any) 值 %% - **} - private - function GetValue();virtual; - begin - end - function SetValue();virtual; - begin - end - FNextCtrl; -end + inherited; + end +end -type TTipMessageButton = class(TGraphicControl) -{** - @ignore(忽略) %% - @explan(说明) 提示按钮 %% -**} - public - function Create(AOwner);override; - begin - inherited; - height := 18; - width := 18; - caption := "提示信息"; - fmessageCaption := nil; - fmessageText := nil; - fimageType := 0; - fmessagebox := new TMessageboxADlg(AOwner); - setMessageCaption("提示"); - end - function MouseUp(o,e);override; - begin - inherited; - if e.skip then return; - if not fmessagebox.parent then fmessagebox.parent := parent; - if fmessageText=nil then fmessagebox.mbText := caption; - fmessagebox.ChooseDlg(); - end - procedure Paint();override; - begin - {** - @explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %% - **} - reset_tn(); - Canvas.StretchDraw(array(0,iconTop,iconSidelength,iconSidelength+iconTop),ftipImage.getImage(fimageType)); - if iconSidelength nil then - begin - isConstIconSize := 1; - iconSidelength := l; - end else - isConstIconSize := 0; - end - function getIconSize(); - begin - {** - @explan(说明) 获取提示图标的边长%% - @return(integer)边长%% - **} - if isConstIconSize then return iconSidelength; - reset_tn(); - return iconSidelength; - end - function setIconType(i); - begin - {** - @explan(说明) 设置显示的提示图标类型%% - @param(l)(integer)0:疑问，默认 - 1：错误 - 2：消息 - 3：警告%% - **} - if(ifint(i)or ifint64(i))and i >= 0 and i<5 then - begin - if fimageType <> i then - begin - fimageType := i; - if parent then invalidateRect(nil,1); - end - return 1; - end - return 0; - end - property messageText:string read fmessageText write setMessageText; - property messageCaption:string read fmessageCaption write setMessageCaption; - property showInfomationIcon:bool read isInfomationIcon write setInfomationIcon; - {** - @param(messageText)(string)要显示的提示对话框的文字%% - @param(messageCaption)(string)要显示的提示对话框的标题%% - @param(showInfomationIcon)(bool)提示对话框内是否显示一个消息图标%% - **} - protected - class function Sinit();override; - begin - inherited; - if not ftipImage then ftipImage := new TTipImage(); - end - private - type TTipImage=class() - public - function create(); - begin - init(); - end - function getImage(n); - begin - return imageData[n]; - end - private - { - 0:state_unknown ○? - 1:state_error ○! - 2:state_hint ○i - 3:state_warning △! - 4:state_infomation □ - } - function init(); - begin - imageData := array(); - imageData[0]:= "0502000000060400000074797065000203000000696D670006040000006461746 -100026502000089504E470D0A1A0A0000000D4948445200000010000000100806 -0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA864000001FA49444154 -384FA590C16BD37014C7FD63A617118F3B78F0A6C2849D062AEEB08322E261301 -0E7CDE1C58975177187ECB0218A8843F0302C8C6DB0D16DD0DAAEB16BBB68D3AD -59D3C43499499A768D7ECD7BD01FCD7612BFF08197F7BEDF6F48CEE03F75AAC07 -4427C5CF1F1447270FFB9C5D04C3BBA9D54AC6035ED623CA1E1CD928DEFB56304 -9D3F0CCDB4A31B79FA250A92290B77A68A500E5A08C310DD6E3706EDE8461EF2F -6C40587668091896D942ABFD06EB71104012E8DAEC5D8CC36F8461EF2524614CC -2CEC627A4E86EFFB705D97997D5F661E25BEE2C2F067CCCCE7794F9E6792CC195 -170FD5E12E96F061CC71198A6095555F142DAC4C0950F989C5E462693412EB783 -D594C21951707EE8132CDB43B3D9846118D8DB5322631ED2DB14CE5E5DC4AD893 -528CA0F64B33BCC6EB1C2195170713809ABE941D3EA2814CA90E52273EEDA1253 -A91C881D51285639230A46C6B3D14F32502E57512AA902CB3A62FA77C4F27A953 -3A2E0D5BB46F41335ECEF1BD1DBEA82C19B05A67FA7AA3A9EBEAE724614D4CD2E -6E3CD491CEBBD16738A8D56CE6F298C6F49E8954DA662F654401E9CB4607A3933 -6327280462380AE07F0BC90A19976DBB9166E471EF2F6240A485CF2D8C1CB053F -321F43AB87D00E436CE53A48CC7B51D8898549B10292FEF337A4C516EE4E1D61E -881CDD04C3BBA9DD4A9827F13F017E5DF89FE289AB2290000000049454E44AE42 -608200"; - imageData[1]:= "0502000000060400000074797065000203000000696D670006040000006461746 -10002C502000089504E470D0A1A0A0000000D4948445200000010000000100806 -0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000025A49444154 -384FA592FB4B53611CC6FB63C2B40B2111843F686988D9C598E6A5EDB09B735B2 -DA78C4CCAA9BB485B91E8424C22B6650E85A0A00B545A1121116194457431529B -6B37DBDCA6672B787ADF77E76C893F450FBC3F7D9FCFF3BD9CB309FFA90D01BFF -B4E2063D7236DD562AD578354B71A892E25E267E5F87986135C79AD0BC8823A2C -DB5A91F4B9C0DFF5B097F00D2268D6216C6A42B0BD5E7067950B48DB74E02D2D8 -80FDBF16B6A02FCE805AC3A4FB2C75F772233398E88AB07DF0D122CE86B044A08 -E02D5AACF668101BB631386555B3272AD1AD246B28907EE043E8D2397C6DAEC66 -75515ABB100BA67C462C8C3161592BD2A66A0A2FBC73AC90D3A38F0F7C630D7C6 -E10357C16A2C801AE89EBCD7C140B1A3280A2E9B6488B44911BF6C45E48A136F1 -B4B598D05443BA4E0EF7B91B46B1928761445C170EB71840CE4884639E2E35731 -535BC26A2C20D8DE80B53B1EAC90CF268E4A3B663ECE3213057FE81B11D036206 -0E0101F1BC1CB9ADDACC602FCA72488B9FB911CB1E746A51DE3D70690B8E563E0 -92A61E7ED531849D660406FB305D5D9C0F98D71DC13793824C7123372AED288A8 -28BCA3A2CC86BB132E1C61BE5513CABDCC16A2CE08BFA003E292AB1E4E844EAF6 -68AE63D4E524DFDEC1C0794EC2E039B3114FF76FC3E3F2A27C00D57B5939669BC -AB0683F8DE44D2F2217C94FA39561B1458AD07933391C81BB8C78525184A97D5B -04EAAF00AAD775257825D98377CD120406C83D3C4388BA87E0EFB761863B44C04 -23C2A2B10DC59AD0BA07A717817A60F16E379D54EB2E77632EE56326E2126F716 -E061E966C195D786807F13F007E8743A916FA8D5250000000049454E44AE42608 -200"; - imageData[2]:= "0502000000060400000074797065000203000000696D670006040000006461746 -100026F01000089504E470D0A1A0A0000000D4948445200000010000000100806 -0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000010449444154 -384FC590CD4EC24014467D4C1FC23720AE890FC082858961876B6358E24A59904 -0F83102024A2920CA6F202632F7F3DEA197D0306D349A709259F44ECF99764EF0 -47FE2F709ACCFD6A29A140F6AE81AF8D09266E6E0A9D50C406746088305B13460 -B823F277853C2CB84D07E2734DF0C5ABC84C4D5FD61E02C95B783218BFE8CD063 -B9FB41780EE4C7A141CDDF062EAE8BD1813ECBAF7CAA95C784C6682B57592E7B3 -10159F20BF2F91D3EB535367862B93E30A8B05C62B9EC6DAC749E7908070419C8 -254A641FF99A52CFD8B0E0BC444187FBEB32570B7681E9F2D33EEB9EB20BB8901 -707939553542203F272FAB61A292ACE804A71A212FB0B3FE1D801E01BC7E9AA1F -1B492A780000000049454E44AE42608200"; - imageData[3]:= "0502000000060400000074797065000203000000696D670006040000006461746 -100029B02000089504E470D0A1A0A0000000D4948445200000010000000100806 -0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000023049444154 -384FA5924B68135114860342C1858208BA1041B42A528A146BADA5ED4A70272AD -5048D2EA48B2E74D195B85044280A165D3488A216DA8A521F68D5FAC65402DAE2 -BBCD63F268A3C699BC6D329919F398CCEF99C9A531A45D883FFC309C7BFEEF70C -F5C13FE530B0212F636C45FB522F6A2059167DB59B55A0B02F470DAD983D4D733 -088F6E63D56ACD0BD0C3519A5CCCA7919F754178B8153FEF6F61A7959A17107DD -E0291B3415333D0F261A4A62E2274B7819D56AA0AA087234F9B81620EB9A80DF9 -783F4112F83EBC19DF6ED6B3AEB2AA007A580A0E533E09F750BB61557622ED19C -4CC501DEB2AAB021079D28CE47837A0E520050EC335D86E58F25AA11592E05F76 -C17F6D03EB2E690EA08785C74DF81D1BA7E509907C87E01A68332C7ACC5033EF2 -085C6E0BD520BEED25A96FA0B203C6A426AB29726C590156C04B0627A642703EC -87ECB7A2989D4178EC249C1756B31403E8617EA491C2191444079480D50028C14 -EC4DF9B21BAF741F676201BB6A12085F0E5EC4A7C3CBDBC0CE01F34D292AED3E2 -C2C8F2E7A1F80F10E060F90AEE0EC8DC5E48EEDD50150EBCFD1C264E2C2D01F47 -0C47E84FEB9448F6614B2CF6238C3D1648F85C2165AA299007B20797641F1512F -5D73B26F071CC76A600ADD6B801C7A6D00B4C22CF957C92A7DEB9EAB259913541 -711FF74076FBA16C1F4E3363D905BF508DEA8C3F4C02604FA37C277753DBC97D7 -C1DDB70653BDABF0B967053E9C5A8689E34BF0B67B311C476B8CB0BDD354F90EF -E5DC01F26687F1D27F303B60000000049454E44AE42608200"; - imageData[4]:= "0502000000060400000074797065000203000000696D670006040000006461746 -10002F002000089504E470D0A1A0A0000000D4948445200000010000000100806 -0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000028549444154 -384FA591CB4F136114C5FD9F9C71634C646188090644C18588A60852C028442D6 -2202A1429EFB6D08729050BC8A3CAAB552A9456DA0E15C7D287057948DA8AC1C4 -44571A8D28C73BD3490B61653CC959CD3DBF7BCF7C87F09F3A00C835ACE2942E8 -A2C4D04275A03C868E171BC6591ECC7B1079C3495D63E40B67E0527D56194F585 -D0E78E638CDB12DDEB8C41A67F05B6760E6C9D539A4E2A0510B666B605D13AB50 -647601B3D337128ADEF707F64056ADB1AAC9E041AC7A260CB27C15E9B94521220 -4B1B4166FB9218B6BDDE462D856E0F8631ECFB80616F02B72C212806C2B0CC6D4 -2F92404B6C40AB678240DC8542FA1D414809DFF849AC1281454E1863988EF3F77 -44579A7954F6F0503C0A60F0650CE79B5F802918480332DA79EA1987D6B6819B7 -D41549903A834F1E8776FC2422E3772491B7C542B0CFDCC2AD87C731A7054C961 -62F1236AFA43B4E90D2A1EFA6938F9C777C9729D17A55DF3640FAE1ABCB072313 -067BAC5EF2280AD7363DCBF2576153695E97D14F2211AFF8A6F3F7650D2E94671 -870B97C9728D0BA30B04C8D1EC053861726E40F5741915063FE4DD5E5CD1CEE36 -DEC0B017EA1A8651645D45BD6EC40750F07AD2302F674E71E40B503856A37863D -7154E838C8D51E38F8047EFFD9152B84DE7F46A1D24EB6C1F82C8AFC3B6304E81 -0A212E0FA3858B915F74683B038D751A27641D63A838BAA691436D870A17E1205 -F513681B0DD0F32ED0F92AB0E4144010231BC2E1BC5ED40ED18BCCAE4261F2D2C -9CF71A9D18E2A9D0B7A5B188A7E0E6C76432A2C280510C4E4F782C933E2DCDD29 -68A797F1D8BB415E47A73D82DC1A2B98EC460A3749D349ED030862CFEAE989BAC -0E46AE8D4660A35891B051FC96990A6D23A00F837017F01AE4B3263C856875900 -00000049454E44AE42608200"; - for i := 0 to length(imageData)-1 do - begin - t := new tcustombitmap(); - t.Readvcon(HexFormatStrToTsl(imageData[i])); - imageData[i]:= t; - end - end - imageData; - end - function setMessageText(str); - begin - fmessageText := str; - fmessagebox.mbText := str; - end - function setMessageCaption(str); - begin - fmessageCaption := str; - fmessagebox.Caption := str; - end - function setInfomationIcon(b); - begin - isInfomationIcon := b?1:0; - fmessagebox.mbiconstyle := isInfomationIcon?0x40:0; - end - function reset_tn(); - begin - //重新计算图标的边长及位置 - if not isConstIconSize then iconSidelength := height50?(c[0]-50):100; - top := c[1]>50?(c[1]-50):100; - return ShowDlg(result,t); - end - function OnOkClk(); - begin - EndModal(1); - end - function OnCancelClk(); - begin - EndModal(0); - end - function DoWMSIZE(o,e);override; - begin - h := clientrect; - ht := h[3]-h[1]; - wd := h[2]-h[0]; - FBOk.Left := wd/2-50; - FBOK.top := ht-33; - FBCancel.Left := FBOk.Left+FBOK.Width+20; - FBCancel.top := ht-33; - end - class function RegisterInputType(t); - begin - {** - @explan(说明) 注册input类型 %% - @param(t)(TInputEditor) 编辑类 %% - **} - if t is class(TInputEditor)then - begin - if not SFInputType then SFInputType := new TMyArrayA(); - return SFInputType[t.classtype]:= t; - end else - if ifarray(t)then - begin - for i,v in t do RegisterInputType(v); - end - end - class function GetInputType(n); - begin - {** - @explan(说明) 获得注册类型 %% - **} - if SFInputType and ifstring(n)then return SFInputType[n]; - end - function Recycling();override; - begin - inherited; - FSetData := nil; - FInfoa := nil; - FInfo := nil; - FBOk := nil; - FBCancel := nil; - FLabels := nil; - FEdits := nil; - FTips := nil; - end - private - function RebuildInput(); - begin - ld := length(FInfoa); - lb := length(FLabels); - lp := length(FTips); - for i := 0 to lp-1 do FTips[i].Recycling(); - for i := 0 to lb-1 do - begin - FLabels[i].Recycling(); - FEdits[i].Recycling(); - end - FLabels := array(); - FEdits := array(); - for i := 0 to ld-1 do - begin - FLabels[i]:= new TLabel(self); - tp := FInfoa[i]["type"]; - if ifstring(tp)then - begin - tp := GetInputType(tp); - end - if ifobj(tp)then FEdits[i]:= createobject(tp,self); - else FEdits[i]:= new TInputString(self); - syg := FEdits[i-1]; - if syg then - begin - syg.NextCtrl := FEdits[i]; - end - if i=ld-1 then FEdits[i].NextCtrl := FBOk; - end - sp := 5; - for i,v in FInfoa do - begin - lb := FLabels[i]; - le := FEdits[i]; - lb.caption := v["caption"]; - lb.left := 20; - vtp := v["tip"]; - if ifstring(vtp)and vtp then - begin - tp := new TTipMessageButton(self); - tp.caption := vtp; - tp.left := 2; - tp.top := sp+3; - FTips[length(FTips)]:= tp; - tp.parent := self; - end - lb.top := sp; - lb.width := length(v["caption"])* 8+3; - le.value := v["value"]; - le.top := lb.top; - le.left := lb.width+lb.left; - if v["readonly"]then - begin - if le is class(tedit)then le.readonly := true; - else le.Enabled := false; - end else - begin - if le is class(tedit)then le.readonly := false; - else le.Enabled := true; - end - wd := max(le.left+le.width+10,wd); - sp += max(lb.height,le.height); - sp += 4; - le.SetInfo(v); - le.parent := self; - lb.parent := self; - end - width := wd+10; - height := sp+60+10; - //echo "\r\nin thisf function:",wd,"===",(sp+60); - //echo "\r\nin thisf function:",width,"===",height; - end - type tinputbool=class(tcheckbtn,TInputEditor) - {** - @explan(说明) 输入框 %% - **} - class function ClassType();override; - begin - return "bool"; - end - function Create(AOwner);override; - begin - inherited; - width := 16; - height := 17; - OnKeyPress := thisfunction(OnNextKeyPress); - end - function Recycling();override; - begin - NextCtrl := nil; - inherited; - end - private - function GetValue();virtual; - begin - return Checked; - end - function SetValue(v);virtual; - begin - Checked := v; - end - end - type TInputString=class(TEdit,TInputEditor) - {** - @explan(说明) 输入框 %% - **} - class function ClassType();override; - begin - return "string"; - end - function Create(AOwner);override; - begin - inherited; - width := 300; - OnKeyPress := thisfunction(OnNextKeyPress); - end - function Recycling();override; - begin - NextCtrl := nil; - inherited; - end - private - function GetValue();virtual; - begin - return text; - end - function SetValue(v);virtual; - begin - text := v; - end - end - type TInputPassWord=class(tpassword,TInputEditor) - {** - @explan(说明) 输入框 %% - **} - class function ClassType();override; - begin - return "password"; - end - function Create(AOwner);override; - begin - inherited; - width := 300; - OnKeyPress := thisfunction(OnNextKeyPress); - end - function Recycling();override; - begin - NextCtrl := nil; - inherited; - end - private - function GetValue();virtual; - begin - return text; - end - function SetValue(v);virtual; - begin - text := v; - end - end - type TInputInteger=class(TInputString) - class function ClassType();override; - begin - return "integer"; - end - function Create(AOwner);override; - begin - inherited; - OnKeyPress := thisfunction(InPutChar); - end - function InPutChar(o,e); - begin - cd := e.CharCode; - if cd=VK_BACK or cd=VK_DELETE then return; - if cd=VK_TAB then OnNextKeyPress(o,e); - else - begin - if not(cd >= ord("0")and cd <= ord("9"))then - begin - e.skip := true; - end - end - end - private - function GetValue();override; - begin - return StrToIntDef(self.Text,0); - end - function SetValue(v);override; - begin - if ifnumber(v)then Text := IntToStr(v); - end - end - type TInputBtn=class(TBtn,TInputEditor) - {** - @explan(说明) 按钮 %% - **} - function Create(AOwner);override; - begin - inherited; - height := 25; - OnKeyPress := thisfunction(OnNextKeyPress); - end - function Recycling();override; - begin - NextCtrl := nil; - inherited; - end - end - type TEditAndBtnUni=class(TWincontrol) - {** - @explan(说明) edit button 组合 %% - **} - private - FBtn; - FText; - public - function BtnClick(o,e);virtual; - function WMSETFOCUS(o,e):WM_SETFOCUS;override; - begin - if FBtn then FBtn.SetFocus(); - end - function Create(AOwner);override; - begin - inherited; - Height := 22; - FBtn := new tbtn(self); - FBtn.caption := ".."; - FText := new tedit(self); - FText.caption := ""; - FBtn.Parent := self; - FText.Parent := self; - FBtn.OnClick := thisfunction(BtnClick); - FText.OnKeyUP := function(o,e) - begin - if e.CharCode=VK_TAB then - begin - self.parent._send_(WM_USER,3,self.Handle); - end - end - end - function DoControlAlign();override; - begin - c := clientRect; - FBtn.top := 1; - FBtn.Left := C[2]-C[0]-18; - FBtn.Width := 15; - FBtn.Height := c[3]-c[1]-2; - FText.top := 1; - FText.Left := 1; - FText.Height := c[3]-c[1]-2; - FText.Width := C[2]-C[0]-22; - end - property Text read GetText Write SetText; - private - function GetText(); - begin - return FText.Text; - end - function SetText(v); - begin - FText.Text := v; - end - end - type TInputFile=class(TEditAndBtnUni,TInputEditor) - class function ClassType();override; - begin - return "file"; - end - function Create(AOwner);override; - begin - inherited; - width := 300; - height := 30; - end - function BtnClick(o,e);override; - begin - if not FFile then - begin - FFile := new TOpenFileADlg(self); - FFile.parent := self; - end - if FFile.ChooseDlg()then - begin - text := FFile.FileName; - end - end - private - function GetValue();override; - begin - return text; - end - function SetValue(v);override; - begin - text := v; - end - FFile; - end - type TInputPath=class(TEditAndBtnUni,TInputEditor) - class function ClassType();override; - begin - return "path"; - end - function Create(AOwner);override; - begin - inherited; - width := 300; - height := 30; - end - function BtnClick(o,e);override; - begin - if not FFile then - begin - FFile := new TFolderChooseADlg(self); - FFile.parent := self; - end - if FFile.ChooseDlg()then - begin - text := FFile.Folder; - end - end - private - function GetValue();override; - begin - return text; - end - function SetValue(v);override; - begin - text := v; - end - FFile; - end - function Tostr(v); - begin - if not ifstring(v)then return tostn(v); - return v; - end - function RegularData(d); - begin - r := array(); - FInfo := New TMyArrayA(); - v := new TMyArrayA(); - for i in d do - begin - vi := d[i]; - if not ifarray(vi)then continue; - v.Data := vi; - vn := v["name"]; - //if not ifstring(vn) then continue; - if FInfo[vn]then continue; - FInfo[vn]:= 1; - r[idx,"name"]:= vn; - r[idx,"caption"]:= v["caption"]?:(v["Comment"]?: wn); - for j in v.IndexNames() do - begin - if j in array("caption","name")then continue; - vj := v[j]; - r[idx,j]:= vj; - end - idx++; - end - return r; - end - FSetData; - FInfoa; - FInfo; - FBOk; - FBCancel; - FLabels; - FEdits; - FTips; - static SFInputType; - static SHashInited; + end end implementation diff --git a/funcext/tvclib/utslvcldlg.tsf b/funcext/tvclib/utslvcldlg.tsf index c95c75f..e0629e7 100644 --- a/funcext/tvclib/utslvcldlg.tsf +++ b/funcext/tvclib/utslvcldlg.tsf @@ -1,6 +1,6 @@ unit utslvcldlg; interface -uses cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclbase; +uses cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclbase,utslvclgdi,utslvclstdctl; type TCommDlg=class(tcomponent) {** @explan(说明) 选择对话框类 %% @@ -534,8 +534,840 @@ type tcustomfsdlg = class(TCommDlg) @param(FileMustExist)(bool) 若在文件名输入框中输入不存在的文件名则提示文件名不存在；默认则不提示而直接返回路径，用于打开对话框。 %% **} end +type TcustomTipMessageButton = class(TGraphicControl) +{** + @ignore(忽略) %% + @explan(说明) 提示按钮 %% +**} + public + function Create(AOwner);override; + begin + inherited; + height := 18; + width := 18; + caption := "提示信息"; + fmessageCaption := nil; + fmessageText := nil; + fimageType := 0; + fmessagebox := new TcustommsgADlg(AOwner); + setMessageCaption("提示"); + end + function MouseUp(o,e);override; + begin + inherited; + if e.skip then return; + if not fmessagebox.parent then fmessagebox.parent := parent; + if fmessageText=nil then fmessagebox.mbText := caption; + fmessagebox.ChooseDlg(); + end + procedure Paint();override; + begin + {** + @explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %% + **} + reset_tn(); + Canvas.StretchDraw(array(0,iconTop,iconSidelength,iconSidelength+iconTop),ftipImage.getImage(fimageType)); + if iconSidelength nil then + begin + isConstIconSize := 1; + iconSidelength := l; + end else + isConstIconSize := 0; + end + function getIconSize(); + begin + {** + @explan(说明) 获取提示图标的边长%% + @return(integer)边长%% + **} + if isConstIconSize then return iconSidelength; + reset_tn(); + return iconSidelength; + end + function setIconType(i); + begin + {** + @explan(说明) 设置显示的提示图标类型%% + @param(l)(integer)0:疑问，默认 + 1：错误 + 2：消息 + 3：警告%% + **} + if(ifint(i)or ifint64(i))and i >= 0 and i<5 then + begin + if fimageType <> i then + begin + fimageType := i; + if parent then invalidateRect(nil,1); + end + return 1; + end + return 0; + end + property messageText:string read fmessageText write setMessageText; + property messageCaption:string read fmessageCaption write setMessageCaption; + property showInfomationIcon:bool read isInfomationIcon write setInfomationIcon; + {** + @param(messageText)(string)要显示的提示对话框的文字%% + @param(messageCaption)(string)要显示的提示对话框的标题%% + @param(showInfomationIcon)(bool)提示对话框内是否显示一个消息图标%% + **} + protected + class function Sinit();override; + begin + inherited; + if not ftipImage then ftipImage := new TTipImage(); + end + private + type TTipImage=class() + public + function create(); + begin + init(); + end + function getImage(n); + begin + return imageData[n]; + end + private + { + 0:state_unknown ○? + 1:state_error ○! + 2:state_hint ○i + 3:state_warning △! + 4:state_infomation □ + } + function init(); + begin + imageData := array(); + imageData[0]:= "0502000000060400000074797065000203000000696D670006040000006461746 +100026502000089504E470D0A1A0A0000000D4948445200000010000000100806 +0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000001FA49444154 +384FA590C16BD37014C7FD63A617118F3B78F0A6C2849D062AEEB08322E261301 +0E7CDE1C58975177187ECB0218A8843F0302C8C6DB0D16DD0DAAEB16BBB68D3AD +59D3C43499499A768D7ECD7BD01FCD7612BFF08197F7BEDF6F48CEE03F75AAC07 +4427C5CF1F1447270FFB9C5D04C3BBA9D54AC6035ED623CA1E1CD928DEFB56304 +9D3F0CCDB4A31B79FA250A92290B77A68A500E5A08C310DD6E3706EDE8461EF2F +6C40587668091896D942ABFD06EB71104012E8DAEC5D8CC36F8461EF2524614CC +2CEC627A4E86EFFB705D97997D5F661E25BEE2C2F067CCCCE7794F9E6792CC195 +170FD5E12E96F061CC71198A6095555F142DAC4C0950F989C5E462693412EB783 +D594C21951707EE8132CDB43B3D9846118D8DB5322631ED2DB14CE5E5DC4AD893 +528CA0F64B33BCC6EB1C2195170713809ABE941D3EA2814CA90E52273EEDA1253 +A91C881D51285639230A46C6B3D14F32502E57512AA902CB3A62FA77C4F27A953 +3A2E0D5BB46F41335ECEF1BD1DBEA82C19B05A67FA7AA3A9EBEAE724614D4CD2E +6E3CD491CEBBD16738A8D56CE6F298C6F49E8954DA662F654401E9CB4607A3933 +6327280462380AE07F0BC90A19976DBB9166E471EF2F6240A485CF2D8C1CB053F +321F43AB87D00E436CE53A48CC7B51D8898549B10292FEF337A4C516EE4E1D61E +881CDD04C3BBA9DD4A9827F13F017E5DF89FE289AB2290000000049454E44AE42 +608200"; + imageData[1]:= "0502000000060400000074797065000203000000696D670006040000006461746 +10002C502000089504E470D0A1A0A0000000D4948445200000010000000100806 +0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000025A49444154 +384FA592FB4B53611CC6FB63C2B40B2111843F686988D9C598E6A5EDB09B735B2 +DA78C4CCAA9BB485B91E8424C22B6650E85A0A00B545A1121116194457431529B +6B37DBDCA6672B787ADF77E76C893F450FBC3F7D9FCFF3BD9CB309FFA90D01BFF +B4E2063D7236DD562AD578354B71A892E25E267E5F87986135C79AD0BC8823A2C +DB5A91F4B9C0DFF5B097F00D2268D6216C6A42B0BD5E7067950B48DB74E02D2D8 +80FDBF16B6A02FCE805AC3A4FB2C75F772233398E88AB07DF0D122CE86B044A08 +E02D5AACF668101BB631386555B3272AD1AD246B28907EE043E8D2397C6DAEC66 +75515ABB100BA67C462C8C3161592BD2A66A0A2FBC73AC90D3A38F0F7C630D7C6 +E10357C16A2C801AE89EBCD7C140B1A3280A2E9B6488B44911BF6C45E48A136F1 +B4B598D05443BA4E0EF7B91B46B1928761445C170EB71840CE4884639E2E35731 +535BC26A2C20D8DE80B53B1EAC90CF268E4A3B663ECE3213057FE81B11D036206 +0E0101F1BC1CB9ADDACC602FCA72488B9FB911CB1E746A51DE3D70690B8E563E0 +92A61E7ED531849D660406FB305D5D9C0F98D71DC13793824C7123372AED288A8 +28BCA3A2CC86BB132E1C61BE5513CABDCC16A2CE08BFA003E292AB1E4E844EAF6 +68AE63D4E524DFDEC1C0794EC2E039B3114FF76FC3E3F2A27C00D57B5939669BC +AB0683F8DE44D2F2217C94FA39561B1458AD07933391C81BB8C78525184A97D5B +04EAAF00AAD775257825D98377CD120406C83D3C4388BA87E0EFB761863B44C04 +23C2A2B10DC59AD0BA07A717817A60F16E379D54EB2E77632EE56326E2126F716 +E061E966C195D786807F13F007E8743A916FA8D5250000000049454E44AE42608 +200"; + imageData[2]:= "0502000000060400000074797065000203000000696D670006040000006461746 +100026F01000089504E470D0A1A0A0000000D4948445200000010000000100806 +0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000010449444154 +384FC590CD4EC24014467D4C1FC23720AE890FC082858961876B6358E24A59904 +0F83102024A2920CA6F202632F7F3DEA197D0306D349A709259F44ECF99764EF0 +47FE2F709ACCFD6A29A140F6AE81AF8D09266E6E0A9D50C406746088305B13460 +B823F277853C2CB84D07E2734DF0C5ABC84C4D5FD61E02C95B783218BFE8CD063 +B9FB41780EE4C7A141CDDF062EAE8BD1813ECBAF7CAA95C784C6682B57592E7B3 +10159F20BF2F91D3EB535367862B93E30A8B05C62B9EC6DAC749E7908070419C8 +254A641FF99A52CFD8B0E0BC444187FBEB32570B7681E9F2D33EEB9EB20BB8901 +707939553542203F272FAB61A292ACE804A71A212FB0B3FE1D801E01BC7E9AA1F +1B492A780000000049454E44AE42608200"; + imageData[3]:= "0502000000060400000074797065000203000000696D670006040000006461746 +100029B02000089504E470D0A1A0A0000000D4948445200000010000000100806 +0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000023049444154 +384FA5924B68135114860342C1858208BA1041B42A528A146BADA5ED4A70272AD +5048D2EA48B2E74D195B85044280A165D3488A216DA8A521F68D5FAC65402DAE2 +BBCD63F268A3C699BC6D329919F398CCEF99C9A531A45D883FFC309C7BFEEF70C +F5C13FE530B0212F636C45FB522F6A2059167DB59B55A0B02F470DAD983D4D733 +088F6E63D56ACD0BD0C3519A5CCCA7919F754178B8153FEF6F61A7959A17107DD +E0291B3415333D0F261A4A62E2274B7819D56AA0AA087234F9B81620EB9A80DF9 +783F4112F83EBC19DF6ED6B3AEB2AA007A580A0E533E09F750BB61557622ED19C +4CC501DEB2AAB021079D28CE47837A0E520050EC335D86E58F25AA11592E05F76 +C17F6D03EB2E690EA08785C74DF81D1BA7E509907C87E01A68332C7ACC5033EF2 +085C6E0BD520BEED25A96FA0B203C6A426AB29726C590156C04B0627A642703EC +87ECB7A2989D4178EC249C1756B31403E8617EA491C2191444079480D50028C14 +EC4DF9B21BAF741F676201BB6A12085F0E5EC4A7C3CBDBC0CE01F34D292AED3E2 +C2C8F2E7A1F80F10E060F90AEE0EC8DC5E48EEDD50150EBCFD1C264E2C2D01F47 +0C47E84FEB9448F6614B2CF6238C3D1648F85C2165AA299007B20797641F1512F +5D73B26F071CC76A600ADD6B801C7A6D00B4C22CF957C92A7DEB9EAB259913541 +711FF74076FBA16C1F4E3363D905BF508DEA8C3F4C02604FA37C277753DBC97D7 +C1DDB70653BDABF0B967053E9C5A8689E34BF0B67B311C476B8CB0BDD354F90EF +E5DC01F26687F1D27F303B60000000049454E44AE42608200"; + imageData[4]:= "0502000000060400000074797065000203000000696D670006040000006461746 +10002F002000089504E470D0A1A0A0000000D4948445200000010000000100806 +0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000028549444154 +384FA591CB4F136114C5FD9F9C71634C646188090644C18588A60852C028442D6 +2202A1429EFB6D08729050BC8A3CAAB552A9456DA0E15C7D287057948DA8AC1C4 +44571A8D28C73BD3490B61653CC959CD3DBF7BCF7C87F09F3A00C835ACE2942E8 +A2C4D04275A03C868E171BC6591ECC7B1079C3495D63E40B67E0527D56194F585 +D0E78E638CDB12DDEB8C41A67F05B6760E6C9D539A4E2A0510B666B605D13AB50 +647601B3D337128ADEF707F64056ADB1AAC9E041AC7A260CB27C15E9B94521220 +4B1B4166FB9218B6BDDE462D856E0F8631ECFB80616F02B72C212806C2B0CC6D4 +2F92404B6C40AB678240DC8542FA1D414809DFF849AC1281454E1863988EF3F77 +44579A7954F6F0503C0A60F0650CE79B5F802918480332DA79EA1987D6B6819B7 +D41549903A834F1E8776FC2422E3772491B7C542B0CFDCC2AD87C731A7054C961 +62F1236AFA43B4E90D2A1EFA6938F9C777C9729D17A55DF3640FAE1ABCB072313 +067BAC5EF2280AD7363DCBF2576153695E97D14F2211AFF8A6F3F7650D2E94671 +870B97C9728D0BA30B04C8D1EC053861726E40F5741915063FE4DD5E5CD1CEE36 +DEC0B017EA1A8651645D45BD6EC40750F07AD2302F674E71E40B503856A37863D +7154E838C8D51E38F8047EFFD9152B84DE7F46A1D24EB6C1F82C8AFC3B6304E81 +0A212E0FA3858B915F74683B038D751A27641D63A838BAA691436D870A17E1205 +F513681B0DD0F32ED0F92AB0E4144010231BC2E1BC5ED40ED18BCCAE4261F2D2C +9CF71A9D18E2A9D0B7A5B188A7E0E6C76432A2C280510C4E4F782C933E2DCDD29 +68A797F1D8BB415E47A73D82DC1A2B98EC460A3749D349ED030862CFEAE989BAC +0E46AE8D4660A35891B051FC96990A6D23A00F837017F01AE4B3263C856875900 +00000049454E44AE42608200"; + for i := 0 to length(imageData)-1 do + begin + t := new tcustombitmap(); + t.Readvcon(HexFormatStrToTsl(imageData[i])); + imageData[i]:= t; + end + end + imageData; + end + function setMessageText(str); + begin + fmessageText := str; + fmessagebox.mbText := str; + end + function setMessageCaption(str); + begin + fmessageCaption := str; + fmessagebox.Caption := str; + end + function setInfomationIcon(b); + begin + isInfomationIcon := b?1:0; + fmessagebox.mbiconstyle := isInfomationIcon?0x40:0; + end + function reset_tn(); + begin + //重新计算图标的边长及位置 + if not isConstIconSize then iconSidelength := height50?(c[0]-50):100; + top := c[1]>50?(c[1]-50):100; + return ShowDlg(result,t); + end + function OnOkClk(); + begin + EndModal(1); + end + function OnCancelClk(); + begin + EndModal(0); + end + function DoWMSIZE(o,e);override; + begin + h := clientrect; + ht := h[3]-h[1]; + wd := h[2]-h[0]; + FBOk.Left := wd/2-50; + FBOK.top := ht-33; + FBCancel.Left := FBOk.Left+FBOK.Width+20; + FBCancel.top := ht-33; + end + class function RegisterInputType(t); + begin + {** + @explan(说明) 注册input类型 %% + @param(t)(TInputEditor) 编辑类 %% + **} + if t is class(TInputEditor)then + begin + if not SFInputType then SFInputType := new tstrindexarray(); + return SFInputType[t.classtype]:= t; + end else + if ifarray(t)then + begin + for i,v in t do RegisterInputType(v); + end + end + class function GetInputType(n); + begin + {** + @explan(说明) 获得注册类型 %% + **} + if SFInputType and ifstring(n)then return SFInputType[n]; + end + function Recycling();override; + begin + inherited; + FSetData := nil; + FInfoa := nil; + FInfo := nil; + FBOk := nil; + FBCancel := nil; + FLabels := nil; + FEdits := nil; + FTips := nil; + end + private + function RebuildInput(); + begin + ld := length(FInfoa); + lb := length(FLabels); + lp := length(FTips); + for i := 0 to lp-1 do FTips[i].Recycling(); + for i := 0 to lb-1 do + begin + FLabels[i].Recycling(); + FEdits[i].Recycling(); + end + FLabels := array(); + FEdits := array(); + for i := 0 to ld-1 do + begin + FLabels[i]:= new TcustomLabel(self); + tp := FInfoa[i]["type"]; + if ifstring(tp)then + begin + tp := GetInputType(tp); + end + if ifobj(tp)then FEdits[i]:= createobject(tp,self); + else FEdits[i]:= new TInputString(self); + syg := FEdits[i-1]; + if syg then + begin + syg.NextCtrl := FEdits[i]; + end + if i=ld-1 then FEdits[i].NextCtrl := FBOk; + end + sp := 5; + for i,v in FInfoa do + begin + lb := FLabels[i]; + le := FEdits[i]; + lb.caption := v["caption"]; + lb.left := 20; + vtp := v["tip"]; + if ifstring(vtp)and vtp then + begin + tp := new TcustomTipMessageButton(self); + tp.caption := vtp; + tp.left := 2; + tp.top := sp+3; + FTips[length(FTips)]:= tp; + tp.parent := self; + end + lb.top := sp; + lb.width := length(v["caption"])* 8+3; + le.value := v["value"]; + le.top := lb.top; + le.left := lb.width+lb.left; + if v["readonly"]then + begin + if le is class(tcustomedit)then le.readonly := true; + else le.Enabled := false; + end else + begin + if le is class(tcustomedit)then le.readonly := false; + else le.Enabled := true; + end + wd := max(le.left+le.width+10,wd); + sp += max(lb.height,le.height); + sp += 4; + le.SetInfo(v); + le.parent := self; + lb.parent := self; + end + width := wd+10; + height := sp+60+10; + //echo "\r\nin thisf function:",wd,"===",(sp+60); + //echo "\r\nin thisf function:",width,"===",height; + end + function Tostr(v); + begin + if not ifstring(v)then return tostn(v); + return v; + end + function RegularData(d); + begin + r := array(); + FInfo := New tstrindexarray(); + v := new tstrindexarray(); + for i in d do + begin + vi := d[i]; + if not ifarray(vi)then continue; + v.Data := vi; + vn := v["name"]; + //if not ifstring(vn) then continue; + if FInfo[vn]then continue; + FInfo[vn]:= 1; + r[idx,"name"]:= vn; + r[idx,"caption"]:= v["caption"]?:(v["Comment"]?: wn); + for j in v.IndexNames() do + begin + if j in array("caption","name")then continue; + vj := v[j]; + r[idx,j]:= vj; + end + idx++; + end + return r; + end + FSetData; + FInfoa; + FInfo; + FBOk; + FBCancel; + FLabels; + FEdits; + FTips; + static SFInputType; + static SHashInited; +end implementation +type TInputEditor=class() + {** + @ignore(忽略) %% + @explan(说明)输入框注册控件基类 %% + **} + class function ClassType(); + begin + {** + @explan(说明) 类型名字 %% + @return(string) 名字 %% + **} + return ""; + end + function OnNextKeyPress(o,e);virtual; + begin + {** + @explan(说明) key值判断 %% + **} + if e.CharCode=0x9 then FocusNext(); + end + function FocusNext();virtual; + begin + {** + @explan(说明) 设置下一个获得焦点 %% + **} + if NextCtrl is class(TWinControl)then + begin + NextCtrl.SetFocus(); + end + end + function SetInfo(info);virtual; + begin + {** + @explan(说明) 设置额外信息 %% + @param(info)(array) 信息 %% + **} + end + property NextCtrl read FNextCtrl Write FNextCtrl; + property Value read GetValue write SetValue; + {** + @param(NextCtrl)(TInputEditor) 下一个控件 %% + @param(Value)(any) 值 %% + **} + private + function GetValue();virtual; + begin + end + function SetValue();virtual; + begin + end + FNextCtrl; +end +type tinputbool=class(tcustomcheckbtn,TInputEditor) + {** + @explan(说明) 输入框 %% + **} + class function ClassType();override; + begin + return "bool"; + end + function Create(AOwner);override; + begin + inherited; + width := 16; + height := 17; + OnKeyPress := thisfunction(OnNextKeyPress); + end + function Recycling();override; + begin + NextCtrl := nil; + inherited; + end + private + function GetValue();virtual; + begin + return Checked; + end + function SetValue(v);virtual; + begin + Checked := v; + end +end +type TInputString=class(tcustomedit,TInputEditor) + {** + @explan(说明) 输入框 %% + **} + class function ClassType();override; + begin + return "string"; + end + function Create(AOwner);override; + begin + inherited; + width := 300; + OnKeyPress := thisfunction(OnNextKeyPress); + end + function Recycling();override; + begin + NextCtrl := nil; + inherited; + end + private + function GetValue();virtual; + begin + return text; + end + function SetValue(v);virtual; + begin + text := v; + end +end +type TInputPassWord=class(tcustompassword,TInputEditor) + {** + @explan(说明) 输入框 %% + **} + class function ClassType();override; + begin + return "password"; + end + function Create(AOwner);override; + begin + inherited; + width := 300; + OnKeyPress := thisfunction(OnNextKeyPress); + end + function Recycling();override; + begin + NextCtrl := nil; + inherited; + end + private + function GetValue();virtual; + begin + return text; + end + function SetValue(v);virtual; + begin + text := v; + end +end +type TInputInteger=class(TInputString) + class function ClassType();override; + begin + return "integer"; + end + function Create(AOwner);override; + begin + inherited; + OnKeyPress := thisfunction(InPutChar); + end + function InPutChar(o,e); + begin + cd := e.CharCode; + if cd=VK_BACK or cd=VK_DELETE then return; + if cd=VK_TAB then OnNextKeyPress(o,e); + else + begin + if not(cd >= ord("0")and cd <= ord("9"))then + begin + e.skip := true; + end + end + end + private + function GetValue();override; + begin + return StrToIntDef(self.Text,0); + end + function SetValue(v);override; + begin + if ifnumber(v)then Text := IntToStr(v); + end +end +type TInputBtn=class(tcustombtn,TInputEditor) + {** + @explan(说明) 按钮 %% + **} + function Create(AOwner);override; + begin + inherited; + height := 25; + OnKeyPress := thisfunction(OnNextKeyPress); + end + function Recycling();override; + begin + NextCtrl := nil; + inherited; + end +end +type TEditAndBtnUni=class(tcustomcontrol) + {** + @explan(说明) edit button 组合 %% + **} + private + FBtn; + FText; + public + function BtnClick(o,e);virtual; + function WMSETFOCUS(o,e):WM_SETFOCUS;override; + begin + if FBtn then FBtn.SetFocus(); + end + function Create(AOwner);override; + begin + inherited; + Height := 22; + FBtn := new tcustombtn(self); + FBtn.caption := ".."; + FText := new tcustomedit(self); + //FText.Border := true; + FText.caption := ""; + FBtn.Parent := self; + FText.Parent := self; + FBtn.OnClick := thisfunction(BtnClick); + FText.OnKeyUP := function(o,e) + begin + if e.CharCode=VK_TAB then + begin + self.parent._send_(WM_USER,3,self.Handle); + end + end + end + function DoControlAlign();override; + begin + c := clientRect; + echo tostn(c); + FBtn.SetBoundsRect(array(C[2]-18,1,C[2]-3,c[3]-2)); + FText.SetBoundsRect(array(c[0]+1,c[1]+1,c[2]-22,c[3]-2)); + end + property Text read GetText Write SetText; + private + function GetText(); + begin + return FText.Text; + end + function SetText(v); + begin + FText.Text := v; + end +end +type TInputFile=class(TEditAndBtnUni,TInputEditor) + class function ClassType();override; + begin + return "file"; + end + function Create(AOwner);override; + begin + inherited; + width := 300; + height := 30; + end + function BtnClick(o,e);override; + begin + if not FFile then + begin + FFile := new tcustomfsdlg(self); + FFile.parent := self; + end + if FFile.ChooseDlg()then + begin + text := FFile.FileName; + end + end + private + function GetValue();override; + begin + return text; + end + function SetValue(v);override; + begin + text := v; + end + FFile; +end +type TInputPath=class(TEditAndBtnUni,TInputEditor) + class function ClassType();override; + begin + return "path"; + end + function Create(AOwner);override; + begin + inherited; + width := 300; + height := 30; + end + function BtnClick(o,e);override; + begin + if not FFile then + begin + FFile := new tcustomfolderdlg(self); + FFile.parent := self; + end + if FFile.ChooseDlg()then + begin + text := FFile.Folder; + end + end + private + function GetValue();override; + begin + return text; + end + function SetValue(v);override; + begin + text := v; + end + FFile; +end function xor(a,b); begin {** diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index 70c2287..c975961 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -2304,6 +2304,75 @@ type tVirtualCalender=class(TSLUIBASE) FCellWidth; FCellHeight; end +type TcustomLabel = class(TGraphicControl) + {** + @explan(说明)标签控件 %% + **} + private + FTextAlign; + function SetTextAlign(v); + begin + if v <> FTextAlign then + begin + FTextAlign := v; + InvalidateRect(nil,true); + end + end + protected + function SetControlFont(v);override; + begin + inherited; + //invalidaterect(nil,true); + invalidaterect(nil,false); + end + public + function paint();override; + begin + dc := canvas; + dc.font := font; + rc := ClientRect; + if border then + begin + rc[0]+= 1; + rc[1]+= 1; + rc[2]-= 1; + rc[3]-= 1; + end + CanvasDrawAlignText(dc,rc,self.Caption,FTextAlign); + if border then + begin + dc.Draw("polyline",array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1]))); + end + end + function create(AOwner);override; + begin + inherited; + caption := "label"; + FTextAlign := 0; + //border := true; + end + class function CanvasDrawAlignText(dc,rect,txt,al); + begin + {** + @explan(说明) 在指定区域内按照对齐方式绘制文本%% + @param(al)(member of TAlignStyle9) 对齐方式 %% + **} + if not(dc is class(TCustomcanvas))then exit; + als := array(36,0,33 + ,2,36 + ,37 + ,38,40 + ,41 + ,42); + val := als[al]; + if ifnil(val)then val := 36; + return dc.drawtext(txt,rect,val .| DT_NOPREFIX); + end + property TextAlign:AlignStyle9 read FTextAlign write SetTextAlign; + {** + @param(TextAlign)(member of TAlignStyle9) 文字对齐 %% + **} +end type tcustomedit=class(TCustomControl) {** @explan(说明) 单行文本编辑框类 %%