Attribute VB_Name = "CDialoge"
Option Explicit

Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const DM_DUPLEX = &H1000&
Const DM_ORIENTATION = &H1&
Const PD_PRINTSETUP = &H40
Const PD_DISABLEPRINTTOFILE = &H80000

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    FLAGS As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    FLAGS As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const BIF_RETURNONLYFSDIRS = &H1

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Dim OFName As OPENFILENAME

Public Function ShowColor(Parent As Form) As Long
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long

    'set the structure size
    cc.lStructSize = Len(cc)
    'Set the owner
    cc.hwndOwner = Parent.hwnd
    'set the application's instance
    cc.hInstance = App.hInstance
    
    cc.lpCustColors = String(16 * 4, Chr(0))
    'no extra flags
    cc.FLAGS = 0

    'Show the 'Select Color'-dialog
    If CHOOSECOLOR(cc) <> 0 Then
        ShowColor = cc.rgbResult
    Else
        ShowColor = -1
    End If
End Function

Public Function ShowOpen(Filter As String, OwnerWH As Long, Optional DefultPath As String) As String
  Dim I As Integer
  'Set the structure size
  OFName.lStructSize = Len(OFName)
  'Set the owner window
  OFName.hwndOwner = OwnerWH
  'Set the application's instance
  OFName.hInstance = App.hInstance
  'Set the filet
  If Right(Filter, 1) <> Chr(0) Then Filter = Filter + Chr(0)
  OFName.lpstrFilter = Filter
  'Create a buffer
  OFName.lpstrFile = Space$(254)
  'Set the maximum number of chars
  OFName.nMaxFile = 255
  'Create a buffer
  OFName.lpstrFileTitle = Space$(254)
  'Set the maximum number of chars
  OFName.nMaxFileTitle = 255
  'Set the initial directory
  OFName.lpstrInitialDir = DefultPath
  'Set the dialog title
  OFName.lpstrTitle = App.Title
  'no extra flags
  OFName.FLAGS = 4

  'Show the 'Open File'-dialog
  If GetOpenFileName(OFName) Then
    I = InStr(OFName.lpstrFile, Chr(0)) - 1
    If I > 0 Then ShowOpen = Left(OFName.lpstrFile, I)
  Else
    ShowOpen = ""
  End If
End Function

Public Sub ShowSave(Path As String, Filter As String, DefultPath As String, DefultFile As String, FilterIndex As Integer, OwnerWH As Long)
  Dim I As Integer
  'Set the structure size
  OFName.lStructSize = Len(OFName)
  'Set the owner window
  OFName.hwndOwner = OwnerWH
  'Set the application's instance
  OFName.hInstance = App.hInstance
  'Set the filet
  If Right(Filter, 1) <> Chr(0) Then Filter = Filter + Chr(0)
  OFName.lpstrFilter = Filter
  'Create a buffer
  If Len(DefultFile) > 254 Then DefultFile = ""
  OFName.lpstrFile = DefultFile + Space$(254 - Len(DefultFile))
  'Set the maximum number of chars
  OFName.nMaxFile = 255
  'Create a buffer
  OFName.lpstrFileTitle = Space$(254)
  'Set the maximum number of chars
  OFName.nMaxFileTitle = 255
  'Set the initial directory
  OFName.lpstrInitialDir = DefultPath
  'Set the dialog title
  OFName.lpstrTitle = App.Title
  'no extra flags
  OFName.FLAGS = 4
  OFName.nFilterIndex = FilterIndex

  'Show the 'Save File'-dialog
  If GetSaveFileName(OFName) Then
    I = InStr(OFName.lpstrFile, Chr(0)) - 1
    If I > 0 Then
      Path = Left(OFName.lpstrFile, I)
      FilterIndex = OFName.nFilterIndex
    End If
  Else
    Path = ""
  End If
End Sub

Public Function GetFolder(hwnd As Long, DialogTitle As String) As String
  Dim Ret As Boolean
  Dim pidl As Long
  Dim Folder As String
  Dim BrInfo As BROWSEINFO

  BrInfo.hOwner = hwnd
  BrInfo.pidlRoot = 0
  BrInfo.lpszTitle = DialogTitle
  BrInfo.ulFlags = BIF_RETURNONLYFSDIRS

  pidl = SHBrowseForFolder(BrInfo)
  Folder = String$(512, 0)
  Ret = SHGetPathFromIDList(ByVal pidl, ByVal Folder)

  If Ret = True Then
    GetFolder = Left(Folder, InStr(Folder, Chr$(0)) - 1)
  Else
    GetFolder = ""
  End If
End Function
