我的标题栏上的颜色和图像有问题 [英] I have problem with the colors and images on the title bar

问题描述

Assalam-o-alikum，我正在制作一个标签控制的网页浏览器我已将标签放在标题栏上，但现在如果有人可以在vb.net中提供代码，则图像和颜色不正确（因为我不擅长c＃和其他人）这将是一个很大的帮助。这是表格的照片：



< img src =http://imagizer.imageshack.us/v2/150x100q90/910/i0mqnd.png\"border =0>



，这是我的代码：



进口系统

Imports System.Collections.Generic

Imports System.ComponentModel

Imports System.Data

Imports System.Drawing

进口System.Text

进口系统.Windows.Forms

Imports System.Runtime.InteropServices

Imports System.Diagnostics

Imports System.Drawing.Drawing2D

进口Ontop.AeroNonClientButtons



公共舱Form1

私人dwmMargins作为Dwm.MARGINS

私人_marginOk As Boolean

Private _aeroEnabled As Boolean

Public Sub New（）

SetStyle（ControlStyles.ResizeRedraw，True）



InitializeComponent（）





DoubleBuffered = True



CheckGlassEnabled（）< br $>
结束子

#Region道具



'''< summary>

'''如果启用了aero则获取

'''

Public ReadOnly属性AeroEnabled（）As Boolean

获取

返回_aeroEnabled

结束获取

结束物业





#End Region



#Region方法



'''< summary>

'''设置AeroEnabled的值

'''

Private Sub CheckGlassEnabled（）

如果是Environment.OSVersion .Version.Major> = 6然后

Dim enabled As Integer = 0

Dim response As Integer = Dwm.DwmIsCompositionEnabled（启用）



_aeroEnabled = enabled = 1

结束如果

结束次级



'''< summary>

'''相当于LoWord C宏

'''

'''< param name =dwValue/>

'''< returns>

公共共享函数LoWord（dwValue As Integer）作为整数

返回dwValue和& HFFFF

结束功能



'''< summary>

'''相当于HiWord C Macro

'''

'''< param name =dwValue/>

'''< returns>

公共共享函数HiWord（dwValue As Integer）作为整数

返回（dwValue>> 16）和& HFFFF

结束功能

#End Region



受保护的覆盖Sub OnResize（e As EventArgs）

MyBase.OnResize（e）



TabControl1.MaximumSize =新尺寸（Me.Size）

结束子



受保护的覆盖Sub OnActivated（e As EventArgs）

MyBase.OnActivated（e）



如果dwmMargins.cyTopHeight< TabControl1.Bottom然后

dwmMargins.cyTopHeight = TabControl1.Bottom

结束如果



Dwm.DwmExtendFrameIntoClientArea（Me .Handle，dwmMargins）

结束子



受保护的覆盖Sub OnPaint（e作为PaintEventArgs）

MyBase。 OnPaint（e）



如果_aeroEnabled那么

e.Graphics.Clear（Color.Transparent）

Else

e.Graphics.Clear（Color.FromArgb（& HC2，& HD9，& HF7））

结束如果



e.Graphics.FillRectangle（SystemBrushes.ButtonFace，Rectangle.FromLTRB（dwmMargins.cxLeftWidth - 100，dwmMargins.cyTopHeight - 100，Width - dwmMargins.cxRightWidth - 100，Height - dwmMargins.cyBottomHeight - 100））

结束子



受保护覆盖​​子WndProc（ByRef m As Message）

Dim WM_NCCALCSIZE As Integer =& ; H83

Dim WM_NCHITTEST As Integer =& H84

Dim result As IntPtr



Dim dwmHandled As Integer = Dwm.DwmDefWindowProc（m .HWnd，m.Msg，m.WParam，m.LParam，结果）



如果dwmHandled = 1那么

m.Result =结果

返回

结束如果



如果m.Msg = WM_NCCALCSIZE AndAlso CType（m.WParam，Integer） ）= 1然后

Dim nccsp As NCCALCSIZE_PARAMS = CType（Marshal.PtrToStructure（m.LParam，GetType（NCCALCSIZE_PARAMS）），NCCALCSIZE_PARAMS）



'调整（缩小）客户矩形以容纳边框：

nccsp.rect0.Top + = 0

nccsp.rect0.Bottom + = 0

nccsp.rect0.Left + = 0

nccsp.rect0.Right + = 0



如果不_marginOk那么

'设置客户区将传递给DwmExtendIntoClientArea

dwmMargins.cyTopHeight = nccsp.rect2.Top - nccsp.rect1.Top

