drewfrm.bas

请你们使用一下!可能你们喜欢这个.我在我的电脑上使用过.

Attribute VB_Name = "module1"
Option Explicit
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public ponum As Integer
Public Clockf(50) As String
Public clockn(50) As String
Public Alertft(50) As String
Public Alertot(50) As String
Public alertfms(50) As String
Public alertoms(50) As String
Public alertoda(50) As String
Public Const WM_SYSCOMMAND = &H112
Public AUTOPLAY As Boolean
Public Const SC_MOVE = &HF010&
Public Const HTCAPTION = 2
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Public xy() As POINTAPI
Public 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
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function drewfrm(hWnd As Long, pathname As String)
    Dim hrgn As Long
    Dim lres As Long
    Dim inputdata As String
    Dim i As Integer
    Open pathname For Input As 1
    Line Input #1, inputdata
       ponum = Val(inputdata)
    Close #1
    ReDim xy(ponum - 1) As POINTAPI
         Open pathname For Input As 1
         Line Input #1, inputdata
    For i = 0 To ponum - 1
         Line Input #1, inputdata
         xy(i).x = Val(inputdata)
         Line Input #1, inputdata
         xy(i).y = Val(inputdata)
    Next i
    Close #1
    hrgn = CreatePolygonRgn(xy(0), ponum, 2)
    lres = SetWindowRgn(hWnd, hrgn, True)
End Function
Public Function typetime(timetype As String)
    If Left(timetype, 2) = "闹铃" Then
       If Mid$(timetype, 3, 2) = "每日" Then
          typetime = 1
       ElseIf Mid$(timetype, 3, 2) = "今次" Then
          typetime = 2
       End If
    ElseIf Left(timetype, 2) = "提醒" Then
       If Mid$(timetype, 3, 2) = "每日" Then
          typetime = 3
       ElseIf Mid$(timetype, 3, 2) = "今次" Then
          typetime = 4
       End If
    End If
End Function
Public Function timemove(Timetxt As String)
    Form1.Line3.X1 = 920 + 540 * Cos(3.14159 / 2 - Second(Timetxt) * 3.14159 / 30)
    Form1.Line3.Y1 = 1880 - 540 * Sin(3.14159 / 2 - Second(Timetxt) * 3.14159 / 30)
    Form1.Line1.X1 = 920 + 400 * Cos(3.14159 / 2 - Minute(Timetxt) * 3.14159 / 30)
    Form1.Line1.Y1 = 1880 - 400 * Sin(3.14159 / 2 - Minute(Timetxt) * 3.14159 / 30)
    Form1.Line2.X1 = 920 + 300 * Cos(3.14159 / 2 - Hour(Timetxt) * 3.14159 / 6 - (Minute(Timetxt) \ 12) * 3.14159 / 30)
    Form1.Line2.Y1 = 1880 - 300 * Sin(3.14159 / 2 - Hour(Timetxt) * 3.14159 / 6 - (Minute(Timetxt) \ 12) * 3.14159 / 30)
End Function
Public Sub PutWindowOnTop(pFrm As Form)
    Dim lngWindowPosition As Long
    lngWindowPosition = SetWindowPos(pFrm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub