548 lines
15 KiB
Plaintext
548 lines
15 KiB
Plaintext
unit utslvcldlg;
|
||
interface
|
||
uses cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclbase;
|
||
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=opRemove then
|
||
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
|
||
|
||
implementation
|
||
function xor(a,b);
|
||
begin
|
||
{**
|
||
@explan(说明) 异或 运算 %%
|
||
@return(bool)
|
||
**}
|
||
return(a and not(b))or(b and not(a));
|
||
end
|
||
initialization
|
||
end. |