Problem while dragging a transparent RichTextBox

I've created a transparent RTB and dragging it using Rhino's WM_NCLBUTTONDOWN code. The form has a picture.

But the problem is, when I try to drag the transparent RTB (Ctrl+LeftClick on the RTB and drag), the background doesn't get updated.

I tried to subclass the RTB for WM_MOVING / WM_WINDOWPOSCHANGING and SendMessage-ed WM_NCPAINT,WM_ERASEBKGND, WM_PAINT. But that didn't work.

I tried RedrawWindow, but that didn't work either.

Only, if I hide the RTB and show it again - that works (Command1_Click).

Any idea how to update the background while moving ?

Thanks in advance ! :)

PS. I don't want to use DrawFocusRect or similar method to show a blank rectangle while dragging. I would like to show full contents of the rtb while dragging.

Code:

---

' Add a CommandButton and a RichTextBox in your form
Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TRANSPARENT = &H20&
'
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Sub Command1_Click()

    ' Backgrund updates only if you click this button
    RichTextBox1.Visible = False
    RichTextBox1.Visible = True

End Sub

Private Sub Form_Load()

    With RichTextBox1
        .Text = ""
        .SelColor = vbWhite
        .SelBold = True
        .SelText = "press Ctrl+LeftClick to drag"
    End With

    ' Make RichTextBox transparent -->
    ' If you run this code after the RTB becomes visible, you'll need to call Command1_Click
    SetWindowLong RichTextBox1.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
    '
    Me.Picture = LoadPicture("C:\WINDOWS\Web\Wallpaper\Wind.jpg")

End Sub

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)

    If Shift And vbCtrlMask Then
        RichTextBox1.MousePointer = rtfSizeAll
    End If

End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)

    If Not (Shift And vbCtrlMask) Then
        RichTextBox1.MousePointer = rtfDefault
    End If

End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
    ' Press Ctrl and LeftClick to drag
    If (Button = vbLeftButton) And (Shift And vbCtrlMask) Then
        ReleaseCapture
        SendMessageLong RichTextBox1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
        RichTextBox1.MousePointer = rtfDefault
    End If

End Sub

---

RTB.Refresh will cause the RTB to update the background (rather than hiding/showing it).

Don't bother using WM_NCLBUTTONDOWN - just handle the dragging yourself (it's about the same amount of code) and then you can refresh the RTB as you see fit.

I actually bothered to test what I said above - i also needed to refresh the form:

Code:

---

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TRANSPARENT = &H20&

Private sX As Single, sY As Single
Private bDrag As Boolean

Private Sub Form_Load()
    SetWindowLong RichTextBox1.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        sX = X: sY = Y
        bDrag = True
    End If
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sDiffX As Single, sDiffY As Single
    If bDrag Then
        sDiffX = sX - X
        sDiffY = sY - Y
        If CBool(sDiffX) Or CBool(sDiffY) Then
            RichTextBox1.Move RichTextBox1.Left - sDiffX, RichTextBox1.Top - sDiffY
            Me.Refresh
            RichTextBox1.Refresh
        End If
    End If
End Sub

Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bDrag = False
End Sub

---

just click-drag rather then ctrl-click-drag

not perfect - bit of tearing if you move the rtb too fast - but not bad for the minimal amount of code :)

Thanks bush ! :thumb:
I tried RTB.Refresh (only) and your above code with Me.Refresh.
I noticed, in both cases, if part of RTB is behind top or left border, it draws the backgroung correctly. But it flickers horribly though. I hope this will give you some pointer that I can't notice.

