LuckyPhill
asked on
Painting Splitter Bars
How do i paint a splitter bar exactly (or as close as possible) as the VB6 IDE does it?
at the moment my splitter bar code renders like a non filled rectangle... yurrrk amateurish!!
Here is the code i have at the moment... (minus the api decls) the SetROP2 hdc, R2_NOTXORPEN doesnt seem to like the fillrect call... groan...
' Get the Desktop DC:
hdc = CreateDCAsNull("DISPLAY", 0, 0, 0)
' Create a brush
h = CreateHatchBrush(HS_BDIAGO NAL, RGB(240, 240, 240))
' Create a pen
p = CreatePen(1, 1, RGB(240, 240, 240))
' load em in
SelectObject hdc, h
SelectObject hdc, p
' Set to XOR drawing mode:
SetROP2 hdc, R2_NOTXORPEN
' do the fill rectangle call (doesnt seem to work
' with R2_NOTXORPEN???)
FillRect hdc, rcCurrent, h
' release the resources.
DeleteObject h
DeleteObject p
DeleteDC hdc
at the moment my splitter bar code renders like a non filled rectangle... yurrrk amateurish!!
Here is the code i have at the moment... (minus the api decls) the SetROP2 hdc, R2_NOTXORPEN doesnt seem to like the fillrect call... groan...
' Get the Desktop DC:
hdc = CreateDCAsNull("DISPLAY", 0, 0, 0)
' Create a brush
h = CreateHatchBrush(HS_BDIAGO
' Create a pen
p = CreatePen(1, 1, RGB(240, 240, 240))
' load em in
SelectObject hdc, h
SelectObject hdc, p
' Set to XOR drawing mode:
SetROP2 hdc, R2_NOTXORPEN
' do the fill rectangle call (doesnt seem to work
' with R2_NOTXORPEN???)
FillRect hdc, rcCurrent, h
' release the resources.
DeleteObject h
DeleteObject p
DeleteDC hdc
an easy splitter: a form and a picturebox
Dim OffsetY As Single
Private Sub Form_Load()
Picture1.Appearance = 0
Picture1.BackColor = vbBlack
Picture1.Height = 4 * Screen.TwipsPerPixelY
Picture1.MousePointer = vbSizeNS
Picture1.ZOrder
End Sub
Private Sub Form_Resize()
Picture1.Move Me.ScaleWidth - 15 * Screen.TwipsPerPixelX, Picture1.Top
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
OffsetY = Y
Picture1.Move 0, Picture1.Top, Me.ScaleWidth
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
Picture1.Top = Picture1.Top + Y - OffsetY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
Picture1.Move Me.ScaleWidth - 15 * Screen.TwipsPerPixelX, Picture1.Top
End If
End Sub
Dim OffsetY As Single
Private Sub Form_Load()
Picture1.Appearance = 0
Picture1.BackColor = vbBlack
Picture1.Height = 4 * Screen.TwipsPerPixelY
Picture1.MousePointer = vbSizeNS
Picture1.ZOrder
End Sub
Private Sub Form_Resize()
Picture1.Move Me.ScaleWidth - 15 * Screen.TwipsPerPixelX, Picture1.Top
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
OffsetY = Y
Picture1.Move 0, Picture1.Top, Me.ScaleWidth
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
Picture1.Top = Picture1.Top + Y - OffsetY
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbLeftButton Then
Picture1.Move Me.ScaleWidth - 15 * Screen.TwipsPerPixelX, Picture1.Top
End If
End Sub
ASKER
Sorry guys maybe I should rephrase the question... :)
...here goes...
Hold down the left mouse button on a splitter point in the VB6 IDE (eg: between the window area and the property page area) move your mouse until the splitter is visible against some white background.
How do I render the splitter graphic using API calls and XOR pixel rendering?
Thanks..!
...here goes...
Hold down the left mouse button on a splitter point in the VB6 IDE (eg: between the window area and the property page area) move your mouse until the splitter is visible against some white background.
How do I render the splitter graphic using API calls and XOR pixel rendering?
Thanks..!
ASKER
Well I solved it myself...
This is the answer I was looking for...
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private m_lPattern(0 To 3) As Long
Private m_hBm As Long
Private Sub Class_Initialize()
Dim i As integer
For i = 0 To 3
m_lPattern(i) = &HAAAA5555
Next i
Dim tbm As BITMAP
' Create a monochrome bitmap containing the desired pattern:
tbm.bmType = 0
tbm.bmWidth = 16
tbm.bmHeight = 8
tbm.bmWidthBytes = 2
tbm.bmPlanes = 1
tbm.bmBitsPixel = 1
tbm.bmBits = VarPtr(m_lPattern(0))
m_hBm = CreateBitmapIndirect(tbm)
End Sub
Private Sub DrawGraphics(rc As RECT)
Dim hdc As Long, h As Long, p As Long
hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
' Make a brush from the bitmap bits
h = CreatePatternBrush(m_hBm)
SelectObject hdc, h
PatBlt hdc, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, PATINVERT
DeleteObject h
End Sub
This is the answer I was looking for...
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private m_lPattern(0 To 3) As Long
Private m_hBm As Long
Private Sub Class_Initialize()
Dim i As integer
For i = 0 To 3
m_lPattern(i) = &HAAAA5555
Next i
Dim tbm As BITMAP
' Create a monochrome bitmap containing the desired pattern:
tbm.bmType = 0
tbm.bmWidth = 16
tbm.bmHeight = 8
tbm.bmWidthBytes = 2
tbm.bmPlanes = 1
tbm.bmBitsPixel = 1
tbm.bmBits = VarPtr(m_lPattern(0))
m_hBm = CreateBitmapIndirect(tbm)
End Sub
Private Sub DrawGraphics(rc As RECT)
Dim hdc As Long, h As Long, p As Long
hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
' Make a brush from the bitmap bits
h = CreatePatternBrush(m_hBm)
SelectObject hdc, h
PatBlt hdc, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, PATINVERT
DeleteObject h
End Sub
ASKER
Solved it myself,
see my previous comment posted...
I'll try to be more specific with my questions in future.
LuckyPhill
see my previous comment posted...
I'll try to be more specific with my questions in future.
LuckyPhill
Hi Phill
why do you delete this question it contains valuable info
ask com.sup. to reduce its points to 0 and move it to the PAQ
why do you delete this question it contains valuable info
ask com.sup. to reduce its points to 0 and move it to the PAQ
ASKER
ok thanks! how do I do that?
ASKER
pierrecampe done that, good idea...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Tech Ed, hopefully someone else will find the info usefull
LuckyPhill
LuckyPhill
here are a few examples how to do this, full source code to the ones you download.
http://www.planetsourcecode.com/xq/ASP/txtCodeId.21763/lngWId.1/qx/vb/scripts/ShowCode.htm
Splitter Control is a Windows Explorer style splitter. To use it, add controls to it the same way you do for a frame, and set the Child1 and/or Child2 properties to the names of the added controls
http://ad-adex3.flycast.com/server/iframe/PlanetSourceCode/11483814_PlanetSourceCode/;referrer=ads.exhedra.com%2fads%2fShowAd.Asp;/4200455
This control creates a splitter bar with 2 resizable panels. The panels are adjustable by a specifying the size of the Child1 panel through the PanelSize property. It also includes minimum and maxmimum size parameters. It is well commented and also provides a demo application to explain all the options. I would also like to thank Mark Joyal for his great SplitterControl on which this is based. His control provides a way to resize based by a percentage, while mine provides a way to resize based on a size value. Since this is my first Active-X control, I would really appreciate your votes and any feedback you can provide
http://www.planetsourcecode.com/xq/ASP/txtCodeId.8486/lngWId.1/qx/vb/scripts/ShowCode.htm
The simplest (as few as three lines of code needed!) and best code to implement explorer-style splitter bars
http://www.planetsourcecode.com/xq/ASP/txtCodeId.22959/lngWId.1/qx/vb/scripts/ShowCode.htm
http://www.planetsourcecode.com/xq/ASP/txtCodeId.22959/lngWId.1/qx/vb/scripts/ShowCode.htm
Horizontal and Vertical Splitter Bar UserControls OCX for use in OLE development environments
Horizontal and Vertical Splitter Bar UserControls OCX for use in OLE development environments
ALSO HERES SOME CODE YOU MAY BE ABLE TO USER
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6180
ClientLeft = 210
ClientTop = 1800
ClientWidth = 7575
LinkTopic = "Form1"
ScaleHeight = 6180
ScaleWidth = 7575
Begin VB.PictureBox picOuterFrame
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 5535
Left = 120
ScaleHeight = 5505
ScaleWidth = 7065
TabIndex = 0
Top = 120
Width = 7095
Begin VB.PictureBox spltVertical
Appearance = 0 'Flat
CausesValidation= 0 'False
ClipControls = 0 'False
FillColor = &H8000000F&
FillStyle = 0 'Solid
ForeColor = &H8000000F&
Height = 4935
Left = 3480
MousePointer = 9 'Size W E
ScaleHeight = 4905
ScaleWidth = 225
TabIndex = 1
Top = 0
Width = 255
End
Begin VB.PictureBox picRight
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 4815
Left = 3840
ScaleHeight = 4785
ScaleWidth = 2985
TabIndex = 2
Top = 240
Width = 3015
End
Begin VB.PictureBox picLeft
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 4575
Left = 0
ScaleHeight = 4545
ScaleWidth = 3345
TabIndex = 3
Top = 240
Width = 3375
Begin VB.PictureBox spltHorizontal
Appearance = 0 'Flat
FillColor = &H8000000F&
FillStyle = 0 'Solid
ForeColor = &H8000000F&
Height = 255
Left = 480
MousePointer = 7 'Size N S
ScaleHeight = 225
ScaleWidth = 2385
TabIndex = 4
Top = 2160
Width = 2415
End
Begin VB.PictureBox picTopLeft
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1815
Left = 480
ScaleHeight = 1785
ScaleWidth = 2025
TabIndex = 6
Top = 120
Width = 2055
End
Begin VB.PictureBox picBottomLeft
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1815
Left = 600
ScaleHeight = 1785
ScaleWidth = 2025
TabIndex = 5
Top = 2520
Width = 2055
End
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const SPLT_WDTH As Long = 80 'width of the spltter bar
Private Const MIN_WINDOW As Long = 10 'Minimum size for any frame created by splitter bars
Private Sub Form_Load()
'**** Splitter Code ****
'No Borders, they are for development an
' d debugging
spltVertical.BorderStyle = 0
spltHorizontal.BorderStyle
picOuterFrame.BorderStyle = 0
picLeft.BorderStyle = 0
picTopLeft.BorderStyle = 0
picBottomLeft.BorderStyle = 0
picRight.BorderStyle = 0
'**** End Splitter Code ****
End Sub
Private Sub picRight_Resize()
'Resize your object to the inside of the
' frame
'YourObject.Move 0, 0, picRight.Width, p
' icRight.Height
End Sub
Private Sub picTopLeft_Resize()
'Resize your object to the inside of the
' frame
'YourObject.Move 0, 0, picTopLeft.Width,
' picTopLeft.Height
End Sub
Private Sub picBottomLeft_Resize()
'Resize your object to the inside of the
' frame
'YourObject.Move 0, 0, picBottomLeft.Wid
' th, picBottomLeft.Height
End Sub
Private Sub Form_Resize()
'For this example, I chose to reside all
' the frames, depending on the size of the
'
' form. You may choose to put this whole
' assembly in another sub-frame.
'**** Splitter Code ****
'Resize the outer frame
Dim height1 As Long, width1 As Long
height1 = ScaleHeight - (2 * SPLT_WDTH)
If height1 < 0 Then height1 = 0
width1 = ScaleWidth - (2 * SPLT_WDTH)
If width1 < 0 Then width1 = 0
picOuterFrame.Move SPLT_WDTH, SPLT_WDTH, width1, height1
'**** End Splitter Code ****
End Sub
'**** Splitter Code ****
Private Sub spltVertical_MouseDown(But
If Button = vbLeftButton Then
spltVertical.Move (spltVertical.Left - (SPLT_WDTH \ 2)) + x, 0, SPLT_WDTH, picOuterFrame.ScaleHeight
spltVertical.BackColor = vbButtonShadow 'change the splitter colour
End If
End Sub
Private Sub spltVertical_MouseMove(But
If spltVertical.BackColor = vbButtonShadow Then
spltVertical.Move (spltVertical.Left - (SPLT_WDTH \ 2)) + x, 0, SPLT_WDTH, picOuterFrame.ScaleHeight
End If
End Sub
Private Sub spltVertical_MouseUp(Butto
If spltVertical.BackColor = vbButtonShadow Then
spltVertical.BackColor = vbButtonFace 'restore splitter colour
spltVertical.Move (spltVertical.Left - (SPLT_WDTH \ 2)) + x, 0, SPLT_WDTH, picOuterFrame.ScaleHeight
'Set the absolute Boundaries
Dim lAbsLeft As Long
Dim lAbsRight As Long
lAbsLeft = MIN_WINDOW
lAbsRight = picOuterFrame.ScaleWidth - (SPLT_WDTH + MIN_WINDOW)
Select Case spltVertical.Left
Case Is < lAbsLeft 'the pane is too thin
spltVertical.Move lAbsLeft, 0, SPLT_WDTH, picOuterFrame.ScaleHeight
Case Is > lAbsRight 'the pane is too wide
spltVertical.Move lAbsRight, 0, SPLT_WDTH, picOuterFrame.ScaleHeight
End Select
'reposition both frames, and the spltVer
' tical bar
picOuterFrame_Resize
End If
End Sub
Private Sub spltHorizontal_MouseDown(B
If Button = vbLeftButton Then
spltHorizontal.BackColor = vbButtonShadow 'change the splitter colour
spltHorizontal.Move 0, (spltHorizontal.Top - (SPLT_WDTH \ 2)) + y, picLeft.ScaleWidth, SPLT_WDTH
End If
End Sub
Private Sub spltHorizontal_MouseMove(B
If spltHorizontal.BackColor = vbButtonShadow Then
spltHorizontal.Move 0, (spltHorizontal.Top - (SPLT_WDTH \ 2)) + y, picLeft.ScaleWidth, SPLT_WDTH
End If
End Sub
Private Sub splthorizontal_MouseUp(But
If spltHorizontal.BackColor = vbButtonShadow Then
spltHorizontal.BackColor = vbButtonFace 'restore splitter colour
spltHorizontal.Move 0, (spltHorizontal.Top - (SPLT_WDTH \ 2)) + y, picLeft.ScaleWidth, SPLT_WDTH
'Set the absolute Boundaries
Dim lAbsTop As Long
Dim lAbsBottom As Long
lAbsTop = MIN_WINDOW
lAbsBottom = picLeft.ScaleHeight - (SPLT_WDTH + MIN_WINDOW)
Select Case spltHorizontal.Top
Case Is < lAbsTop 'the pane is too short
spltHorizontal.Move 0, lAbsTop, picLeft.ScaleWidth, SPLT_WDTH
Case Is > lAbsBottom 'the pane is too tall
spltHorizontal.Move 0, lAbsBottom, picLeft.ScaleWidth, SPLT_WDTH
End Select
'reposition both sub-frames, and the spl
' tHorizontal bar
picLeft_Resize
End If
End Sub
Private Sub picOuterFrame_Resize()
Dim x1 As Long
Dim x2 As Long
Dim y1 As Long
On Error Resume Next
y1 = picOuterFrame.ScaleHeight
x1 = spltVertical.Left
x2 = x1 + SPLT_WDTH + 1
picLeft.Move 0, 0, x1 - 1, y1
spltVertical.Move x1, 0, SPLT_WDTH, y1
picRight.Move x2, 0, picOuterFrame.ScaleWidth - x2, y1
'Force a refresh on the left side
picLeft_Resize
End Sub
Private Sub picLeft_Resize()
'Resize the internal stuff. Only the wid
' th's
Dim x1 As Long
Dim y1 As Long
Dim y2 As Long
Dim y3 as Long
x1 = picLeft.Width
y1 = spltHorizontal.Top
y2 = y1 + SPLT_WDTH + 1
'We have to make sure that we do not siz
' e any windows to a negative dimension
y3 = y1 - 1
If y3 < MIN_WINDOW Then
y3 = MIN_WINDOW
End If
picTopLeft.Move 0, 0, x1, y3
spltHorizontal.Move 0, y1, x1, SPLT_WDTH
y3 = picLeft.ScaleHeight - y2
If y3 < MIN_WINDOW Then
y3 = MIN_WINDOW
End If
picBottomLeft.Move 0, y2, x1, y3
End Sub
'**** End Splitter Code ****
good luck
hope this helps
Andy