While i'm looking at my old files and the clipboard stuff, you (or
others) may enjoy this little thing. It let's you browse and copy text
as you go, no need to go between notepad and sites. It just collates
all your copies into a file. Only text though.
Just highlight any text anywhere right click and copy, next you'll see
it in the grabber. If you don't like it.. well, tough. :)
Form requires a CommonDialog control (cmd1), an imagelist (default
name), a RichtextBox(rtb) and a timer.
The imagelist contains two icons. I used the "light globe on" and
"light globe off" icons from the common graphics folder, but it's just
an indicator really. Timer is set to a reasonable timeout, in my case
2000 milliseconds was adequate, i'm nt that fast with copying.. :)
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As
Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long,
ByVal cx As Long, ByVal cy As Long, ByVal wFlags_ As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOACTIVATE = &H10
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const IMP_SWAP = SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_NOMOVE
Dim brkLine As String
Dim isChanged As Boolean
Dim szBuff As String
Private Sub Form_Load()
brkLine = String(40, "-")
'may need the ClpBrd contents already, so lets ask.
If MsgBox("Ok to clear clipboard ?", vbYesNo, App.Title) = vbYes
Then Clipboard.Clear
'set to a truetype font at a reasonable size
Caption = App.Title & " " & App.Major & "." & App.Minor
rtb.Font = "Times New Roman"
rtb.Font.Size = 9
rtb.Top = 20
rtb.Left = 20
Me.Left = 0
Me.Top = 0
Me.Width = Screen.Width / 4
Me.Height = Screen.Height / 3
' set snoop and always ontop
mnFile_Click 0
mnFile_Click 1
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim s As String
Dim xFlag As Boolean
Select Case UnloadMode
Case 0, 1: s = "Exiting (USER REQUEST)"
Case 2, 3: s = "Exiting (FORCED REQUEST)"
Case Else: s = "Exiting (UNKNOWN REASON)"
End Select
MUST_EXIT:
If isChanged = True Then
If MsgBox("Discard last changes ?", vbYesNo, s) = vbNo Then
If UnloadMode < 2 Then
Cancel = True 'senile user :)
Else 'this is not a drill.
If xFlag <> True Then
s = "Suggested to Save and EXIT !"
xFlag = True
GoTo MUST_EXIT 'try a bit more logic
Else
Cancel = True 'we've tried,just succumb to it
End If
End If
End If
End If
End Sub
Private Sub Form_Resize()
Static inResize As Boolean
If inResize = True Then Exit Sub
If Me.WindowState = vbMinimized Then Exit Sub
inResize = True
rtb.Width = Width - 250
rtb.Height = Height - (TextHeight("Z") * 3)
inResize = False
End Sub
Private Sub mnFile_Click(Index As Integer)
Dim fNo As Integer
Dim s As String
Select Case Index
Case Is = 0: 'always on top ?
mnFile(0).Checked = Not mnFile(0).Checked
SetWindowPos hwnd, HWND_NOTOPMOST +
IIf(mnFile(0).Checked, 1, 0), 0, 0, 0, 0, IMP_SWAP
Case Is = 1: 'Set snoop mode.. switch timer on/off really.
mnFile(1).Checked = Not mnFile(1).Checked
Timer1.Enabled = mnFile(1).Checked
rtb.AutoVerbMenu = Not mnFile(1).Checked 'disable
if timer is on.
If mnFile(1).Checked = True Then
Icon = ImageList1.ListImages(1).Picture
Else
Icon = ImageList1.ListImages(2).Picture
End If
Case Is = 3: 'save contents
CMD1.CancelError = True
CMD1.DialogTitle = "Save file as.."
CMD1.InitDir = "desktop"
On Error GoTo NO_SAVE
CMD1.ShowSave
If Dir(CMD1.FileName) <> "" Then 'make sure we do
the right thing.
Select Case (MsgBox("Append to file ?",
vbYesNoCancel, "File exists!"))
Case Is = vbCancel: GoTo NO_SAVE
Case Is = vbNo: ' ok, are we sure ?
If MsgBox("Ok to overwrite
?", vbYesNo, "O/Write " & CMD1.FileTitle) = vbNo Then GoTo NO_SAVE
Kill CMD1.FileName 'yep, so
kill the old file.
End Select
End If
'rtEd has a savefile, but afaik, no append option.
fNo = FreeFile
Open CMD1.FileName For Append As fNo
Print #fNo, rtb
Close
isChanged = False
Caption = App.Title & "(" & CMD1.FileTitle & ")"
NO_SAVE:
On Error GoTo 0
Case Is = 4: 'load a file
If isChanged = True Then
If MsgBox("Discard changes ?", vbYesNo, "Load
file") = vbNo Then GoTo NO_LOAD
End If
CMD1.CancelError = True
CMD1.DialogTitle = "Load a file"
CMD1.Filter = "Text Files|*.txt|All Files|*.*"
CMD1.FilterIndex = 0
On Error GoTo NO_LOAD
CMD1.ShowOpen
rtb.Visible = False 'hide the box to improve
performance
rtb.Text = ""
MousePointer = vbHourglass 'plonk this on, in case
of a big file.
Timer1.Enabled = False
rtb.LoadFile CMD1.FileName, rtfText 'load as text
NO_LOAD:
If Err Then MsgBox ("Load error : " & Err.Number)
MousePointer = vbDefault
isChanged = False
rtb.Visible = True
If mnFile(1).Checked = True Then Timer1.Enabled =
True
On Error GoTo 0
Case Is = 5: ' clear
rtb.Text = ""
Case Is = 7:
Unload Me
End Select
End Sub
Private Sub rtb_Change()
isChanged = True
End Sub
Private Sub Timer1_Timer()
If (Clipboard.GetFormat(vbCFText) = True) Then
rtb.Text = rtb.Text & vbCrLf & brkLine & vbCrLf
rtb.Text = rtb.Text & Clipboard.GetText
isChanged = True
Clipboard.Clear
End If
End Sub
--
Regards, Frank