dwmMargins.cxLeftWidth = nccsp.rect2.Left - nccsp.rect1 .Left

dwmMargins.cyBottomHeight = nccsp.rect1.Bottom - nccsp.rect2.Bottom

dwmMargins.cxRightWidth = nccsp.rect1.Right - nccsp.rect2.Right

_marginOk = True

结束如果



Marshal.StructureToPtr（nccsp，m.LParam，False）



m.Result = IntPtr.Zero

ElseIf m.Msg = WM_NCHITTEST AndAlso CType（m.Result，Integer）= 0然后

m.Result = HitTestNCA（m.HWnd，m.WParam，m.LParam）

否则

MyBase.WndProc（m）

结束如果

结束子



私人函数HitTestNCA（hwnd As IntPtr，wparam As IntPtr，lparam As In tPtr）作为IntPtr

Dim HTNOWHERE As Integer = 0

Dim HTCLIENT As Integer = 1

Dim HTCAPTION As Integer = 2

Dim HTGROWBOX As Integer = 4

Dim HTSIZE As Integer = HTGROWBOX

Dim HTMINBUTTON As Integer = 8

Dim HTMAXBUTTON as Integer = 9

Dim HTLEFT As Integer = 2

Dim HTRIGHT As Integer = 11

Dim HTTOP as Integer = 12

Dim HTTOPLEFT As Integer = 13

Dim HTTOPRIGHT As Integer = 14

Dim HTBOTTOM As Integer = 15

Dim HTBOTTOMLEFT As Integer = 16

Dim HTBOTTOMRIGHT As Integer = 17

Dim HTREDUCE As Integer = HTMINBUTTON

Dim HTZOOM As Integer = HTMAXBUTTON

Dim HTSIZEFIRST As Integer = HTLEFT

Dim HTSIZELAST As Integer = HTBOTTOMRIGHT



Dim p As New Point（LoWord（CType（lparam，Integer）），HiWord（CType（lparam，Integer）））



Dim topleft As Rectangle = RectangleToScreen（New矩形（0,0，dwmMargins.cxLeftWidth，dwmMargins.cxLeftWidth））



如果topleft.Contains（p）那么

返回新的IntPtr （HTTOPLEFT）

结束如果



Dim topright As Rectangle = RectangleToScreen（新矩形（宽度 - dwmMargins.cxRightWidth，0，dwmMargins.cxRightWidth） ，dwmMargins.cxRightWidth））



如果topright.Contains（p）那么

返回新的IntPtr（HTTOPRIGHT）

结束如果



Dim botleft As Rectangle = RectangleToScreen（New Rectangle（0，Height - dwmMargins.cyBottomHeight，dwmMargins.cxLeftWidth，dwmMargins.cyBottomHeight））



如果是botleft.Contains（p）那么

返回新的IntPtr（HTBOTTOMLEFT）

结束如果



Dim botright As Rectangle = RectangleToScreen（新矩形（宽度 - dwmMargins.cxRightWidth，高度 - dwmMargins.cyBottomHeight，dwmMargins.cxRightWidth，dwmMargins.cyBottomHeight））



如果是botright.Contains（p）那么

返回新的IntPtr（HTBOTTOMRIGHT）

结束如果



Dim top As Rectangle = RectangleToScreen（新矩形（0,0，宽度，dwmMargins.cxLeftWidth））



如果top.Contains（p）然后

返回新的IntPtr（HTTOP）

结束如果



Dim cap作为Rectangle = RectangleToScreen（新矩形（0，dwmMargins.cxLeftWidth，宽度，dwmMargins.cyTopHeight - dwmMargins.cxLeftWidth））



如果cap.Contains（p）则

返回新的IntPtr（HTCAPTION）

结束如果



Dim left As Rectangle = RectangleToScreen（New R ectangle（0,0，dwmMargins.cxLeftWidth，Height））



如果left.Contains（p）那么

返回新的IntPtr（HTLEFT ）

结束如果



Dim right As Rectangle = RectangleToScreen（新矩形（宽度 - dwmMargins.cxRightWidth，0，dwmMargins.cxRightWidth，Height） ））



如果正确。包含（p）然后

返回新的IntPtr（HTRIGHT）

结束If



Dim bottom As Rectangle = RectangleToScreen（New Rectangle（0，Height - dwmMargins.cyBottomHeight，Width，dwmMargins.cyBottomHeight））



如果是bottom.Contains（p）那么

返回新的IntPtr（HTBOTTOM）

结束如果



返回新的IntPtr（HTCLIENT）

结束函数

