学习API制作的不规则窗体一
0 Reply , Posted in 程序代码 on 2017 28, 2017
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
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