My final goal is to place the RTB on desktop. I'm making a transparent 'StickyNotes' that is bottommost window. (WM_NCLBUTTONDOWN is easy in this case. Saves you ClientToScreen or vice versa calculations. I'm lazy. :p)
(I said 'on a form' in my first post, 'cause I thought it would be easier to try it in a normal form first.)

Here is the alternate code I was working on. (not enough comment and buggy code. Sorry for that.)

On Form_Load I'm placing the RTB on desktop, when user clicks on the RTB, I'm placing it back on the form so that the user can move it with the titlebar.
On WM_ACTIVATE(wparam=false), I'm placing it back on desktop.

(The 5 sec timer is needed, 'cause whenever desktop refreshes, the rtb becomes blank. I think I can solve this problem later by hooking into desktop for WM_PAINT etc.)

But, I'm not happy with it. I need a way to flickerlessly move the rtb on desktop without the form.

Form code

Code:

---

' Add a RTB and a Timer in the form
Option Explicit

' Center the form taking the task bar into account.
Private Sub PositionForm(ByVal frm As Form)

    Dim wa_info As RECT
    Dim wa_wid As Single
    Dim wa_hgt As Single
    Dim wa_left As Single
    Dim wa_top As Single

    If SystemParametersInfo(SPI_GETWORKAREA, 0, wa_info, 0) <> 0 Then
        ' We got the work area bounds.
        ' Center the form in the work area.
        wa_wid = ScaleX(wa_info.Right, vbPixels, vbTwips)
        wa_hgt = ScaleY(wa_info.Bottom, vbPixels, vbTwips)
        wa_left = ScaleX(wa_info.Left, vbPixels, vbTwips)
        wa_top = ScaleY(wa_info.Top, vbPixels, vbTwips)
    Else
        ' We did not get the work area bounds.
        ' Center the form on the whole screen.
        wa_wid = Screen.Width
        wa_hgt = Screen.Height
    End If

    ' Center the form.
    frm.Move (wa_wid - Width + wa_left), (wa_hgt - Height + wa_top)

End Sub

Private Sub Form_Activate()

    SetToDesktop Me.hwnd

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyEscape Then 'escape to exit
        If MsgBox("Do you want to exit ?", vbYesNo Or vbDefaultButton2, "Exit ?") = vbYes Then
            Unload Me
            Exit Sub
        End If
    End If

End Sub

Private Sub Form_Load()

    Form1.Left = Form1.Left - Screen.Width
    SetWindowLong RichTextBox1.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
    Me.BackColor = vbBlack

    With RichTextBox1
        .BackColor = vbBlack

        If Dir$(App.Path & "\Notes.rtf") <> "" Then
            .LoadFile App.Path & "\Notes.rtf", rtfRTF
        Else
            .Text = ""
            .SelColor = &HC0E0FF
            .SelFontName = "Times New Roman"
            .SelFontSize = 12
        End If

    End With

    MakeFormStickey
    '  pOldWindPocRTB = SetWindowLong(RichTextBox1.hwnd, GWL_WNDPROC, AddressOf WndProcRTB)
    PositionForm Me

End Sub

Private Sub Form_Resize()

    On Error Resume Next

    'On Error Resume Next
    If Me.Width < 1000 Then Me.Width = 1000
    If Me.Height < 1000 Then Me.Height = 1000
    RichTextBox1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight

End Sub

Private Sub Form_Unload(Cancel As Integer)

    MakeFormUnStickey

    '  SetWindowLong RichTextBox1.hwnd, GWL_WNDPROC, pOldWindPocRTB
End Sub

Private Sub RichTextBox1_Click()

    If GetParent(RichTextBox1.hwnd) <> Me.hwnd Then
        ' Change parent back to Form
        Dim rt As RECT
        GetWindowRect RichTextBox1.hwnd, rt
        Me.BorderStyle = vbBSNone
        Me.Caption = Me.Caption
        Me.Move rt.Left * Screen.TwipsPerPixelX, rt.Top * Screen.TwipsPerPixelY
        Me.BorderStyle = 2
        Me.Caption = Me.Caption
        SetParent RichTextBox1.hwnd, Me.hwnd
        RichTextBox1.Move 0, 0
        SetForegroundWindow Me.hwnd
    End If

End Sub

Private Sub MakeFormStickey()

    pOldWindPocForm = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProcForm)

End Sub

Private Sub MakeFormUnStickey()

    SetWindowLong Me.hwnd, GWL_WNDPROC, pOldWindPocForm

End Sub
 
Private Sub Timer1_Timer()

    With RichTextBox1
'        .Visible = False
'        .Visible = True
        .Refresh
    End With
End Sub

---

Module Code

Code:

---

Option Explicit
'
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As RECT, ByVal fuWinIni As Long) As Long
Public 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
Public Declare Function ClientToScreen Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Public Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As WINDOWPOS) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long
'
Public Const SWP_SHOWWINDOW = &H40
Public Const WM_ACTIVATE As Long = &H6
Public Const GWL_WNDPROC& = (-4)
Public Const SPI_GETWORKAREA = 48
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
'
Public Type POINTAPI

    x As Long
    y As Long
