home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "Module1"
- '画面全体のコピーを取得
- Public Declare Function BitBlt Lib "gdi32" ( _
- ByVal hDestDC As Long, _
- ByVal x As Long, ByVal y As Long, _
- ByVal nWidth As Long, _
- ByVal nHeight As Long, _
- ByVal hSrcDC As Long, _
- ByVal XSrc As Long, ByVal YSrc As Long, _
- ByVal dwRop As Long _
- ) As Long
-
-
- '長方形を塗りつぶす
- Public Declare Function FillRect Lib "user32" ( _
- ByVal hdc As Long, _
- lpRect As RECT, _
- ByVal hBrush As Long _
- ) As Long
-
- '画面へのハンドルを取得
- Public Declare Function GetDesktopWindow Lib "user32" () As Long
-
- 'ハンドルをデバイスコンテキストに変換
- Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
-
- 'デバイスコンテキストを解放
- Public Declare Function ReleaseDC Lib "user32" ( _
- ByVal hwnd As Long, ByVal hdc As Long _
- ) As Long
-
- Public Type RECT
- Left As Long
- Top As Long
- Right As Long
- Bottom As Long
- End Type
-
- 'ウィンドウの位置設定
- Public Declare Sub 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 _
- )
-
- 'マウスカーソルの表示制御
- Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
- 'システム起動時間
- Public Declare Function GetTickCount Lib "kernel32" () As Long
-
- Public 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
-
- Public Declare Function mciGetErrorString Lib "winmm.dll" _
- Alias "mciGetErrorStringA" ( _
- ByVal dwError As Long, _
- ByVal lpstrBuffer As String, _
- ByVal uLength As Long _
- ) As Long
-
- 'SetWindowsPos
- Public Const HWND_TOPMOST = -1
- Public Const HWND_NOTOPMOST = -2
- Public Const HWND_BOTTOM = 1
- Public Const PM_NOREMOVE = 0
- Public Const PM_NOYIELD = 2
- Public Const PM_REMOVE = 1
- 'BitBlt
- Public Const SWP_NOACTIVATE = &H10
- Public Const SWP_NOMOVE = &H2
- Public Const SWP_NOSIZE = &H1
- Public Const SRCCOPY = &HCC0020
- Public Const MERGECOPY = &HC000CA
- Public Const MERGEPAINT = &HBB0226
- Public Const SRCAND = &H8800C6
- Public Const SRCPAINT = &HEE0086
-
- Public flagQuit As Boolean
-
- Sub Main()
-
- If App.PrevInstance = True Then
- Exit Sub
- End If
-
- Select Case UCase$(Left$(Command$, 2))
- Case "/C"
- Load frmAbout
- frmAbout.lblDescription = App.Comments
- frmAbout.lblDisclaimer = App.LegalCopyright
- frmAbout.Show
- Exit Sub
-
- Case "/A"
- Load frmAbout
- frmAbout.lblDescription = App.Comments
- frmAbout.lblDisclaimer = App.LegalCopyright
- frmAbout.Show
- Exit Sub
-
- Case "/S"
- flagQuit = False
- Randomize
- Load FormMain
- 'スクリーンの常に最前面に表示されるよう設定
- Call SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
- 'マウスカーソルを消す
- ' Do Until ShowCursor(False) < 0
- ' Loop
-
- 'スクリーンセーバー動作の部分
- Do
- DoEvents
- Loop While flagQuit = False
-
- 'カーソル復活
- Do Until ShowCursor(True) >= 0
- Loop
- '画面復活
- Unload FormMain
-
- Exit Sub
-
- Case Else
- Exit Sub
- End Select
- End Sub
-