私有子Form1_Load（发件人作为对象，e作为EventArgs）处理MyBase.Load

Dim t As New TabPage

Dim newtab As New Tab

t.ImageIndex = 0

newtab.Show（）

newtab.TopLevel = False

newtab.AxWebBrowser1.RegisterAsBrowser = True

newtab.Dock = DockStyle.Fill

t.Controls.Add（newtab）

TabControl1。 TabPages.Add（t）

结束子



请有人帮助我

先谢谢，hamza

Assalam-o-alikum, I am making a tab controlled web browser i have placed the tabs on the title bar but now the images and the colors are not correct if someone you can provide the code in vb.net(because i am not good at c# and others)it will be a big help. this is the photo of the form:

<img src="http://imagizer.imageshack.us/v2/150x100q90/910/i0mqnd.png" border="0">

and this is my code:

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Drawing.Drawing2D
Imports Ontop.AeroNonClientButtons

Public Class Form1
Private dwmMargins As Dwm.MARGINS
Private _marginOk As Boolean
Private _aeroEnabled As Boolean
Public Sub New()
SetStyle(ControlStyles.ResizeRedraw, True)

InitializeComponent()


DoubleBuffered = True

CheckGlassEnabled()
End Sub
#Region "Props"

''' <summary>
''' Gets if aero is enabled
'''
Public ReadOnly Property AeroEnabled() As Boolean
Get
Return _aeroEnabled
End Get
End Property


#End Region

#Region "Methods"

''' <summary>
''' Sets the value of AeroEnabled
'''
Private Sub CheckGlassEnabled()
If Environment.OSVersion.Version.Major >= 6 Then
Dim enabled As Integer = 0
Dim response As Integer = Dwm.DwmIsCompositionEnabled(enabled)

_aeroEnabled = enabled = 1
End If
End Sub

''' <summary>
''' Equivalent to the LoWord C Macro
'''
''' <param name="dwValue" />
''' <returns>
Public Shared Function LoWord(dwValue As Integer) As Integer
Return dwValue And &HFFFF
End Function

''' <summary>
''' Equivalent to the HiWord C Macro
'''
''' <param name="dwValue" />
''' <returns>
Public Shared Function HiWord(dwValue As Integer) As Integer
Return (dwValue >> 16) And &HFFFF
End Function
#End Region

Protected Overrides Sub OnResize(e As EventArgs)
MyBase.OnResize(e)

TabControl1.MaximumSize = New Size(Me.Size)
End Sub

Protected Overrides Sub OnActivated(e As EventArgs)
MyBase.OnActivated(e)

If dwmMargins.cyTopHeight < TabControl1.Bottom Then
dwmMargins.cyTopHeight = TabControl1.Bottom
End If

Dwm.DwmExtendFrameIntoClientArea(Me.Handle, dwmMargins)
End Sub

Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)

If _aeroEnabled Then
e.Graphics.Clear(Color.Transparent)
Else
e.Graphics.Clear(Color.FromArgb(&HC2, &HD9, &HF7))
End If

e.Graphics.FillRectangle(SystemBrushes.ButtonFace, Rectangle.FromLTRB(dwmMargins.cxLeftWidth - 100, dwmMargins.cyTopHeight - 100, Width - dwmMargins.cxRightWidth - 100, Height - dwmMargins.cyBottomHeight - 100))
End Sub

Protected Overrides Sub WndProc(ByRef m As Message)
Dim WM_NCCALCSIZE As Integer = &H83
Dim WM_NCHITTEST As Integer = &H84
Dim result As IntPtr

Dim dwmHandled As Integer = Dwm.DwmDefWindowProc(m.HWnd, m.Msg, m.WParam, m.LParam, result)

If dwmHandled = 1 Then
m.Result = result
Return
End If

If m.Msg = WM_NCCALCSIZE AndAlso CType(m.WParam, Integer) = 1 Then
Dim nccsp As NCCALCSIZE_PARAMS = CType(Marshal.PtrToStructure(m.LParam, GetType(NCCALCSIZE_PARAMS)), NCCALCSIZE_PARAMS)

' Adjust (shrink) the client rectangle to accommodate the border:
nccsp.rect0.Top += 0
nccsp.rect0.Bottom += 0
nccsp.rect0.Left += 0
nccsp.rect0.Right += 0

If Not _marginOk Then
'Set what client area would be for passing to DwmExtendIntoClientArea
dwmMargins.cyTopHeight = nccsp.rect2.Top - nccsp.rect1.Top
dwmMargins.cxLeftWidth = nccsp.rect2.Left - nccsp.rect1.Left
dwmMargins.cyBottomHeight = nccsp.rect1.Bottom - nccsp.rect2.Bottom
dwmMargins.cxRightWidth = nccsp.rect1.Right - nccsp.rect2.Right
_marginOk = True
End If

