2017-2-28
15:42

root
root

[程序代码]学习API制作的不规则窗体一

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal Y2 As Long) As Long
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 Const RGN_XOR = 3
'Private Const RGN_AND = 1
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

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETHORIZONTALEXTENT = &H194

'Private doevents mybutton As CommandButton
Private WithEvents NewButton As CommandButton
Private WithEvents NewButton1 As CommandButton
Private WithEvents mylist As ListBox
'Private WithEvents myplay As WindowsMediaPlayer

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
    Call ReleaseCapture
    Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub


Private Sub Form_Load()
 Dim x1, x2, x3, x4, x5
    x1 = CreateEllipticRgn(150, 150, 200, 200)
    x2 = CreateEllipticRgn(150, 150, 350, 350)
    x3 = CreateEllipticRgn(150, 300, 200, 350)
    x4 = CreateEllipticRgn(300, 150, 350, 200)
    x5 = CreateEllipticRgn(300, 300, 350, 350)
'    CombineRgn x1, x1, x2, RGN_XOR
'    CombineRgn x1, x1, x2, RGN_AND
    CombineRgn x1, x1, x2, RGN_OR
    CombineRgn x1, x1, x3, RGN_OR
    CombineRgn x1, x1, x4, RGN_OR
    CombineRgn x1, x1, x5, RGN_OR
    SetWindowRgn hwnd, x1, 1
    Me.BackColor = vbRed
    Set NewButton = Controls.Add("VB.CommandButton", "NewCmd", Me)
   ' NewButton.Move Command1.Left + Command1.Width + 240, Command1.Top, Command1.Width, Command1.Height
    With NewButton
        .Left = 3200
        .Top = 2000
        .Width = 1000
        .Height = 350
        .Caption = "Exit"
       ' .Style = Grapical
        '.BackColor = vbBlue
        .Visible = True
    End With
    Set mylist = Controls.Add("VB.listbox", "listfirst", Me)
     With mylist
        .Left = 2800
        .Top = 2400
        .Width = 1800
        .Height = 2000
       '‘ .AddItem "lanshan"
        .BackColor = vbGreen
        .Visible = True
     End With
     SendMessage mylist.hwnd, LB_SETHORIZONTALEXTENT, 200, 0
      Set NewButton1 = Controls.Add("VB.CommandButton", "Open", Me)
   ' NewButton.Move Command1.Left + Command1.Width + 240, Command1.Top, Command1.Width, Command1.Height
    With NewButton1
        .Left = 3200
        .Top = 4400
        .Width = 1000
        .Height = 350
        .Caption = "Open"
       ' .Style = Grapical
       ' .BackColor = vbBlue
        .Visible = True
    End With
    WindowsMediaPlayer1.Visible = False
   ' Set myplay = Controls.Add("VB.WindowsMediaPlayer", "play", Me)
   ' Me.PaintPicture Me.Picture, 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Set NewButton = Nothing
  Set mylist = Nothing
  Set myopendialog = Nothing
End Sub

Private Sub mylist_DblClick()
WindowsMediaPlayer1.URL = mylist.Text
'WindowsMediaPlayer1. = True
WindowsMediaPlayer1.Controls.play
End Sub

Private Sub NewButton_Click()
    End
End Sub

Private Sub NewButton1_Click()
   CommonDialog1.FileName = ""
    CommonDialog1.Flags = &H80000
    CommonDialog1.Filter = "MP3文件(*.MP3)|*.mp3|WMA文件(*.WMA)|*.wma"
    CommonDialog1.DialogTitle = "打开文件"
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then
        MsgBox "文件为空!!!"
    Else
       mylist.Refresh
       mylist.AddItem CommonDialog1.FileName
    End If
End Sub
文章如需转载请注明:转载自: 紫灵幽梦
« 上一篇 下一篇 »

相关文章:

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表留言: