[此贴子已经被作者于2007-8-3 21:28:44编辑过]

附件传不上来，我把代码发上来，你们看看哪有问题？？
Form1---code:
'API函数声明
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CreateRectRgn 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 mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

'透明窗体参数设置
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2 '颜色无效
Private Const LWA_COLORKEY = &H1 '颜色有效
'初始数据
Dim Flag As Boolean
Dim X1 As Long
Dim Y1 As Long
Dim Res As Integer
Dim Ret As String * 1024

Private Sub Bai_Click()
Label1.ForeColor = RGB(255, 255, 255)
End Sub

Private Sub GBNaoZhong_Click()
'Res = mciSendString("close all", Ret, 1024, 0)
Dim K As Integer
If Shijiandao = True Then
K = MsgBox("关闭闹钟！", 0 + vbInformation, "闹钟")
If K = 1 Then
Timer2.Enabled = False
Form2.Combo1.Text = "12"
Form2.Combo2.Text = "00"
H = -1
M = -1
Res = mciSendString("close all", Ret, 1024, 0)
End If
Else
K = MsgBox("你还没设置闹钟，是否现在设置？", 4 + vbInformation, "闹钟")
If K = 7 Then
Timer2.Enabled = False
Form2.Combo1.Text = "12"
Form2.Combo2.Text = "00"
H = -1
M = -1
Res = mciSendString("close all", Ret, 1024, 0)
Else
Load Form2
Form2.Visible = True
Timer2.Interval = 10
Shijiandao = False
Form2.Combo1.Text = "12"
Form2.Combo2.Text = "00"
End If
End If
Shijiandao = False
End Sub

Private Sub Hei_Click()
Label1.ForeColor = RGB(0, 0, 0)
End Sub

Private Sub Hong_Click()
Label1.ForeColor = RGB(255, 0, 0)
End Sub

'双击退出
Private Sub Image1_DblClick()
Res = mciSendString("close all", Ret, 1024, 0)
End
End Sub

Private Sub Form_Load()
Form1.ScaleMode = 3
'透明窗体
Dim rtn As Long
If FengG = False Then
If Bian = True Then
Label1.Top = Label1.Top - 2
Label1.Left = Label1.Left - 1
Image1.Width = Image1.Width - 130
Image1.Height = Image1.Height - 20
Form1.Width = Form1.Width - 130
Form1.Height = Form1.Height - 20
End If

rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
Form1.Picture = LoadPicture(App.Path & "\史努比(230,60,1).bmp")
SetWindowLong hWnd, GWL_EXSTYLE, rtn
'SetLayeredWindowAttributes hWnd, RGB(230, 60, 1), 200, LWA_ALPHA
SetLayeredWindowAttributes hWnd, RGB(230, 60, 1), 255, LWA_COLORKEY
End If
If FengG = True Then
Label1.Top = Label1.Top + 2
Label1.Left = Label1.Left + 1
Image1.Width = Image1.Width + 130
Image1.Height = Image1.Height + 20
Form1.Width = Form1.Width + 130
Form1.Height = Form1.Height + 20
Form1.Picture = LoadPicture(App.Path & "\米老鼠(194,122,50).bmp")

rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hWnd, RGB(194, 122, 50), 255, LWA_COLORKEY
End If

'时间显示
Label1.Caption = Time

Timer1.Interval = 1000
Timer2.Interval = 1000
Timer1.Enabled = True
Timer2.Enabled = False

Hour = -1
Min = -1

'切割窗体
Dim i As Integer
Dim rwnd, X2, Y2
X2 = ScaleX(Me.Width, vbTwips, vbPixels)
Y2 = ScaleY(Me.Height, vbTwips, vbPixels)
rwnd = CreateRectRgn(5, 30, X2 - 5, Y2 - 5)
SetWindowRgn Me.hWnd, rwnd, True
'窗体置前,初始左上角
Call ZuoS_Click
SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, &H1 Or &H2

End Sub
'窗体移动
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Flag = True
X1 = X
Y1 = Y
End If
If Button = 2 Then
Form1.PopupMenu CaiDan, 4
End If
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Flag = True Then
Form1.Move Form1.Left + (X - X1), Form1.Top + (Y - Y1)
End If
Image1.ToolTipText = Format(Date, "dddddd") & " " & WeekdayName(Weekday(Date))
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Flag = False
Form1.Move Form1.Left + (X - X1), Form1.Top + (Y - Y1)
End Sub

Private Sub Lan_Click()
Label1.ForeColor = RGB(0, 0, 255)
End Sub

Private Sub Lu_Click()
Label1.ForeColor = RGB(0, 255, 0)
End Sub

Private Sub MLS_Click()
FengG = True
Bian = True
Call Form_Load
End Sub

'闹钟设置
Private Sub NZSheZhi_Click()
Form2.Visible = True
Form2.Label3.Caption = Format(Time, "hh:mm")
End Sub

Private Sub SLB_Click()
FengG = False
Call Form_Load
End Sub

'时时更新时间
Private Sub Timer1_Timer()
Dim T As String
Label1.Caption = Time
T = Format(Time, "hh:mm")
If Val(Left(T, 2)) = Hour And Val(Mid(T, 4, 2)) = Min Then
Shijiandao = True
Timer2.Enabled = True
End If
End Sub
'启动闹钟
Private Sub Timer2_Timer()
'Dim Res As Integer, Ret As String * 1024
'If Val(Left(Label1.Caption, 2)) = Hour And Val(Mid(Label1.Caption, 4, 2)) = Min Then
'If CommonDialog1.FileName = "" Then
'Res = mciSendString("play " & App.Path & "\110.mp3", Ret, 1024, 0)
'Else
'Res = mciSendString("play " & LingY, Ret, 1024, 0)
'End If
'End If
If Shijiandao = True Then
Call LING_YIN
Timer2.Interval = 0
End If
End Sub
'退出
Private Sub TuiChu_Click()
Unload Me
Res = mciSendString("close all", Ret, 1024, 0)
End
End Sub

'窗体位置选择
Private Sub YouS_Click()
Form1.Top = 50
Form1.Left = 100
End Sub

Private Sub YouX_Click()
Form1.Top = 12000
Form1.Left = 100
End Sub

Private Sub ZDY_Click()
Form3.Visible = True
End Sub

Private Sub ZhongX_Click()
Form1.Top = 6200
Form1.Left = 8400
End Sub

Private Sub ZuoS_Click()
Form1.Top = 50
Form1.Left = 16500
End Sub
'闹钟铃音
Private Sub LING_YIN()

Res = mciSendString("open 110.mp3", Ret, 1024, 0)
Res = mciSendString("play 110.mp3", Ret, 1024, 0)

End Sub


Form2----code:
Private Sub Combo1_Change()
If Not IsNumeric(Combo1.Text) Or Val(Combo1.Text) < 0 Or Val(Combo1.Text) > 24 Then
MsgBox "请输入正确的时间或从下拉表里选择！", vbOKOnly + vbInformation, "友情提示"
Combo1.Text = "12"
End If
End Sub

Private Sub Combo2_Change()
If Not IsNumeric(Combo2.Text) Or Val(Combo2.Text) < 0 Or Val(Combo2.Text) > 59 Then
MsgBox "请输入正确的时间或从下拉表里选择！", vbOKOnly + vbInformation, "友情提示"
Combo2.Text = "00"
End If
End Sub

Private Sub Command1_Click()
Hour = Val(Combo1.Text)
Min = Val(Combo2.Text)
Me.Visible = False
End Sub

Private Sub Command2_Click()
Hour = -1
Min = -1
Combo1.Text = "12"
Combo2.Text = "00"
Me.Visible = False
End Sub

Private Sub Timer1_Timer()
Form2.Label3.Caption = Format(Form1.Label1.Caption, "hh:mm")
End Sub


Form3---code:

Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim S As Long

Private Sub Command1_Click()
Form1.Label1.ForeColor = Picture1.BackColor
Unload Me
End Sub

Private Sub Command2_Click()
HScroll1.Value = 0
HScroll2.Value = 0
HScroll3.Value = 0
Form1.Label1.ForeColor = S
Unload Me
End Sub

Private Sub Form_Load()
R = 0: G = 0: B = 0
Picture1.BackColor = RGB(R, G, B)
S = Form1.Label1.ForeColor
End Sub

Private Sub HScroll1_Change()
R = HScroll1.Value
Picture1.BackColor = RGB(R, G, B)
Form1.Label1.ForeColor = Picture1.BackColor
End Sub

Private Sub HScroll2_Change()
G = HScroll2.Value
Picture1.BackColor = RGB(R, G, B)
Form1.Label1.ForeColor = Picture1.BackColor
End Sub

Private Sub HScroll3_Change()
B = HScroll3.Value
Picture1.BackColor = RGB(R, G, B)
Form1.Label1.ForeColor = Picture1.BackColor
End Sub


模块：
Public Hour As Integer
Public Min As Integer
Public Shijiandao As Boolean
Public FengG As Boolean
Public Bian As Boolean