Au zecours !!! API Get...openFile ???
Le
LE TROLL
Bonjour,
Je n'y comprend rien, pour imprimer, y a-t-il quelqu'un
qui saurait me mettre ça en état de marche, lol, ma
procédure d'impression est à la fin, n'hésitez pas à
supprimer tout ce qui ne sert à rien (constantes), ce que je
voudrais:
- GRISER "imprimer dans un fichier", ou effacer
-impression = bloquer le choix à 1
- tout le document (bloquer à ce choix)
--
Dim cheminFichier As String
'
Private Declare Function GetOpenFileName Lib
"comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
Private Enum OFN_Constants
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EX_NOPLACESBAR = &H1
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
OFN_USEMONIKERS = &H1000000
End Enum
'
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 Function OpenFileDialog(Optional DialogTitle As
String, Optional sFilter As String, Optional Flags As
OFN_Constants, Optional InitialDir As String, Optional
hwndOwner As Long, Optional hInstance As Long) As String
Dim OFName As OPENFILENAME
'
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = hwndOwner
OFName.hInstance = hInstance
OFName.lpstrFilter = "Fichiers jpg (*.jpg)" & vbNullChar
& "*.jpg" & vbNullChar & "Fichiers bitmap (*.bmp)" &
vbNullChar & "*.bmp" & vbNullChar & vbNullChar ' filtres
fichiers
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = InitialDir
OFName.lpstrTitle = "Sélectionner votre image" ' titre
OFName.Flags = OFN_READONLY ' [X] lecture seule
If GetOpenFileName(OFName) Then: OpenFileDialog =
Trim$(OFName.lpstrFile)
'
CheminFichier = OFName.lpstrFile ' chemin fichier
End Function
imp-
Sub m_imprimer_Click()
Dim rep
'
' ME COMPLETER POUR QUE ÇA ARCHE, svp :o)
If Len(Trim(Text1)) < 1 Then
MsgBox "Page vide ", vbExclamation
Exit Sub
End If
rep = ""
rep = MsgBox("Confirmer l'impression", vbDefaultButton2 +
vbYesNo + vbQuestion)
If rep <> vbYes Then Exit Sub
'
Printer.FontSize = 12
Printer.FontName = "courier new"
Printer.Print " "
Printer.Print Calendar1.Value
Printer.Print " "
Printer.Print Text1.Text
Printer.EndDoc
End Sub
--
Merci, au revoir et à bientôt :o)
--
ECRIRE AU TROLL http://irolog.free.fr/letroll/index.html
LE TROLL, éleveur de trolls depuis César, qui disait :
Avec une hache, celui qui tient le manche a toujours raison
!
Je n'y comprend rien, pour imprimer, y a-t-il quelqu'un
qui saurait me mettre ça en état de marche, lol, ma
procédure d'impression est à la fin, n'hésitez pas à
supprimer tout ce qui ne sert à rien (constantes), ce que je
voudrais:
- GRISER "imprimer dans un fichier", ou effacer
-impression = bloquer le choix à 1
- tout le document (bloquer à ce choix)
--
Dim cheminFichier As String
'
Private Declare Function GetOpenFileName Lib
"comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
Private Enum OFN_Constants
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EX_NOPLACESBAR = &H1
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
OFN_USEMONIKERS = &H1000000
End Enum
'
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 Function OpenFileDialog(Optional DialogTitle As
String, Optional sFilter As String, Optional Flags As
OFN_Constants, Optional InitialDir As String, Optional
hwndOwner As Long, Optional hInstance As Long) As String
Dim OFName As OPENFILENAME
'
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = hwndOwner
OFName.hInstance = hInstance
OFName.lpstrFilter = "Fichiers jpg (*.jpg)" & vbNullChar
& "*.jpg" & vbNullChar & "Fichiers bitmap (*.bmp)" &
vbNullChar & "*.bmp" & vbNullChar & vbNullChar ' filtres
fichiers
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = InitialDir
OFName.lpstrTitle = "Sélectionner votre image" ' titre
OFName.Flags = OFN_READONLY ' [X] lecture seule
If GetOpenFileName(OFName) Then: OpenFileDialog =
Trim$(OFName.lpstrFile)
'
CheminFichier = OFName.lpstrFile ' chemin fichier
End Function
imp-
Sub m_imprimer_Click()
Dim rep
'
' ME COMPLETER POUR QUE ÇA ARCHE, svp :o)
If Len(Trim(Text1)) < 1 Then
MsgBox "Page vide ", vbExclamation
Exit Sub
End If
rep = ""
rep = MsgBox("Confirmer l'impression", vbDefaultButton2 +
vbYesNo + vbQuestion)
If rep <> vbYes Then Exit Sub
'
Printer.FontSize = 12
Printer.FontName = "courier new"
Printer.Print " "
Printer.Print Calendar1.Value
Printer.Print " "
Printer.Print Text1.Text
Printer.EndDoc
End Sub
--
Merci, au revoir et à bientôt :o)
--
ECRIRE AU TROLL http://irolog.free.fr/letroll/index.html
LE TROLL, éleveur de trolls depuis César, qui disait :
Avec une hache, celui qui tient le manche a toujours raison
!
Poser une question
On verra après pour l'impression, on va déjà s'occuper de la sélection
du fichier par l'utilisateur, ça va déjà faire des messages suffisamment
lourds. De toute façon, ta procédure d'impression fonctionne, vers
l'imprimante par défaut, et il n'y a pas de dialogue correspondant.
Tu l'appelles comment ta fonction de sélection de fichier ?
Il y a des trucs qui coincent avec les types des paramètres de
OpenFileDialog si je la rends publique, alors je suggèrerais bien
d'ajouter dans le module
Public Function ChoixFichier(Optional strFiltre As String)
If IsMissing(strFiltre) Then strFiltre = "*.*"
ChoixFichier = OpenFileDialog( _
"Choix d'un fichier", _
strFiltre, OFN_LONGNAMES, "C:", 0, 0)
End Function
Tu peux mettre tout sur la même ligne (sauf la ligne de début et la
ligne de fin), mais dans un newsgroup elle serait fragmentée, pas pratique.
Attention à sFilter, dans OpenFileDialog tu te donnes le mal de le
recevoir en deuxième paramètre, et tu l'ignores après. Il faudrait remplacer
> OFName.lpstrFilter = "Fichiers jpg (*.jpg)" & vbNullChar
> & "*.jpg" & vbNullChar & "Fichiers bitmap (*.bmp)" &
> vbNullChar & "*.bmp" & vbNullChar & vbNullChar ' filtres
> fichiers
par OFName.lpstrFilter = sFilter
le deuxième paramètre de OpenFileDialog s'appelant sFilter,
et dans la fonction appelante, donc ChoixFichier, donner le filtre en
deuxième paramètre, ici j'ai mis "*.*" pour faire simple mais tu peux
mettre l'initialisation que tu veux, par exemple
If IsMissing(strFiltre) Then
strFiltre = _
"Fichiers jpg (*.jpg)" & vbNullChar _
& "*.jpg" & vbNullChar & "Fichiers bitmap (*.bmp)" _
& vbNullChar & "*.bmp" & vbNullChar & vbNullChar
' filtres fichiers
End IF
Tu peux aussi traiter de la même manière les autres paramètres pour
faire quelque chose de plus fin.
Je me rappelle qu'il y a un piège dans Windows XP et je vois que tu n'es
pas tombé dedans, un des membres de OFName doit être initialisé avec des
caractères nuls alors qu'avec Windows 98 on pouvait mettre des espaces.
Si on oublie ça la boîte de dialogue ne s'ouvre pas. Je le mentionne de
mémoire, et pour mémoire. D'ailleurs tu n'as pas mis de caractères nuls
et ça marche quand même, bon, c'est ça l'essentiel.
Avec ces quelques modifs tu devrais arriver à avoir la sélection du
fichier, ce sera déjà bien avancé.
"Gloops" 428f4dd3$0$30604$
Ah, ben tu appelles au secours pour GetOpenFile, je viens au secours
pour GetOpenFile ...
J'ai essayé, elle imprime ta procédure, non ?
Dans les flags on peut indiquer soit qu'on veut imprimer dans un
fichier, soit qu'on veut interdire l'impression dans un fichier.
Dans WIN32API on trouve juste après la déclaration de PrintDlg :
______
Const PD_PRINTTOFILE = &H20
'imprimer vers un fichier
Const PD_DISABLEPRINTTOFILE = &H80000
'interdire l'impression vers un fichier
Const PD_HIDEPRINTTOFILE = &H100000
'cacher la case impression vers un fichier
______
D'après la doc la suite dépend du pilote de l'imprimante, il convient de
se référer à la doc de celui-ci.
Peut-être bien d'ailleurs que tu n'auras pas besoin du tout de
GetOpenFile dans ce projet, car c'est le pilote qui ouvre la boîte de
sélection de fichier. (ça servira une autre fois)
Bon, mais quand même il n'y a pas de boîte de dialogue d'impression dans
ton affaire, et ça fait un bout de temps que je cherche le lien, le site
APIGuide est passé à .Net alors j'ai du mal à y trouver le code VB6.
Alors tant pis pour l'infraction à la charte, je balance ça en direct.
Code d'appel des Common Dialogs par API.
Le mode d'emploi consiste à créer un nouveau projet, sur le formulaire
Form1 créer (et placer) six boutons de commandes, qui donc bien entendu
vont s'appeler Command1 à Command6, faire un double-clic sur le
formulaire pour ouvrir son module, presser Ctrl A pour tout sélectionner
(et effacer), coller le code ci-dessous.
Quand tu démarres tu n'as plus qu'à cliquer sur le bouton ShowPrinter.
Une fois que c'est fait et que tu as vérifié que ça donne bien ce que tu
veux il ne reste plus qu'à regarder ce que le module a dans les tripes.
C'est après ça que tu chipotes avec l'histoire d'imposer l'impression
dans un fichier. Il me semble que tu as une boîte de dialogue pour
sélectionner les paramètres d'impression, pour imprimer vraiment il faut
laisser juste après l'instruction Print, que d'ailleurs tu as déjà dans
ton projet.
Les impressions je ne m'en suis pas servi tant que ça, si tu as des
soucis je te suggère un fil nommé quelque chose comme "Dialogue
d'impression", ça situe mieux.
HS : En revanche j'ai fait des sélections de polices de caractères (tant
qu'on y est puisque c'est aussi du Common Dialog), et je sais qu'il y
avait un souci dans la sélection du script, Microsoft a corrigé le tir,
enfin ça fait quelques années, probablement avec Windows XP ça baigne.
En revanche il y a aussi une erreur de conception, la police est
sélectionnée avant le script, alors que sur le terrain c'est de
l'inverse qu'on a besoin, j'ai par ailleurs mijoté ça sur mesure.
J'ai la flemme d'adapter ça à la largeur du newsgroup, je te laisse
corriger les sauts de ligne là où tu verras le texte en rouge.
Source : APIGuide, téléchargé il y a quelques années.
Adresse actuelle du site :
http://www.mentalis.org/agnet/apiguide.shtml
================================================================================ 'This project needs 6 command buttons
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 POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 PAGESETUPDLG
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
flags As Long
ptPaperSize As POINTAPI
rtMinMargin As RECT
rtMargin As RECT
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As String
hPageSetupTemplate As Long
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
Private 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 As String * 31
End Type
Private Type CHOOSEFONT
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
' contains cust. dlg. template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the
EnumFonts
' call back with the extra
FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type
Private Type PRINTDLG_TYPE
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 Type DEVNAMES_TYPE
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
extra As String * 100
End Type
Private Type DEVMODE_TYPE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
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
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias
"PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias
"PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias
"ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long)
As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As
Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As
Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long)
As Long
Dim OFName As OPENFILENAME
Dim CustomColors() As Byte
Private Sub Command1_Click()
Dim sFile As String
sFile = ShowOpen
If sFile <> "" Then
MsgBox "You chose this file: " + sFile
Else
MsgBox "You pressed cancel"
End If
End Sub
Private Sub Command2_Click()
Dim sFile As String
sFile = ShowSave
If sFile <> "" Then
MsgBox "You chose this file: " + sFile
Else
MsgBox "You pressed cancel"
End If
End Sub
Private Sub Command3_Click()
Dim NewColor As Long
NewColor = ShowColor
If NewColor <> -1 Then
Me.BackColor = NewColor
Else
MsgBox "You chose cancel"
End If
End Sub
Private Sub Command4_Click()
MsgBox ShowFont
End Sub
Private Sub Command5_Click()
ShowPrinter Me
End Sub
Private Sub Command6_Click()
ShowPageSetupDlg
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail:
'Redim the variables to store the cutstom colors
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
'Set the captions
Command1.Caption = "ShowOpen"
Command2.Caption = "ShowSave"
Command3.Caption = "ShowColor"
Command4.Caption = "ShowFont"
Command5.Caption = "ShowPrinter"
Command6.Caption = "ShowPageSetupDlg"
End Sub
Private Function ShowColor() As Long
Dim cc As CHOOSECOLOR
Dim Custcolor(16) As Long
Dim lReturn As Long
'set the structure size
cc.lStructSize = Len(cc)
'Set the owner
cc.hwndOwner = Me.hwnd
'set the application's instance
cc.hInstance = App.hInstance
'set the custom colors (converted to Unicode)
cc.lpCustColors = StrConv(CustomColors, vbUnicode)
'no extra flags
cc.flags = 0
'Show the 'Select Color'-dialog
If CHOOSECOLOR(cc) <> 0 Then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function
Private Function ShowOpen() As String
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the owner window
OFName.hwndOwner = Me.hwnd
'Set the application's instance
OFName.hInstance = App.hInstance
'Set the filet
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" +
Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'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 = "C:"
'Set the dialog title
OFName.lpstrTitle = "Open File - KPD-Team 1998"
'no extra flags
OFName.flags = 0
'Show the 'Open File'-dialog
If GetOpenFileName(OFName) Then
ShowOpen = Trim$(OFName.lpstrFile)
Else
ShowOpen = ""
End If
End Function
Private Function ShowFont() As String
Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
Dim fontname As String, retval As Long
lfont.lfHeight = 0 ' determine default height
lfont.lfWidth = 0 ' determine default width
lfont.lfEscapement = 0 ' angle between baseline and escapement vector
lfont.lfOrientation = 0 ' angle between baseline and orientation
vector
lfont.lfWeight = FW_NORMAL ' normal weight i.e. not bold
lfont.lfCharSet = DEFAULT_CHARSET ' use default character set
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS ' default precision mapping
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS ' default clipping
precision
lfont.lfQuality = DEFAULT_QUALITY ' default quality setting
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN ' default
pitch, proportional with serifs
lfont.lfFaceName = "Times New Roman" & vbNullChar ' string must be
null-terminated
' Create the memory block which will act as the LOGFONT structure
buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
pMem = GlobalLock(hMem) ' lock and get pointer
CopyMemory ByVal pMem, lfont, Len(lfont) ' copy structure's
contents into block
' Initialize dialog box: Screen and printer fonts, point size
between 10 and 72.
cf.lStructSize = Len(cf) ' size of structure
cf.hwndOwner = Form1.hwnd ' window Form1 is opening this dialog box
cf.hDC = Printer.hDC ' device context of default printer (using
VB's mechanism)
cf.lpLogFont = pMem ' pointer to LOGFONT memory block buffer
cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)
cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or
CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0) ' black
cf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold
or anything
cf.nSizeMin = 10 ' minimum point size
cf.nSizeMax = 72 ' maximum point size
' Now, call the function. If successful, copy the LOGFONT
structure back into the structure
' and then print out the attributes we mentioned earlier that the
user selected.
retval = CHOOSEFONT(cf) ' open the dialog box
If retval <> 0 Then ' success
CopyMemory lfont, ByVal pMem, Len(lfont) ' copy memory back
' Now make the fixed-length string holding the font name into a
"normal" string.
ShowFont = Left(lfont.lfFaceName, InStr(lfont.lfFaceName,
vbNullChar) - 1)
Debug.Print ' end the line
End If
' Deallocate the memory block we created earlier. Note that this must
' be done whether the function succeeded or not.
retval = GlobalUnlock(hMem) ' destroy pointer, unlock block
retval = GlobalFree(hMem) ' free the allocated memory
End Function
Private Function ShowSave() As String
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the owner window
OFName.hwndOwner = Me.hwnd
'Set the application's instance
OFName.hInstance = App.hInstance
'Set the filet
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" +
Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'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 = "C:"
'Set the dialog title
OFName.lpstrTitle = "Save File - KPD-Team 1998"
'no extra flags
OFName.flags = 0
'Show the 'Save File'-dialog
If GetSaveFileName(OFName) Then
ShowSave = Trim$(OFName.lpstrFile)
Else
ShowSave = ""
End If
End Function
Private Function ShowPageSetupDlg() As Long
Dim m_PSD As PAGESETUPDLG
'Set the structure size
m_PSD.lStructSize = Len(m_PSD)
'Set the owner window
m_PSD.hwndOwner = Me.hwnd
'Set the application instance
m_PSD.hInstance = App.hInstance
'no extra flags
m_PSD.flags = 0
'Show the pagesetup dialog
If PAGESETUPDLG(m_PSD) Then
ShowPageSetupDlg = 0
Else
ShowPageSetupDlg = -1
End If
End Function
Public Sub ShowPrinter(frmOwner As Form, Optional PrintFlags As Long)
'-> Code by Donald Grover
Dim PrintDlg As PRINTDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE
Dim lpDevMode As Long, lpDevName As Long
Dim bReturn As Integer
Dim objPrinter As Printer, NewPrinterName As String
' Use PrintDialog to get the handle to a memory
' block with a DevMode and DevName structures
PrintDlg.lStructSize = Len(PrintDlg)
PrintDlg.hwndOwner = frmOwner.hwnd
PrintDlg.flags = PrintFlags
On Error Resume Next
'Set the current orientation and duplex setting
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmSize = Len(DevMode)
DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
DevMode.dmPaperWidth = Printer.Width
DevMode.dmOrientation = Printer.Orientation
DevMode.dmPaperSize = Printer.PaperSize
DevMode.dmDuplex = Printer.Duplex
On Error GoTo 0
'Allocate memory for the initialization hDevMode structure
'and copy the settings gathered above into this memory
PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT,
Len(DevMode))
lpDevMode = GlobalLock(PrintDlg.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
End If
'Set the current driver, device, and port name strings
With DevName
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
.wDefault = 0
End With
With Printer
DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) &
.Port & Chr(0)
End With
'Allocate memory for the initial hDevName structure
'and copy the settings gathered above into this memory
PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT,
Len(DevName))
lpDevName = GlobalLock(PrintDlg.hDevNames)
If lpDevName > 0 Then
CopyMemory ByVal lpDevName, DevName, Len(DevName)
bReturn = GlobalUnlock(lpDevName)
End If
'Call the print dialog up and let the user make changes
If PrintDialog(PrintDlg) <> 0 Then
'First get the DevName structure.
lpDevName = GlobalLock(PrintDlg.hDevNames)
CopyMemory DevName, ByVal lpDevName, 45
bReturn = GlobalUnlock(lpDevName)
GlobalFree PrintDlg.hDevNames
'Next get the DevMode structure and set the printer
'properties appropriately
lpDevMode = GlobalLock(PrintDlg.hDevMode)
CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
GlobalFree PrintDlg.hDevMode
NewPrinterName = UCase$(Left(DevMode.dmDeviceName,
InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
If Printer.DeviceName <> NewPrinterName Then
For Each objPrinter In Printers
If UCase$(objPrinter.DeviceName) = NewPrinterName Then
Set Printer = objPrinter
'set printer toolbar name at this point
End If
Next
End If
On Error Resume Next
'Set printer object properties according to selections made
'by user
Printer.Copies = DevMode.dmCopies
Printer.Duplex = DevMode.dmDuplex
Printer.Orientation = DevMode.dmOrientation
Printer.PaperSize = DevMode.dmPaperSize
Printer.PrintQuality = DevMode.dmPrintQuality
Printer.ColorMode = DevMode.dmColor
Printer.PaperBin = DevMode.dmDefaultSource
On Error GoTo 0
End If
End Sub
"Gloops" 428fd3c9$0$3143$
PTI, la fonction IsMissing() ne fonctionne qu'avec des paramètres de type
Variant.. ce qui n'est pas très pratique. Toutefois, au lieu de vérifier si
le paramètres est manquant et lui assigner par la suite, tu peux définir une
valeur par défaut directement dans la signature de la fonction.
comme ceci :
'***
Public Function ChoixFichier(Optional ByRef strFiltre As String = "*.*")
'...
End Function
'***
--
Cordialement
Yanick
MVP pour Visual Basic