vbAccelerator - Contents of code file: frmCDlgSample.frm
VERSION 5.00
Begin VB.Form frmCDlgSample
Caption = "vbAccelerator Common Dialog sample"
ClientHeight = 2790
ClientLeft = 5070
ClientTop = 2550
ClientWidth = 5145
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmCDlgSample.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2790
ScaleWidth = 5145
Begin VB.Frame fraSep
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 75
Left = -780
TabIndex = 2
Top = -45
Width = 5895
End
Begin VB.TextBox txtDoc
Height = 1935
Left = 60
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 780
Width = 5055
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "vbAccelerator minimum code single executable
CommonDialog sample."
Height = 435
Left = 660
TabIndex = 1
Top = 180
Width = 4335
End
Begin VB.Image imgIcon
Height = 480
Left = 60
Picture = "frmCDlgSample.frx":1272
Top = 120
Width = 480
End
Begin VB.Shape Shape1
BorderColor = &H00C0C000&
BorderWidth = 8
Height = 375
Left = 540
Top = 300
Width = 435
End
Begin VB.Menu mnuFileTOP
Caption = "&File"
Begin VB.Menu mnuFile
Caption = "&Open..."
Index = 0
Shortcut = ^O
End
Begin VB.Menu mnuFile
Caption = "&Save..."
Index = 1
Shortcut = ^S
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 2
End
Begin VB.Menu mnuFile
Caption = "E&xit"
Index = 3
End
End
End
Attribute VB_Name = "frmCDlgSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Function ReadFileText(ByVal sFile As String) As String
On Error GoTo ErrorHandler
Dim iFile As Integer
Dim sBuf As String
iFile = FreeFile
Open sFile For Binary Access Read Lock Write As #iFile
sBuf = Space$(LOF(iFile))
Get #iFile, , sBuf
Close #iFile
ReadFileText = sBuf
Exit Function
ErrorHandler:
MsgBox "An error occurred trying to read '" & sFile & "'" & vbCrLf & "[" &
Err.Number & "] :" & Err.Description
Close #iFile
Exit Function
End Function
Private Sub WriteFileText(ByVal sFile As String, ByVal sText As String)
On Error GoTo ErrorHandler
Dim iFile As Integer
iFile = FreeFile
Open sFile For Binary Access Write Lock Read As #iFile
Put #iFile, , sText
Close #iFile
Exit Sub
ErrorHandler:
MsgBox "An error occurred trying to read '" & sFile & "'" & vbCrLf & "[" &
Err.Number & "] :" & Err.Description
Close #iFile
Exit Sub
End Sub
Private Sub Form_Resize()
On Error Resume Next
fraSep.Move -6 * Screen.TwipsPerPixelX, -3 * Screen.TwipsPerPixelY,
Me.ScaleWidth + 12 * Screen.TwipsPerPixelX
txtDoc.Move txtDoc.Left, txtDoc.TOp, Me.ScaleWidth - txtDoc.Left * 2,
Me.ScaleHeight - txtDoc.TOp - 2 * Screen.TwipsPerPixelY
End Sub
Private Sub mnuFile_Click(Index As Integer)
Dim cc As cCommonDialog
Dim sFile As String
Select Case Index
Case 0
Set cc = New cCommonDialog
If cc.VBGetOpenFileName(sFile, , , , , , "Text Files (*.txt)|*.txt|All
Files (*.*)|*.*", , , , "TXT", Me.hWnd, OFN_HIDEREADONLY) Then
txtDoc.Text = ReadFileText(sFile)
End If
Case 1
Set cc = New cCommonDialog
If cc.VBGetSaveFileName(sFile, , , "Text Files (*.txt)|*.txt|All Files
(*.*)|*.*", , , , "TXT", Me.hWnd) Then
WriteFileText sFile, txtDoc.Text
End If
Case 3
Unload Me
End Select
End Sub
|
|