home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1999 February / VPR9902A.BIN / Vpr_data / Program / vb / prog / FormMain.frm next >
Text File  |  1998-11-17  |  9KB  |  275 lines
  1. VERSION 5.00
  2. Begin VB.Form FormMain 
  3.    BorderStyle     =   0  'なし
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   3060
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   5685
  9.    BeginProperty Font 
  10.       Name            =   "ＭＳ Ｐゴシック"
  11.       Size            =   12
  12.       Charset         =   128
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    LinkTopic       =   "Form1"
  19.    ScaleHeight     =   3060
  20.    ScaleMode       =   0  'ﾕｰｻﾞｰ
  21.    ScaleWidth      =   5685
  22.    ShowInTaskbar   =   0   'False
  23.    StartUpPosition =   3  'Windows の既定値
  24.    Begin VB.PictureBox PictureClockDraw 
  25.       Appearance      =   0  'ﾌﾗｯﾄ
  26.       BackColor       =   &H00000000&
  27.       BorderStyle     =   0  'なし
  28.       BeginProperty Font 
  29.          Name            =   "Courier New"
  30.          Size            =   14.25
  31.          Charset         =   0
  32.          Weight          =   400
  33.          Underline       =   0   'False
  34.          Italic          =   0   'False
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       ForeColor       =   &H00FFFFFF&
  38.       Height          =   2775
  39.       Left            =   1920
  40.       ScaleHeight     =   2775
  41.       ScaleWidth      =   3615
  42.       TabIndex        =   1
  43.       Top             =   120
  44.       Width           =   3615
  45.    End
  46.    Begin VB.Timer TimerClockDraw 
  47.       Interval        =   1000
  48.       Left            =   120
  49.       Top             =   1440
  50.    End
  51.    Begin VB.PictureBox PictureBlack 
  52.       Appearance      =   0  'ﾌﾗｯﾄ
  53.       AutoRedraw      =   -1  'True
  54.       BackColor       =   &H00404040&
  55.       BorderStyle     =   0  'なし
  56.       BeginProperty Font 
  57.          Name            =   "ＭＳ Ｐゴシック"
  58.          Size            =   9
  59.          Charset         =   128
  60.          Weight          =   400
  61.          Underline       =   0   'False
  62.          Italic          =   0   'False
  63.          Strikethrough   =   0   'False
  64.       EndProperty
  65.       ForeColor       =   &H80000008&
  66.       Height          =   1215
  67.       Left            =   120
  68.       ScaleHeight     =   1215
  69.       ScaleWidth      =   1575
  70.       TabIndex        =   0
  71.       Top             =   120
  72.       Width           =   1575
  73.    End
  74. End
  75. Attribute VB_Name = "FormMain"
  76. Attribute VB_GlobalNameSpace = False
  77. Attribute VB_Creatable = False
  78. Attribute VB_PredeclaredId = True
  79. Attribute VB_Exposed = False
  80. Private Const Pi = 3.14159265358979
  81. Private Const TwoPi = Pi + Pi
  82. Private Const HalfPi = Pi / 2
  83.  
  84. Private Sub Form_Load()
  85.     Dim Res As Long
  86.     Dim ResMCIStr As String * 256
  87.     Dim hwndSrc As Long, hSrcDC As Long
  88.     'デスクトップ画面全体をコピー
  89.     Left = 0
  90.     Top = 0
  91.     Width = Screen.Width
  92.     Height = Screen.Height
  93.     Move 0, 0, Screen.Width, Screen.Height
  94.     PictureBlack.Move 0, 0, Screen.Width, Screen.Height
  95.     Show
  96.     
  97.     PictureBlack.ScaleMode = vbPixels
  98.     hwndSrc = GetDesktopWindow()
  99.     hSrcDC = GetDC(hwndSrc)
  100.     Res = BitBlt(PictureBlack.hdc, 0, 0, PictureBlack.ScaleWidth, _
  101.         PictureBlack.ScaleHeight, hSrcDC, 0, 0, SRCAND)
  102.     Res = ReleaseDC(hwndSrc, hSrcDC)
  103.     
  104.     'CD演奏
  105.     Res = mciSendString("open cdaudio", ResMCIStr, 256, 0)
  106.     Res = mciSendString("play cdaudio", ResMCIStr, 256, 0)
  107.     
  108. End Sub
  109.  
  110. Private Sub Form_Unload(Cancel As Integer)
  111.     Dim Res As Long
  112.     Dim ResMCIStr As String * 256
  113.     
  114.     'CD停止
  115.     Res = mciSendString("stop cdaudio", ResMCIStr, 256, 0)
  116.     Res = mciSendString("close cdaudio", ResMCIStr, 256, 0)
  117.  
  118. End Sub
  119.  
  120. Private Sub PictureBlack_Click()
  121.     flagQuit = True
  122.  
  123. End Sub
  124.  
  125. Private Sub PictureBlack_KeyDown(KeyCode As Integer, Shift As Integer)
  126.     flagQuit = True
  127.  
  128. End Sub
  129.  
  130. Private Sub PictureBlack_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  131.     Static ptrXlast As Integer
  132.     Static ptrYlast As Integer
  133.     Dim ptrXnow As Integer
  134.     Dim ptrYnow As Integer
  135.     
  136.     ptrXnow = x
  137.     ptrYnow = y
  138.     If ptrXlast = 0 And ptrYlast = 0 Then
  139.         ptrXlast = ptrXnow
  140.         ptrYlast = ptrYnow
  141.         Exit Sub
  142.     End If
  143.     If ptrXnow <> ptrXlast Or ptrYnow <> ptrYlast Then
  144.         flagQuit = True
  145.     End If
  146.  
  147. End Sub
  148.  
  149. Private Sub TimerClockDraw_Timer()
  150.     Dim Res As Long
  151.     Dim valTimeH As Integer
  152.     Dim valTimeM As Integer
  153.     Dim valTimeS As Integer
  154.     Dim valDegH As Double
  155.     Dim valDegM As Double
  156.     Dim valDegS As Double
  157.     Dim valPtHx As Double
  158.     Dim valPtHy As Double
  159.     Dim valPtMx As Double
  160.     Dim valPtMy As Double
  161.     Dim valPtSx As Double
  162.     Dim valPtSy As Double
  163.     Dim ResMCIStr As String * 256
  164.     Static countMove As Integer
  165.     
  166.     '現在の秒の値を追跡
  167.     Static LastSecond
  168.     '秒の更新チェック
  169.     If Second(Now) = LastSecond Then
  170.         Exit Sub
  171.     Else
  172.         LastSecond = Second(Now)
  173.     End If
  174.     
  175.     '背景イメージ復活
  176.     With PictureClockDraw
  177.         .Visible = False
  178.         .ScaleMode = vbPixels
  179.         If countMove <= 0 Then
  180.             countMove = 4
  181. '            .Width = .Height / 3 * 4
  182.             .Left = Int(Rnd * (FormMain.Width - .Width))
  183.             .Top = Int(Rnd * (FormMain.Height - .Height))
  184.         End If
  185.         countMove = countMove - 1
  186.         .Visible = True
  187.         .Cls
  188.     End With
  189.     
  190.     PictureBlack.ScaleMode = vbPixels
  191.     Res = BitBlt(PictureClockDraw.hdc, 0, 0, _
  192.         PictureClockDraw.ScaleWidth, PictureClockDraw.ScaleHeight, _
  193.         PictureBlack.hdc, _
  194.         FormMain.ScaleX(PictureClockDraw.Left, vbTwips, vbPixels), _
  195.         FormMain.ScaleY(PictureClockDraw.Top, vbTwips, vbPixels), _
  196.         SRCCOPY)
  197.     
  198.     '時刻変数更新
  199.     valTimeH = Hour(Now)
  200.     valTimeM = Minute(Now)
  201.     valTimeS = Second(Now)
  202.     '針の角度計算
  203.     valDegH = TwoPi * (valTimeH + valTimeM / 60) / 12 - HalfPi
  204.     valDegM = TwoPi * (valTimeM + valTimeS / 60) / 60 - HalfPi
  205.     valDegS = TwoPi * valTimeS / 60 - HalfPi
  206.     '針の終端点計算
  207.     valPtHx = 0.4 * Cos(valDegH)
  208.     valPtHy = 0.4 * Sin(valDegH)
  209.     valPtMx = 0.7 * Cos(valDegM)
  210.     valPtMy = 0.7 * Sin(valDegM)
  211.     valPtSx = 0.9 * Cos(valDegS)
  212.     valPtSy = 0.9 * Sin(valDegS)
  213.     
  214.     
  215.     '時計縁取り表示
  216.     Dim rat As Single
  217.     PictureClockDraw.Scale
  218.     rat = PictureClockDraw.ScaleWidth / PictureClockDraw.ScaleHeight
  219.     PictureClockDraw.Scale (-1, -1)-(1, 1)
  220.     PictureClockDraw.DrawWidth = 3
  221.     PictureClockDraw.Circle (0, 0), 0.95, RGB(50, 100, 50), , , 1 / rat
  222.     PictureClockDraw.Scale (-rat, -1)-(rat, 1)
  223.     PictureClockDraw.DrawWidth = 5
  224.     PictureClockDraw.Circle (0, 0), 0.8, RGB(50, 50, 150)
  225.     
  226.     '新しい針を描画
  227.     PictureClockDraw.DrawWidth = 3
  228.     PictureClockDraw.Line (0, 0)-(valPtMx, valPtMy), RGB(255, 255, 255)
  229.     PictureClockDraw.DrawWidth = 3
  230.     PictureClockDraw.Line (0, 0)-(valPtHx, valPtHy), RGB(255, 255, 255)
  231.     PictureClockDraw.DrawWidth = 1
  232.     PictureClockDraw.Line (0, 0)-(valPtSx, valPtSy), RGB(255, 255, 255)
  233.     
  234.     Dim strPrint As String
  235.     Dim ptrX As Integer
  236.     Dim ptrY As Integer
  237.     
  238.     '現在時刻表示
  239.     PictureClockDraw.ScaleMode = vbPixels
  240.     strPrint = Format$(Now, "hh:mm:ss")
  241.     ptrX = PictureClockDraw.ScaleWidth \ 2
  242.     ptrY = PictureClockDraw.ScaleHeight \ 2
  243.     PictureClockDraw.CurrentX = ptrX - PictureClockDraw.TextWidth(strPrint) \ 2
  244.     PictureClockDraw.CurrentY = -50 + ptrY - PictureClockDraw.TextHeight(strPrint) \ 2
  245.     PictureClockDraw.Print strPrint
  246.     
  247.     '演奏中トラック表示
  248.     Res = mciSendString("status cdaudio media present", ResMCIStr, 256, 0)
  249.     If StrComp(ResMCIStr, "True", vbTextCompare) Then
  250.         Exit Sub
  251.     End If
  252.     
  253.     Res = mciSendString("status cdaudio current track", ResMCIStr, 256, 0)
  254.     PictureClockDraw.ScaleMode = vbPixels
  255.     Res = Val(ResMCIStr)
  256.     strPrint = "Track " + Format$(Res, "#0")
  257.     ptrX = PictureClockDraw.ScaleWidth \ 2
  258.     ptrY = PictureClockDraw.ScaleHeight \ 2
  259.     PictureClockDraw.CurrentX = ptrX - PictureClockDraw.TextWidth(strPrint) \ 2
  260.     PictureClockDraw.CurrentY = 50 + ptrY - PictureClockDraw.TextHeight(strPrint) \ 2
  261.     PictureClockDraw.Print strPrint
  262.  
  263.     '演奏中ポジション表示
  264.     Res = mciSendString("status cdaudio position", ResMCIStr, 256, 0)
  265.     PictureClockDraw.ScaleMode = vbPixels
  266.     strPrint = "Position " + Left(ResMCIStr, 5)
  267.     ptrX = PictureClockDraw.ScaleWidth \ 2
  268.     ptrY = PictureClockDraw.ScaleHeight \ 2
  269.     PictureClockDraw.CurrentX = ptrX - PictureClockDraw.TextWidth(strPrint) \ 2
  270.     PictureClockDraw.CurrentY = 20 + ptrY - PictureClockDraw.TextHeight(strPrint) \ 2
  271.     PictureClockDraw.Print strPrint
  272.     
  273. End Sub
  274.  
  275.