keks-n писал(а):Народ, кто мешает работать с dx9vb.dll? Конвертим TLB в заголовки и не надо мучиться. Все примеры от VB6 можно перевести. Единственная неувязка с DirectPlay - тот требует объект, реализующий некий интерфейс.
'Subject: DirectPlay Include
'Author: Vladimir Shulakov and Michael Ritter
'Origin: sp@zdt.ru and mwrit@cogni.to
'Ver/Date: 0.09/2004_09_11
'Notes: DirectPlay include file
'
'
' *****************************************************
' * This software is supplied under the terms of the *
' * Copyright and Warranties agreement found in *
' * the book "DirectX Programming with PowerBASIC". *
' * This code may not be copied or disclosed except *
' * in accordance with the terms of that agreement. *
' * Portions copyright Microsoft Corporation, *
' * Copyrightщ 2004 Vladimir Shulakov, Michael Ritter *
' * All rights reserved. *
' *****************************************************
'
'----------------------------------------------------
'equates
Перенес pbdplay.inc в ссылку
http://sp.ltr32.com/pb/pbdplay.zip
'' Пример:
#COMPILE EXE
#REGISTER NONE
#DIM ALL
#INCLUDE "WIN32API.INC"
#INCLUDE "PBDDRAW.INC"
#INCLUDE "PBDPLAY.INC"
%ID_LABEL = 101
%ID_COMBO = 102
%ID_EXIT = 103
%ID_ENTER = 105
GLOBAL DPlay AS DWORD 'IDirectPlay3 Main DirectPlay object
GLOBAL SetConnection AS LONG 'Choosen connection
GLOBAL hret AS LONG
GLOBAL hdlg AS LONG
GLOBAL hPlayer AS DWORD ' Player id
GLOBAL sessd AS DPSESSIONDESC2
GLOBAL PName AS DPNAME ' Player name structure
GLOBAL hEvent AS LONG ' Event raised when incoming data
GLOBAL CCount AS LONG
GLOBAL SessionCount AS LONG
TYPE Sess
DPss AS DPSESSIONDESC2
NameC AS STRING *255
Password AS STRING *255
END TYPE
DECLARE SUB LoadCombo()
DECLARE FUNCTION SessInit() AS LONG
DECLARE CALLBACK FUNCTION DlgProc() AS LONG
DECLARE FUNCTION EnumConnectionsCallback(BYREF lpGuid AS STRING *16, BYVAL lpConnection AS LONG, BYVAL dwCSize AS LONG, BYVAL lpName AS LONG, BYVAL dwFlags AS LONG, BYVAL lpContext AS LONG) AS LONG
DECLARE FUNCTION EnumSessionsCallback(BYVAL SessionDPss AS LONG, TimeOutX AS LONG, BYVAL Flags AS LONG, BYVAL lpContext AS LONG) AS LONG
'************************************************************************************
'* PBMAIN *
'************************************************************************************
FUNCTION PBMAIN() AS LONG
DIM ConnectionB(0 TO 9) AS GLOBAL STRING
DIM ConnectionN(0 TO 9) AS GLOBAL ASCIIZ *512
DIM Sessions(0 TO 9) AS GLOBAL Sess
LOCAL ReceivedData() AS BYTE
LOCAL DataSize AS LONG ' Data length
LOCAL count AS LONG
LOCAL MessageCount AS LONG ' Number of messages
LOCAL FromCon AS DWORD
LOCAL CreatePlayerOrGroup AS DPMSG_CREATEPLAYERORGROUP
LOCAL DestroyPlayerOrGroup AS DPMSG_DESTROYPLAYERORGROUP
LOCAL DataX AS ASCIIZ *255
LOCAL i AS LONG
' Initialize GUID values
! CALL DPLAY_INIT
DIALOG NEW 0, "DirectPlay Sample",,, 300, 70, 0, TO hDlg
CONTROL ADD LABEL, hDlg, %ID_LABEL, "Search", 5, 5, 100, 12, %SS_SUNKEN OR %SS_CENTER
CONTROL ADD COMBOBOX, hDlg, %ID_COMBO, , 110, 5, 180, 90', %SS_SUNKEN OR %SS_CENTER
CONTROL ADD BUTTON, hDlg, %ID_ENTER, "Create session", 10, 50, 80, 14
CONTROL ADD BUTTON, hDlg, %ID_EXIT, "Exit", 250, 50, 40, 14
CONTROL SET COLOR hDlg, %ID_LABEL, %YELLOW, %BLUE
DIALOG SHOW MODELESS hDlg, CALL DlgProc
FOR i = 1 TO 10
SLEEP 10
DIALOG DOEVENTS
NEXT i
MOUSEPTR 11
' Create the DirectPlay object
hret = CoCreateInstance (BYVAL VARPTR(CLSID_DirectPlay), BYVAL 0, 1, BYVAL VARPTR(IID_IDirectPlay4), DPlay)
IF hret <> 0 THEN MSGBOX "CoCreateInstance Error"
' Enumerate connections
hret = MCALL (DPlay, %DP3EnumConnections, BYVAL 0&, CODEPTR(EnumConnectionsCallback), BYVAL 0&, 0)
IF hret <> 0 THEN MSGBOX "EnumConnections Error"
IF SetConnection = -1 THEN DPlay = %NULL: EXIT FUNCTION
! CALL LoadCombo
'--------------------------------------------------------------------------------
'********************************************************************************
DO
DataX = ""
IF WaitForSingleObject(hEvent,0) = 0 THEN
DIALOG SET TEXT hdlg, HEX$(WaitForSingleObject(hEvent,0)) & " " & HEX$(%WAIT_FAILED)
' Read all messages
hret = MCALL(DPlay,%DP3GetMessageCount, hPlayer, MessageCount)
IF hret <> 0 THEN MSGBOX "GetMessageCount Error"
DO WHILE MessageCount > 0
FromCon = %DPID_ALLPLAYERS
DataSize = 0
ON ERROR RESUME NEXT
DO
ERRCLEAR
REDIM ReceivedData(DataSize)
hret = MCALL (DPlay,%DP3Receive, FromCon, hPlayer, %DPRECEIVE_ALL, VARPTR(ReceivedData(0)), DataSize)
IF hret <> 0 THEN MSGBOX "Receive Error"
LOOP UNTIL hret <> &h8877001E
DECR MessageCount
IF FromCon = %DPID_SYSMSG THEN
SELECT CASE ReceivedData(0)
CASE %DPSYS_CREATEPLAYERORGROUP
CopyMemory VARPTR(CreatePlayerOrGroup), VARPTR(ReceivedData(0)), LEN(CreatePlayerOrGroup)
DataX = ACODE$(PEEK$(CreatePlayerOrGroup.DPMSG_CREATEPLAYERORGROUP_dpnName.DPNAME_lpszShortName,255))
MSGBOX DataX & " has joined"
DataX = ""
CASE %DPSYS_DESTROYPLAYERORGROUP
CopyMemory VARPTR(DestroyPlayerOrGroup), ReceivedData(0), LEN(DestroyPlayerOrGroup)
DataX = ACODE$(PEEK$(DestroyPlayerOrGroup.DPMSG_DESTROYPLAYERORGROUP_dpnName.DPNAME_lpszShortName,255))
MSGBOX DataX & " DESTROYPLAYERORGROUP "
DataX = ""
CASE ELSE
END SELECT
ELSE
DataX = SPACE$(DataSize / 2)
CopyMemory BYVAL VARPTR(DataX), ReceivedData(0), DataSize
MSGBOX "Received : " & DataX
DataX = ""
END IF
LOOP
END IF
IF GetAsyncKeyState(%VK_LEFT) <> 0 THEN DataX = UCODE$("Left" & $NUL)
IF GetAsyncKeyState(%VK_UP) <> 0 THEN DataX = UCODE$("Up" & $NUL)
IF GetAsyncKeyState(%VK_DOWN) <> 0 THEN DataX = UCODE$("Down" & $NUL)
IF GetAsyncKeyState(%VK_RIGHT) <> 0 THEN DataX = UCODE$("Right" & $NUL)
IF DataX <> "" AND hPlayer <> 0 THEN
'send the string Data as a UNICode string.
hret = MCALL(DPlay, %DP3Send, hPlayer, %DPID_ALLPLAYERS, 0, VARPTR(DataX), LEN(DataX) * 2)
IF hret <> 0 THEN MSGBOX "Error Send" ELSE MSGBOX "Sent : " & DataX
END IF
DIALOG DOEVENTS TO count
LOOP WHILE count
ERR_EX:
' Clean up
IF dplay <> 0 THEN CALL MCALL(DPlay,%DP3DestroyPlayer,hPlayer)
IF dplay <> 0 THEN CALL MCALL(DPlay,%DP3Close)
DPlay = %NULL
CoUninitialize
END FUNCTION
'*****************************************************************
' EnumSessions Callback function
'*****************************************************************
FUNCTION EnumSessionsCallback(BYVAL SessionDPss AS LONG, TimeOutX AS LONG, BYVAL Flags AS LONG, BYVAL lpContext AS LONG) AS LONG
IF SessionDPss <> 0 THEN
' Copy connection data
CopyMemory VARPTR(Sessions(SessionCount).DPss), BYVAL SessionDPss, LEN(Sessions(SessionCount).DPss)
Sessions(SessionCount).NameC = ACODE$(PEEK$(Sessions(SessionCount).DPss.DPSESSIONDESC2_lpszSessionName,255))
IF Sessions(SessionCount).DPss.DPSESSIONDESC2_lpszPassword <> 0 THEN
' Copy password
Sessions(SessionCount).Password = ACODE$(PEEK$(Sessions(SessionCount).DPss.DPSESSIONDESC2_lpszPassword,255))
END IF
! inc SessionCount
END IF
FUNCTION = 0 ' Stop enumeration
END FUNCTION
'*****************************************************************
' EnumConnections Callback function
'*****************************************************************
FUNCTION EnumConnectionsCallback(BYREF lpGuid AS STRING *16, BYVAL lpConnection AS LONG, BYVAL dwCSize AS LONG, BYVAL lpName AS LONG, BYVAL dwFlags AS LONG, BYVAL lpContext AS LONG) AS LONG
LOCAL NameC AS DPNAME
' Copy connection data
ConnectionB(CCount) = PEEK$(lpConnection, dwCSize)
POKE$ VARPTR(NameC), PEEK$(lpName, SIZEOF(DPNAME))
ConnectionN(CCount) = ACODE$(PEEK$(NameC.DPNAME_lpszShortName,255))
! inc CCount
FUNCTION = 1 ' Continue enumeration
END FUNCTION
'*****************************************************************
' Fill the combo with connection names
'*****************************************************************
SUB LoadCombo()
DIM i AS LONG
FOR i = 0 TO CCount - 1
COMBOBOX ADD hDlg, %ID_COMBO, ConnectionN(i)
NEXT
COMBOBOX SELECT hDlg, %ID_COMBO, 1
END SUB
'*****************************************************************
' DIALOG CALLBACK function
'*****************************************************************
CALLBACK FUNCTION DlgProc() AS LONG
SELECT CASE CBMSG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %ID_EXIT
DIALOG END CBHNDL
CASE %ID_ENTER
IF dplay <> 0 AND hPlayer <> 0 THEN CALL MCALL(DPlay,%DP3DestroyPlayer,hPlayer)
CONTROL SET TEXT CBHNDL, %ID_LABEL, "Search"
CONTROL SEND CBHNDL ,%ID_COMBO,%CB_GETCURSEL,0,0 TO SetConnection
CONTROL DISABLE CBHNDL, %ID_ENTER
! CALL SessInit
END SELECT
END SELECT
END FUNCTION
'*****************************************************************
' Init Session
'*****************************************************************
FUNCTION SessInit() AS LONG
LOCAL SName AS ASCIIZ *255
LOCAL ShortName AS ASCIIZ *255 ' Player short name
LOCAL LongName AS ASCIIZ *255 ' Player long name
' Initialize choosen connection
hret = MCALL(DPlay, %DP3InitializeConnection, STRPTR(ConnectionB(SetConnection)), 0)
IF hret <> 0 THEN MSGBOX "InitializeConnection Error" & HEX$(hret) _
:FUNCTION = %FALSE:EXIT FUNCTION
' Enumerate sessions
CONTROL SET TEXT hDlg, %ID_LABEL, "Enumerating processing"
sessd.DPSESSIONDESC2_dwSize = SIZEOF(sessd)
sessd.DPSESSIONDESC2_guidApplication = GUID$("{625201e1-344f-11d5-9eb2-00c026ee24c6}")
'GUID$("{17553DA0-02EE-11D2-A098-9C9501C1441E}")
hret = MCALL(DPlay,%DP3EnumSessions, VARPTR(sessd), 0, CODEPTR(EnumSessionsCallback), BYVAL 0&, %DPENUMSESSIONS_AVAILABLE)
IF hret <> 0 THEN MSGBOX "EnumSessions Error":FUNCTION = %FALSE:EXIT FUNCTION
' If no session found
IF SessionCount = 0 THEN
' Create a session
SName = "DX_PLAY"
sessd.DPSESSIONDESC2_dwFlags = %DPSESSION_KEEPALIVE
sessd.DPSESSIONDESC2_dwSize = SIZEOF(DPSESSIONDESC2)
sessd.DPSESSIONDESC2_lpszSessionName = VARPTR(SName)
hret = MCALL(DPlay, %DP3Open, VARPTR(sessd), %DPOPEN_CREATE)
IF hret = 0 THEN
CONTROL SET COLOR hDlg, %ID_LABEL, %RED, %GREEN
CONTROL SET TEXT hDlg, %ID_LABEL, "Create Session Ok"
DIALOG DOEVENTS
ELSE
MSGBOX "Session Error":FUNCTION = %FALSE:EXIT FUNCTION
END IF
ELSE
' Join a session
sessd = Sessions(0).DPss
sessd.DPSESSIONDESC2_lpszSessionName = VARPTR(Sessions(0).NameC)
hret = MCALL(DPlay,%DP3Open, VARPTR(sessd), %DPOPEN_JOIN)
IF hret = 0 THEN MSGBOX "Joined " & Sessions(0).NameC ELSE MSGBOX "Session Error":FUNCTION = %FALSE:EXIT FUNCTION
END IF
ShortName = "PB"
LongName = "PBL"
PName.DPNAME_dwSize = SIZEOF(DPNAME)
PName.DPNAME_lpszShortName = VARPTR(ShortName)
PName.DPNAME_lpszLongName = VARPTR(LongName)
' Create an event for incoming data
hEvent = CreateEvent(BYVAL %NULL, 0, 0,BYVAL %NULL)
hret = MCALL(DPlay, %DP3CreatePlayer, VARPTR(hPlayer), VARPTR(Pname), hEvent, BYVAL %NULL, 0, 0)
IF hret <> 0 THEN MSGBOX "CreatePlayer Error ":FUNCTION = %FALSE:EXIT FUNCTION
FUNCTION = %TRUE
END FUNCTION
FUNCTION M_CALL CDECL (BYVAL ObjectPtr AS DWORD, BYVAL MethodName AS DWORD,_
OPTIONAL BYVAL v1 AS DWORD, OPTIONAL BYVAL v2 AS DWORD, _
OPTIONAL BYVAL v3 AS DWORD, OPTIONAL BYVAL v4 AS DWORD, _
OPTIONAL BYVAL v5 AS DWORD, OPTIONAL BYVAL v6 AS DWORD, _
OPTIONAL BYVAL v7 AS DWORD, OPTIONAL BYVAL v8 AS DWORD, _
OPTIONAL BYVAL v9 AS DWORD, OPTIONAL BYVAL v10 AS DWORD, _
OPTIONAL BYVAL v11 AS DWORD, OPTIONAL BYVAL v12 AS DWORD, _
OPTIONAL BYVAL v13 AS DWORD, OPTIONAL BYVAL v14 AS DWORD, _
OPTIONAL BYVAL v15 AS DWORD, OPTIONAL BYVAL v16 AS DWORD, _
OPTIONAL BYVAL v17 AS DWORD, OPTIONAL BYVAL v18 AS DWORD) EXPORT AS LONG
'function takes
' ObjectPtr - pointer to the direct draw object
' MethodName - the method to perform
' v1 - v18 - optional variables that may be used in the call
'
'function returns
' long - %DD_OK on success or error code on error
'
'notes: method calls to dx go through here
! push v18 ' push v1 - v18 onto stack
! push v17
! push v16
! push v15
! push v14
! push v13
! push v12
! push v11
! push v10
! push v9
! push v8
! push v7
! push v6
! push v5
! push v4
! push v3
! push v2
! push v1
! mov eax, ObjectPtr ' move pointer to dx object into eax
! mov ecx, MethodName ' move method to execute into ecx
! push eax
! mov eax, [eax] ' move pointer to eax into eax
! CALL DWORD PTR [eax+ecx] ' call method offset
! mov FUNCTION, eax ' move return value into function
END FUNCTION
tyomitch писал(а):volo, имей совесть: мегабайтные листинги клади в аттачи. Иначе топик превращается не пойми во что.
keks-n писал(а):Значит, либо d3dx9 либо не используется, либо юзается одна из библ с названием вида d3dx9_##.dll, которые идут с некоторыми поставками иксов и имеют неполную функциональность.
keks-n писал(а):Для восьмых иксов оптимален вариант через переходник, предназначенный, для VB6. Собираюсь сделать обёртку над d3dx9.lib на асме.
D'alex писал(а):Все конечно красиво-слов нет... и работа проведена большая..
Но ведь это все под Dx7 и если переводить это хотя бы на Dx9 ,
то годы уйдут и девятка перестанет быть актуальной....
Просто зачем так надо было мучиться ,если под семерку в PB
можно было использовать стандартную dx7vb.dll которая входит во все пакеты с Dx...не думаю ,что потеря в скорости была бы заметной...
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0