Attribute VB_Name = "NewOpciones"
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


Declare Function SHGetFileInfo Lib "Shell32" Alias "SHGetFileInfoA" _
                              (ByVal pszPath As Any, _
                              ByVal dwFileAttributes As Long, _
                              psfi As SHFILEINFO, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As Long) As Long



Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
    (ByVal lpRootPathName As String, _
    lpFreeBytesAvailableToCaller As Currency, _
    lpTotalNumberOfBytes As Currency, _
    lpTotalNumberOfFreeBytes As Currency) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Const SHGFI_TYPENAME = &H400&
Public Const MAX_PATH = 260

Public Type RECT
     Left As Long
     Top As Long
     Right As Long
     Bottom As Long
End Type

Type SHFILEINFO   ' shfi
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Public EstaonTop As Boolean

Public Function GetStrFromBuffer(szStr As String) As String
  If InStr(szStr, vbNullChar) Then
    GetStrFromBuffer = Left$(szStr, InStr(szStr, vbNullChar) - 1)
  Else
    GetStrFromBuffer = szStr
  End If
End Function


Public Function FreeDiscSpace(ByVal lpRootPathName As String)

'lpRootPathName= Directorio raiz de la unidad a examinar

'Valores devueltos por la función:
    Dim EspLibre, EspTotal As Long
    Dim ret As Long
    Dim lpFreeBytesAvailableToCaller As Currency
    Dim lpTotalNumberOfBytes As Currency
    Dim lpTotalNumberOfFreeBytes As Currency
    '
    Dim TotalBytes As Currency
    Dim TotalFreeBytes As Currency

    ret = GetDiskFreeSpaceEx(lpRootPathName, _
            lpFreeBytesAvailableToCaller, _
            lpTotalNumberOfBytes, _
            lpTotalNumberOfFreeBytes)

    TotalBytes = lpTotalNumberOfBytes * 10000
    TotalFreeBytes = lpTotalNumberOfFreeBytes * 10000
    EspTotal = Round((TotalBytes / 1048576), 2)
    EspLibre = Round((TotalFreeBytes / 1048576), 2)
    Form1.LbltotalBytes.Caption = EspTotal & " Mbytes (" & CStr(Round((EspTotal / 1024), 2)) & ") Gb"
    Form1.LblBytesLibres.Caption = EspLibre & " Mbytes (" & CStr(Round((EspLibre / 1024), 2)) & ") Gb"

End Function

Public Function TryIsCPL(PathEntyre As String)

Dim WinSysDir As String, WSDirLen As Long

On Error Resume Next
Shell "Rundll32.exe shell32.dll,Control_RunDLL " & PathEntyre

End Function

Public Function ExplodeForm(f As Form, Movement As Integer)
    
    Dim MyRect As RECT
    Dim formWidth%, formHeight%, i%, X%, Y%, cx%, cy%
    Dim TheScreen As Long
    Dim Brush As Long

If Form5.ChkAnim.Value = 0 Then Exit Function
    GetWindowRect f.hWnd, MyRect
    formWidth = MyRect.Right - MyRect.Left
    formHeight = MyRect.Bottom - MyRect.Top
    TheScreen = GetDC(0)
    Brush = CreateSolidBrush(f.BackColor)
    
    For i = 1 To Movement
        cx = formWidth * (i / Movement)
        cy = formHeight * (i / Movement)
        X = MyRect.Left + (formWidth - cx) / 2
        Y = MyRect.Top + (formHeight - cy) / 2
        Ts = Rectangle(TheScreen, X, Y, X + cx, Y + cy)
     DeleteObject (Ts)
    Next i
    
    X = ReleaseDC(0, TheScreen)
    DeleteObject (Brush)
    
End Function

Public Function MakeMeRun(lista As ListView)

Dim Answer As Long
Dim PathEntero As String

On Error Resume Next
    
If Form5.ChkDblClick.Value = 0 Then Exit Function
  If lista.ListItems.Count = 0 Then Exit Function
  PathEntero = MakeFullPath(lista, lista.SelectedItem.Index)
  Answer = ShellExecute(Form1.hWnd, "open", PathEntero, vbNullString, vbNullString, conSwNormal)
  If Answer = 31 Then TryIsCPL (PathEntero)
  Exit Function
  
EscribirTexto "El archivo no existe o la extencion no esta asociada a ninguna aplicacion", 5000, vbYellow

End Function

Public Function GetTypeName(sFilePath As String)
  
  Dim shfi As SHFILEINFO
  
  If SHGetFileInfo(ByVal sFilePath, 0&, shfi, Len(shfi), SHGFI_TYPENAME) Then
    If InStr(shfi.szTypeName, vbNullChar) > 1 Then
      GetTypeName = GetStrFromBuffer(shfi.szTypeName)
    Else
      GetTypeName = "<Archivo sin asociación>"
    End If
  End If

End Function

Public Function MakeFullPath(lista As ListView, Indice As Long) As String

Dim Temp, PathEntero, Change, Formato, Unidad As String
Dim Recorre As Integer
Dim TipoUnit As Long

On Error Resume Next

If lista.ListItems.Count > 0 Then
    If lista.ListItems.Item(Indice).ListSubItems(1).Text = "DIRECTORIO PRINCIPAL" Then
      Change = "\"
    Else
      Change = lista.ListItems.Item(Indice).ListSubItems(1).Text
    End If
    
    Formato = ""
    
    
    If lista.ListItems.Item(Indice).ListSubItems(3).Text <> "ARCHIVO" Then Formato = "." & Form1.ListView1.ListItems.Item(Indice).ListSubItems(3).Text
    
    If lista.ListItems.Item(Indice).ListSubItems(4).Text = "NN" Then
    
    Dim MySysObj As Object
    Set MySysObj = CreateObject("scripting.filesystemobject")
      Recorre = Form3.Drive1.ListCount - 1
      Do While Recorre >= 0
      Unidad = Form3.Drive1.List(Recorre)
      TipoUnit = GetDriveType(Unidad)
      If TipoUnit = 2 Then
        PathEntero = ""
        GoTo IFoundIt
      End If
      PathEntero = Unidad & Change + lista.ListItems.Item(Indice).Text + Formato
      If MySysObj.fileexists(PathEntero) = True Then GoTo IFoundIt
      Recorre = Recorre - 1
      Loop
    Else
      Unidad = lista.ListItems.Item(Indice).ListSubItems(4).Text
      PathEntero = Unidad & Change + lista.ListItems.Item(Indice).Text + Formato
      GoTo IFoundIt
    End If

  MakeFullPath = ""

  Exit Function

IFoundIt:
  MakeFullPath = PathEntero

End If

End Function

Public Function LockList()

On Error Resume Next

Form1.ListView1.FullRowSelect = False
Form1.ListView1.LabelEdit = lvwManual
Form1.mnuOpcionesLista.Enabled = False

End Function

Public Function UnlockList()
On Error Resume Next

Form1.ListView1.FullRowSelect = True
Form1.ListView1.LabelEdit = lvwAutomatic
Form1.mnuOpcionesLista.Enabled = True
End Function

Public Function StopProgram(Unidad As String) As Boolean

Dim MyNum As Long

StopProgram = False

MyNum = GetDriveType(Unidad)
If MyNum = 5 Then StopProgram = True

End Function

Public Function LeerTec(KeyCode As Integer)

Select Case KeyCode
Case 2
Form3.Command1.Value = True
Case 3
Form3.Command2.Value = 1
Case 22
Form3.Command4.Value = 1
End Select

End Function

Public Function ShowHelp(Numero As Integer)

End Function
