Autor
|
Tema: duda con control drive...es un drive??? (Leído 3,548 veces)
|
Anteros
Desconectado
Mensajes: 128
|
holas gente!!! q tipo de drive (o control ) es ese q aparece en el commondialog openfile o savefile??? ya q ese control muestra ademas de las unidades otras cosas como: escritorio, mis documentos, mis sitios de red , etc... gracias por todo
|
|
|
En línea
|
|
|
|
DrakoX
Desconectado
Mensajes: 191
|
es un commondialog, su nombre lo dice
salu2
|
|
|
En línea
|
|
|
|
vivachapas
Desconectado
Mensajes: 612
|
si exsactamente... buscalo en componentes (Ctrl + T) Microsoft Common Dialog 6.0
|
|
|
En línea
|
|
|
|
Anteros
Desconectado
Mensajes: 128
|
ya se q es un commondialog pero me refiero exactamente al drive donde aparecen las unidades y otros...
He estado viendo y parece ser un combobox con algunas lineas de codigo q muestra todo lo q dije en mi primer post...
el commondialog es un control conformado por otrs controles ... o no??
|
|
|
En línea
|
|
|
|
|
CeLaYa
Desconectado
Mensajes: 543
|
el commondialog es un control que viene dentro del archivo COMDLG32.ocx, ahora que si lo que quieres es crear es control mediante código pues lo puedes hacer mediante el uso de api's: en un módulo pones: Option Explicit
Type RECT left As Long top As Long Right As Long Bottom As Long End Type
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Const GWL_HINSTANCE = (-6) Const SWP_NOSIZE = &H1 Const SWP_NOZORDER = &H4 Const SWP_NOACTIVATE = &H10 Const HCBT_ACTIVATE = 5 Const WH_CBT = 5
Dim hHook As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLORS) As Long Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long Declare Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONTS) As Long Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLGS) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Const OFN_ALLOWMULTISELECT = &H200 Public Const OFN_CREATEPROMPT = &H2000 Public Const OFN_ENABLEHOOK = &H20 Public Const OFN_ENABLETEMPLATE = &H40 Public Const OFN_ENABLETEMPLATEHANDLE = &H80 Public Const OFN_EXPLORER = &H80000 Public Const OFN_EXTENSIONDIFFERENT = &H400 Public Const OFN_FILEMUSTEXIST = &H1000 Public Const OFN_HIDEREADONLY = &H4 Public Const OFN_LONGNAMES = &H200000 Public Const OFN_NOCHANGEDIR = &H8 Public Const OFN_NODEREFERENCELINKS = &H100000 Public Const OFN_NOLONGNAMES = &H40000 Public Const OFN_NONETWORKBUTTON = &H20000 Public Const OFN_NOREADONLYRETURN = &H8000 Public Const OFN_NOTESTFILECREATE = &H10000 Public Const OFN_NOVALIDATE = &H100 Public Const OFN_OVERWRITEPROMPT = &H2 Public Const OFN_PATHMUSTEXIST = &H800 Public Const OFN_READONLY = &H1 Public Const OFN_SHAREAWARE = &H4000 Public Const OFN_SHAREFALLTHROUGH = 2 Public Const OFN_SHAREWARN = 0 Public Const OFN_SHARENOWARN = 1 Public Const OFN_SHOWHELP = &H10 Public Const OFS_MAXPATHNAME = 256
Public Const LF_FACESIZE = 32
'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below 'are mine to save long statements; they're not 'a standard Win32 type. Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Public Type OPENFILENAME nStructSize As Long hwndOwner As Long hInstance As Long sFilter As String sCustomFilter As String nCustFilterSize As Long nFilterIndex As Long sFile As String nFileSize As Long sFileTitle As String nTitleSize As Long sInitDir As String sDlgTitle As String flags As Long nFileOffset As Integer nFileExt As Integer sDefFileExt As String nCustDataSize As Long fnHook As Long sTemplateName As String End Type
Type NMHDR hwndFrom As Long idfrom As Long code As Long End Type
Type OFNOTIFY hdr As NMHDR lpOFN As OPENFILENAME pszFile As String ' May be NULL End Type
Type CHOOSECOLORS 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
Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(LF_FACESIZE) As Byte End Type
Public Type CHOOSEFONTS lStructSize As Long hwndOwner As Long ' caller's window handle hDC As Long ' printer DC/IC or NULL lpLogFont As Long ' ptr. to a LOGFONT struct iPointSize As Long ' 10 * size in points of selected font flags As Long ' enum. type flags rgbColors As Long ' returned text color lCustData As Long ' data passed to hook fn. lpfnHook As Long ' ptr. to hook function lpTemplateName As String ' custom template name hInstance As Long ' instance handle of.EXE that lpszStyle As String ' return the style field here nFontType As Integer ' same value reported to the EnumFonts MISSING_ALIGNMENT As Integer nSizeMin As Long ' minimum pt size allowed & nSizeMax As Long ' max pt size allowed if End Type
Public Const CC_RGBINIT = &H1 Public Const CC_FULLOPEN = &H2 Public Const CC_PREVENTFULLOPEN = &H4 Public Const CC_SHOWHELP = &H8 Public Const CC_ENABLEHOOK = &H10 Public Const CC_ENABLETEMPLATE = &H20 Public Const CC_ENABLETEMPLATEHANDLE = &H40 Public Const CC_SOLIDCOLOR = &H80 Public Const CC_ANYCOLOR = &H100
Public Const COLOR_FLAGS = CC_FULLOPEN Or CC_ANYCOLOR Or CC_RGBINIT
Public Const CF_SCREENFONTS = &H1 Public Const CF_PRINTERFONTS = &H2 Public Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) Public Const CF_SHOWHELP = &H4& Public Const CF_ENABLEHOOK = &H8& Public Const CF_ENABLETEMPLATE = &H10& Public Const CF_ENABLETEMPLATEHANDLE = &H20& Public Const CF_INITTOLOGFONTSTRUCT = &H40& Public Const CF_USESTYLE = &H80& Public Const CF_EFFECTS = &H100& Public Const CF_APPLY = &H200& Public Const CF_ANSIONLY = &H400& Public Const CF_SCRIPTSONLY = CF_ANSIONLY Public Const CF_NOVECTORFONTS = &H800& Public Const CF_NOOEMFONTS = CF_NOVECTORFONTS Public Const CF_NOSIMULATIONS = &H1000& Public Const CF_LIMITSIZE = &H2000& Public Const CF_FIXEDPITCHONLY = &H4000& Public Const CF_WYSIWYG = &H8000 ' must also have CF_SCREENFONTS CF_PRINTERFONTS Public Const CF_FORCEFONTEXIST = &H10000 Public Const CF_SCALABLEONLY = &H20000 Public Const CF_TTONLY = &H40000 Public Const CF_NOFACESEL = &H80000 Public Const CF_NOSTYLESEL = &H100000 Public Const CF_NOSIZESEL = &H200000 Public Const CF_SELECTSCRIPT = &H400000 Public Const CF_NOSCRIPTSEL = &H800000 Public Const CF_NOVERTFONTS = &H1000000
Public Const SIMULATED_FONTTYPE = &H8000 Public Const PRINTER_FONTTYPE = &H4000 Public Const SCREEN_FONTTYPE = &H2000 Public Const BOLD_FONTTYPE = &H100 Public Const ITALIC_FONTTYPE = &H200 Public Const REGULAR_FONTTYPE = &H400
Public Const LBSELCHSTRING = "commdlg_LBSelChangedNotify" Public Const SHAREVISTRING = "commdlg_ShareViolation" Public Const FILEOKSTRING = "commdlg_FileNameOK" Public Const COLOROKSTRING = "commdlg_ColorOK" Public Const SETRGBSTRING = "commdlg_SetRGBColor" Public Const HELPMSGSTRING = "commdlg_help" Public Const FINDMSGSTRING = "commdlg_FindReplace"
Public Const CD_LBSELNOITEMS = -1 Public Const CD_LBSELCHANGE = 0 Public Const CD_LBSELSUB = 1 Public Const CD_LBSELADD = 2
Type PRINTDLGS lStructSize As Long hwndOwner As Long hDevMode As Long hDevNames As Long hDC As Long flags As Long nFromPage As Integer nToPage As Integer nMinPage As Integer nMaxPage As Integer nCopies As Integer hInstance As Long lCustData As Long lpfnPrintHook As Long lpfnSetupHook As Long lpPrintTemplateName As String lpSetupTemplateName As String hPrintTemplate As Long hSetupTemplate As Long End Type
Public Const PD_ALLPAGES = &H0 Public Const PD_SELECTION = &H1 Public Const PD_PAGENUMS = &H2 Public Const PD_NOSELECTION = &H4 Public Const PD_NOPAGENUMS = &H8 Public Const PD_COLLATE = &H10 Public Const PD_PRINTTOFILE = &H20 Public Const PD_PRINTSETUP = &H40 Public Const PD_NOWARNING = &H80 Public Const PD_RETURNDC = &H100 Public Const PD_RETURNIC = &H200 Public Const PD_RETURNDEFAULT = &H400 Public Const PD_SHOWHELP = &H800 Public Const PD_ENABLEPRINTHOOK = &H1000 Public Const PD_ENABLESETUPHOOK = &H2000 Public Const PD_ENABLEPRINTTEMPLATE = &H4000 Public Const PD_ENABLESETUPTEMPLATE = &H8000 Public Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000 Public Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000 Public Const PD_USEDEVMODECOPIES = &H40000 Public Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000 Public Const PD_DISABLEPRINTTOFILE = &H80000 Public Const PD_HIDEPRINTTOFILE = &H100000 Public Const PD_NONETWORKBUTTON = &H200000
Type DEVNAMES wDriverOffset As Integer wDeviceOffset As Integer wOutputOffset As Integer wDefault As Integer End Type
Public Const DN_DEFAULTPRN = &H1
Public Type SelectedFile nFilesSelected As Integer sFiles() As String sLastDirectory As String bCanceled As Boolean End Type
Public Type SelectedColor oSelectedColor As OLE_COLOR bCanceled As Boolean End Type
Public Type SelectedFont sSelectedFont As String bCanceled As Boolean bBold As Boolean bItalic As Boolean nSize As Integer bUnderline As Boolean bStrikeOut As Boolean lColor As Long sFaceName As String End Type
Public FileDialog As OPENFILENAME Public ColorDialog As CHOOSECOLORS Public FontDialog As CHOOSEFONTS Public PrintDialog As PRINTDLGS Dim ParenthWnd As Long
Public Function ShowOpen(ByVal hWnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedFile Dim ret As Long Dim Count As Integer Dim fileNameHolder As String Dim LastCharacter As Integer Dim NewCharacter As Integer Dim tempFiles(1 To 200) As String Dim hInst As Long Dim Thread As Long ParenthWnd = hWnd FileDialog.nStructSize = Len(FileDialog) FileDialog.hwndOwner = hWnd FileDialog.sFileTitle = Space$(2048) FileDialog.nTitleSize = Len(FileDialog.sFileTitle) FileDialog.sFile = FileDialog.sFile & Space$(2047) & Chr$(0) FileDialog.nFileSize = Len(FileDialog.sFile) 'If FileDialog.flags = 0 Then FileDialog.flags = OFS_FILE_OPEN_FLAGS 'End If 'Set up the CBT hook hInst = GetWindowLong(hWnd, GWL_HINSTANCE) Thread = GetCurrentThreadId() If centerForm = True Then hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread) Else hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread) End If ret = GetOpenFileName(FileDialog)
If ret Then If Trim$(FileDialog.sFileTitle) = "" Then LastCharacter = 0 Count = 0 While ShowOpen.nFilesSelected = 0 NewCharacter = InStr(LastCharacter + 1, FileDialog.sFile, Chr$(0), vbTextCompare) If Count > 0 Then tempFiles(Count) = Mid(FileDialog.sFile, LastCharacter + 1, NewCharacter - LastCharacter - 1) Else ShowOpen.sLastDirectory = Mid(FileDialog.sFile, LastCharacter + 1, NewCharacter - LastCharacter - 1) End If Count = Count + 1 If InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0), vbTextCompare) = InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0) & Chr$(0), vbTextCompare) Then tempFiles(Count) = Mid(FileDialog.sFile, NewCharacter + 1, InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0) & Chr$(0), vbTextCompare) - NewCharacter - 1) ShowOpen.nFilesSelected = Count End If LastCharacter = NewCharacter Wend ReDim ShowOpen.sFiles(1 To ShowOpen.nFilesSelected) For Count = 1 To ShowOpen.nFilesSelected ShowOpen.sFiles(Count) = tempFiles(Count) Next Else ReDim ShowOpen.sFiles(1 To 1) ShowOpen.sLastDirectory = left$(FileDialog.sFile, FileDialog.nFileOffset) ShowOpen.nFilesSelected = 1 ShowOpen.sFiles(1) = Mid(FileDialog.sFile, FileDialog.nFileOffset + 1, InStr(1, FileDialog.sFile, Chr$(0), vbTextCompare) - FileDialog.nFileOffset - 1) End If ShowOpen.bCanceled = False Exit Function Else ShowOpen.sLastDirectory = "" ShowOpen.nFilesSelected = 0 ShowOpen.bCanceled = True Erase ShowOpen.sFiles Exit Function End If End Function
Public Function ShowSave(ByVal hWnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedFile Dim ret As Long Dim hInst As Long Dim Thread As Long ParenthWnd = hWnd FileDialog.nStructSize = Len(FileDialog) FileDialog.hwndOwner = hWnd FileDialog.sFileTitle = Space$(2048) FileDialog.nTitleSize = Len(FileDialog.sFileTitle) FileDialog.sFile = Space$(2047) & Chr$(0) FileDialog.nFileSize = Len(FileDialog.sFile) If FileDialog.flags = 0 Then FileDialog.flags = OFS_FILE_SAVE_FLAGS End If 'Set up the CBT hook hInst = GetWindowLong(hWnd, GWL_HINSTANCE) Thread = GetCurrentThreadId() If centerForm = True Then hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread) Else hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread) End If ret = GetSaveFileName(FileDialog) ReDim ShowSave.sFiles(1)
If ret Then ShowSave.sLastDirectory = left$(FileDialog.sFile, FileDialog.nFileOffset) ShowSave.nFilesSelected = 1 ShowSave.sFiles(1) = Mid(FileDialog.sFile, FileDialog.nFileOffset + 1, InStr(1, FileDialog.sFile, Chr$(0), vbTextCompare) - FileDialog.nFileOffset - 1) ShowSave.bCanceled = False Exit Function Else ShowSave.sLastDirectory = "" ShowSave.nFilesSelected = 0 ShowSave.bCanceled = True Erase ShowSave.sFiles Exit Function End If End Function
Public Function ShowColor(ByVal hWnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedColor Dim customcolors() As Byte ' dynamic (resizable) array Dim i As Integer Dim ret As Long Dim hInst As Long Dim Thread As Long
ParenthWnd = hWnd If ColorDialog.lpCustColors = "" Then ReDim customcolors(0 To 16 * 4 - 1) As Byte 'resize the array For i = LBound(customcolors) To UBound(customcolors) customcolors(i) = 254 ' sets all custom colors to white Next i ColorDialog.lpCustColors = StrConv(customcolors, vbUnicode) ' convert array End If ColorDialog.hwndOwner = hWnd ColorDialog.lStructSize = Len(ColorDialog) ColorDialog.flags = COLOR_FLAGS 'Set up the CBT hook hInst = GetWindowLong(hWnd, GWL_HINSTANCE) Thread = GetCurrentThreadId() If centerForm = True Then hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread) Else hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread) End If ret = ChooseColor(ColorDialog) If ret Then ShowColor.bCanceled = False ShowColor.oSelectedColor = ColorDialog.rgbResult Exit Function Else ShowColor.bCanceled = True ShowColor.oSelectedColor = &H0& Exit Function End If End Function
Public Function ShowFont(ByVal hWnd As Long, ByVal startingFontName As String, Optional ByVal centerForm As Boolean = True) As SelectedFont Dim ret As Long Dim lfLogFont As LOGFONT Dim hInst As Long Dim Thread As Long Dim i As Integer ParenthWnd = hWnd FontDialog.nSizeMax = 0 FontDialog.nSizeMin = 0 FontDialog.nFontType = Screen.FontCount FontDialog.hwndOwner = hWnd FontDialog.hDC = 0 FontDialog.lpfnHook = 0 FontDialog.lCustData = 0 FontDialog.lpLogFont = VarPtr(lfLogFont) If FontDialog.iPointSize = 0 Then FontDialog.iPointSize = 10 * 10 End If FontDialog.lpTemplateName = Space$(2048) FontDialog.rgbColors = RGB(0, 255, 255) FontDialog.lStructSize = Len(FontDialog) If FontDialog.flags = 0 Then FontDialog.flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT 'Or CF_EFFECTS End If For i = 0 To Len(startingFontName) - 1 lfLogFont.lfFaceName(i) = Asc(Mid(startingFontName, i + 1, 1)) Next 'Set up the CBT hook hInst = GetWindowLong(hWnd, GWL_HINSTANCE) Thread = GetCurrentThreadId() If centerForm = True Then hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread) Else hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread) End If ret = ChooseFont(FontDialog) If ret Then ShowFont.bCanceled = False ShowFont.bBold = IIf(lfLogFont.lfWeight > 400, 1, 0) ShowFont.bItalic = lfLogFont.lfItalic ShowFont.bStrikeOut = lfLogFont.lfStrikeOut ShowFont.bUnderline = lfLogFont.lfUnderline ShowFont.lColor = FontDialog.rgbColors ShowFont.nSize = FontDialog.iPointSize / 10 For i = 0 To 31 ShowFont.sSelectedFont = ShowFont.sSelectedFont + Chr(lfLogFont.lfFaceName(i)) Next ShowFont.sSelectedFont = Mid(ShowFont.sSelectedFont, 1, InStr(1, ShowFont.sSelectedFont, Chr(0)) - 1) Exit Function Else ShowFont.bCanceled = True Exit Function End If End Function Public Function ShowPrinter(ByVal hWnd As Long, Optional ByVal centerForm As Boolean = True) As Long Dim hInst As Long Dim Thread As Long ParenthWnd = hWnd PrintDialog.hwndOwner = hWnd PrintDialog.lStructSize = Len(PrintDialog) 'Set up the CBT hook hInst = GetWindowLong(hWnd, GWL_HINSTANCE) Thread = GetCurrentThreadId() If centerForm = True Then hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread) Else hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread) End If ShowPrinter = PrintDlg(PrintDialog) End Function Private Function WinProcCenterScreen(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim rectForm As RECT, rectMsg As RECT Dim x As Long, y As Long If lMsg = HCBT_ACTIVATE Then 'Show the MsgBox at a fixed location (0,0) GetWindowRect wParam, rectMsg x = Screen.Width / Screen.TwipsPerPixelX / 2 - (rectMsg.Right - rectMsg.left) / 2 y = Screen.Height / Screen.TwipsPerPixelY / 2 - (rectMsg.Bottom - rectMsg.top) / 2 Debug.Print "Screen " & Screen.Height / 2 Debug.Print "MsgBox " & (rectMsg.Right - rectMsg.left) / 2 SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE 'Release the CBT hook UnhookWindowsHookEx hHook End If WinProcCenterScreen = False End Function
Private Function WinProcCenterForm(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim rectForm As RECT, rectMsg As RECT Dim x As Long, y As Long 'On HCBT_ACTIVATE, show the MsgBox centered over Form1 If lMsg = HCBT_ACTIVATE Then 'Get the coordinates of the form and the message box so that 'you can determine where the center of the form is located GetWindowRect ParenthWnd, rectForm GetWindowRect wParam, rectMsg x = (rectForm.left + (rectForm.Right - rectForm.left) / 2) - ((rectMsg.Right - rectMsg.left) / 2) y = (rectForm.top + (rectForm.Bottom - rectForm.top) / 2) - ((rectMsg.Bottom - rectMsg.top) / 2) 'Position the msgbox SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE 'Release the CBT hook UnhookWindowsHookEx hHook End If WinProcCenterForm = False End Function
y desde un form: Option Explicit
' Para abrir Private Sub Command1_Click() Dim sOpen As SelectedFile Dim Count As Integer Dim FileList As String
On Error GoTo e_Trap FileDialog.sFilter = "Text Files (*.txt)" & Chr$(0) & "*.sky" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" ' See Standard CommonDialog Flags for all options FileDialog.flags = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT FileDialog.sDlgTitle = "Show Open" FileDialog.sInitDir = App.Path & "\" sOpen = ShowOpen(Me.hWnd) If Err.Number <> 32755 And sOpen.bCanceled = False Then FileList = "Directory : " & sOpen.sLastDirectory & vbCr For Count = 1 To sOpen.nFilesSelected FileList = FileList & sOpen.sFiles(Count) & vbCr Next Count Call MsgBox(FileList, vbOKOnly + vbInformation, "Show Open Selected") End If Exit Sub e_Trap: Exit Sub Resume
End Sub
'Para Guardar Private Sub Command2_Click() Dim sSave As SelectedFile Dim Count As Integer Dim FileList As String
On Error GoTo e_Trap FileDialog.sFilter = "Text Files (*.txt)" & Chr$(0) & "*.sky" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" ' See Standard CommonDialog Flags for all options FileDialog.flags = OFN_HIDEREADONLY FileDialog.sDlgTitle = "Show Save" FileDialog.sInitDir = App.Path & "\" sSave = ShowSave(Me.hWnd) If Err.Number <> 32755 And sSave.bCanceled = False Then FileList = "Directory : " & sSave.sLastDirectory & vbCr For Count = 1 To sSave.nFilesSelected FileList = FileList & sSave.sFiles(Count) & vbCr Next Count Call MsgBox(FileList, vbOKOnly + vbInformation, "Show Save Selected") End If Exit Sub e_Trap: Exit Sub Resume
End Sub
'Para ver las fuentes (tipos de letras) Private Sub Command3_Click() Dim sFont As SelectedFont On Error GoTo e_Trap FontDialog.iPointSize = 12 * 10 sFont = ShowFont(Me.hWnd, "Times New Roman") Exit Sub e_Trap: Exit Sub End Sub
'para ver las impresoras Private Sub Command4_Click() On Error GoTo e_Trap Call ShowPrinter(Me.hWnd) Exit Sub e_Trap: Exit Sub End Sub
'y la ventana de colores Private Sub Command5_Click() Dim sColor As SelectedColor On Error GoTo e_Trap sColor = ShowColor(Me.hWnd) Exit Sub e_Trap: Exit Sub End Sub
a ver si eso resuelve tu duda....
|
|
|
En línea
|
"La soledad es el elemento de los grandes talentos". Cristina de Suecia (1626-1689) Reina de Suecia.
|
|
|
pynsoluciones
Desconectado
Mensajes: 3
|
¿Sabeis como se puede activar el control con un determinado valor? por ejemplo tamaño de la fuente = 16
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
URGENTE - Acceder a Pen drive estropeado
« 1 2 3 »
Hardware
|
Dracomega
|
26
|
17,874
|
11 Enero 2011, 20:36 pm
por simorg
|
|
|
Alguien a comprado un pen drive Kingston 128GB?
Hardware
|
moikano→@
|
4
|
7,123
|
27 Enero 2011, 14:38 pm
por moikano→@
|
|
|
Los mapas de Nokia Drive estarán disponibles sin conexión
Noticias
|
wolfbcn
|
0
|
1,662
|
21 Noviembre 2011, 22:21 pm
por wolfbcn
|
|
|
REVIVIR PEN DRIVE
Dudas Generales
|
emilianoDERBI
|
1
|
3,809
|
31 Enero 2012, 14:00 pm
por skapunky
|
|
|
duda de google drive en ordenador
Dudas Generales
|
Novedades
|
0
|
1,787
|
4 Febrero 2023, 00:39 am
por Novedades
|
|