readme.frm

一个VB编写的校园即时广播系统,具有简单的定时广播性能

VERSION 5.00
Begin VB.Form Readme 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "关于我"
   ClientHeight    =   2160
   ClientLeft      =   105
   ClientTop       =   1200
   ClientWidth     =   1875
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "Readme.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   144
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   125
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Interval        =   50
      Left            =   -45
      Top             =   -15
   End
   Begin VB.Image Image1 
      Height          =   1320
      Left            =   270
      Picture         =   "Readme.frx":000C
      ToolTipText     =   "我是罗明"
      Top             =   885
      Width           =   1485
   End
End
Attribute VB_Name = "Readme"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 GetSystemMetrics Lib "user32" (ByVal nIndex 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)
Private Type POINTAPI
   X As Long
   Y As Long
End Type

Private scnPts() As POINTAPI
Private rgnPts() As POINTAPI

Private Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33


Private Const ALTERNATE = 1
Private m_FillMode As Long
Private Const nPts& = 36


Private Sub Form_Load()
   Me.Top = 0
   Me.Left = 0 - Me.Width
   m_FillMode = ALTERNATE
   Dim rtn
rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
   With Me
      .ScaleMode = vbPixels
      .Icon = Nothing
   End With
End Sub

Private Static Sub CalcRgnPoints()
   ReDim scnPts(0 To nPts) As POINTAPI
   ReDim rgnPts(0 To nPts) As POINTAPI
   Dim offset As Long
   Dim angle As Long
   Dim theta As Double
   Dim radius1 As Long
   Dim radius2 As Long
   Dim x1 As Long
   Dim y1 As Long
   Dim xOff As Long
   Dim yOff As Long
   Dim n As Long
   Const Pi# = 3.14159265358979
   Const DegToRad# = Pi / 180
   x1 = Me.ScaleWidth \ 2
   y1 = Me.ScaleHeight \ 2
   If x1 > y1 Then
      radius1 = y1 * 0.85
   Else
      radius1 = x1 * 0.85
   End If
   radius2 = radius1 * 0.5
   xOff = GetSystemMetrics(SM_CXFRAME)
   yOff = GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYCAPTION)
   n = 0
   For angle = 0 To 360 Step 10
      theta = (angle - offset) * DegToRad
      If n Mod 2 Then
         scnPts(n).X = x1 + (radius1 * (Sin(theta)))
         scnPts(n).Y = y1 + (radius1 * (Cos(theta)))
      Else
         scnPts(n).X = x1 + (radius2 * (Sin(theta)))
         scnPts(n).Y = y1 + (radius2 * (Cos(theta)))
      End If
      rgnPts(n).X = scnPts(n).X + xOff
      rgnPts(n).Y = scnPts(n).Y + yOff
      n = n + 1
DoEvents
   Next angle
   offset = (offset + 2) Mod 361
End Sub

Private Sub Image1_DblClick()
MsgBox "谢谢使用本软件" & Chr(13) & " 请你多多支持", , "校园及时通"
Timer1.Enabled = False
Dim a As Integer
For a = 50 To 450
Me.Left = Me.Left - a
DoEvents
If Me.Left + Me.Width < 0 Then Unload Me: Exit Sub
Next
Unload Me
End Sub

Private Static Sub Timer1_Timer()
   Dim nRet As Long
   Dim hRgn As Long
   CalcRgnPoints
   hRgn = CreatePolygonRgn(rgnPts(0), nPts, m_FillMode)
   nRet = SetWindowRgn(Me.hwnd, hRgn, True)
DoEvents
If Me.Left > Screen.Width Then
Unload Me: Exit Sub
End If
Me.Left = Me.Left + 30
End Sub