Let's take a look at the form that I want to implement:
The background color of the form (the rounded radius is equal to the border width in the following code, which is for the general processing, the reference, the reference, can be modified to the code, so that the two have different values. Different effects are changed as needed by the user. On the left box, the color is white (in actually DrawEdge process, can be set to other values) to the gradient of the form background color, under the right box, the color is RGB (132, 132, 132) (actually Drawedge) In the process, COLBOTTOMRIGHT is determined, or other value can be set to the gradient of the form background color.
To achieve this effect, your form (the same useful to the object of the HWnd property, also practical) should be set: 1 - BorderStyle = 0, 2 - scalemode = 3 (all the length units used by all GDI APIs For PIXEL, corresponding to the setting of this item). 3 - AutoRedraw = True
Mainly used three processes: windowshape - 'remodeling the form profile, entry function, call two functions MAKEROUNDCORNER - Rounded DrawEdge - Extended box
The following code is the code in the form to achieve special effects: ====================================== ================================================================================================================================================================= 1, 10 'Top 1, setwindowpos me.hwnd, hwndownpos me.hwnd, hwnd_topmost, 0, 0, 0, 0, swp_noactivate or swp_nosizend sub ================== =================================================================================
The following is a specific implementation code, can be placed in a module: ========================================= ========================== Option ExplicitPrivate Declare function setWindowRgn2 (Byval HRGN As Long, Byval Bredraw as boolean ) As LongPrivate Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As LongPrivate 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 Longprivate 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 LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate 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 LONGPRIVATE DECLARE FUNCTION COPYRECT LIB "User32" (LPDESTRECT 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 LongPrivate 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 LongPrivate Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As LongPrivate Declare Function RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) As LongPublic 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 LongPrivate Const RGN_AND = 1 'intersection Private Const RGN_COPY = 5' covering Private Const RGN_OR = 2 'EVATE CONST RGN_XOR = 3' Division PRIVATE CONST RGN_DIFF = 4
Public Type Rect Left As Long Top As Long Right As Long Bottom As LONGEND 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' Do not 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 = -2nd enumpublic Type Pointapi x ask Y as longend type
'constants for fillmodepublic const alternate = 1PUBLIC const window = 2
Private Type TRIVERTEX X As Long Y As Long Red As Integer Green As Integer Blue As Integer Alpha As IntegerEnd TypePrivate Type GRADIENT_RECT UpperLeft As Long LowerRight As LongEnd TypePrivate Type GRADIENT_TRIANGLE Vertex1 As Long Vertex2 As Long Vertex3 As LongEnd TypePublic Const CLR_INVALID = -1
'Gradientfill for structural public enum gradientfillRectType gradient_fill_rect_h = 0 gradient_fill_rect_v = 1 gradient_fill_triangle = 2nd 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 (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_TRIANGLEEnd SubPublic 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 _) 'Parameter Description FillRect Gravity Rectangular Area' Color0: Starting Color [Symmetric Time Central Axis Color] 'Color1: End Point Color [Symmetric Border Color]' EDIR : Color gravity direction 'linearsymmetrical: Whether linear symmetry (longitudinal gradient X-axis symmetry, otherwise Y Axisymmetric) DIM I AS INTEGER
Dim tTV (0 To 1) As TRIVERTEX Dim tGR As GRADIENT_RECT '' center of the gradation If LinearSymmetrical = False Then setTriVertexColor tTV (0), TranslateColor (Color0) setTriVertexColor tTV (1), TranslateColor (Color1) tTV (0) .X = FillRect .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 'symmetrical gradient Else' front half setTriVertexColor tTV (0), TranslateColor (Color1) setTriVertexColor tTV (1), TranslateColor (Color0) 'transverse gradient, the left half 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 '' portrait gradient, Half 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 '' 'The second half settrivertexcolor TTV (0), TranslateColor (color0) SettrivertexColor TTV (1), TranslateColor (Color1)' lateral gradient, Right half if edir = gradient_fill_rect_h TTTV (0) .x = (FillRect.right FillRect.Left) / 2 TTV (0) .y = fillRect.top TTV (1) .x = fillRect.Right TTV (1) .Y = fillRect.bottom '' portrait gradient, lower half 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 IfEnd SubPrivate 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, lBlueEnd SubPrivate Sub setTriVertexColorComponent (ByRef iColor As INTEGER, BYVAL LCOMPONENT As Long) IF (LComponent and & H8000 &) = & H8000 & Ten IColor = (LComponent and & H7F00 &) IColor = ICOLOR OR & H8000 else icolor = LComponent End IFEND 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 IfEnd Function
Public Sub Windowshape (HWND As Long, _ LBACKCOLR AS Long, _ LWIDTH AS INTEGER, _ LHEIGHT AS INTEGER, _ LEDEGEWIDTH AS INTEGER 'Removing Forms Outline' 1. Shape Call Makeroundcorner (HWnd, Lwidth, LHEIGHT, LEDEGEWIDTH) '2. Frame 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 LngmaInframeend 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 'triangle vertex Dim Vcolor (0 to 2) as long 'Three Vertices DIM COLTOPLEFT AS Long' Dark Dim Colbottomright As Long 'Light Color' Two Color Gradient Coltopleft = VBWHITE 'RGB (132, 132, 132) Colbottomright = RGB (65, 65, 65 ') left With rctGradient .left = 0 .top = lEdgeWidth .right = lEdgeWidth .bottom = lHeight - lEdgeWidth End With GradientFillRect hdc, rctGradient, colTopLeft, lBackColor, GRADIENT_FILL_RECT_h, False' on With rctGradient .left = lEdgeWidth .top = 0 .right = lWidth - lEdgeWidth .bottom = lEdgeWidth End With GradientFillRect hdc, rctGradient, colTopLeft, lBackColor, GRADIENT_FILL_RECT_v, False 'Right With rctGradient .left = lWidth - lEdgeWidth .top = lEdgeWidth .right = lWidth .bottom = lHeight - lEdgeWidth .right = lWidth - - lEdgeWidth .bottom lEdgeWidth End With GradientFillRect hdc, rctGradient, lBackColor, colBottomRight, GRADIENT_FILL_RECT_h, False 'under With rctGradient .left = lEdgeWidth .top = lHeight = lHeight End With GradientFillRect hdc, rctGradient, lBackColor, colBottomRight, GRADIENT_FILL_RECT_v, False 'at the corners of three-color gradation VColor (2) = lBackColor If lEdgeWidth> 0 Then' upper left 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 'left 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) = Colnetopleft Vcolor (1) = Colbottomright GradientFillTria HDC, PNT, Vcolor 'Right lower 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 'upper right Pnt (0). X = lwidth (SQR (2) - 1) * LedgeWidth PNT (0) .y = LedGewidth PNT (1) .x = LWID Th - 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 vcolorend sub == module code end
The form in this article is provided in the form of the form in which the author's own "Form Title Window Control" and "XP Style Button" are used, and it is intended that the reader decides whether it is also posted by the response of this article. Discussion.
This is the first time to bring your own things on 9CBS, and readers have proposed valuable comments and suggestions to improve them together.
