Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Au zecours !!! API Get...openFile ???

6 réponses
Avatar
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
!

6 réponses

Avatar
Gloops
Bonjour,

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é.
Avatar
LE TROLL
lol, merci, mais je veux imprimer !!!!


"Gloops" a écrit dans le message de news:
428f4dd3$0$30604$
Bonjour,

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é.




Avatar
Gloops
LE TROLL a écrit, le 21/05/2005 17:39 :

lol, merci, mais je veux imprimer !!!!



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
Avatar
LE TROLL
merci :o)


"Gloops" a écrit dans le message de news:
428fd3c9$0$3143$
LE TROLL a écrit, le 21/05/2005 17:39 :

lol, merci, mais je veux imprimer !!!!



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



Avatar
Zoury
Salut Gloops! :O)

Public Function ChoixFichier(Optional strFiltre As String)
If IsMissing(strFiltre) Then strFiltre = "*.*"



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
Avatar
Gloops
Ah, voilà une info qu'elle est utile.
ça me rappelait bien quelque chose que le paramètre optionnel doive être
variant, et comme je réussissais à lui donne un type et que ça
m'arrangeait, c'est vrai que je n'ai pas beaucoup cherché.

Je note ça dans mes tablettes, merci.



Zoury a écrit, le 24/05/2005 15:56 :

Salut Gloops! :O)


Public Function ChoixFichier(Optional strFiltre As String)
If IsMissing(strFiltre) Then strFiltre = "*.*"




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
'***