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="recycling" 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

implementation
function xor(a,b);
begin
    {**
    @explan(说明) 异或 运算 %%
    @return(bool)	
    **}
    return(a and not(b))or(b and not(a));
end
initialization
end.