Hey Mike ! 
Author Message
 Hey Mike !

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



Fri, 29 Jul 2005 22:39:31 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Hey Hey

2. Access 97 Developer's Handbook, Ken Getz, Paul Litwin, Mike Gilbert

3. Attachment save automatic: for Mike Blake-Knox

4. ABC Home Page Thanks to Mike Beckman

5. Mike wants HELP

6. Another imaging question (Mike Williams?) :-)

7. Attention Mike (maureen)

8. Happy birthday to Mike W.

9. Mike - Ref: Printer dialog and NT

10. Mike Williams

11. ATTN: Mike Formatting a text box for printing(Updated)

12. New question Mike (Maureen) : still about picturebox!!

 

 
Powered by phpBB® Forum Software