home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / glm2demo.exe / %MAINDIR% / CommonDialog / opensave.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-06-10  |  21.5 KB  |  612 lines
  1. VERSION 5.00
  2. Begin VB.Form FileOpenSaveForm 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "File Open and File Save example"
  5.    ClientHeight    =   6600
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   9510
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   6600
  13.    ScaleWidth      =   9510
  14.    ShowInTaskbar   =   0   'False
  15.    Begin VB.CommandButton ShowOpenBut 
  16.       Caption         =   "Sho&w Open Dialog!"
  17.       BeginProperty Font 
  18.          Name            =   "MS Sans Serif"
  19.          Size            =   12
  20.          Charset         =   0
  21.          Weight          =   700
  22.          Underline       =   0   'False
  23.          Italic          =   0   'False
  24.          Strikethrough   =   0   'False
  25.       EndProperty
  26.       Height          =   375
  27.       Left            =   120
  28.       TabIndex        =   38
  29.       Top             =   6120
  30.       Width           =   2505
  31.    End
  32.    Begin VB.CommandButton ShowSaveBut 
  33.       Caption         =   "&Show Save Dialog!"
  34.       BeginProperty Font 
  35.          Name            =   "MS Sans Serif"
  36.          Size            =   12
  37.          Charset         =   0
  38.          Weight          =   700
  39.          Underline       =   0   'False
  40.          Italic          =   0   'False
  41.          Strikethrough   =   0   'False
  42.       EndProperty
  43.       Height          =   375
  44.       Left            =   120
  45.       TabIndex        =   37
  46.       Top             =   5520
  47.       Width           =   2505
  48.    End
  49.    Begin VB.Frame Frame6 
  50.       Caption         =   "Results"
  51.       BeginProperty Font 
  52.          Name            =   "MS Sans Serif"
  53.          Size            =   13.5
  54.          Charset         =   0
  55.          Weight          =   700
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   1050
  61.       Left            =   2760
  62.       TabIndex        =   33
  63.       Top             =   5440
  64.       Width           =   6615
  65.       Begin VB.TextBox PathText 
  66.          Height          =   285
  67.          Left            =   1380
  68.          TabIndex        =   27
  69.          Top             =   660
  70.          Width           =   5055
  71.       End
  72.       Begin VB.TextBox FileSelectedText 
  73.          Height          =   285
  74.          Left            =   1380
  75.          TabIndex        =   26
  76.          Top             =   300
  77.          Width           =   5055
  78.       End
  79.       Begin VB.Label Label9 
  80.          AutoSize        =   -1  'True
  81.          Caption         =   "Path Selected"
  82.          Height          =   195
  83.          Left            =   120
  84.          TabIndex        =   35
  85.          Top             =   690
  86.          Width           =   1005
  87.       End
  88.       Begin VB.Label Label3 
  89.          AutoSize        =   -1  'True
  90.          Caption         =   "File(s) Selected"
  91.          Height          =   195
  92.          Left            =   120
  93.          TabIndex        =   34
  94.          Top             =   330
  95.          Width           =   1080
  96.       End
  97.    End
  98.    Begin VB.Frame Frame5 
  99.       Caption         =   "OK and Cancel Button Options"
  100.       BeginProperty Font 
  101.          Name            =   "MS Sans Serif"
  102.          Size            =   8.25
  103.          Charset         =   0
  104.          Weight          =   700
  105.          Underline       =   0   'False
  106.          Italic          =   0   'False
  107.          Strikethrough   =   0   'False
  108.       EndProperty
  109.       Height          =   1125
  110.       Left            =   120
  111.       TabIndex        =   32
  112.       Top             =   120
  113.       Width           =   6735
  114.       Begin VB.CheckBox CancelErrorCheck 
  115.          Caption         =   "&Raise Error On Cancel"
  116.          Height          =   285
  117.          Left            =   120
  118.          TabIndex        =   2
  119.          Top             =   630
  120.          Width           =   1905
  121.       End
  122.       Begin VB.CheckBox HideCancelCheck 
  123.          Caption         =   "Hide Cancel B&utton"
  124.          Height          =   285
  125.          Left            =   120
  126.          TabIndex        =   1
  127.          Top             =   240
  128.          Width           =   1845
  129.       End
  130.       Begin VB.CheckBox CustomButtonCaptionCheck 
  131.          Caption         =   "Change &Open/Save Button Caption"
  132.          Height          =   285
  133.          Left            =   2640
  134.          TabIndex        =   3
  135.          Top             =   240
  136.          Width           =   2865
  137.       End
  138.       Begin VB.TextBox CustomButtonCaptionText 
  139.          Height          =   345
  140.          Left            =   5580
  141.          TabIndex        =   4
  142.          Text            =   "&Select"
  143.          Top             =   210
  144.          Width           =   945
  145.       End
  146.       Begin VB.TextBox CustomCancelCaptionText 
  147.          Height          =   345
  148.          Left            =   5580
  149.          TabIndex        =   6
  150.          Text            =   "E&xit"
  151.          Top             =   630
  152.          Width           =   945
  153.       End
  154.       Begin VB.CheckBox CustomCancelCaptionCheck 
  155.          Caption         =   "Change &Cancel Button Caption"
  156.          Height          =   285
  157.          Left            =   2640
  158.          TabIndex        =   5
  159.          Top             =   630
  160.          Width           =   2865
  161.       End
  162.    End
  163.    Begin VB.Frame Frame4 
  164.       Caption         =   "Dialog Box Position"
  165.       BeginProperty Font 
  166.          Name            =   "MS Sans Serif"
  167.          Size            =   8.25
  168.          Charset         =   0
  169.          Weight          =   700
  170.          Underline       =   0   'False
  171.          Italic          =   0   'False
  172.          Strikethrough   =   0   'False
  173.       EndProperty
  174.       Height          =   1500
  175.       Left            =   120
  176.       TabIndex        =   31
  177.       Top             =   1320
  178.       Width           =   6735
  179.       Begin VB.CheckBox SetDlgPosCheck 
  180.          Caption         =   "Set &Dialog Position"
  181.          Height          =   285
  182.          Left            =   120
  183.          TabIndex        =   7
  184.          Top             =   240
  185.          Width           =   1845
  186.       End
  187.       Begin VB.CheckBox SetDlgPosToScreenCheck 
  188.          Caption         =   "Set Dialog &Position Relative To Screen"
  189.          Height          =   285
  190.          Left            =   480
  191.          TabIndex        =   8
  192.          Top             =   600
  193.          Width           =   3075
  194.       End
  195.       Begin VB.TextBox XPosText 
  196.          Height          =   345
  197.          Left            =   2040
  198.          TabIndex        =   10
  199.          Text            =   "0"
  200.          Top             =   1020
  201.          Width           =   555
  202.       End
  203.       Begin VB.TextBox YPosText 
  204.          Height          =   345
  205.          Left            =   4080
  206.          TabIndex        =   12
  207.          Text            =   "0"
  208.          Top             =   1020
  209.          Width           =   555
  210.       End
  211.       Begin VB.Label Label1 
  212.          AutoSize        =   -1  'True
  213.          Caption         =   "&X Position"
  214.          Height          =   195
  215.          Left            =   1200
  216.          TabIndex        =   9
  217.          Top             =   1065
  218.          Width           =   705
  219.       End
  220.       Begin VB.Label Label2 
  221.          Caption         =   "&Y Position"
  222.          Height          =   225
  223.          Left            =   3240
  224.          TabIndex        =   11
  225.          Top             =   1065
  226.          Width           =   735
  227.       End
  228.    End
  229.    Begin VB.Frame Frame3 
  230.       Caption         =   "&Flags"
  231.       BeginProperty Font 
  232.          Name            =   "MS Sans Serif"
  233.          Size            =   8.25
  234.          Charset         =   0
  235.          Weight          =   700
  236.          Underline       =   0   'False
  237.          Italic          =   0   'False
  238.          Strikethrough   =   0   'False
  239.       EndProperty
  240.       Height          =   5310
  241.       Left            =   6960
  242.       TabIndex        =   24
  243.       Top             =   120
  244.       Width           =   2415
  245.       Begin VB.ListBox List1 
  246.          Height          =   4545
  247.          ItemData        =   "opensave.frx":0000
  248.          Left            =   120
  249.          List            =   "opensave.frx":0046
  250.          MultiSelect     =   1  'Simple
  251.          TabIndex        =   25
  252.          Top             =   240
  253.          Width           =   2175
  254.       End
  255.    End
  256.    Begin VB.Frame Frame2 
  257.       Caption         =   "Other Options"
  258.       BeginProperty Font 
  259.          Name            =   "MS Sans Serif"
  260.          Size            =   8.25
  261.          Charset         =   0
  262.          Weight          =   700
  263.          Underline       =   0   'False
  264.          Italic          =   0   'False
  265.          Strikethrough   =   0   'False
  266.       EndProperty
  267.       Height          =   1095
  268.       Left            =   120
  269.       TabIndex        =   30
  270.       Top             =   4320
  271.       Width           =   6735
  272.       Begin VB.CheckBox RaiseEventCheck 
  273.          Caption         =   "Raise Callback &Event"
  274.          Height          =   285
  275.          Left            =   4680
  276.          TabIndex        =   22
  277.          Top             =   240
  278.          Width           =   1875
  279.       End
  280.       Begin VB.TextBox OpenSaveFilterText 
  281.          Height          =   315
  282.          Left            =   1830
  283.          TabIndex        =   23
  284.          Text            =   "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico|All Files (*.*)|*.*"
  285.          Top             =   630
  286.          Width           =   4755
  287.       End
  288.       Begin VB.TextBox OpenSaveCaptionText 
  289.          Height          =   315
  290.          Left            =   1830
  291.          TabIndex        =   21
  292.          Text            =   "Open"
  293.          Top             =   240
  294.          Width           =   1995
  295.       End
  296.       Begin VB.Label Label5 
  297.          Caption         =   "Open Save Filter"
  298.          Height          =   255
  299.          Left            =   240
  300.          TabIndex        =   36
  301.          Top             =   675
  302.          Width           =   1515
  303.       End
  304.       Begin VB.Label Label4 
  305.          Caption         =   "Di&alog Box Caption"
  306.          Height          =   255
  307.          Left            =   240
  308.          TabIndex        =   20
  309.          Top             =   270
  310.          Width           =   1515
  311.       End
  312.    End
  313.    Begin VB.Frame Frame1 
  314.       Caption         =   "Help Options"
  315.       BeginProperty Font 
  316.          Name            =   "MS Sans Serif"
  317.          Size            =   8.25
  318.          Charset         =   0
  319.          Weight          =   700
  320.          Underline       =   0   'False
  321.          Italic          =   0   'False
  322.          Strikethrough   =   0   'False
  323.       EndProperty
  324.       Height          =   1455
  325.       Left            =   120
  326.       TabIndex        =   0
  327.       Top             =   2840
  328.       Width           =   6735
  329.       Begin VB.CommandButton Command1 
  330.          Caption         =   "&Browse..."
  331.          Height          =   375
  332.          Left            =   5520
  333.          TabIndex        =   15
  334.          Top             =   200
  335.          Width           =   1095
  336.       End
  337.       Begin VB.TextBox HelpKeyText 
  338.          Height          =   315
  339.          Left            =   2880
  340.          TabIndex        =   19
  341.          Top             =   1050
  342.          Width           =   1005
  343.       End
  344.       Begin VB.TextBox HelpContextNumberText 
  345.          Height          =   315
  346.          Left            =   2880
  347.          TabIndex        =   18
  348.          Top             =   630
  349.          Width           =   1005
  350.       End
  351.       Begin VB.OptionButton HelpKeyOpt 
  352.          Caption         =   "Help &Key"
  353.          Height          =   255
  354.          Left            =   180
  355.          TabIndex        =   17
  356.          Top             =   1080
  357.          Width           =   1245
  358.       End
  359.       Begin VB.TextBox HelpFileText 
  360.          Height          =   315
  361.          Left            =   1410
  362.          TabIndex        =   14
  363.          Top             =   210
  364.          Width           =   4005
  365.       End
  366.       Begin VB.OptionButton HelpContextOpt 
  367.          Caption         =   "Help Co&ntext"
  368.          Height          =   255
  369.          Left            =   180
  370.          TabIndex        =   16
  371.          Top             =   690
  372.          Value           =   -1  'True
  373.          Width           =   1245
  374.       End
  375.       Begin VB.Label Label8 
  376.          Caption         =   "Help Key Word"
  377.          Height          =   255
  378.          Left            =   1620
  379.          TabIndex        =   29
  380.          Top             =   1110
  381.          Width           =   1155
  382.       End
  383.       Begin VB.Label Label7 
  384.          Caption         =   "Context Number"
  385.          Height          =   255
  386.          Left            =   1620
  387.          TabIndex        =   28
  388.          Top             =   690
  389.          Width           =   1155
  390.       End
  391.       Begin VB.Label Label6 
  392.          Caption         =   "&Help File Name"
  393.          Height          =   255
  394.          Left            =   150
  395.          TabIndex        =   13
  396.          Top             =   240
  397.          Width           =   1155
  398.       End
  399.    End
  400. Attribute VB_Name = "FileOpenSaveForm"
  401. Attribute VB_GlobalNameSpace = False
  402. Attribute VB_Creatable = False
  403. Attribute VB_PredeclaredId = True
  404. Attribute VB_Exposed = False
  405. Option Explicit
  406. Dim WithEvents dwCmdDialog As dwFileOpenSave
  407. Attribute dwCmdDialog.VB_VarHelpID = -1
  408. Private Declare Function EnableWindow& Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long)
  409. Private Sub command1_Click()
  410. Dim dwCmdDialog As dwFileOpenSave
  411. Dim lres As Long
  412. Dim lstr As String
  413.     Set dwCmdDialog = New dwFileOpenSave
  414.     dwCmdDialog.DialogTitle = "Select Help File"
  415.     dwCmdDialog.Filter = "Help (*.hlp)|*.hlp|All Files (*.*)|*.*"
  416.     dwCmdDialog.DlgWindowOwner = Me.hWnd
  417.     dwCmdDialog.SetDialogPosition = True
  418.     dwCmdDialog.PosX = 50
  419.     dwCmdDialog.PosY = 50
  420.     dwCmdDialog.CustomOkButtonCaption = True
  421.     dwCmdDialog.OkButtonCaption = "Select"
  422.     dwCmdDialog.Flags = glmcdOFNEnableHook Or glmcdOFNLongNames Or glmcdOFNFileMustexist Or glmcdOFNNoChangeDir Or glmcdOFNHideReadOnly
  423.     If WindowsVersion <> 35 Then
  424.         dwCmdDialog.Flags = dwCmdDialog.Flags Or glmcdOFNExplorer
  425.     End If
  426.     lres = dwCmdDialog.ShowOpen
  427.     If lres = 1 Then
  428.         HelpFileText.Text = dwCmdDialog.filename
  429.     End If
  430.     Set dwCmdDialog = Nothing
  431. End Sub
  432. Private Sub dwCmdDialog_dwCmnDlgCallback(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long, retval As Long)
  433. Debug.Print "Message " & Hex$(msg) & " for " & Hex$(hWnd)
  434. End Sub
  435. Private Sub Form_Load()
  436.     If SetDlgPosCheck.Value Then
  437.         SetDlgPosToScreenCheck.Enabled = True
  438.         XPosText.Enabled = True
  439.         YPosText.Enabled = True
  440.     Else
  441.         SetDlgPosToScreenCheck.Enabled = False
  442.         XPosText.Enabled = False
  443.         YPosText.Enabled = False
  444.     End If
  445.     If HelpContextOpt.Value Then
  446.         HelpContextNumberText.Enabled = True
  447.         HelpKeyText.Enabled = False
  448.         HelpKeyText.Text = ""
  449.     Else
  450.         HelpKeyText.Enabled = True
  451.         HelpContextNumberText.Enabled = False
  452.         HelpContextNumberText.Text = ""
  453.     End If
  454.     ' Initialize list box
  455.     List1.Selected(0) = True    ' Show Read Only button
  456.     List1.Selected(4) = True    ' Show Help button
  457.     List1.Selected(5) = True    ' enable hook
  458.     If WindowsVersion <> 35 Then
  459.         List1.Selected(19) = True    ' explorer style
  460.     End If
  461. End Sub
  462. Private Sub HelpContextOpt_Click()
  463.     HelpContextNumberText.Enabled = True
  464.     HelpKeyText.Enabled = False
  465.     HelpKeyText.Text = ""
  466. End Sub
  467. Private Sub HelpKeyOpt_Click()
  468.     HelpKeyText.Enabled = True
  469.     HelpContextNumberText.Enabled = False
  470.     HelpContextNumberText.Text = ""
  471. End Sub
  472. Private Sub SetDlgPosCheck_Click()
  473.     If SetDlgPosCheck.Value Then
  474.         SetDlgPosToScreenCheck.Enabled = True
  475.         XPosText.Enabled = True
  476.         YPosText.Enabled = True
  477.     Else
  478.         SetDlgPosToScreenCheck.Enabled = False
  479.         XPosText.Enabled = False
  480.         YPosText.Enabled = False
  481.     End If
  482. End Sub
  483. Private Sub ShowOpenBut_Click()
  484. Dim lres As Long
  485. Dim specialhandling As Boolean
  486.     Set dwCmdDialog = New dwFileOpenSave
  487.     GetDialogInfo dwCmdDialog
  488.     ' Need a special check to handle the case where the Explorer style common dialog
  489.     ' is used and the vertical position of the common dialog is specified to a position
  490.     ' lower (greater) than that of the dialog's owner window.
  491.     If dwCmdDialog.Flags And glmcdOFNExplorer Then
  492.         If dwCmdDialog.SetDialogPosition Then
  493.             ' *** Same problem can occur if the vertical position is specified to a negative value.
  494.             If dwCmdDialog.SetDialogRelativeToScreen Then
  495.                 specialhandling = True
  496.                 ' Set the dialog's owner window to the desktop and
  497.                 ' manually disable the owner window.
  498.                 dwCmdDialog.DlgWindowOwner = 0
  499.                 Me.Enabled = False  ' or use the EnableWindow API function to disable window
  500. '                Call EnableWindow(Me.hwnd, False)
  501.             End If
  502.         End If
  503.     End If
  504.     lres = dwCmdDialog.ShowOpen
  505.     If specialhandling Then
  506.         Me.Enabled = True   ' or use the EnableWindow API function to enable window
  507. '        Call EnableWindow(Me.hwnd, True)
  508.         ' This is needed for Windows 95, for some reason the application loses the focus
  509.         ' after the dialog closes. This may produce a flicker though. Not needed on NT.
  510.         Me.SetFocus
  511.     End If
  512.     If lres <> 1 Then
  513.         ' If cancel was selected, or other error.
  514.         FileSelectedText.Text = ""
  515.         PathText.Text = ""
  516.     Else
  517.         GetDialogResults dwCmdDialog
  518.     End If
  519.     Set dwCmdDialog = Nothing
  520. End Sub
  521. Private Function GetOpenSaveFlags() As Long
  522. Dim lcount As Long, lindex As Long
  523. Dim flagvalue As Long
  524.     lindex = List1.ListCount
  525.     For lcount = 0 To lindex - 1 Step 1
  526.         If List1.Selected(lcount) Then
  527.             flagvalue = flagvalue + 2 ^ lcount
  528.         End If
  529.     Next
  530.     GetOpenSaveFlags = flagvalue
  531. End Function
  532. Private Sub ShowSaveBut_Click()
  533. Dim lres As Long
  534. Dim specialhandling As Boolean
  535.     Set dwCmdDialog = New dwFileOpenSave
  536.     GetDialogInfo dwCmdDialog
  537.     ' Need a special check to handle the case where the Explorer style common dialog
  538.     ' is used and the vertical position of the common dialog is specified to a position
  539.     ' lower (greater) than that of the dialog's owner window.
  540.     If dwCmdDialog.Flags And glmcdOFNExplorer Then
  541.         If dwCmdDialog.SetDialogPosition Then
  542.             ' *** Same problem can occur if the vertical position is specified to a negative value.
  543.             If dwCmdDialog.SetDialogRelativeToScreen Then
  544.                 specialhandling = True
  545.                 ' Set the dialog's owner window to the desktop and
  546.                 ' manually disable the owner window.
  547.                 dwCmdDialog.DlgWindowOwner = 0
  548.                 Me.Enabled = False  ' or use the EnableWindow API function to disable window
  549. '                Call EnableWindow(Me.hwnd, False)
  550.             End If
  551.         End If
  552.     End If
  553.     lres = dwCmdDialog.ShowSave
  554.     If specialhandling Then
  555.         Me.Enabled = True   ' or use the EnableWindow API function to enable window
  556. '        Call EnableWindow(Me.hwnd, True)
  557.         ' This is needed for Windows 95, for some reason the application loses the focus
  558.         ' after the dialog closes. This may produce a flicker though. Not needed on NT.
  559.         Me.SetFocus
  560.     End If
  561.     If lres <> 1 Then
  562.         ' If cancel was selected, or other error.
  563.         FileSelectedText.Text = ""
  564.         PathText.Text = ""
  565.     Else
  566.         GetDialogResults dwCmdDialog
  567.     End If
  568.     Set dwCmdDialog = Nothing
  569. End Sub
  570. Private Sub GetDialogInfo(dwCmdDialog As dwFileOpenSave)
  571.     dwCmdDialog.DialogTitle = OpenSaveCaptionText.Text
  572.     dwCmdDialog.Filter = OpenSaveFilterText.Text
  573.     dwCmdDialog.DlgWindowOwner = Me.hWnd
  574.     dwCmdDialog.HideCancel = HideCancelCheck.Value
  575.     dwCmdDialog.SetDialogPosition = SetDlgPosCheck.Value
  576.     dwCmdDialog.SetDialogRelativeToScreen = SetDlgPosToScreenCheck.Value
  577.     dwCmdDialog.PosX = Val(XPosText.Text)
  578.     dwCmdDialog.PosY = Val(YPosText.Text)
  579.     dwCmdDialog.CustomOkButtonCaption = CustomButtonCaptionCheck.Value
  580.     dwCmdDialog.OkButtonCaption = CustomButtonCaptionText.Text
  581.     dwCmdDialog.CustomCancelButtonCaption = CustomCancelCaptionCheck.Value
  582.     dwCmdDialog.CancelButtonCaption = CustomCancelCaptionText.Text
  583.     dwCmdDialog.RaiseCallbackEvent = RaiseEventCheck.Value
  584.     dwCmdDialog.CancelError = CancelErrorCheck.Value
  585.     dwCmdDialog.Flags = GetOpenSaveFlags()
  586.     dwCmdDialog.HelpFile = Trim$(HelpFileText.Text)
  587.     If dwCmdDialog.HelpFile <> "" Then
  588.         If HelpContextOpt.Value Then
  589.             dwCmdDialog.HelpCommand = glmcdHCContext
  590.             dwCmdDialog.HelpContext = Val(HelpContextNumberText.Text)
  591.         Else
  592.             dwCmdDialog.HelpCommand = glmcdHCKey
  593.             dwCmdDialog.HelpKey = HelpKeyText.Text
  594.         End If
  595.     End If
  596. End Sub
  597. Private Sub GetDialogResults(dwCmdDialog As dwFileOpenSave)
  598. Dim findex As Long, fcount As Long
  599. Dim fname As String
  600.     ' A file was selected
  601.     If dwCmdDialog.FileCount > 1 Then
  602.         fcount = dwCmdDialog.FileCount
  603.         For findex = 1 To fcount Step 1
  604.             fname = fname & dwCmdDialog.FileNameByIndex(findex) & " "
  605.         Next
  606.         FileSelectedText.Text = fname
  607.     Else
  608.         FileSelectedText.Text = dwCmdDialog.FileTitle
  609.     End If
  610.     PathText.Text = dwCmdDialog.FilePath
  611. End Sub
  612.