Changeset 585 for trunk

Timestamp:

Aug 11, 2008, 10:37:02 PM (16 years ago)

Author:

NoWest

Message:

Joystickのクラスを作ってみました。

かなり前に作ったんですが、ココ最近の改良に合わせて色々弄っております。

Location:

trunk/ab5.0/ablib/src

Files:

• Classes/ActiveBasic/Windows/MM (added)
• Classes/ActiveBasic/Windows/MM/Joystick.ab (added)
• Classes/ActiveBasic/Windows/Registry.ab (modified) (9 diffs)
• api_mmsys.sbp (modified) (3 diffs)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Registry.ab

@@ -45 +45 @@
     Function Name( ) As String
         Dim name As String
-        If IsNothing(This.subkeyname) Then 
+        If ActiveBasic.IsNothing(This.subkeyname) Then 
             name = This.rootkeyname
         Else
@@ -76 +76 @@
     '新しいサブキーを作成するか、または既存のサブキーを開きます。  
     Function CreateSubKey( subkey As String ) As RegistryKey
-        If IsNothing(subkey) Then Return Nothing
+        If ActiveBasic.IsNothing(subkey) Then Return Nothing
         Dim buf = subkey
         '末尾の\を除去
@@ -108 +108 @@
     '指定したサブキーを削除します。文字列 subkey では、大文字と小文字は区別されません。  
     Sub DeleteSubKey ( subkey As String )
-        If IsNothing( subkey ) Then Exit Sub
+        If ActiveBasic.IsNothing( subkey ) Then Exit Sub
         This.DeleteSubKey( subkey, True )
     End Sub
     Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
-        If IsNothing( subkey ) Then Exit Sub
+        If ActiveBasic.IsNothing( subkey ) Then Exit Sub
         Dim key = This.OpenSubKey(subkey)
         If key.SubKeyCount <> 0 Then
@@ -128 +128 @@
     'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。  
     Sub DeleteSubKeyTree ( subkey As String )
-        If IsNothing( subkey ) Then Exit Sub
+        If ActiveBasic.IsNothing( subkey ) Then Exit Sub
         Dim key = This.OpenSubKey( subkey )
         If key.SubKeyCount <> 0 Then
@@ -142 +142 @@
     '指定した値をこのキーから削除します。  
     Sub DeleteValue ( name As String )
-        If IsNothing( name ) Then Exit Sub
+        If ActiveBasic.IsNothing( name ) Then Exit Sub
         This.DeleteValue( name, True )
     End Sub
     Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
-        If IsNothing( name ) Then Exit Sub
+        If ActiveBasic.IsNothing( name ) Then Exit Sub
         RegDeleteValue( This.handle, ToTCStr(name) )
         This.edited = True
@@ -203 +203 @@
                 Return New System.String( pbData As LPCTSTR )
             Case REG_MULTI_SZ
-                Return New System.String( pbData As LPCTSTR )
+                Dim list As System.Collections.Generic.List<String>
+                Dim s As System.String
+                Do
+                    s = New System.String(pbData As *TCHAR)
+                    If s.Length = 0 Then Exit Do
+                    list.Add(s)
+                    pbData += (s.Length + SizeOf(TCHAR))
+                Loop
+                Return list
             Case REG_QWORD
                 Dim qw As QWord
@@ -221 +229 @@
     '指定した名前に関連付けられた値のレジストリ データ型を取得します。  
     Function GetValueKind ( name As String ) As RegistryValueKind
-        If IsNothing( name ) Then Exit Sub
+        If ActiveBasic.IsNothing( name ) Then Exit Sub
         Dim dwType As DWord
         If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
@@ -262 +270 @@
     '指定したサブキーを取得します。  
     Function OpenSubKey ( name As String ) As RegistryKey
-        If IsNothing(name) Then Return Nothing
+        If ActiveBasic.IsNothing(name) Then Return Nothing
         Dim buf = name
         '末尾の\を除去
@@ -338 +346 @@
 
     Sub SubKey( subkey As String )
-        If IsNothing(subkey) Then Exit Sub
+        If ActiveBasic.IsNothing(subkey) Then Exit Sub
         This.subkeyname = subkey
     End Sub

