当前位置:编程学习 > VB >>

诚求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 Sub
VB代码普导

上一个:VB如何设置在失去焦点之后仍然相应键盘事件?
下一个:VB中怎么使image控件实现九十度旋转

CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,