?? frmgradtitle.frm
字號:
VERSION 5.00
Begin VB.Form frmGradTitle
BorderStyle = 0 'None
Caption = "Gradient TitleBar"
ClientHeight = 5715
ClientLeft = 2130
ClientTop = 2355
ClientWidth = 6630
Icon = "frmGradTitle.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5715
ScaleWidth = 6630
Begin VB.PictureBox picTitleBar
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 280
Left = 20
ScaleHeight = 285
ScaleWidth = 6480
TabIndex = 1
Top = 20
Width = 6480
Begin VB.Image imgMaximize
Height = 210
Left = 5880
Picture = "frmGradTitle.frx":0442
Top = 30
Width = 240
End
Begin VB.Image imgMinimize
Height = 210
Left = 5640
Picture = "frmGradTitle.frx":0724
Top = 30
Width = 240
End
Begin VB.Image imgCloseForm
Height = 210
Left = 6240
Picture = "frmGradTitle.frx":0A06
Top = 30
Width = 240
End
Begin VB.Image imgFormIcon
Height = 240
Left = 60
Stretch = -1 'True
Top = 20
Width = 240
End
Begin VB.Label lblFormCaption
BackStyle = 0 'Transparent
Caption = "Form Caption"
ForeColor = &H00FFFFFF&
Height = 255
Left = 360
TabIndex = 2
Top = 30
Width = 3975
End
End
Begin VB.CommandButton cmdDummy
Caption = "Command1"
Height = 195
Left = 2880
TabIndex = 0
Top = 60
Width = 75
End
Begin VB.Line lineBorder1
X1 = 0
X2 = 0
Y1 = 0
Y2 = 5640
End
Begin VB.Line lineBorder2
X1 = 0
X2 = 6600
Y1 = 0
Y2 = 0
End
Begin VB.Line lineBorder3
X1 = 6600
X2 = 6600
Y1 = 5640
Y2 = 0
End
Begin VB.Line lineBorder4
X1 = 0
X2 = 6600
Y1 = 5640
Y2 = 5640
End
Begin VB.Image imgMaximizeButton
Height = 210
Left = 3360
Picture = "frmGradTitle.frx":0CE8
Top = 60
Width = 240
End
Begin VB.Image imgNormalizeButton
Height = 210
Left = 3600
Picture = "frmGradTitle.frx":0FCA
Top = 60
Width = 240
End
Begin VB.Image imgCloseFormButton
Height = 210
Left = 3840
Picture = "frmGradTitle.frx":12AC
Top = 60
Width = 240
End
Begin VB.Image imgCloseFormButtonDown
Height = 210
Left = 4800
Picture = "frmGradTitle.frx":158E
Top = 60
Width = 240
End
Begin VB.Image imgNormalizeButtonDown
Height = 210
Left = 4560
Picture = "frmGradTitle.frx":1870
Top = 60
Width = 240
End
Begin VB.Image imgMaximizeButtonDown
Height = 210
Left = 4320
Picture = "frmGradTitle.frx":1B52
Top = 60
Width = 240
End
Begin VB.Image imgMinimizeButtonDown
Height = 210
Left = 4080
Picture = "frmGradTitle.frx":1E34
Top = 60
Width = 240
End
Begin VB.Image imgMinimizeButton
Height = 210
Left = 3120
Picture = "frmGradTitle.frx":2116
Top = 60
Width = 240
End
End
Attribute VB_Name = "frmGradTitle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'一個漸變的標題框,在此例中我們可以看到繪圖的應用技巧
'尤其是實現漸變的方法,很值得我們借鑒
'另外也涉及了拖動無標題窗口的技巧
Option Explicit
Private IsMaximized As Boolean
Private IsMinimized As Boolean
Private ButtonsCount As Integer
Private Sub Form_Paint()
ReSize
EndFRDrag Me.Top, Me.Left
End Sub
Private Sub imgCloseForm_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
imgCloseForm.Picture = imgCloseFormButtonDown.Picture
End Sub
Private Sub imgCloseForm_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
' Unload All of the Forms
Dim frm As Form
imgCloseForm.Picture = imgCloseFormButton.Picture
For Each frm In Forms
Unload frm
Next frm
End
End Sub
Private Sub imgMaximize_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsMaximized = True Then
imgMaximize.Picture = imgNormalizeButtonDown.Picture
Else
imgMaximize.Picture = imgMaximizeButtonDown.Picture
End If
End Sub
Private Sub imgMaximize_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsMaximized = False Then
Me.WindowState = 2
IsMaximized = True
Form_Resize
imgMaximize.Picture = imgNormalizeButton.Picture
Else
Me.WindowState = 0
IsMaximized = False
Form_Resize
imgMaximize.Picture = imgMaximizeButton.Picture
End If
End Sub
Private Sub imgMinimize_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
imgMinimize.Picture = imgMinimizeButtonDown.Picture
End Sub
Private Sub imgMinimize_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsMinimized = False Then
Me.WindowState = 1
IsMinimized = True
Form_Resize
imgMinimize.Picture = imgMinimizeButton.Picture
Else
Me.WindowState = 0
IsMinimized = False
Form_Resize
imgMinimize.Picture = imgMinimizeButton.Picture
End If
End Sub
Private Sub Form_Activate()
IsMinimized = False
End Sub
Private Sub Form_Load()
Dim frameHeight As Long
Dim frameWidth As Long
Me.ScaleMode = 3
' 'compute the width of the left and right dialog frame
frameHeight = GetSystemMetrics(SM_CYDLGFRAME) * 2
' 'compute the width of the top and bottom dialog frame
frameWidth = GetSystemMetrics(SM_CXDLGFRAME) * 2
Me.ScaleMode = 1
ButtonsCount = 0
If Me.MaxButton = True Then ButtonsCount = ButtonsCount + 1
If Me.MinButton = True Then ButtonsCount = ButtonsCount + 2
Select Case ButtonsCount
Case 0
imgMaximize.Visible = False
imgMinimize.Visible = False
Case 1
imgMinimize.Visible = False
Case 2
imgMaximize.Visible = False
End Select
ReSize
DrawCaption Me.Caption
imgFormIcon.Picture = Me.Icon
End Sub
Private Sub Form_Resize()
ReSize
End Sub
Private Sub picTitleBar_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
BeginFRDrag x, y
End Sub
Private Sub picTitleBar_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then DoFRDrag x, y
End Sub
Private Sub picTitleBar_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
EndFRDrag x, y
End Sub
Private Sub lblFormCaption_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
BeginFRDrag x, y
End Sub
Private Sub lblFormCaption_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then DoFRDrag x, y
End Sub
Private Sub lblFormCaption_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
EndFRDrag x, y
End Sub
Private Sub BeginFRDrag(x As Single, y As Single)
If IsMaximized = True Then Exit Sub
If IsMinimized = True Then Exit Sub
Dim tDc As Long
Dim sDc As Long
Dim d As Long
' 'convert points to POINTAPI struct
dpoint.x = x
dpoint.y = y
' 'get screen area of Me
GetWindowRect Me.hwnd, fbox 'screen Rect of Me
TwipsPerPixelX = Screen.TwipsPerPixelX
TwipsPerPixelY = Screen.TwipsPerPixelY
' 'get point of mousedown in screen coordinates
temp = dpoint
ClientToScreen Me.hwnd, temp
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, tbox
d = ReleaseDC(0, sDc)
oldbox = tbox
End Sub
Private Sub DoFRDrag(x As Single, y As Single)
If IsMaximized = True Then Exit Sub
If IsMinimized = True Then Exit Sub
Dim tDc As Long
Dim sDc As Long
Dim d As Long
tpoint.x = x
tpoint.y = y
ClientToScreen Me.hwnd, tpoint
tbox.Left = (fbox.Left + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
tbox.Top = (fbox.Top + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY
tbox.Right = (fbox.Right + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
tbox.Bottom = (fbox.Bottom + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, oldbox
DrawFocusRect sDc, tbox
d = ReleaseDC(0, sDc)
oldbox = tbox
End Sub
Private Sub EndFRDrag(x As Single, y As Single)
If IsMaximized = True Then Exit Sub
If IsMinimized = True Then Exit Sub
Dim tDc As Long
Dim sDc As Long
Dim d As Long
Dim newleft As Single
Dim newtop As Single
sDc = GetDC(ByVal 0)
DrawFocusRect sDc, oldbox
d = ReleaseDC(0, sDc)
newleft = x + fbox.Left * TwipsPerPixelX - dpoint.x
newtop = y + fbox.Top * TwipsPerPixelY - dpoint.y
Me.Move newleft, newtop
cmdDummy.SetFocus
End Sub
Private Sub DrawCaption(sCaption As String)
lblFormCaption.Caption = sCaption
End Sub
Private Sub ReSize()
lineBorder1.BorderColor = vb3DHighlight
lineBorder2.BorderColor = vb3DHighlight
lineBorder3.BorderColor = vb3DShadow
lineBorder4.BorderColor = vb3DShadow
lineBorder1.Y2 = Me.Height
lineBorder2.X2 = Me.Width
lineBorder3.X1 = Me.Width - 10
lineBorder3.X2 = Me.Width - 10
lineBorder3.Y1 = 0
lineBorder3.Y2 = Me.Height
lineBorder4.X1 = 0
lineBorder4.X2 = Me.Width - 10
lineBorder4.Y1 = Me.Height - 10
lineBorder4.Y2 = Me.Height - 10
picTitleBar.Width = Me.Width - 25
imgCloseForm.Left = picTitleBar.Width - imgCloseForm.Width - GT_SPACERVAL
imgMaximize.Left = picTitleBar.Width - imgCloseForm.Width - imgMaximize.Width - GT_SPACERVAL * 2
If ButtonsCount <> 2 Then
imgMinimize.Left = picTitleBar.Width - imgCloseForm.Width - imgMaximize.Width - imgMinimize.Width - GT_SPACERVAL * 2
Else
imgMinimize.Left = picTitleBar.Width - imgCloseForm.Width - imgMinimize.Width - GT_SPACERVAL * 2
End If
Select Case GT_HOW
Case "TtoB"
MakeGrad picTitleBar, 0, GT_RED, GT_GREEN, GT_BLUE, -3, -3, -3
Case "LtoR"
MakeGrad picTitleBar, 1, GT_RED, GT_GREEN, GT_BLUE, -3, -3, -3
Case Else
MakeGrad picTitleBar, 1, GT_RED, GT_GREEN, GT_BLUE, -3, -3, -3
End Select
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -