1380 lines
40 KiB
Plaintext
1380 lines
40 KiB
Plaintext
unit utslvcldlg;
|
||
interface
|
||
uses cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclbase,utslvclgdi,utslvclstdctl;
|
||
type TCommDlg=class(tcomponent)
|
||
{**
|
||
@explan(说明) 选择对话框类 %%
|
||
**}
|
||
private
|
||
FChooseOk;
|
||
FWndOwner;
|
||
FCaption;
|
||
function SetParent(p);
|
||
begin
|
||
FWndOwner := p;
|
||
end
|
||
protected
|
||
function SetCaption(v);virtual;
|
||
begin
|
||
FCaption := v;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function Notification(AComponent,Operation);override;
|
||
begin
|
||
if Operation=opRecycling then //opRemove
|
||
begin
|
||
if AComponent=FWndOwner then FWndOwner := nil;
|
||
end
|
||
inherited;
|
||
end
|
||
function OpenDlg();
|
||
begin
|
||
{**
|
||
@explan(说明) 打开对话框 %%
|
||
**}
|
||
return FChooseOk := ChooseDlg();
|
||
end
|
||
function ChooseDlg();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 打开对话框虚函数
|
||
**}
|
||
end
|
||
property ChooseOk read FChooseOk;
|
||
property WndOwner:variable read FWndOwner write FWndOwner;
|
||
property Parent read FWndOwner write SetParent;
|
||
property Caption:string read FCaption write SetCaption;
|
||
{**
|
||
@param(ChooseOk)(bool) 是否执行成功 %%
|
||
@param(WndOwner)(TWinControl) 所属窗口 %%
|
||
**}
|
||
end
|
||
type TcustommsgADlg=class(TCommDlg)
|
||
{**
|
||
@explan(说明) 消息提示框 %%
|
||
**}
|
||
private
|
||
FmbText;
|
||
Fbtnvals;
|
||
Ficonvals;
|
||
Fbtnval;
|
||
Ficonval;
|
||
function setMbtext(v)
|
||
begin
|
||
if FmbText <> v then
|
||
begin
|
||
FmbText := v;
|
||
end
|
||
end
|
||
function setcaption(v);override;
|
||
begin
|
||
if caption=v then exit;
|
||
inherited;
|
||
end
|
||
function setmbbtnstyle(v)
|
||
begin
|
||
if Fbtnval <> v and(v in Fbtnvals)then
|
||
begin
|
||
Fbtnval := v;
|
||
end
|
||
end
|
||
function setmbiconstyle(v)
|
||
begin
|
||
if Ficonval <> v and(v in Ficonvals)then
|
||
begin
|
||
Ficonval := v;
|
||
end
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FmbText := "";
|
||
caption := "提示";
|
||
Fbtnval := 0;
|
||
Ficonval := 48;
|
||
Fbtnvals := array(0,1,2,3,4,5,6,16384);
|
||
Ficonvals := array(48,64,32,16);
|
||
end
|
||
function ChooseDlg();override;
|
||
begin
|
||
hd := 0;
|
||
if Parent is class(TWinControl)then hd := Parent.Handle;
|
||
r := _wapi.MessageBoxA(hd,mbText,self.caption,Fbtnval .| Ficonval);
|
||
return r;
|
||
end
|
||
{
|
||
判断messagebox按钮是否被按下：根据 ChooseDlg()函数的返回值进行判断
|
||
代码 值 描述
|
||
IDABORT 3 "中止"按钮被选中
|
||
IDCANCEL 2 "取消"按钮已被选中
|
||
IDCONTINUE 11 "继续"按钮被选中
|
||
IDIGNORE 5 "忽略"按钮已被选中
|
||
IDNO 7 在"NO"按钮被选中
|
||
IDOK 1 "OK"按钮被选中
|
||
IDRETRY 4 "重试"按钮被按下
|
||
IDTRYAGAIN 10 "再试一次"按钮被按下
|
||
IDYES 6 "yes"按钮被选中
|
||
}
|
||
property mbText:string read FmbText write setMbtext;
|
||
property mbbtnstyle:MBbtnstyle read Fbtnval write setmbbtnstyle;
|
||
property mbiconstyle:MBiconstyle read Ficonval write setmbiconstyle;
|
||
{**
|
||
@param(mbText)(string)字符串%%
|
||
@param(mbbtnstyle)(TMBbtnstyle)按钮样式%%
|
||
@param(mbiconstyle)(TMBiconstyle)图标样式%%
|
||
**}
|
||
end
|
||
type tcustomcolordlg=class(TCommDlg)
|
||
{**
|
||
@explan(说明)颜色选择器 %%
|
||
**}
|
||
private
|
||
Fdlgcolor;
|
||
function SetCustomColors(cols);
|
||
begin
|
||
if ifarray(cols)then
|
||
begin
|
||
Fdlgcolor.lpcustcolors._setvalue_(0,cols);
|
||
end
|
||
end
|
||
function GetCustomColors();
|
||
begin
|
||
return Fdlgcolor.lpcustcolors._getdata_();
|
||
end
|
||
function SetResult(c);
|
||
begin
|
||
Fdlgcolor.rgbresult := c;
|
||
end
|
||
function GetResult()
|
||
begin
|
||
r := Fdlgcolor.rgbresult;
|
||
return r;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
Fdlgcolor := new ttagCHOOSECOLORA();
|
||
end
|
||
function ChooseDlg();override;
|
||
begin
|
||
Fdlgcolor.flags := CC_RGBINIT .| CC_SOLIDCOLOR; //.| CC_SHOWHELP .| CC_SOLIDCOLOR;
|
||
if WndOwner is class(TWinControl)then Fdlgcolor.hwndowner := WndOwner.Handle;
|
||
r := _wapi.ChooseColorA(Fdlgcolor._getptr_);
|
||
return r;
|
||
end
|
||
{**
|
||
@param(CustomColors)(array of integer) 自定义颜色 %%
|
||
@param(RgbResult)(integer) 颜色rgba值 %%
|
||
**}
|
||
property CustomColors read GetCustomColors write SetCustomColors;
|
||
property Result:color read GetResult write SetResult;
|
||
|
||
end
|
||
type tcustomfontdlg=class(TCommDlg)
|
||
{**
|
||
@explan(说明) 字体选择对话框 %%
|
||
**}
|
||
private
|
||
FFontChoose;
|
||
function SetFontInfo(v);
|
||
begin
|
||
FFontChoose.SetFontInfo(v);
|
||
if ifnumber(v["color"])then FFontChoose.rgbcolors := v["color"];
|
||
end
|
||
function GetFontInfo();
|
||
begin
|
||
r := GetFont();
|
||
if r is class(ttagLOGFONTA)then r := r._getdata_();
|
||
if ifarray(r)then
|
||
begin
|
||
r["color"]:= FFontChoose.rgbcolors;
|
||
fh := r["height"];
|
||
if fh<0 then r["height"]:= abs(fh);
|
||
fw := r["width"];
|
||
if fw=0 then r["width"]:= integer(abs(fh/2));
|
||
else if fw<0 then r["width"]:= abs(fw);
|
||
end
|
||
return r;
|
||
end
|
||
function GetFont();
|
||
begin
|
||
return FFontChoose.lplogfont;
|
||
end
|
||
function SetColor(v);
|
||
begin
|
||
FFontChoose.rgbcolors := V;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FFontChoose := new ttagCHOOSEFONTA();
|
||
FFontChoose.flags := CF_EFFECTS .| CF_INITTOLOGFONTSTRUCT; //.|CF_BOTH ;
|
||
end
|
||
function ChooseDlg();override;
|
||
begin
|
||
if WndOwner is class(TWinControl)then FFontChoose.hwndowner := WndOwner.Handle;
|
||
return _wapi.ChooseFontA(FFontChoose._getptr_);
|
||
end
|
||
property FontInfo:font read GetFontInfo write SetFontInfo;
|
||
property color Write SetColor;
|
||
|
||
{**
|
||
@param(LogFont)(ttagLOGFONTA) 逻辑字体对象%%
|
||
@param(FontInfo)(array) 字体信息数组 %%
|
||
**}
|
||
end
|
||
type tcustomfolderdlg=class(TCommDlg)
|
||
{**
|
||
@explan(说明) 文件夹路径选择对话框 %%
|
||
**}
|
||
private
|
||
FBrowse;
|
||
FFolder;
|
||
FRootFold;
|
||
FRootStr;
|
||
FEditBox;
|
||
FDefaultDirstr;
|
||
FDefaultDir;
|
||
function SetDefaultDir(d);
|
||
begin
|
||
if ifstring(d)and d <> FDefaultDirstr then
|
||
begin
|
||
FDefaultDirstr := d;
|
||
FDefaultDir.setv(d);
|
||
end
|
||
end
|
||
function freeil();
|
||
begin
|
||
if FRootFold then _wapi.ILFree(FRootFold);
|
||
FRootFold := nil;
|
||
FRootStr := nil;
|
||
end
|
||
function SetEditBox(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if FEditBox <> nv then
|
||
begin
|
||
FEditBox := nv;
|
||
end
|
||
end
|
||
function SetRootFold(p);
|
||
begin
|
||
if ifnil(p)then freeil();
|
||
if not(p and ifstring(p))then exit;
|
||
if FRootStr=p then exit;
|
||
freeil();
|
||
FRootFold := _wapi.ILCreateFromPathA(p);
|
||
if FRootFold then FRootStr := p;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FEditBox := true;
|
||
FDefaultDir := new tcstring(1024);
|
||
FBrowse := new TBrowseinfoA();
|
||
end
|
||
function ChooseDlg();override;
|
||
begin
|
||
if WndOwner is class(TWinControl)then FBrowse.hwndowner := WndOwner.Handle;
|
||
if FRootFold then FBrowse.pidlroot := FRootFold;
|
||
flg := 0x8;
|
||
if FEditBox then flg .|= 0x00000010;
|
||
//if FNewFolder then flg .|= 0x00000040 .| 0x00000100 .| 0x00000080;
|
||
FBrowse.ulflags := flg;
|
||
if FDefaultDirstr then
|
||
begin
|
||
FBrowse.lparam := FDefaultDir.ptr;
|
||
FBrowse.lpfn := getwinprocptr(0x11);
|
||
end
|
||
ft := _wapi.SHBrowseForFolderA(FBrowse._getptr_);
|
||
if not ft then return 0;
|
||
s := s1 := "";
|
||
setlength(s1,1024);
|
||
f := _wapi.SHGetPathFromIDListA(ft,s1);
|
||
if not f then return 0;
|
||
for i := 1 to length(s1) do
|
||
begin
|
||
ts := s1[i];
|
||
if ts="\0" then break;
|
||
s += ts;
|
||
end
|
||
FFolder := s;
|
||
return true;
|
||
end
|
||
property DefaultDir read FDefaultDirstr write SetDefaultDir;
|
||
property RootFolder:directory read FRootStr write SetRootFold;
|
||
property Folder read FFolder;
|
||
property EditBox:bool read FEditBox write SetEditBox;
|
||
{**
|
||
@param(Folder)(string) 文件夹路径 %%
|
||
**}
|
||
end
|
||
type tcustomfsdlg = class(TCommDlg)
|
||
{**
|
||
@explan(说明) 保存文件,获得文件名 %%
|
||
@param(FFileTag)(TtagOFNA)openfile 对象 %%
|
||
**}
|
||
protected FFileTag;
|
||
function dlgType();virtual;
|
||
begin
|
||
//对话框类型：0x1：保存为窗口。0x2：打开窗口。
|
||
return 1;
|
||
end
|
||
function setCaption(s);override;
|
||
begin
|
||
if ifstring(s)then
|
||
begin
|
||
inherited;
|
||
FFileTag.lpstrtitle := s;
|
||
end
|
||
end
|
||
private
|
||
FFilter;
|
||
Ffilterindex;
|
||
fIsShowHidden;
|
||
fIsMultiselected;
|
||
fIsOverwritePrompt;
|
||
fIsLinkFilePath;
|
||
fIsCreatePrompt;
|
||
fIsFileMustExist;
|
||
finitialdir;
|
||
function setFlagsBit(b,m,n);
|
||
begin
|
||
//b：要设置的位的值，m：要设置的位的值的保存成员，n：要设置的位。
|
||
if xor(b,m)then
|
||
begin
|
||
if b then FFileTag.Flags .|= n;
|
||
else FFileTag.Flags :=.!((.!FFileTag.Flags).| n);
|
||
m := b;
|
||
end
|
||
end
|
||
function setShowHidden(b);
|
||
begin
|
||
setFlagsBit(b,fIsShowHidden,0x10000000);
|
||
end
|
||
function setMultiSelected(b);
|
||
begin
|
||
tb := fIsMultiselected;
|
||
setFlagsBit(b,fIsMultiselected,0x200);
|
||
if b and tb <> fIsMultiselected then
|
||
begin
|
||
s := "";
|
||
setlength(s,1024 * 16);
|
||
FFileTag.lpstrfile := s;
|
||
end
|
||
end
|
||
function setOverwritePrompt(b);
|
||
begin
|
||
setFlagsBit(b,fIsOverwritePrompt,0x2);
|
||
end
|
||
function setLinkFilePath(b);
|
||
begin
|
||
setFlagsBit(b,fIsLinkFilePath,0x100000);
|
||
end
|
||
function setCreatePrompt(b);
|
||
begin
|
||
setFlagsBit(b,fIsCreatePrompt,0x2000);
|
||
end
|
||
function setFileMustExist(b);
|
||
begin
|
||
//FFileTag.SetValue();
|
||
setFlagsBit(b,fIsFileMustExist,0x1000);
|
||
end
|
||
function GetResult();
|
||
begin
|
||
return FFileTag.lpstrfile;
|
||
end
|
||
function setfilter(f);
|
||
begin
|
||
{**
|
||
@explan(说明)设置筛选条件%%
|
||
@param(f)(array)筛选条件采用字符串下标的字符串数组,下标作为显示,值作为筛选条件
|
||
array("所有文件":"*.*","tsl流文件":"*.stm")
|
||
%%
|
||
**}
|
||
if FFilter=f then exit;
|
||
s := "";
|
||
rf := array();
|
||
if ifarray(f)then
|
||
begin
|
||
for i,v in f do
|
||
begin
|
||
if v and ifstring(v)and ifstring(i)then
|
||
begin
|
||
s += i+"\0"+v+"\0";
|
||
rf[i]:= v;
|
||
end
|
||
end
|
||
end
|
||
if length(s)then
|
||
begin
|
||
s += "\0";
|
||
FFileTag.lpstrfilter := s;
|
||
FFilter := rf;
|
||
end
|
||
Ffilterindex := 1;
|
||
end
|
||
function OpenFileDlg();virtual;
|
||
begin
|
||
r := _wapi.GetSaveFileNameA(FFileTag._getptr_);
|
||
return r;
|
||
end
|
||
function setDefaultFileExtension(s);
|
||
begin
|
||
if ifstring(s)then FFileTag.lpstrdefext := s;
|
||
end
|
||
function getDefaultFileExtension();
|
||
begin
|
||
return FFileTag.lpstrdefext;
|
||
end
|
||
function setInitialDir(s);
|
||
begin
|
||
if ifstring(s)and s <> "" then
|
||
begin
|
||
finitialdir.setv(s);
|
||
FfileTag.lpstrinitialdir := finitialdir.ptr;
|
||
end else
|
||
FfileTag.lpstrinitialdir := 0;
|
||
end
|
||
function getInitialDir();
|
||
begin
|
||
if FFileTag.lpstrinitialdir=finitialdir.ptr then return finitialdir.getv();
|
||
else return "";
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FFileTag := new TtagOFNA();
|
||
FFileTag.Flags .|= 0x80000; // .| OFN_ENABLEHOOK;
|
||
//FFileTag.hinstance := happ;
|
||
//FFileTag.lpfnHook := getwinprocptr(0x10);
|
||
finitialdir := new tcstring(512);
|
||
//FFileTag.lcustdata := finitialdir._getptr_;// 0x178;
|
||
//echo tostn(FFileTag._getdata_);
|
||
end
|
||
function getSelectedItemName();
|
||
begin
|
||
{**
|
||
@explan(说明)获取所选择文件的文件名%%
|
||
@return(string)当选择不止一个文件时，该函数返回首文件名。%%
|
||
**}
|
||
return FFileTag.lpstrfiletitle;
|
||
end
|
||
function ChooseDlg();override;
|
||
begin
|
||
{**
|
||
@explan(说明)打开一个对话框以使用户选择将要打开或保存的文件的路径%%
|
||
@return(bool)是否选择了有效的文件路径%%
|
||
**}
|
||
if WndOwner is class(TWinControl)then FFileTag.hwndowner := WndOwner.Handle;
|
||
if Ffilterindex>0 and FFilter then FFileTag.nfilterindex := Ffilterindex;
|
||
FFileTag.lpstrfile := "\0\0";
|
||
FFileTag.lpstrfiletitle := "";
|
||
r := OpenFileDlg();
|
||
if FFilter then Ffilterindex := FFileTag.nfilterindex;
|
||
return r;
|
||
end
|
||
function getResults();
|
||
begin //r2
|
||
{**
|
||
@explan(说明)获取所选择文件的完整路径%%
|
||
@return(array)所选择文件路径的数组%%
|
||
**}
|
||
s := FFileTag._getvalue_("lpstrfile",FFileTag.nmaxfile);
|
||
r := array();
|
||
i := 0;
|
||
l := length(s);
|
||
while i <= l and s[++i]<> '\0' do;
|
||
if not i then return r;
|
||
t := s[1:i-1];
|
||
if not Multiselected or(i<l and s[i+1]='\0')then return array(t);
|
||
t += ioFileseparator(); // '\\';
|
||
b := i;
|
||
while++i <> l do if s[i]='\0' then
|
||
begin
|
||
r[j++]:= t+s[b+1:i-1];
|
||
if s[i+1]='\0' then break;
|
||
b := i;
|
||
end
|
||
return r;
|
||
end
|
||
property filter:filefilter read FFilter write setfilter;
|
||
property filterindex read Ffilterindex write Ffilterindex;
|
||
property FileName read GetResult;
|
||
// property struct read FFileTag write FFileTag;
|
||
property DefaultFileExtension:string read getDefaultFileExtension write setDefaultFileExtension;
|
||
property initialDir:filename read getInitialDir write setInitialDir;
|
||
property ShowHidden:bool read fIsShowHidden write setShowHidden;
|
||
property Multiselected:bool read fIsMultiselected write setMultiselected;
|
||
property OverwritePrompt:bool read fIsOverwritePrompt write setOverwritePrompt;
|
||
property LinkFilePath:bool read fIsLinkFilePath write setLinkFilePath;
|
||
property FileMustExist:bool read fIsFileMustExist write setFileMustExist;
|
||
property CreatePrompt:bool read fIsCreatePrompt write setCreatePrompt;
|
||
|
||
{**
|
||
@param(filter)(array) array("所有文件":"*.*","tsl流文件":"*.stm")%%
|
||
@param(FileName)(string) 文件名,不成功返回上一次的结果。 %%
|
||
@param(DefaultFileExtension)(string) 默认扩展名，当文件名输入框中未指定扩展名且未选择保存类型时将使用该扩展名，用于保存对话框。 %%
|
||
@param(initialDir)(string) 默认打开路径 %%
|
||
@param(caption)(string) 对话框名称。%%
|
||
@param(ShowHidden)(bool) 是否强制显示隐藏文件。 %%
|
||
@param(Multiselected)(bool) 可多选，用于打开对话框。 %%
|
||
@param(OverwritePrompt)(bool) 开启覆盖保存提醒，用于保存对话框。 %%
|
||
@param(LinkFilePath)(bool) 若所选为快捷方式文件则返回该文件本身路径；默认返回其指向文件的路径。 %%
|
||
@param(CreatePrompt)(bool) 若在文件名输入框中输入不存在的文件名则提示是否创建；默认则不提示而直接返回路径，用于打开对话框。 %%
|
||
@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<width then
|
||
begin
|
||
canvas.font := font;
|
||
canvas.drawtext(caption,array(iconSidelength,0,width,height),36);
|
||
end
|
||
end
|
||
function setIconSize(l);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置提示图标的边长，设置之后图标大小就不会根据控件大小变化而变化。%%
|
||
@param(l)(integer)要设置的长度，以像素为单位，为nil时取消设置%%
|
||
**}
|
||
if l <> 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 := height<width?height:width;
|
||
iconTop :=(height-iconSidelength)/2;
|
||
if iconTop<0 then iconTop := 0;
|
||
end
|
||
isConstIconSize;//控件显示的图标尺寸是否不变
|
||
iconSidelength;//控件图标边长
|
||
iconTop;//控件图标位置
|
||
fmessageCaption;//对话框标题
|
||
fmessageText;//对话框内容
|
||
isInfomationIcon;
|
||
fimageType;//控件图标类型
|
||
fmessagebox;
|
||
static ftipImage;
|
||
end
|
||
|
||
type TcustomInPutQuerys= class(tcustomscrollcontrol)
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 输入 %%
|
||
**}
|
||
{**
|
||
@example(输入范例)
|
||
wd := new TInPutQuerys();
|
||
d := array(("name":"A","value":100,"Comment":"年龄","readonly":0),
|
||
("Name":"b","value":10,"caption":"工作年限","readonly":1));
|
||
wd.SetData(d);
|
||
if wd.ShowDlg(r,"get") then echo tostn(r);
|
||
**}
|
||
protected
|
||
class Function Sinit();override;
|
||
begin
|
||
inherited;
|
||
if not SHashInited then
|
||
begin
|
||
SHashInited := 1;
|
||
RegisterInputType(array(class(TInputString),class(TInputInteger),
|
||
class(TInputFile),class(TInputPath),class(TInputPassWord),
|
||
class(TInputBool)));
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
caption := "input";
|
||
visible := false;
|
||
wspopup := true;
|
||
wscaption := true;
|
||
FBOk := new TInputBtn(self);
|
||
FBOk.caption := "确定";
|
||
FBOk.onclick := thisfunction(OnOkClk);
|
||
FBOk.parent := self;
|
||
FTips := array();
|
||
FBCancel := new TInputBtn(self);
|
||
FBOk.NextCtrl := FBCancel;
|
||
FBCancel.caption := "取消";
|
||
FBCancel.onclick := thisfunction(OnCancelClk);
|
||
FBCancel.parent := self;
|
||
FLabels := FEdits := array();
|
||
height := 150;
|
||
width := 400;
|
||
end
|
||
function SetData(d);
|
||
begin
|
||
{**
|
||
@explan(说明) 输入框 %%
|
||
@param(d)(array) 二维表,列标为 name ,value ,caption %%
|
||
**}
|
||
if FSetData=d then return;
|
||
FSetData := d;
|
||
r := RegularData(d);
|
||
FInfoa := r;
|
||
return RebuildInput();
|
||
end
|
||
function ShowDlg(result,c);
|
||
begin
|
||
{**
|
||
@explan(说明) 显示输入框 %%
|
||
@param(result)(array) 返回值 %%
|
||
@param(c)(string) 标题 ,可以忽略%%
|
||
**}
|
||
if ifstring(c)then caption := c;
|
||
if ShowModal()then
|
||
begin
|
||
for i,v in FLabels do
|
||
begin
|
||
FInfo[FInfoa[i,"name"]]:= FEdits[i].value;
|
||
end
|
||
result := FInfo.ToArray();
|
||
return true;
|
||
end
|
||
end
|
||
function ShowQuerys(result,t);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据位置显示输入框 %%
|
||
@param(result)(array) 返回值 %%
|
||
@param(t)(string) 标题,可以忽略 %%
|
||
**}
|
||
c := array(200,200);
|
||
_wapi.GetCursorPos(c);
|
||
Left := c[0]>50?(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
|
||
{**
|
||
@explan(说明) 异或 运算 %%
|
||
@return(bool)
|
||
**}
|
||
return(a and not(b))or(b and not(a));
|
||
end
|
||
initialization
|
||
end. |