vbAccelerator - Contents of code file: frmClipboardRing.frmVERSION 5.00
Begin VB.Form frmDocument
ClientHeight = 6375
ClientLeft = 3360
ClientTop = 4980
ClientWidth = 6585
ControlBox = 0 'False
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmClipboardRing.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6375
ScaleWidth = 6585
WindowState = 2 'Maximized
Begin VB.TextBox txtEditor
Height = 7875
HideSelection = 0 'False
Left = 2760
MultiLine = -1 'True
OLEDropMode = 1 'Manual
ScrollBars = 3 'Both
TabIndex = 0
Text = "frmClipboardRing.frx":1272
Top = 180
Width = 3375
End
End
Attribute VB_Name = "frmDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_sFileName As String
Private Function FileExists(ByVal sFile As String) As Boolean
On Error Resume Next
Dim sDir As String
sDir = Dir(sFile)
FileExists = (Len(sDir) > 0 And Err.Number = 0)
On Error GoTo 0
End Function
Public Function Save() As Boolean
If Not (FileExists(m_sFileName)) Then
Save = SaveAs()
Else
' Save
On Error Resume Next
Kill m_sFileName
On Error GoTo saveError
Dim iFile As Integer
iFile = FreeFile
Open m_sFileName For Binary Access Write Lock Read As #iFile
Put #iFile, , txtEditor.Text
Close #iFile
Save = True
End If
Exit Function
saveError:
Dim lErr As Long, sErr As String
lErr = Err.Number
sErr = Err.Description
On Error Resume Next
Close #iFile
On Error GoTo 0
Err.Raise lErr, App.EXEName & ".frmDocument", sErr
Save = False
Exit Function
End Function
Public Function SaveAs() As String
Dim c As New cCommonDialog
Dim sFile As String
If (c.VBGetSaveFileName(sFile, , , "Text Files (*.txt)|*.txt|All Files
(*.*)|*.*", , , , "TXT", Me.hwnd)) Then
Dim sT As String
sT = m_sFileName
m_sFileName = sT
If Not (Save()) Then
m_sFileName = sT
End If
End If
End Function
Public Property Let FilePath(ByVal sName As String)
m_sFileName = sName
End Property
Public Property Get FilePath() As String
FilePath = m_sFileName
End Property
Public Function OpenFile(ByVal sFile As String) As Boolean
On Error GoTo openError
If Len(sFile) = 0 Then
Dim c As New cCommonDialog
If Not (c.VBGetOpenFileName(sFile, , , , , , "Text Files
(*.txt)|*.txt|All Files (*.*)|*.*", , , , "TXT", mfrmMain.hwnd)) Then
Exit Function
End If
End If
Dim iFile As Integer
iFile = FreeFile
Open sFile For Binary Access Read Lock Write As #iFile
Dim sBuf As String
sBuf = String(LOF(iFile), 32)
Get #iFile, , sBuf
txtEditor.Text = sBuf
Close #iFile
m_sFileName = sFile
Me.Caption = Filename
OpenFile = True
Exit Function
openError:
Dim lErr As Long, sErr As String
lErr = Err.Number
sErr = Err.Description
On Error Resume Next
Close #iFile
On Error GoTo 0
Err.Raise lErr, App.EXEName & ".frmDocument", Err.Description
Exit Function
End Function
Public Sub AddText(ByVal sText As String)
txtEditor.SelText = sText
End Sub
Private Property Get Filename() As String
Dim iPos As Long
Dim iNextPos As Long
iPos = 1
iNextPos = 1
Do
iNextPos = InStr(iPos, m_sFileName, "\")
If (iNextPos > 0) Then
iPos = iNextPos + 1
End If
Loop While iNextPos > 0
Filename = Mid(m_sFileName, iPos)
End Property
Private Sub Form_Load()
Me.Caption = Filename()
End Sub
Private Sub Form_OLECompleteDrag(Effect As Long)
mfrmMain.tabTools.Shown = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
txtEditor.Move 2 * Screen.TwipsPerPixelX, 2 * Screen.TwipsPerPixelY,
Me.ScaleWidth - 4 * Screen.TwipsPerPixelX, Me.ScaleHeight - 4 *
Screen.TwipsPerPixelY
End Sub
Private Sub txtEditor_OLEDragDrop(Data As DataObject, Effect As Long, Button As
Integer, Shift As Integer, x As Single, y As Single)
If (Data.GetFormat(vbCFText)) Then
txtEditor.SelText = Data.GetData(vbCFText)
mfrmMain.tabTools.Shown = False
txtEditor.SetFocus
End If
End Sub
Private Sub txtEditor_OLEDragOver(Data As DataObject, Effect As Long, Button As
Integer, Shift As Integer, x As Single, y As Single, State As Integer)
If (Data.GetFormat(vbCFText)) Then
Effect = vbDropEffectCopy
If (mfrmMain.tabTools.Shown) Then
mfrmMain.tabTools.Shown = False
End If
End If
End Sub
|
|