How to call common diaglog of winodws through APIS

How to call common diaglog of winodws through APIS (1)

1. File Properties dialog box
Type shellexecuteinfo
Cbsize as long
Fmask as long
Hwnd as long
Lpverb as string
Lpfile as string
Lpparameters as string
Lpdirectory as string
Nshow as long
Hinstapp as long
Lpidlist as long '(optional)
Optional Parameter
Hkeyclass as long 'optional parameter
Dwhotkey as long '(optional)
Hicon as long '(optional)
Hprocess as long '(optional)
End type

Const see_mask_invokeidlist = & HC
Const see_mask_nocloseprocess = & h40
Const see_mask_flag_no_ui = & H400

Declare function shellexecuteex lib "shell32.dll" alias "shellexecuteex "_
(SEI as shellexecuteinfo) as long
Public Function showproperties (filename as string, ownerhwnd as long) as long
'Open the Properties dialog box for the specified file. If the returned value is <= 32, an error occurs.
Dim SEI as shellexecuteinfo
Dim R as long
With sei
. Cbsize = Len (SEI)
. Fmask = see_mask_nocloseprocess or see_mask_invokeidlist or see_mask_flag_no_ui
. Hwnd = ownerhwnd
. Lpverb = "properties"
. Lpfile = filename
. Lpparameters = vbnullchar
. Lpdirectory = vbnullchar
. Nshow = 0
. Hinstapp = 0
. Lpidlist = 0
End
R = shellexecuteex (SEI)
Showproperties = sei. hinstapp
End Function

Create a project and add a button and a text box named text1
Put the following code into commandbbutton_click
Dim R as long
Dim fname as string
'Get the file name and path from text1
Fname = (text1)
R = showproperties (fname, me. hwnd)
If r <= 32 then msgbox "error"

2. Use the Win95 dialog box
Private declare function shellabout lib "shell32.dll "_
Alias "shellabouta" (byval hwnd as long, byval szapp as string ,_
Byval szotherstuff as string, byval hicon as long) as long
Example:
Dim X as long
X = shellabout (form1.hwnd, "Visual Basic 6.0 ",_
"Alkaline studio mousetracker ver 1.0", form1.icon)

2. Call the "Capture printer port" dialog box
Private declare function wnetconnectiondialog lib "records. dll "_
(Byval hwnd as long, byval dwtype as long) as long
Example:
Dim X as long
X = wnetconnectiondialog (Me. hwnd, 2)

3. Call the color dialog box
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
Private declare function choosecolor lib "comdlg32.dll" alias "choosecolora" (pchoosecolor as choosecolor) as long

Place the following code into an event:
Dim cc as choosecolor
Dim custcolor (16) as long
Cc. lstructsize = Len (cc)
Cc. hwndowner = form1.hwnd
Cc. hinstance = app. hinstance
Cc. Flags = 0
Cc. lpcustcolors = string $ (16*4, 0)
Dim
Dim X
Dim C1
Dim C2
Dim C3
Dim C4
A = choosecolor (cc)
CLS
If (a) then
Msgbox "color chosen:" & STR $ (CC. rgbresult)

For x = 1 to Len (CC. lpcustcolors) Step 4
C1 = ASC (mid $ (CC. lpcustcolors, X, 1 ))
C2 = ASC (mid $ (CC. lpcustcolors, x + 1, 1 ))
C3 = ASC (mid $ (CC. lpcustcolors, x + 2, 1 ))
C4 = ASC (mid $ (CC. lpcustcolors, x + 3, 1 ))
Custcolor (X/4) = (C1) + (C2 * 256) + (C3 * 65536) + (C4 * 16777216)
Msgbox "custom color" & int (X/4) & "=" & custcolor (X/4)
Next x
Else
Msgbox "cancel was pressed"
End if

4. Call the copy disk dialog box
Private declare function shformatdrive lib "shell32" (byval hwnd as long, byval drive as long, byval fmtid as long, byval options as long) as long
Private declare function getdrivetype lib "Kernel32" alias "getdrivetypea" (byval ndrive as string) as long

Example:
Add a DriveListBox named drive1 to the form and put the following code into an event.
Dim driveletter $, drivenumber &, drivetype &
Dim retval &, retfrommsg &
Driveletter = ucase (drive1.drive)
Drivenumber = (ASC (driveletter)-65)
Drivetype = getdrivetype (driveletter)
If drivetype = 2 then' floppies, etc
Retval = shell ("rundll32.exe diskcopy. dll, diskcopyrundll "_
& Drivenumber & "," & drivenumber, 1) 'notice space after
Else 'just in case' diskcopyrundll
Retfrommsg = msgbox ("only floppies can" & vbcrlf &_
"Be diskcopied! ", 64," diskcopy example ")
End if

5. Call the format floppy disk dialog box
Private declare function shformatdrive lib "shell32" (byval hwnd as long, byval drive as long, byval fmtid as long, byval options as long) as long
Private declare function getdrivetype lib "Kernel32" alias "getdrivetypea" (byval ndrive as string) as long
Parameter settings:
Fmtid-
3.5 "5.25"
-------------------------
0 1.44 m 1.2 m
1 1.44 m 1.2 m
2 1.44 m 1.2 m
3 1.44 m 360 K
4 1.44 m 1.2 m
5 720 K 1.2 m
6 1.44 m 1.2 m
7 1.44 m 1.2 m
8 1.44 m 1.2 m
9 1.44 m 1.2 m

