Common Dialog Cancel button


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 3 of 3

Thread: Common Dialog Cancel button

  1. #1
    Vasia Guest

    Common Dialog Cancel button


    How do we detect if Cancel button was pressed. If you're thinking of a CancelError
    property - don't respond. It's not what I'm looking for.

    Thank you all in advance.
    No e-mail please.

  2. #2
    Eduardo A. Morcillo Guest

    Re: Common Dialog Cancel button

    > How do we detect if Cancel button was pressed. If you're thinking of a
    CancelError
    > property - don't respond. It's not what I'm looking for.


    With the Common Dialog control, the CancelError property and an On Error in
    the code is the only way.

    --
    Eduardo A. Morcillo (MS-MVP)
    http://www.domaindlx.com/e_morcillo



  3. #3
    Michael Culley Guest

    Re: Common Dialog Cancel button

    Its not ideal but it actually works quite well, if you cancel then execution
    jumps to the end of the function, which is what you want.

    Alternatively, you could use the code below (paste it into a class and call
    it CommonDialog or something like it). You will need to strip out the error
    handling and line numbering.

    --
    Michael Culley
    www.vbdotcom.com

    Option Explicit

    Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA"
    (pChoosecolor As CHOOSECOLOR) As Long
    Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA"
    (pChoosefont As CHOOSEFONT) As Long
    Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd
    As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As
    Long) 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 CommDlgExtendedError Lib "comdlg32.dll" () 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
    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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As
    Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
    (Destination As Any, Source As Any, ByVal Length As Long)
    Private Const GMEM_MOVEABLE = &H2
    Private Const GMEM_ZEROINIT = &H40
    Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

    Private Const LF_FACESIZE = 32
    Private Const LF_FULLFACESIZE = 64
    Private Const FW_BOLD = 700

    Private Const CDERR_DIALOGFAILURE = &HFFFF
    Private Const CDERR_FINDRESFAILURE = &H6
    Private Const CDERR_GENERALCODES = &H0
    Private Const CDERR_INITIALIZATION = &H2
    Private Const CDERR_LOADRESFAILURE = &H7
    Private Const CDERR_LOADSTRFAILURE = &H5
    Private Const CDERR_LOCKRESFAILURE = &H8
    Private Const CDERR_MEMALLOCFAILURE = &H9
    Private Const CDERR_MEMLOCKFAILURE = &HA
    Private Const CDERR_NOHINSTANCE = &H4
    Private Const CDERR_NOHOOK = &HB
    Private Const CDERR_NOTEMPLATE = &H3
    Private Const CDERR_REGISTERMSGFAIL = &HC
    Private Const CDERR_STRUCTSIZE = &H1

    Private Const FNERR_BUFFERTOOSMALL = &H3003
    Private Const FNERR_FILENAMECODES = &H3000
    Private Const FNERR_INVALIDFILENAME = &H3002
    Private Const FNERR_SUBCLASSFAILURE = &H3001

    Private Const DN_DEFAULTPRN = &H1

    Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    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(1 To 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 Long
    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 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 DEVNAMES
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    End Type

    Public Enum HelpCmdEnum
    HELP_COMMAND = &H102&
    HELP_CONTENTS = &H3&
    HELP_CONTEXT = &H1
    HELP_CONTEXTPOPUP = &H8&
    HELP_FORCEFILE = &H9&
    HELP_HELPONHELP = &H4
    HELP_INDEX = &H3
    HELP_KEY = &H101
    HELP_MULTIKEY = &H201&
    HELP_PARTIALKEY = &H105&
    HELP_QUIT = &H2
    HELP_SETCONTENTS = &H5&
    HELP_SETINDEX = &H5
    HELP_SETWINPOS = &H203&
    HELP_FINDER = &HB&
    End Enum

    Public Enum FontFlagsEnum
    CF_ANSIONLY = &H400&
    CF_APPLY = &H200&
    CF_BOTH = &H3
    CF_EFFECTS = &H100&
    CF_TTONLY = &H40000
    CF_FIXEDPITCHONLY = &H4000&
    CF_FORCEFONTEXIST = &H10000
    CF_INITTOLOGFONTSTRUCT = &H40&
    CF_LIMITSIZE = &H2000&
    CF_WYSIWYG = &H8000
    CF_NOFACESEL = &H80000
    CF_NOOEMFONTS = &H800&
    CF_NOSCRIPTSEL = &H800000
    CF_NOSIMULATIONS = &H1000&
    CF_NOSIZESEL = &H200000
    CF_NOSTYLESEL = &H100000
    CF_NOVECTORFONTS = &H800&
    CF_NOVERTFONTS = &H1000000
    CF_SCREENFONTS = &H1
    CF_PRINTERFONTS = &H2
    CF_SCRIPTSONLY = &H400&
    CF_SCALABLEONLY = &H20000
    CF_SELECTSCRIPT = &H400000
    CF_SHOWHELP = &H4&
    CF_USESTYLE = &H80&
    End Enum

    'internal property buffers

    Private iAction As Integer 'internal buffer for Action property
    Private bCancelError As Boolean 'internal buffer for CancelError property
    Private lColor As Long 'internal buffer for Color property
    Private lCopies As Long 'internal buffer for lCopies property
    Private sDefaultExt As String 'internal buffer for sDefaultExt property
    Private sDialogTitle As String 'internal buffer for DialogTitle property
    Private sFileName As String 'internal buffer for FileName property
    Private sFileTitle As String 'internal buffer for FileTitle property
    Private sFilter As String 'internal buffer for Filter property
    Private iFilterIndex As Integer 'internal buffer for FilterIndex property
    Private lFlags As Long 'internal buffer for Flags property
    Private bFontBold As Boolean 'internal buffer for FontBold property
    Private bFontItalic As Boolean 'internal buffer for FontItalic property
    Private sFontName As String 'internal buffer for FontName property
    Private lFontSize As Long 'internal buffer for FontSize property
    Private bFontStrikethru As Boolean 'internal buffer for FontStrikethru
    property
    Private bFontUnderline As Boolean 'internal buffer for FontUnderline
    property
    Private lFromPage As Long 'internal buffer for FromPage property
    Private lhwnd As Long 'internal buffer for hdc property
    Private lhdc As Long 'internal buffer for hdc property
    Private lHelpCommand As Long 'internal buffer for HelpCommand property
    Private sHelpData As String 'internal buffer for HelpContext property
    Private sHelpFile As String 'internal buffer for HelpFile property
    Private sHelpKey As String 'internal buffer for HelpKey property
    Private sInitDir As String 'internal buffer for InitDir property
    Private lMax As Long 'internal buffer for Max property
    Private lMaxFileSize As Long 'internal buffer for MaxFileSize property
    Private lMin As Long 'internal buffer for Min property
    Private objObject As Object 'internal buffer for Object property
    Private iPrinterDefault As Integer 'internal buffer for PrinterDefault
    property
    Private lToPage As Long 'internal buffer for ToPage property
    Private lDeviceName As String 'internal buffer for DeviceName property
    Private lDriverName As String 'internal buffer for DriverName property
    Private lPort As String 'internal buffer for Port property

    Private lApiReturn As Long 'internal buffer for APIReturn property
    Private lExtendedError As Long 'internal buffer for ExtendedError
    property
    Private lCancelled As Boolean 'internal buffer for Cancelled property

    Public Property Get Filter() As String
    On Error GoTo Fail

    'return object's Filter property
    1 Filter = sFilter

    Exit Property
    Fail:
    ErrReport.AddToStackRaiseError TypeName(Me), "Filter[GET]"
    End Property

    Public Sub ShowColor()
    On Error GoTo Fail

    'display the color dialog box

    Dim tChooseColor As CHOOSECOLOR
    Dim alCustomColors(15) As Long
    Dim lCustomColorSize As Long
    Dim lCustomColorAddress As Long
    Dim lMemHandle As Long

    Dim n As Integer

    On Error GoTo ShowColorError


    '*** init property buffers

    1 iAction = 3 'Action property - ShowColor
    2 lApiReturn = 0 'APIReturn property
    3 lExtendedError = 0 'ExtendedError property


    '*** prepare tChooseColor data

    'lStructSize As Long
    4 tChooseColor.lStructSize = Len(tChooseColor)

    'hwndOwner As Long
    5 tChooseColor.hwndOwner = lhwnd

    'hInstance As Long

    'rgbResult As Long
    6 tChooseColor.rgbResult = lColor

    'lpCustColors As Long
    ' Fill custom colors array with all white
    7 For n = 0 To UBound(alCustomColors)
    8 alCustomColors(n) = &HFFFFFF
    9 Next
    ' Get size of memory needed for custom colors
    10 lCustomColorSize = Len(alCustomColors(0)) * 16
    ' Get a global memory block to hold a copy of the custom colors
    11 lMemHandle = GlobalAlloc(GHND, lCustomColorSize)

    12 If lMemHandle = 0 Then
    Exit Sub
    End If
    ' Lock the custom color's global memory block
    13 lCustomColorAddress = GlobalLock(lMemHandle)
    14 If lCustomColorAddress = 0 Then
    Exit Sub
    End If
    ' Copy custom colors to the global memory block
    15 Call CopyMemory(ByVal lCustomColorAddress, alCustomColors(0),
    lCustomColorSize)

    16 tChooseColor.lpCustColors = lCustomColorAddress

    'flags As Long
    17 tChooseColor.flags = lFlags

    'lCustData As Long
    'lpfnHook As Long
    'lpTemplateName As String


    '*** call the ChooseColor API function
    18 lApiReturn = CHOOSECOLOR(tChooseColor)


    '*** handle return from ChooseColor API function
    19 Select Case lApiReturn
    Case 0 'user canceled
    20 If bCancelError = True Then
    'generate an error
    On Error GoTo 0
    21 Err.Raise Number:=vbObjectError + 894, _
    Description:="Cancel Pressed"
    Exit Sub
    End If

    22 Case 1 'user selected a color
    'update property buffer
    23 lColor = tChooseColor.rgbResult

    24 Case Else 'an error occured
    'call CommDlgExtendedError
    25 lExtendedError = CommDlgExtendedError

    End Select

    Exit Sub

    ShowColorError:
    Exit Sub

    Exit Sub
    Fail:
    ErrReport.AddToStackRaiseError TypeName(Me), "ShowColor"
    End Sub

    Public Sub ShowFont()
    On Error GoTo Fail

    'display the font dialog box

    Dim tLogFont As LOGFONT
    Dim tChooseFont As CHOOSEFONT

    Dim lLogFontSize As Long
    Dim lLogFontAddress As Long
    Dim lMemHandle As Long

    On Error GoTo ShowFontError

    '*** init property buffers

    1 iAction = 4 'Action property - ShowFont
    2 lApiReturn = 0 'APIReturn property
    3 lExtendedError = 0 'ExtendedError property


    '*** prepare tChooseFont data

    'tLogFont.lfHeight As Long
    'tLogFont.lfWidth As Long
    'tLogFont.lfEscapement As Long
    'tLogFont.lfOrientation As Long

    'tLogFont.lfWeight As Long - init from FontBold property
    4 If bFontBold = True Then
    5 tLogFont.lfWeight = FW_BOLD
    End If

    'tLogFont.lfItalic As Byte - init from FontItalic property
    6 If bFontItalic = True Then
    7 tLogFont.lfItalic = 1
    End If

    'tLogFont.lfUnderline As Byte - init from FontUnderline property
    8 If bFontUnderline = True Then
    9 tLogFont.lfUnderline = 1
    End If

    'tLogFont.lfStrikeOut As Byte - init from FontStrikethru property
    10 If bFontStrikethru = True Then
    11 tLogFont.lfStrikeOut = 1
    End If

    'tLogFont.lfCharSet As Byte
    'tLogFont.lfOutPrecision As Byte
    'tLogFont.lfClipPrecision As Byte
    'tLogFont.lfQuality As Byte
    'tLogFont.lfPitchAndFamily As Byte
    'tLogFont.lfFaceName(LF_FACESIZE) As Byte

    'tChooseFont.lStructSize As Long
    12 tChooseFont.lStructSize = Len(tChooseFont)

    'tChooseFont.hwndOwner As Long
    'tChooseFont.hdc As Long

    'tChooseFont.lpLogFont As Long
    13 lLogFontSize = Len(tLogFont)

    ' Get a global memory block to hold a copy of tLogFont - exit on failure
    14 lMemHandle = GlobalAlloc(GHND, lLogFontSize)
    15 If lMemHandle = 0 Then
    Exit Sub
    End If

    ' Lock tLogFont's global memory block - exit on failure
    16 lLogFontAddress = GlobalLock(lMemHandle)
    17 If lLogFontAddress = 0 Then
    Exit Sub
    End If

    ' Copy tLogFont to the global memory block
    18 Call CopyMemory(ByVal lLogFontAddress, tLogFont, lLogFontSize)

    19 tChooseFont.lpLogFont = lLogFontAddress

    'tChooseFont.iPointSize As Long - init from FontSize property
    20 tChooseFont.iPointSize = lFontSize * 10

    'tChooseFont.flags As Long - init from Flags property
    21 tChooseFont.flags = lFlags

    'tChooseFont.rgbColors As Long
    'tChooseFont.lCustData As Long
    'tChooseFont.lpfnHook As Long
    'tChooseFont.lpTemplateName As String
    'tChooseFont.hInstance As Long

    'tChooseFont.lpszStyle As String
    'sFont = Chr$(0) & Space$(20) & Chr$(0)
    'tChooseFont.lpszStyle = sFont

    'tChooseFont.nFontType As Integer
    'tChooseFont.MISSING_ALIGNMENT As Integer
    'tChooseFont.nSizeMin As Long
    'tChooseFont.nSizeMax As Long


    '*** call the CHOOSEFONT API function
    22 lApiReturn = CHOOSEFONT(tChooseFont) 'store to APIReturn property


    '*** handle return from CHOOSEFONT API function
    23 Select Case lApiReturn
    Case 0 'user canceled
    24 If bCancelError = True Then
    'generate an error
    25 Err.Raise (2001)
    Exit Sub
    End If

    26 Case 1 'user selected a font
    ' Copy global memory block to tLogFont
    27 Call CopyMemory(tLogFont, ByVal lLogFontAddress,
    lLogFontSize)

    'tLogFont.lfWeight As Long - store to FontBold property
    28 If tLogFont.lfWeight >= FW_BOLD Then
    29 bFontBold = True
    30 Else
    31 bFontBold = False
    End If

    'tLogFont.lfItalic As Byte - store to FontItalic property
    32 If tLogFont.lfItalic = 1 Then
    33 bFontItalic = True
    34 Else
    35 bFontItalic = False
    End If

    'tLogFont.lfUnderline As Byte - store to FontUnderline property
    36 If tLogFont.lfUnderline = 1 Then
    37 bFontUnderline = True
    38 Else
    39 bFontUnderline = False
    End If

    'tLogFont.lfStrikeOut As Byte - store to FontStrikethru property
    40 If tLogFont.lfStrikeOut = 1 Then
    41 bFontStrikethru = True
    42 Else
    43 bFontStrikethru = False
    End If

    'tLogFont.lfFaceName(LF_FACESIZE) As Byte - store to FontName
    property
    44 FontName = sByteArrayToString(tLogFont.lfFaceName())

    'tChooseFont.iPointSize As Long - store to FontSize property
    45 lFontSize = CLng(tChooseFont.iPointSize / 10)

    46 Case Else 'an error occured
    'call CommDlgExtendedError
    47 lExtendedError = CommDlgExtendedError 'store to
    ExtendedError property

    End Select
    Exit Sub

    ShowFontError:
    Exit Sub

    Exit Sub
    Fail:
    ErrReport.AddToStackRaiseError TypeName(Me), "ShowFont"
    End Sub

    Public Sub ShowHelp()
    On Error GoTo Fail

    'run winhelp.exe with the specified help file
    Dim sHelpFileBuff As String
    Dim lData As Long

    On Error GoTo ShowHelpError

    '*** init Private properties
    1 iAction = 6 'Action property - ShowHelp
    2 lApiReturn = 0 'APIReturn property
    3 lExtendedError = 0 'ExtendedError property

    '*** prepare the buffers and parameters for the API function
    'sHelpFile is a null terminated string
    4 sHelpFileBuff = sHelpFile & Chr$(0)

    'sData is dependent on lHelpCommand
    5 Select Case lHelpCommand
    Case 0
    6 lData = 0
    7 Case Else
    8 lData = sHelpData
    End Select

    '*** call the API function
    9 lApiReturn = WinHelp(lhwnd, sHelpFile, lHelpCommand, lData) ' -
    Store to APIReturn property

    10 Select Case lApiReturn
    Case 0 '
    'call CommDlgExtendedError
    11 lExtendedError = CommDlgExtendedError ' - store to
    ExtendedErro220 64914 <3c673ec0$1@10.1.10.29> article retrieved - head and body follows
    From: "Senthil Kumar" <jsenthil_kumar@hotmail.com>
    Sender: "Senthil Kumar" <jsenthil_kumar@hotmail.com>
    Reply-To: "Senthil Kumar" <jsenthil_kumar@hotmail.com>
    Subject: Multiple MDI Child Forms
    Newsgroups: vb.general
    X-User-Info: 139.130.22.26 139.130.22.26
    NNTP-Posting-Host: 10.1.10.29
    Message-ID: <3c673ec0$1@10.1.10.29>
    Date: 10 Feb 2002 19:47:12 -0800
    X-Trace: 10 Feb 2002 19:47:12 -0800, 10.1.10.29
    Lines: 11
    Path: 10.1.10.29
    Xref: 10.1.10.29 vb.general:64914


    First my sincere Thanks for reading this. I have to create multiple
    MDI Child Forms(say 30 nos.) inside an MDI Form. Each child form will
    have the same number of controls(1 Text, 1 Label and 1 CheckBox).
    I can create this very easily. The problem is, after creating all the
    MDI Child Forms I can't manipulate any of the controls except for the
    controls in the last MDI Child Form. The reason for this is, whenever I issue
    'Set NewForm = New Form2', the previously created controls are lost.
    How can I overcome this problem? The problem is very urgent.



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center