trunk/ab5.0/ablib/src/api_mmsys.sbp

@@ -1510 +1510 @@
 Declare Function joyGetNumDevs Lib "winmm" () As DWord
 #ifdef UNICODE
-Declare Function joyGetDevCaps Lib "winmm" Alias "joyGetDevCapsW" (uJoyID As DWord, pjc As *JOYCAPSW, cbjc As DWord) As MMRESULT
-#else
-Declare Function joyGetDevCaps Lib "winmm" Alias "joyGetDevCapsA" (uJoyID As DWord, pjc As *JOYCAPS, cbjc As DWord) As MMRESULT
-#endif
-Declare Function joyGetPos Lib "winmm" (uJoyID As DWord, pji As *JOYINFO) As MMRESULT
-Declare Function joyGetPosEx Lib "winmm" (uJoyID As DWord, pji As *JOYINFOEX) As MMRESULT
-Declare Function joyGetThreshold Lib "winmm" (uJoyID As DWord, puThreshold As *DWord) As MMRESULT
+Declare Function joyGetDevCaps Lib "winmm" Alias "joyGetDevCapsW" (uJoyID As DWord, ByRef pjc As JOYCAPSW, cbjc As DWord) As MMRESULT
+#else
+Declare Function joyGetDevCaps Lib "winmm" Alias "joyGetDevCapsA" (uJoyID As DWord, ByRef pjc As JOYCAPSA, cbjc As DWord) As MMRESULT
+#endif
+Declare Function joyGetPos Lib "winmm" (uJoyID As DWord, ByRef pji As JOYINFO) As MMRESULT
+Declare Function joyGetPosEx Lib "winmm" (uJoyID As DWord, ByRef pji As JOYINFOEX) As MMRESULT
+Declare Function joyGetThreshold Lib "winmm" (uJoyID As DWord, ByRef puThreshold As DWord) As MMRESULT
 Declare Function joyReleaseCapture Lib "winmm" (uJoyID As DWord) As MMRESULT
 Declare Function joySetCapture Lib "winmm" (hwnd As HWND, uJoyID As DWord, uPeriod As DWord, fChanged As BOOL) As MMRESULT
@@ -2002 +2002 @@
 TypeDef LPMCI_GENERIC_PARMS = *MCI_GENERIC_PARMS
 
-Type MCI_OPEN_PARMS
+Type MCI_OPEN_PARMSA
     dwCallback As DWord
     wDeviceID As DWord
@@ -2009 +2009 @@
     lpstrAlias As LPSTR
 End Type
-TypeDef PMCI_OPEN_PARMS = *MCI_OPEN_PARMS
-TypeDef LPMCI_OPEN_PARMS = *MCI_OPEN_PARMS
+TypeDef PMCI_OPEN_PARMSA = *MCI_OPEN_PARMSA
+TypeDef LPMCI_OPEN_PARMSA = *MCI_OPEN_PARMSA
+
+Type MCI_OPEN_PARMSW
+    dwCallback As DWord
+    wDeviceID As DWord
+    lpstrDeviceType As LPWSTR
+    lpstrElementName As LPWSTR
+    lpstrAlias As LPWSTR
+End Type
+TypeDef PMCI_OPEN_PARMSW = *MCI_OPEN_PARMSW
+TypeDef LPMCI_OPEN_PARMSW = *MCI_OPEN_PARMSW
+
+#ifdef UNICODE
+TypeDef MCI_OPEN_PARMS = MCI_OPEN_PARMSW
+TypeDef PMCI_OPEN_PARMS = PMCI_OPEN_PARMSW
+TypeDef LPMCI_OPEN_PARMS = LPMCI_OPEN_PARMSW
+#else
+TypeDef MCI_OPEN_PARMS = MCI_OPEN_PARMSA
+TypeDef PMCI_OPEN_PARMS = PMCI_OPEN_PARMSA
+TypeDef LPMCI_OPEN_PARMS = LPMCI_OPEN_PARMSA
+#endif
 
 Type MCI_PLAY_PARMS