comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[API] Common Dialog (VB)

  • 0 Respuestas
  • 1734 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado ProcessKill

  • *
  • Underc0der
  • Mensajes: 154
  • Actividad:
    0%
  • Reputación 0
  • Arriba los hackers de Argentina!
    • Ver Perfil
    • Email
« en: Febrero 22, 2010, 04:26:31 pm »
Bueno amigos, les dejo el code de esta API para reemplazar a Microsoft Common Dialog Controls 6 (OCX)

El code es el siguiente:

Código: Visual Basic
  1. Option Explicit
  2.  
  3. Private Const OFN_HIDEREADONLY = &H4
  4. Private Const OFN_FILEMUSTEXIST = &H1000
  5. Private Const OFN_CREATEPROMPT = &H2000
  6. Private Const OFN_OVERWRITEPROMPT = &H2
  7. Private Const OFN_EXPLORER = &H80000
  8.  
  9. Private Type OPENFILENAME
  10.     lStructSize As Long
  11.     hwndOwner As Long
  12.     hInstance As Long
  13.     lpstrFilter As String
  14.     lpstrCustomFilter As String
  15.     nMaxCustFilter As Long
  16.     nFilterIndex As Long
  17.     lpstrFile As String
  18.     nMaxFile As Long
  19.     lpstrFileTitle As String
  20.     nMaxFileTitle As Long
  21.     lpstrInitialDir As String
  22.     lpstrTitle As String
  23.     flags As Long
  24.     nFileOffset As Integer
  25.     nFileExtension As Integer
  26.     lpstrDefExt As String
  27.     lCustData As Long
  28.     lpfnHook As Long
  29.     lpTemplateName As String
  30. End Type
  31.  
  32. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  33. Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
  34.  
  35. Dim ofn As OPENFILENAME
  36.  
  37. 'Muestra el cuadro de dialogo para abrir archivos:
  38. Public Function OpenFile(hwnd As Long, Filter As String, Title As String, InitDir As String, Optional Filename As String, Optional FilterIndex As Long) As String
  39.     On Local Error Resume Next
  40.  
  41.     Dim ofn As OPENFILENAME
  42.     Dim a As Long
  43.    
  44.     ofn.lStructSize = Len(ofn)
  45.     ofn.hwndOwner = hwnd
  46.     ofn.hInstance = App.hInstance
  47.    
  48.     If VBA.Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
  49.    
  50.     For a = 1 To Len(Filter)
  51.         If Mid$(Filter, a, 1) = "|" Then Mid(Filter, a, 1) = Chr(0)
  52.     Next
  53.    
  54.         ofn.lpstrFilter = Filter
  55.         ofn.lpstrFile = Space$(254)
  56.         ofn.nMaxFile = 255
  57.         ofn.lpstrFileTitle = Space$(254)
  58.         ofn.nMaxFileTitle = 255
  59.         ofn.lpstrInitialDir = InitDir
  60.         If Not Filename = vbNullString Then ofn.lpstrFile = Filename & Space$(254 - Len(Filename))
  61.         ofn.nFilterIndex = FilterIndex
  62.         ofn.lpstrTitle = Title
  63.         ofn.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
  64.         a = GetOpenFileName(ofn)
  65.  
  66.         If a Then
  67.              OpenFile = Trim$(ofn.lpstrFile)
  68.              If VBA.Right$(VBA.Trim$(OpenFile), 1) = Chr(0) Then OpenFile = VBA.Left$(VBA.Trim$(ofn.lpstrFile), Len(VBA.Trim$(ofn.lpstrFile)) - 1)
  69.              
  70.         Else
  71.              OpenFile = vbNullString
  72.              
  73.         End If
  74.        
  75. End Function
  76.  
  77. 'Muestra el cuadro de dialogo para guardar archivos:
  78. Public Function SaveFile(hwnd As Long, Filter As String, Title As String, InitDir As String, Optional Filename As String, Optional FilterIndex As Long) As String
  79.     On Local Error Resume Next
  80.  
  81.     Dim ofn As OPENFILENAME
  82.     Dim a As Long
  83.    
  84.     ofn.lStructSize = Len(ofn)
  85.     ofn.hwndOwner = hwnd
  86.     ofn.hInstance = App.hInstance
  87.    
  88.     If VBA.Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
  89.    
  90.     For a = 1 To Len(Filter)
  91.         If Mid(Filter, a, 1) = "|" Then Mid(Filter, a, 1) = Chr(0)
  92.     Next
  93.    
  94.         ofn.lpstrFilter = Filter
  95.         ofn.lpstrFile = Space(254)
  96.         ofn.nMaxFile = 255
  97.         ofn.lpstrFileTitle = Space(254)
  98.         ofn.nMaxFileTitle = 255
  99.         ofn.lpstrInitialDir = InitDir
  100.         If Not Filename = vbNullString Then ofn.lpstrFile = Filename & Space(254 - Len(Filename))
  101.         ofn.nFilterIndex = FilterIndex
  102.         ofn.lpstrTitle = Title
  103.         ofn.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT Or OFN_EXPLORER
  104.         a = GetSaveFileName(ofn)
  105.  
  106.         If a Then
  107.              SaveFile = Trim$(ofn.lpstrFile)
  108.              If VBA.Right$(Trim$(SaveFile), 1) = Chr(0) Then SaveFile = VBA.Left$(Trim$(ofn.lpstrFile), Len(Trim$(ofn.lpstrFile)) - 1) & GetExtension(ofn.lpstrFilter, ofn.nFilterIndex)
  109.  
  110.         Else
  111.              SaveFile = vbNullString
  112.              
  113.         End If
  114.        
  115. End Function
  116.  
  117. 'Extrae la extension seleccionada del filtro:
  118. Private Function GetExtension(sfilter As String, pos As Long) As String
  119.     Dim Ext() As String
  120.    
  121.     Ext = Split(sfilter, vbNullChar)
  122.    
  123.     If pos = 1 And Ext(pos) <> "*.*" Then
  124.         GetExtension = "." & Replace(Ext(pos), "*.", "")
  125.         Exit Function
  126.        
  127.     End If
  128.    
  129.     If pos = 1 And Ext(pos) = "*.*" Then
  130.         GetExtension = vbNullString
  131.         Exit Function
  132.        
  133.     End If
  134.    
  135.     If InStr(Ext(pos + 1), "*.*") Then
  136.        GetExtension = vbNullString
  137.        
  138.     Else
  139.        GetExtension = "." & Replace(Ext(pos + 1), "*.", "")
  140.        
  141.     End If
  142.    
  143. End Function

Modo de uso:

Código: Visual Basic
  1. OpenFile(hwnd del form, extensiones, titulo del cuadro)
  2. SavaFile(hwnd del form, extensiones, titulo del cuadro)

Saludos!  8)
« Última modificación: Julio 08, 2011, 09:24:04 am por ANTRAX »

 

¿Te gustó el post? COMPARTILO!