如何创建[圆角、边框色彩渐变、边框宽度自定义]窗体

最新推荐文章于 2023-04-01 14:31:54 发布

zwyl2001

最新推荐文章于 2023-04-01 14:31:54 发布

阅读量1.5k

点赞数

分类专栏： VB.Net 文章标签： integer function constants module user windows

本文链接：https://blog.csdn.net/zwyl2001/article/details/290860

版权

VB.Net 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

先让大家看一下我要实现的窗体效果：

该窗体的背景色、圆角半径(下面代码中将圆角半径等于边框宽度，此为为般化处理，参考者可视具体需要而对代码略作修改，使二者具有不同的值，以获得不同的效果）由用户根据需要改变。上、左边框的色彩为白色(其实为DrawEdge过程中colTopLef决定，可设为其他值)到窗体背景色的渐变，下、右边框的色彩为RGB(132, 132, 132)(其实为DrawEdge过程中colBottomRight所决定，也可设为其他值)到窗体背景色的渐变。

要实现该效果，你的窗体（对任拥有hWnd属性的对象，也一样实用）应作如下设置：
1——BorderStyle=0,
2——ScaleMode=3 (所有GDI类API使用的长度单位都为Pixel，对应于该项的设置）。
3——AutoRedraw=True

主要使用了三个过程：
WindowShape      ——'重塑窗体轮廓，入口函数，调用后两个函数
MakeRoundCorner——圆角
DrawEdge            ——画外框

以下代码为要实现特效的窗体中的代码：
===============================================================
Private Sub Form_Load()
'调用入口函数实现效果
   WindowShape hwnd, hdc, BackColor, ScaleWidth + 1, ScaleHeight + 1, 10
   '将窗体置顶，
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or    SWP_NOMOVE Or SWP_NOSIZE
End Sub
===============================================================

以下为具体实现代码，可置于一个module中：
===============================================================
Option Explicit

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long

Private Declare Function GradientFill Lib "gdi32" Alias "GdiGradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GradientFillTriangle Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length 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

Private Const RGN_AND = 1   '交集
Private Const RGN_COPY = 5 '覆盖
Private Const RGN_OR = 2    '并集
Private Const RGN_XOR = 3   '差集
Private Const RGN_DIFF = 4

Public Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Public Enum ESetWindowPosStyles
   SWP_SHOWWINDOW = &H40
   SWP_HIDEWINDOW = &H80
   SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
   SWP_NOACTIVATE = &H10
   SWP_NOCOPYBITS = &H100
   SWP_NOMOVE = &H2
   SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering
   SWP_NOREDRAW = &H8
   SWP_NOREPOSITION = SWP_NOOWNERZORDER
   SWP_NOSIZE = &H1
   SWP_NOZORDER = &H4
   SWP_DRAWFRAME = SWP_FRAMECHANGED
   HWND_TOPMOST = -1
   HWND_NOTOPMOST = -2
End Enum

Public Type PointApi
X As Long
Y As Long
End Type

'constants for FillMode
Public Const ALTERNATE = 1
Public Const WINDING = 2

Private Type TRIVERTEX
   X As Long
   Y As Long
   Red As Integer
   Green As Integer
   Blue As Integer
   Alpha As Integer
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type
Private Type GRADIENT_TRIANGLE
    Vertex1 As Long
    Vertex2 As Long
    Vertex3 As Long
End Type
Public Const CLR_INVALID = -1

'GradientFill用到的结构
Public Enum GradientFillRectType
   GRADIENT_FILL_RECT_h = 0
   GRADIENT_FILL_RECT_v = 1
   GRADIENT_FILL_TRIANGLE = 2
End Enum

Public Sub GradientFillTria(ByVal lngDc As Long, _
                                 pPnt() As PointApi, _
                                 lColor() As Long)
   Dim Tvert(0 To 2) As TRIVERTEX
   Dim gTRi          As GRADIENT_TRIANGLE
   Dim i             As Integer

   For i = LBound(Tvert) To UBound(Tvert)
      Tvert(i).X = pPnt(i).X
      Tvert(i).Y = pPnt(i).Y
      setTriVertexColor Tvert(i), TranslateColor(lColor(i))
   Next
   gTRi.Vertex1 = 0
   gTRi.Vertex2 = 1
   gTRi.Vertex3 = 2

   GradientFillTriangle lngDc, Tvert(LBound(Tvert)), 3, gTRi, 1, GRADIENT_FILL_TRIANGLE
End Sub

Public Sub GradientFillRect( _
      ByVal lngDc As Long, _
      ByRef FillRect As RECT, _
      ByVal Color0 As Long, _
      ByVal Color1 As Long, _
      eDir As GradientFillRectType, _
      Optional ByVal LinearSymmetrical As Boolean = False _
   )

   '参数说明 FillRect 渐变矩形区域
   '         Color0 ：起点颜色[对称时中心轴颜色]
   '         Color1 ：终点颜色[对称时边框颜色]
   '         eDir   ：颜色渐变方向
   '         LinearSymmetrical:是否线性对称(纵向渐变则X轴对称，否则Y轴对称)
   Dim i As Integer

   Dim tTV(0 To 1) As TRIVERTEX

   Dim tGR As GRADIENT_RECT
   ''中心渐变
   If LinearSymmetrical = False Then
      setTriVertexColor tTV(0), TranslateColor(Color0)
      setTriVertexColor tTV(1), TranslateColor(Color1)
      tTV(0).X = FillRect.left
      tTV(0).Y = FillRect.top
      tTV(1).X = FillRect.right
      tTV(1).Y = FillRect.bottom

      tGR.UpperLeft = 0
      tGR.LowerRight = 1

      GradientFill lngDc, tTV(0), 2, tGR, 1, eDir
   '对称渐变
   Else
      '前半部
      setTriVertexColor tTV(0), TranslateColor(Color1)
      setTriVertexColor tTV(1), TranslateColor(Color0)
      '横向渐变，左半部
      If eDir = GRADIENT_FILL_RECT_h Then
         tTV(0).X = FillRect.left
         tTV(0).Y = FillRect.top
         tTV(1).X = (FillRect.right + FillRect.left) / 2
         tTV(1).Y = FillRect.bottom
      ''纵向渐变，上半部
      Else
         tTV(0).X = FillRect.left
         tTV(0).Y = FillRect.top
         tTV(1).X = FillRect.right
         tTV(1).Y = (FillRect.bottom + FillRect.top) / 2
      End If
      tGR.UpperLeft = 0
      tGR.LowerRight = 1
      GradientFill lngDc, tTV(0), 2, tGR, 1, eDir

      ''后半部
      setTriVertexColor tTV(0), TranslateColor(Color0)
      setTriVertexColor tTV(1), TranslateColor(Color1)
      '横向渐变，右半部
      If eDir = GRADIENT_FILL_RECT_h Then
         tTV(0).X = (FillRect.right + FillRect.left) / 2
         tTV(0).Y = FillRect.top
         tTV(1).X = FillRect.right
         tTV(1).Y = FillRect.bottom
      ''纵向渐变，下半部
      Else
         tTV(0).X = FillRect.left
         tTV(0).Y = (FillRect.bottom + FillRect.top) / 2
         tTV(1).X = FillRect.right
         tTV(1).Y = FillRect.bottom
      End If
      tGR.UpperLeft = 0
      tGR.LowerRight = 1
      GradientFill lngDc, tTV(0), 2, tGR, 1, eDir
   End If
End Sub

Private Sub setTriVertexColor(tTV As TRIVERTEX, lColor As Long)
   Dim lRed As Long
   Dim lGreen As Long
   Dim lBlue As Long

   lRed = (lColor And &HFF&) * &H100&
   lGreen = (lColor And &HFF00&)
   lBlue = (lColor And &HFF0000) / &H100&
   setTriVertexColorComponent tTV.Red, lRed
   setTriVertexColorComponent tTV.Green, lGreen
   setTriVertexColorComponent tTV.Blue, lBlue
End Sub
Private Sub setTriVertexColorComponent(ByRef iColor As Integer, ByVal lComponent As Long)
   If (lComponent And &H8000&) = &H8000& Then
      iColor = (lComponent And &H7F00&)
      iColor = iColor Or &H8000
   Else
      iColor = lComponent
   End If
End Sub

Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
   ' Convert Automation color to Windows color
   If OleTranslateColor(oClr, hPal, TranslateColor) Then
       TranslateColor = CLR_INVALID
   End If
End Function

Public Sub WindowShape(hwnd As Long, _
                        hdc As Long, _
                        lBackColr As Long, _
                        lWidth As Integer, _
                        lHeight As Integer, _
                        lEdegeWidth As Integer)
   '重塑窗体轮廓
   '1.外形
   Call MakeRoundCorner(hwnd, lWidth, lHeight, lEdegeWidth)

   '2.外框
   Call DrawEdge(hdc, lBackColr, lWidth, lHeight, lEdegeWidth)
End Sub

Private Sub MakeRoundCorner(lWnd As Long, lWidth As Integer, lHeight As Integer, intRadias As Integer)
   Dim lngMainFrame    As Long

   lngMainFrame = CreateRoundRectRgn(0, 0, lWidth, lHeight, intRadias * 2, intRadias * 2)
   SetWindowRgn lWnd, lngMainFrame, True
   DeleteObject lngMainFrame
End Sub

Private Sub DrawEdge(ByVal hdc As Long, _
                     lBackColor As Long, _
                     lWidth As Integer, _
                     lHeight As Integer, _
                     Optional lEdgeWidth As Integer = 1)
   Dim rctGradient As RECT
   Dim Pnt(0 To 2)     As PointApi '三角区域顶点
   Dim VColor(0 To 2) As Long      '三顶点颜色
   Dim colTopLeft      As Long '深色
   Dim colBottomRight As Long '浅色
   '四边的两色渐变
   colTopLeft = vbWhite ' RGB(132, 132, 132)
   colBottomRight = RGB(65, 65, 65)
   '左
   With rctGradient
      .left = 0
      .top = lEdgeWidth
      .right = lEdgeWidth
      .bottom = lHeight - lEdgeWidth
   End With
   GradientFillRect hdc, rctGradient, colTopLeft, lBackColor, GRADIENT_FILL_RECT_h, False
   '上
   With rctGradient
      .left = lEdgeWidth
      .top = 0
      .right = lWidth - lEdgeWidth
      .bottom = lEdgeWidth
   End With
   GradientFillRect hdc, rctGradient, colTopLeft, lBackColor, GRADIENT_FILL_RECT_v, False
   '右
   With rctGradient
      .left = lWidth - lEdgeWidth
      .top = lEdgeWidth
      .right = lWidth
      .bottom = lHeight - lEdgeWidth
   End With
   GradientFillRect hdc, rctGradient, lBackColor, colBottomRight, GRADIENT_FILL_RECT_h, False
   '下
   With rctGradient
      .left = lEdgeWidth
      .top = lHeight - lEdgeWidth
      .right = lWidth - lEdgeWidth
      .bottom = lHeight
   End With
   GradientFillRect hdc, rctGradient, lBackColor, colBottomRight, GRADIENT_FILL_RECT_v, False

   '转角处的三色渐变
   VColor(2) = lBackColor
   If lEdgeWidth > 0 Then
      '左上
      Pnt(0).X = lEdgeWidth
      Pnt(0).Y = (1 - Sqr(2)) * lEdgeWidth
      Pnt(1).X = (1 - Sqr(2)) * lEdgeWidth
      Pnt(1).Y = lEdgeWidth
      Pnt(2).X = lEdgeWidth
      Pnt(2).Y = lEdgeWidth
      VColor(0) = colTopLeft
      VColor(1) = colTopLeft
      GradientFillTria hdc, Pnt, VColor
      '左下
      Pnt(0).X = (1 - Sqr(2)) * lEdgeWidth
      Pnt(0).Y = lHeight - lEdgeWidth
      Pnt(1).X = lEdgeWidth
      Pnt(1).Y = lHeight + (Sqr(2) - 1) * lEdgeWidth
      Pnt(2).X = lEdgeWidth
      Pnt(2).Y = lHeight - lEdgeWidth
      VColor(0) = colTopLeft
      VColor(1) = colBottomRight
      GradientFillTria hdc, Pnt, VColor
      '右下
      Pnt(0).X = lWidth - lEdgeWidth
      Pnt(0).Y = lHeight + (Sqr(2) - 1) * lEdgeWidth
      Pnt(1).X = lWidth + (Sqr(2) - 1) * lEdgeWidth
      Pnt(1).Y = lHeight - lEdgeWidth
      Pnt(2).X = lWidth - lEdgeWidth
      Pnt(2).Y = lHeight - lEdgeWidth
      VColor(0) = colBottomRight
      VColor(1) = colBottomRight
      GradientFillTria hdc, Pnt, VColor
      '右上
      Pnt(0).X = lWidth + (Sqr(2) - 1) * lEdgeWidth
      Pnt(0).Y = lEdgeWidth
      Pnt(1).X = lWidth - lEdgeWidth
      Pnt(1).Y = (1 - Sqr(2)) * lEdgeWidth
      Pnt(2).X = lWidth - lEdgeWidth
      Pnt(2).Y = lEdgeWidth
      VColor(0) = colBottomRight
      VColor(1) = colTopLeft
      GradientFillTria hdc, Pnt, VColor
   End If

   Erase Pnt
   Erase VColor
End Sub