Option
0 fast
1 completely
2. copy only system files
3. copy only system files
4. Fast
5 completely
6. copy only system files
7. Copy system files only
8. Fast
9 completely
Example: Same as above
Dim driveletter $, drivenumber &, drivetype &
Dim retval &, retfrommsg %
Driveletter = ucase (drive1.drive)
Drivenumber = (ASC (driveletter)-65) 'Change letter to number: a = 0
Drivetype = getdrivetype (driveletter)
If drivetype = 2 then' floppies, etc
Retval = shformatdrive (Me. hwnd, drivenumber, 0 &, 0 &)
Else
Retfrommsg = msgbox ("This drive is not a removeable" & vbcrlf &_
"Drive! Format this drive? ", 276," shformatdrive example ")
Select case retfrommsg
Case 6 'Yes
'Uncomment to do it...
'Retval = shformatdrive (Me. hwnd, drivenumber, 0 &, 0 &)
Case 7' No
'Do nothing
End select
End if
How to call common diaglog of winodws through APIS (2)

1. Select Directory/folder dialog box
Place the following code in a module
Option explicit
'Call method: String = browseforfolders (hwnd, titleofdialog)
'Example: string1 = browseforfolders (hwnd, "select target folder ...")
Public type browseinfo
Hwndowner as long
Pidlroot as long
Pszdisplayname as long
Lpsztitle as long
Ulflags as long
Lpfncallback as long
Lparam as long
Iimage as long
End type
Public const bif_returnonlyfsdirs = 1
Public const max_path= 260
Public declare sub cotaskmemfree lib "ole32.dll" (byval hmem as long)
Public declare function lstrcat lib "Kernel32" alias "lstrcata" (byval lpstring1 as string, byval lpstring2 as string) as long
Public declare function shbrowseforfolder lib "shell32" (lpbi as browseinfo) as long
Public declare function shgetpathfromidlist lib "shell32" (byval pidlist as long, byval lpbuffer as string) as long

Public Function browseforfolder (hwndowner as long, sprompt as string) as string
Dim inull as integer
Dim lpidlist as long
Dim lresult as long
Dim Spath as string
Dim udtrauma as browseinfo
'Initialization variable
With udtrauma
. Hwndowner = hwndowner
. Lpsztitle = lstrcat (sprompt ,"")
. Ulflags = bif_returnonlyfsdirs
End
'Call the API
Lpidlist = shbrowseforfolder (udtraumatic brain injury)
If lpidlist then
Spath = string $ (max_path, 0)
Lresult = shgetpathfromidlist (lpidlist, Spath)
Call cotaskmemfree (lpidlist)
Inull = instr (Spath, vbnullchar)
If inull then Spath = left $ (Spath, inull-1)
End if
'If you choose to cancel, Spath = ""
Browseforfolder = Spath
End Function
2. Call the "ing network drive" dialog box
Private/Public declare function wnetconnectiondialog lib "records. dll "_
(Byval hwnd as long, byval dwtype as long) as long
X % = wnetconnectiondialog (Me. hwnd, 1)
3. Call the "open file" dialog box
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 declare function getopenfilename lib "comdlg32.dll" alias "getopenfilenamea" (popenfilename as openfilename) as long
Place the following code in an event
Dim ofn as openfilename
Ofn. lstructsize = Len (ofn)
Ofn. hwndowner = form1.hwnd
Ofn. hinstance = app. hinstance
Ofn. lpstrfilter = "text files (*. TXT) "+ CHR $ (0) + "*. TXT "+ CHR $ (0) +" Rich Text Files (*. RTF) "+ CHR $ (0) + "*. rtf "+ CHR $ (0)
Ofn. lpstrfile = space $ (254)
Ofn. nmaxfile = 255
Ofn. lpstrfiletitle = space $ (254)
Ofn. nmaxfiletitle = 255
Ofn. lpstrinitialdir = curdir
Ofn. lpstrtitle = "Our File Open title"
Ofn. Flags = 0
Dim
A = getopenfilename (ofn)
If (a) then
Msgbox "file to open:" + trim $ (ofn. lpstrfile)
Else
Msgbox "cancel was pressed"
End if
4. Call the "print" dialog box
Private type printdlg
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
Private declare function printdlg lib "comdlg32.dll" alias "printdlga" (pprintdlg as printdlg) as long
'Place the following code in an event
Dim tprintdlg as printdlg
Tprintdlg. lstructsize = Len (tprintdlg)
Tprintdlg. hwndowner = me. hwnd
Tprintdlg. HDC = HDC
Tprintdlg. Flags = 0
Tprintdlg. nfrompage = 0
Tprintdlg. ntopage = 0
Tprintdlg. nminpage = 0
Tprintdlg. nmaxpage = 0
Tprintdlg. ncopies = 1
Tprintdlg. hinstance = app. hinstance
Lpprinttemplatename = "print page"
Dim
A = printdlg (tprintdlg)
If a then
Lfrompage = tprintdlg. nfrompage
Ltopage = tprintdlg. ntopage
Lmin = tprintdlg. nminpage
Lmax = tprintdlg. nmaxpage
Lcopies = tprintdlg. ncopies
Printmypage 'customprinting subroutine
End if