home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 1996 August
/
VPR9608A.BIN
/
vpr_data
/
vb32
/
source
/
piano.frm
< prev
next >
Wrap
Text File
|
1996-05-29
|
10KB
|
363 lines
VERSION 4.00
Begin VB.Form Form1
BorderStyle = 0 'なし
Caption = "Form1"
ClientHeight = 3690
ClientLeft = 4950
ClientTop = 4590
ClientWidth = 4815
ControlBox = 0 'False
Height = 4095
Icon = "Piano.frx":0000
Left = 4890
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "Piano.frx":030A
ScaleHeight = 3690
ScaleWidth = 4815
ShowInTaskbar = 0 'False
Top = 4245
Width = 4935
Begin VB.ListBox List1
Height = 60
Left = 120
TabIndex = 1
Top = 240
Width = 3135
End
Begin VB.CommandButton Command1
BackColor = &H00FF8080&
Caption = "×"
BeginProperty Font
name = "MS Pゴシック"
charset = 128
weight = 700
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 252
Left = 3360
TabIndex = 0
Top = 240
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 16
Left = 3360
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 15
Left = 3120
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 14
Left = 3000
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 13
Left = 2760
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 12
Left = 2640
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 11
Left = 2280
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 10
Left = 2040
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 9
Left = 1920
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 8
Left = 1680
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 7
Left = 1560
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 6
Left = 1320
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 5
Left = 1200
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 4
Left = 840
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 3
Left = 600
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 2
Left = 120
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image2
Height = 492
Index = 1
Left = 240
Stretch = -1 'True
Top = 600
Width = 372
End
Begin VB.Image Image2
Height = 852
Index = 0
Left = 480
Stretch = -1 'True
Top = 1080
Width = 372
End
Begin VB.Image Image1
Height = 960
Index = 1
Left = 840
Picture = "Piano.frx":DBCC
Top = 2640
Width = 480
End
Begin VB.Image Image1
Height = 960
Index = 0
Left = 120
Picture = "Piano.frx":E80E
Top = 2640
Width = 480
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim FormMove As Integer
Dim FormX As Integer
Dim FormY As Integer
Private Sub Command1_Click()
Unload Form1
End Sub
Private Sub Form_Load()
Dim nDevice As Long
Dim i As Long
Dim r As Long
Dim OutCaps As MIDIOUTCAPS
Form1.Height = Form1.Height - Form1.ScaleHeight + 170 * Screen.TwipsPerPixelX
Form1.Width = Form1.Width - Form1.ScaleWidth + 320 * Screen.TwipsPerPixelY
Move (Screen.Width - Form1.Width) / 2, (Screen.Height - Form1.Height) / 2
List1.Top = 240
List1.Left = 120
List1.Height = 228
List1.Width = 3132
Command1.Top = 240
Command1.Left = 3360
Command1.Height = 252
Command1.Width = 360
For i = 0 To 16
If i = 1 Or i = 3 Then
Image2(i).Top = 600
Image2(i).Left = 240 + (i - 1) / 2 * 360
Image2(i).Height = 492
ElseIf i = 6 Or i = 8 Or i = 10 Then
Image2(i).Top = 600
Image2(i).Left = 1320 + (i - 6) / 2 * 360
Image2(i).Height = 492
ElseIf i = 13 Or i = 15 Then
Image2(i).Top = 600
Image2(i).Left = 2760 + (i - 13) / 2 * 360
Image2(i).Height = 492
ElseIf i = 0 Or i = 2 Or i = 4 Then
Image2(i).Top = 1080
Image2(i).Left = 120 + i / 2 * 360
Image2(i).Height = 852
ElseIf i = 5 Or i = 7 Or i = 9 Or i = 11 Then
Image2(i).Top = 1080
Image2(i).Left = 1200 + (i - 5) / 2 * 360
Image2(i).Height = 852
ElseIf i = 12 Or i = 14 Or i = 16 Then
Image2(i).Top = 1080
Image2(i).Left = 2640 + (i - 12) / 2 * 360
Image2(i).Height = 852
End If
Image2(i).Width = 360
Next i
For i = 0 To 16
Image2(i).Picture = Image1(0).Picture
Next i
nDevice = midiOutGetNumDevs()
List1.AddItem "MIDI Mapper", 0
For i = 0 To nDevice - 1
r = midiOutGetDevCaps(i, OutCaps, Len(OutCaps))
List1.AddItem OutCaps.szPname, i + 1
Next i
List1.ListIndex = 0
End Sub
Private Sub MidiOpen()
Dim r As Long
Dim OutCaps As MIDIOUTCAPS
Dim OutDev As Long
Dim ErrMsg As String * 256
Dim i As Integer
OutDev = List1.ListIndex - 1
r = midiOutOpen(hMidi, OutDev, Form1.hWnd, 0, &H10000)
If r <> 0 Then
r = midiOutGetErrorText(r, ErrMsg, Len(ErrMsg))
MsgBox ErrMsg
Exit Sub
End If
End Sub
Private Sub MidiClose()
Dim r As Long
r = midiOutReset(hMidi)
r = midiOutClose(hMidi)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormX = Form1.Left + X
FormY = Form1.Top + Y
Form1.MousePointer = 5
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim FormX1, FormY1, FormDX, FormDY As Integer
FormX1 = Form1.Left + X
FormY1 = Form1.Top + Y
FormDX = FormX1 - FormX
FormDY = FormY1 - FormY
Move Form1.Left + FormDX, Form1.Top + FormDY
Form1.MousePointer = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call MidiClose
End
End Sub
Private Sub Image2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r, l As Long
Image2(Index).Picture = Image1(1).Picture
l = &HC0
r = midiOutShortMsg(hMidi, l)
l = &H643090 + Index * 256
r = midiOutShortMsg(hMidi, l)
End Sub
Private Sub Image2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r, l As Long
Image2(Index).Picture = Image1(0).Picture
l = &H643080 + Index * 256
r = midiOutShortMsg(hMidi, l)
End Sub
Private Sub List1_Click()
Call MidiClose
Call MidiOpen
End Sub