诚求vb6的代码,有能力的帮帮忙
越多越好,求全谁多采纳谁
帮忙哈
补充:越多越好!!!!
采纳最多的,不要互相复制啊,给些有用的啊
越多越好,求全谁多采纳谁
帮忙哈
补充:越多越好!!!!
采纳最多的,不要互相复制啊,给些有用的啊
答案:这是我刚写出来的按扭校果可以看看,如有哪些地方不好,请给我一点提义,让我好进步,大家好互相学习
在Form1里加上一个Picture1 ,Appearance = 0 就行了,复制下面代到Form1里
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const BDR_RAISEDINNER = &H4
Const BDR_SUNKENINNER = &H8
Const BDR_OUTER = &H3
Const BDR_INNER = &HC
Const BDR_RAISED = &H5
Const BDR_SUNKEN = &HA
Const BF_LEFT = &H1
Const BF_TOP = &H2
Const BF_RIGHT = &H4
Const BF_BOTTOM = &H8
Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Dim re As RECT
Dim res As RECT
Private Sub Form_Mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim color As Long
re.Top = 0
re.Left = 0
re.Right = Picture1.ScaleWidth / Screen.TwipsPerPixelX
re.Bottom = Picture1.ScaleHeight / Screen.TwipsPerPixelY
color = CreateSolidBrush(65354)
FrameRect Picture1.hdc, re, color
DeleteObject color
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim color As Long
re.Top = 0
re.Left = 0
re.Right = Picture1.ScaleWidth / Screen.TwipsPerPixelX
re.Bottom = Picture1.ScaleHeight / Screen.TwipsPerPixelY
color = CreateSolidBrush(255)
FrameRect Picture1.hdc, re, color
DeleteObject color
End Sub
Private Sub Picture1_Mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
re.Top = 0
re.Left = 0
re.Right = Picture1.ScaleWidth / Screen.TwipsPerPixelX
re.Bottom = Picture1.ScaleHeight / Screen.TwipsPerPixelY
Call DownBackColor
Call Picture1_Paint
Call FocusRect
DrawEdge Picture1.hdc, re, BDR_RAISEDINNER, BF_BOTTOMRIGHT
DrawEdge Picture1.hdc, re, BDR_RAISEDINNER, BF_TOPLEFT
End Sub
Private Sub Picture1_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim color As Long
re.Top = 0
re.Left = 0
re.Right = Picture1.ScaleWidth / Screen.TwipsPerPixelX
re.Bottom = Picture1.ScaleHeight / Screen.TwipsPerPixelY
If Button = 1 Then
Call FocusRect
Call UpBackColor
Call Picture1_Paint
Call FocusRect
DrawEdge Picture1.hdc, re, BDR_SUNKENINNER, BF_BOTTOMRIGHT
DrawEdge Picture1.hdc, re, BDR_SUNKENINNER, BF_TOPLEFT
color = CreateSolidBrush(&HFF0000)
FrameRect Picture1.hdc, re, color
DeleteObject color
End If
End Sub
Private Sub FocusRect()
res.Top = 2
res.Left = 2
res.Right = Picture1.ScaleWidth / Screen.TwipsPerPixelX - 2
res.Bottom = Picture1.ScaleHeight / Screen.TwipsPerPixelY - 2
DrawFocusRect Picture1.hdc, res
End Sub
Private Sub Picture1_Paint()
Dim str As String
str = "Button"
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(str)) / 2
Picture1.CurrentY = (Picture1.ScaleHeight - Picture1.TextHeight(str)) / 2
Picture1.Print str
End Sub
Private Sub DownBackColor()
Dim uH As Single, uW As Single
Dim rInfo As Single, gInfo As Single, bInfo As Single
Dim rSta As Long, gSta As Long, bSta As Long
Dim rEnd As Long, gEnd As Long, bEnd As Long
Dim R As Long, G As Long, B As Long, i As Long
uH = Picture1.ScaleHeight: uW = Picture1.ScaleWidth
rSta = 12640511 Mod 256
gSta = 12640511 \ 256 Mod 256
bSta = 12640511 \ 256 \ 256
rEnd = 14737632 Mod 256
gEnd = 14737632 \ 256 Mod 256
bEnd = 14737632 \ 256 \ 256
rSta = rSta * 1.2: gSta = gSta * 1.2: bSta = bSta * 1.2
rEnd = rEnd * 1.2: gEnd = gEnd * 1.2: bEnd = bEnd * 1.2
rInfo = (rEnd - rSta) / uH
gInfo = (gEnd - gSta) / uH
bInfo = (bEnd - bSta) / uH
For i = 0 To uH - 1
R = rSta + i * rInfo
G = gSta + i * gInfo
B = bSta + i * bInfo
Picture1.Line (0, i)-(uW - 1, i), RGB(R, G, B)
Next i
End Sub
Private Sub UpBackColor()
Dim uH As Single, uW As Single
Dim rInfo As Single, gInfo As Single, bInfo As Single
Dim rSta As Long, gSta As Long, bSta As Long
Dim rEnd As Long, gEnd As Long, bEnd As Long
Dim R As Long, G As Long, B As Long, i As Long
uH = Picture1.ScaleHeight: uW = Picture1.ScaleWidth
rSta = 12640511 Mod 256
gSta = 12640511 \ 256 Mod 256
bSta = 12640511 \ 256 \ 256
rEnd = 14737632 Mod 256
gEnd = 14737632 \ 256 Mod 256
bEnd = 14737632 \ 256 \ 256
rInfo = (rEnd - rSta) / uH
gInfo = (gEnd - gSta) / uH
bInfo = (bEnd - bSta) / uH
For i = 0 To uH - 1
R = rSta + i * rInfo
G = gSta + i * gInfo
B = bSta + i * bInfo
Picture1.Line (0, i)-(uW - 1, i), RGB(R, G, B)
Next i
End SubVB代码普导