COLORIZE frame border , possible? 1

[sal21]

COLORIZE frame border , possible?

 

[OzFoxy]

Is this what you mean?

 

[sal21]

Is this in VB 6.0?

 

[strongm]

No, for some reason you've been provided with an Access solution.

Ok, so ... the VB6 Frame control does not expose any sort of frame border colour property. Nor is there a convenient Windows message we can use. here's a couple of relatively simple solutions (the second is slightly more complex, but also slightly more resilient). I'd explain what they are doing, but you don't ever seem to care much for that sort of thing. Both ideas require a form with a frame and a label

Private Sub Form_Load()
    Dim oldmode As Long
    
    oldmode = Form1.ScaleMode
    Form1.ScaleMode = vbPixels
    Label1.BackStyle = 1 'opaque
    Label1.BackColor = vbRed
    Label1.BorderStyle = 0 ' None
    Label1.Move Frame1.Left - 1, Frame1.Top - 1, Frame1.Width + 2, Frame1.Height + 2
    Label1.ZOrder 0 ' Send to back
    Form1.ScaleMode = oldmode
End Sub

And the second one

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long


Private Sub DrawFrameBorder()
    Dim oldcolor As Long
    Dim oldmode As Long
    Dim hdc As Long
    
    oldmode = Form1.ScaleMode
    oldcolour = Form1.ForeColor


    hdc = GetDC(Me.hwnd) ' Get device context
    Form1.ForeColor = vbRed
    Rectangle hdc, Frame1.Left - 1, Frame1.Top - 1, Frame1.Left + Frame1.Width + 2, Frame1.Top + Frame1.Height + 3
    ReleaseDC Me.hwnd, hdc ' Release device context
    Form1.ForeColor = oldcolour
    Form1.ScaleMode = oldmode
End Sub


Private Sub Form_Paint()
    DrawFrameBorder
End Sub

 

[sal21]

Hi bro. tks for code.
But i see the red border is out of frame.
See image.

 

[strongm]

>the red border is out of frame
Well ... sort of. Both solutions work by in essence drawing a border around the entire frame - a frame border (but yes, outside the frame, since the frame overpaints itself a lot which would erase anything you drew on the frame using either of these two methods. But drawing on the frame itself and retaining that drawing is harder, since the frame has a habit of repainting itself (thus erasing anything you might have drawn) at the drop of a hat. So a potential solution is somewhat harder and more complex. Again, I lack the will to explain the details, butt here's an example. be warned, we are hooking the frame's message loop, which if you mess it up will almost certainly crash you program and VB

You will need a form with a frame (no label required for this one). The following code goes into the form:

Option Explicit

Private Sub Form_Load()
    HookFrame
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookFrame
End Sub

Complex ...

But here's where the real work gets done. This code goes into a standard module

Option Explicit

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As rect, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As rect) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long


Private Type rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const GWL_WNDPROC As Long = -4
Private Const WM_PAINT As Long = &HF

Dim OldWndProc As Long

' Subclass procedure for Frame control
Function FrameWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim result As Long
    
    result = CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam)
    If Msg = WM_PAINT Then
        Dim hDC As Long, rect As rect, hBrush As Long

        hDC = GetDC(hWnd)
        If hDC <> 0 Then
            ' Get Frame dimensions
            ' this is where you can modify the size/position of the rectangle that will be drawn in the frame
            GetWindowRect hWnd, rect
            rect.Right = rect.Right - rect.Left
            rect.Bottom = rect.Bottom - rect.Top
            rect.Left = 0
            rect.Top = 0

            ' Create a custom border brush (change color here)
            hBrush = CreateSolidBrush(RGB(255, 0, 0)) ' Red border

            ' Draw the custom border
            FrameRect hDC, rect, hBrush

            ' Clean up
            DeleteObject hBrush
            ReleaseDC hWnd, hDC
        End If
    End If

    ' return result from default repaint
    FrameWndProc = result
End Function

' Hook the Frame control
Public Sub HookFrame()
    OldWndProc = GetWindowLong(Form1.Frame1.hWnd, GWL_WNDPROC)
    SetWindowLong Form1.Frame1.hWnd, GWL_WNDPROC, AddressOf FrameWndProc
End Sub

' Unhook on form unload to prevent crashes
Public Sub UnhookFrame()
    If OldWndProc <> 0 Then
        SetWindowLong Form1.Frame1.hWnd, GWL_WNDPROC, OldWndProc
    End If
End Sub

Just a note in case it is not apparent - we are NOT colorizing any existing border (frame controls do not expose this capability), we are drawing our own separate, custom border - so if you want to do additional stuff with that border (e.g. make space for some text) you'll have to do it yourself.

 

[sal21]

great code bro!