Marshal.StructureToPtr(nccsp, m.LParam, False)

m.Result = IntPtr.Zero
ElseIf m.Msg = WM_NCHITTEST AndAlso CType(m.Result, Integer) = 0 Then
m.Result = HitTestNCA(m.HWnd, m.WParam, m.LParam)
Else
MyBase.WndProc(m)
End If
End Sub

Private Function HitTestNCA(hwnd As IntPtr, wparam As IntPtr, lparam As IntPtr) As IntPtr
Dim HTNOWHERE As Integer = 0
Dim HTCLIENT As Integer = 1
Dim HTCAPTION As Integer = 2
Dim HTGROWBOX As Integer = 4
Dim HTSIZE As Integer = HTGROWBOX
Dim HTMINBUTTON As Integer = 8
Dim HTMAXBUTTON As Integer = 9
Dim HTLEFT As Integer = 2
Dim HTRIGHT As Integer = 11
Dim HTTOP As Integer = 12
Dim HTTOPLEFT As Integer = 13
Dim HTTOPRIGHT As Integer = 14
Dim HTBOTTOM As Integer = 15
Dim HTBOTTOMLEFT As Integer = 16
Dim HTBOTTOMRIGHT As Integer = 17
Dim HTREDUCE As Integer = HTMINBUTTON
Dim HTZOOM As Integer = HTMAXBUTTON
Dim HTSIZEFIRST As Integer = HTLEFT
Dim HTSIZELAST As Integer = HTBOTTOMRIGHT

Dim p As New Point(LoWord(CType(lparam, Integer)), HiWord(CType(lparam, Integer)))

Dim topleft As Rectangle = RectangleToScreen(New Rectangle(0, 0, dwmMargins.cxLeftWidth, dwmMargins.cxLeftWidth))

If topleft.Contains(p) Then
Return New IntPtr(HTTOPLEFT)
End If

Dim topright As Rectangle = RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, 0, dwmMargins.cxRightWidth, dwmMargins.cxRightWidth))

If topright.Contains(p) Then
Return New IntPtr(HTTOPRIGHT)
End If

Dim botleft As Rectangle = RectangleToScreen(New Rectangle(0, Height - dwmMargins.cyBottomHeight, dwmMargins.cxLeftWidth, dwmMargins.cyBottomHeight))

If botleft.Contains(p) Then
Return New IntPtr(HTBOTTOMLEFT)
End If

Dim botright As Rectangle = RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, Height - dwmMargins.cyBottomHeight, dwmMargins.cxRightWidth, dwmMargins.cyBottomHeight))

If botright.Contains(p) Then
Return New IntPtr(HTBOTTOMRIGHT)
End If

Dim top As Rectangle = RectangleToScreen(New Rectangle(0, 0, Width, dwmMargins.cxLeftWidth))

If top.Contains(p) Then
Return New IntPtr(HTTOP)
End If

Dim cap As Rectangle = RectangleToScreen(New Rectangle(0, dwmMargins.cxLeftWidth, Width, dwmMargins.cyTopHeight - dwmMargins.cxLeftWidth))

If cap.Contains(p) Then
Return New IntPtr(HTCAPTION)
End If

Dim left As Rectangle = RectangleToScreen(New Rectangle(0, 0, dwmMargins.cxLeftWidth, Height))

If left.Contains(p) Then
Return New IntPtr(HTLEFT)
End If

Dim right As Rectangle = RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, 0, dwmMargins.cxRightWidth, Height))

If right.Contains(p) Then
Return New IntPtr(HTRIGHT)
End If

Dim bottom As Rectangle = RectangleToScreen(New Rectangle(0, Height - dwmMargins.cyBottomHeight, Width, dwmMargins.cyBottomHeight))

If bottom.Contains(p) Then
Return New IntPtr(HTBOTTOM)
End If

Return New IntPtr(HTCLIENT)
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim t As New TabPage
Dim newtab As New Tab
t.ImageIndex = 0
newtab.Show()
newtab.TopLevel = False
newtab.AxWebBrowser1.RegisterAsBrowser = True
newtab.Dock = DockStyle.Fill
t.Controls.Add(newtab)
TabControl1.TabPages.Add(t)
End Sub

please somebody help me
Thanks in Advance, hamza

推荐答案

这篇关于我的标题栏上的颜色和图像有问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！