Option Explicit Const LF_FACESIZE = 32 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 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 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(LF_FACESIZE) As Byte 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 LOGFONT ' 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 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 PRINTDLG Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) 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 Dim OFName As OPENFILENAME Dim CustomColors() As Byte Private Sub Form_Load() 'VbAndJava 1999/2000 'Guerrault Yonni 'E-Mail : Yonni4@iFrance.com 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 End Sub Private Function ShowColor() As Long Dim cc As CHOOSECOLOR Dim Custcolor(16) As Long Dim lReturn As Long cc.lStructSize = Len(cc) cc.hwndOwner = Me.hWnd cc.hInstance = App.hInstance cc.lpCustColors = StrConv(CustomColors, vbUnicode) cc.flags = 0 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 OFName.lStructSize = Len(OFName) OFName.hwndOwner = Me.hWnd OFName.hInstance = App.hInstance OFName.lpstrFilter = "Fichiers textes (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0) OFName.lpstrFile = Space$(254) OFName.nMaxFile = 255 OFName.lpstrFileTitle = Space$(254) OFName.nMaxFileTitle = 255 OFName.lpstrInitialDir = "C:\" OFName.lpstrTitle = "Ouvrir fichier - VbAndJava 1999/2000" OFName.flags = 0 If GetOpenFileName(OFName) Then ShowOpen = Trim$(OFName.lpstrFile) Else ShowOpen = "" End If End Function Private Function ShowSave() As String OFName.lStructSize = Len(OFName) OFName.hwndOwner = Me.hWnd OFName.hInstance = App.hInstance OFName.lpstrFilter = "Fichiers textes (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0) OFName.lpstrFile = Space$(254) OFName.nMaxFile = 255 OFName.lpstrFileTitle = Space$(254) OFName.nMaxFileTitle = 255 OFName.lpstrInitialDir = "C:\" OFName.lpstrTitle = "Sauver fichier - VbAndJava 1999/2000" OFName.flags = 0 If GetSaveFileName(OFName) Then ShowSave = Trim$(OFName.lpstrFile) Else ShowSave = "" End If End Function Private Function ShowPrintDlg() As Long Dim m_PD As PRINTDLG m_PD.lStructSize = Len(m_PD) m_PD.hwndOwner = Me.hWnd m_PD.hInstance = App.hInstance m_PD.flags = 0 If PRINTDLG(m_PD) Then ShowPrintDlg = 0 Else ShowPrintDlg = -1 End If End Function Private Function ShowPageSetupDlg() As Long Dim m_PSD As PAGESETUPDLG m_PSD.lStructSize = Len(m_PSD) m_PSD.hwndOwner = Me.hWnd m_PSD.hInstance = App.hInstance m_PSD.flags = 0 If PAGESETUPDLG(m_PSD) Then ShowPageSetupDlg = 0 Else ShowPageSetupDlg = -1 End If End Function Private Function ShowFont() As Long Dim m_Font As LOGFONT Dim m_ChooseFont As CHOOSEFONT m_Font.lfEscapement = 2700 m_Font.lfHeight = -400 / Screen.TwipsPerPixelY m_ChooseFont.flags = 0 m_ChooseFont.hdc = Printer.hdc m_ChooseFont.hInstance = App.hInstance m_ChooseFont.hwndOwner = Me.hWnd m_ChooseFont.lpLogFont = m_Font m_ChooseFont.lStructSize = Len(m_ChooseFont) If CHOOSEFONT(m_ChooseFont) Then ShowFont = 0 Else ShowFont = -1 End If End Function