home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 1999 February
/
VPR9902A.BIN
/
Vpr_data
/
Program
/
vb
/
prog
/
Module1.bas
< prev
next >
Wrap
BASIC Source File
|
1998-11-17
|
4KB
|
134 lines
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