End Type
'
Public Type RECT

    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'
Public Type WINDOWPOS

    hwnd As Long
    hWndInsertAfter As Long
    x As Long
    y As Long
    cx As Long
    cy As Long
    flags As Long
End Type
'
Public ProgMan&
Public shellDllDefView&
Public InternetExplorerServer&
'
Public pOldWindPocForm As Long
'
Public Function WndProcForm(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As WINDOWPOS) As Long

    If (uMsg = WM_ACTIVATE) Then

        'Check to see if Activating the application
        If wParam = 0 Then
            'Application Lost Focus
            Form1.Caption = "Focus Lost"

            With Form1.RichTextBox1
                ' place the RTB on desktop
                Dim rt As RECT
                GetWindowRect .hwnd, rt
                Dim pt As POINTAPI
                ClientToScreen Form1.RichTextBox1.hwnd, pt
                SetWindowPos .hwnd, 0&, pt.x, pt.y, Form1.RichTextBox1.Width / Screen.TwipsPerPixelX, Form1.RichTextBox1.Height / Screen.TwipsPerPixelY, SWP_SHOWWINDOW
                SetToDesktop .hwnd
                Form1.Timer1.Enabled = True
            End With

            Form1.Move -1 * Form1.Width, -1 * Form1.Height
        End If
    End If

    WndProcForm = CallWindowProc(pOldWindPocForm, hwnd, uMsg, wParam, lParam)

End Function
 
Public Sub SetToDesktop(hwnd As Long)

    Dim hParent As Long
    '
    ProgMan& = FindWindow("Progman", vbNullString)
    shellDllDefView& = FindWindowEx(ProgMan&, 0&, "SHELLDLL_DefView", vbNullString)
    InternetExplorerServer& = FindWindowEx(shellDllDefView&, 0&, "Internet Explorer_Server", vbNullString)

    If InternetExplorerServer Then 'set behind icons
        If hParent <> InternetExplorerServer Then
            SetParent hwnd, InternetExplorerServer
            hParent = InternetExplorerServer
        End If

    ElseIf ProgMan Then 'set bottommost

        If hParent <> ProgMan Then
            SetParent hwnd, ProgMan
            hParent = ProgMan
        End If

    Else

        If hParent <> 0 Then
            SetParent hwnd, GetDesktopWindow
            hParent = 0
        End If
    End If

End Sub

---

pscode.com has many VB "sticky notes" samples, maybe you can take some ideas from there.

From screenshots none of them looks like 'trasparent'.
Did you run my previous code ?

Transparency - Done
Always-at-bottom - Done (thanks to bushmobile and others for posting in one of my old thread)
Sticky - Done (you can't move the RTB once it is SetParent to desktop. / or subclass for WM_MOVIEN/WM_WINDOWPOSCHANGING)

Only problem is, if you try to move the RTB (see post#1), the background doesn't get updated.

Edit: OK. This one does.
But it is directly 'drawing' text on the form - making it uneditable. I'll try if I can use regioning on RTB.

Hi guys ! Here is latest update: (code attatched)

Modified this code for regioning.

This is how I've done it:

1. Place the transparent RTB on a picturebox container.
2. Make the full client area of the form transparent.
3. Get (BitBlt) screensout of the area that will go behind the picturebox.
4. Set the bitbelted picture on the picbox container. The RTB will draw the background correctly.
5. Again make the full client area (EXCEPT the area behind the picturebox) of the form transparent.

The problems are:
1. Flickers a lot.
2. Sometimes it draws the wallpaper correctly, but misses to draw a few icons.
3. Problem drawing the RTB scrollbars.
4. Must be activated atleast once.
5. Not sure how-to apply WM_WINDOWPOSCHANGING/WM_WINDOWPOSCHANGE. Without any check for RECT, it goes into infinite loop and crashes.

http://img339.imageshack.us/img339/8...kynotesej8.jpg

Old post I know but this looks very interesting and useful for me right now.

Did you get anywhere further with this?

Regards,

Matt.

Nope. :(