I have a Direct Show video capture application more or less developed in PowerBasic.
I would like to COM enable it as an Out of Process Com server so that it can be controlled from an old VB6 app (Its a big program and rewriting the whole of it is not an option)
As I understand the only way with PowerBasic is to use Low Level Com. Searching I see that Fred did some work on this back in 2010 with his "CC" server but this was not a GUI app.
Question is - Is this feasible and are there any examples?
The other possibility I was thinking of doing is using the WM_CopyData message to control and feedback events to VB6 with.
I would have to subclass the windows messages in VB6 but I think that is possible.
The COM solution would be nicest but may be the CopyData message is easiest
Any pointers, Links to examples, or suggestions would be very gratefully received
Jon
WM_COPYDATA works great.
I am using it with BB64 (BassBox 64-bit EXE written in C++) to exchange data with visual plugin DLLs (written in PowerBASIC 32-bit).
And also with my DirectX movie player.
...
Hi Patrice,
Thanks for your reply - I use the CopyData message in my Sailwave application to communicate with some enhancements that I've added to it that are written in PowerBasic. Sailwave itself is written in Clarion, and I use the CopyData to communicate in both directions between the two. Out of curiosity I just had a look at your sample to see how it compared to mine. But there seems to be something wrong with yours if I'm correct (Please forgive me if I wrong)
This is your calling code
.
CASE %WM_COPYDATA
' wParam holds the string length
' lParam holds the Byte array address
dwData = zGetPrivateMsg(sDataString, wParam, lParam)
szFileName = ""
IF dwData = %ZM_STRINGDATA THEN
IF LEN(sDataString) THEN szFileName = LCASE$(PARSE$(sDataString, $zLim, 1))
END IF
CALL CheckMovieName(szFileName)
FUNCTION = 1: EXIT FUNCTION
Your comment says that wParam holds the length of the string and the code works on this assumption, but according to MSDN it holds a handle to the window passing the data
Parameters
wParam
A handle to the window passing the data.
lParam
A pointer to a COPYDATASTRUCT structure that contains the data to be passed.
Yours does work but it creates a very large string the size of handle of the calling program and then it parses it which can take a long time.
This is my sample version of your zGetPrivateMsg which I think works as a direct replacement for yours but I note that wParam is not used or needed, but I put it in this sample to make it a drop in replacement for yours
FUNCTION zGetPrivateMsg(BYREF sPrivateMsg AS STRING, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
local pRecData AS CopyDataStruct POINTER
pRecData = lParam
REDIM Buf(@pRecData.cbData) AS BYTE
Memory COPY @pRecData.lpData, VARPTR(buf(0)), @pRecData.cbData
sPrivateMsg = PEEK$(VARPTR(buf(0)), @pRecData.cbData)
FUNCTION = @pRecData.dwData
END FUNCTION
Here is your original just for easy comparison
FUNCTION zGetPrivateMsg(BYREF sPrivateMsg AS STRING, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL cds AS COPYDATASTRUCT
REDIM Buf(wParam) AS BYTE
CALL MoveMemory(cds, BYVAL lParam, SIZEOF(cds))
CALL MoveMemory(buf(0), BYVAL cds.lpData, cds.cbData)
sPrivateMsg = PEEK$(VARPTR(buf(0)), wParam)
FUNCTION = cds.dwData
END FUNCTION
Make I take this opportunity to say how much I admire some of you work - you are very talented and creative.
I would still love to do it with Com but the CopyData message will have to do for now
Jon
Just looked at my code this morning after last nights late post and realised I didn't need the byte array. It was a by product of converting my code to fit into your function so now I have, which seems to work fine and is also simpler.
FUNCTION zGetPrivateMsg(BYREF sPrivateMsg AS STRING, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
local pRecData AS CopyDataStruct POINTER
pRecData = lParam
sPrivateMsg = PEEK$(@pRecData.lpData, @pRecData.cbData)
FUNCTION = @pRecData.dwData
END FUNCTION
Jon
QuoteBut there seems to be something wrong with yours if I'm correct (Please forgive me if I wrong)
The way you use
WM_COPYDATA is totaly under your control as soon as you use it with a pointer to a private structure.
Here is how i use it to communicate between my c++ BassBox 64-bit
UNICODE and the PowerBASIC 32-bit
ANSI visual plugin DLLs.
First the private structure i am using
struct BBP {
long gdimageid;
char plugin[MAX_PATH];
DWORD nlevel;
float getdata[256];
DWORD medialength;
DWORD mediapos;
float wimdata[256];
};
COPYDATASTRUCT gCDS; BBP gBBP;
Here is how i use it, to communicate with the plugins:
void BBP_UsePlugin(IN WCHAR* szPlugin) {
if (gP.hzwp) {
memset(gBBP.plugin, 0, MAX_PATH);
WideCharToMultiByte(CP_ACP, 0, szPlugin, -1, gBBP.plugin, MAX_PATH, NULL, NULL);
gCDS.dwData = 2; // Plugin
gCDS.cbData = sizeof(gBBP);
gCDS.lpData = &gBBP;
SendMessage(gP.hzwp, WM_COPYDATA, (WPARAM) gP.hwnd, (LPARAM) &gCDS);
}
}
Here is how i detect the handle of the 32-bit application i want to deal with:
void BBP_Handle() {
if (gP.hzwp == 0) {
WCHAR szFile[MAX_PATH] = { 0 };
PathCombine(szFile, EXEpath(), $BBP);
HINSTANCE nRet = ShellExecute(0, L"open", szFile, L"", EXEpath(), SW_SHOWNOACTIVATE);
Sleep(400);
char zClass[] = "ZWALLPAPER";
gP.hzwp = FindWindowA(zClass, zClass);
if (gP.hzwp) {
BBP_SizeMove();
gBBP.gdimageid = IDC_GDIMAGE;
gCDS.dwData = 1; // Parent
gCDS.cbData = sizeof(gBBP);
gCDS.lpData = &gBBP;
SendMessage(gP.hzwp, WM_COPYDATA, (WPARAM) gP.hwnd, (LPARAM) &gCDS);
BBP_UsePlugin(ListGetText(gP.hlistplugin, ListGetCursel(gP.hlistplugin)));
}
}
}
And here is how i pass the PCM wimdata buffer to the visual plugin to render the OpenGL scene in real time.
if (gP.hzwp) {
if (IsMenuChecked(IDC_PLUGIN, hCtrl)) {
gBBP.nlevel = nLevel;
//memset(&gBBP.getdata[0], 0, 1024);
RtlMoveMemory(&gBBP.getdata[0], BassChannelGetData(gP.channel), 1024);//sizeof(float) * 256);
gBBP.medialength = (DWORD) gP.medialength;
gBBP.mediapos = (DWORD) gP.mediapos;
//memset(&gBBP.wimdata[0], 0, 1024);
RtlMoveMemory(&gBBP.wimdata[0], pInt, 1024);//sizeof(float) * 256);
gCDS.dwData = 0; // OpenGL
gCDS.cbData = sizeof(gBBP);
gCDS.lpData = &gBBP;
SendMessage(gP.hzwp, WM_COPYDATA, (WPARAM) gP.hwnd, (LPARAM) &gCDS);
}
}
And here is the
PowerBASIC code dealing with %WM_COPYDATA case WM_COPYDATA:
ptCDS = lParam
select case long (@ptCDS.dwData)
case 0:
ptBBP = @ptCDS.lpData
nlevel = @ptBBP.nlevel
medialength = @ptBBP.medialength
mediapos = @ptBBP.mediapos
getdataPTR = VARPTR(getdata(0))
wimdataPTR = VARPTR(wimdata(0))
MEMORY COPY VARPTR(@ptBBP.getdata(0)), getdataPTR, 1024
MEMORY COPY VARPTR(@ptBBP.wimdata(0)), wimdataPTR, 1024
RenderOpenGL(hWnd, nLevel, medialength, mediapos, getdataPTR, wimdataPTR)
case 1:
gnParent = wParam
'//if (IsWindow(gnParent)) THEN SetParent(hWnd, gnParent)
ptBBP = @ptCDS.lpData
gnCodeID = @ptBBP.gdimageID
case 2:
ptBBP = @ptCDS.lpData
MEMORY COPY VARPTR(@ptBBP.plugin), VARPTR(szFile), 260
'MoveMemory(VARPTR(szFile), VARPTR(@ptBBP.plugin), 260)
if (BBP_LoadPlugin(hWnd, szFile)) then ' Make sure that a different plugin has been selected
BBP.Msg = BBP_INIT
BBP.ParentWindow = hWnd
BBP.DC = GetDC(BBP.ParentWindow)
BBP.RC = glRC
BBP.BackARGB = 0
if (BBP_Plugin(BBP) = BBP_SUCCESS) then
'zTrace(szFile)
ResizeGLwindow(hWnd)
end if
ReleaseDC(BBP.ParentWindow, BBP.DC)
end if
case 3:
DestroyWindow(hWnd)
end select
function = 1: EXIT function
I found WM_COPYDATA very efficient to perform inter-process communication.
...
Here is the full code to the PowerBASIC bridge used to communicate between the C++ 64-bit and the PB 32-bit process.
' BASS_CONFIG_GVOL_STREAM
'+--------------------------------------------------------------------------+
'| |
'| BBP |
'| (BassBox Plugin) |
'| |
'| OpenGL plugin player |
'| |
'+--------------------------------------------------------------------------+
'| |
'| Author Patrice TERRIER |
'| copyright(c) 2007-2014 |
'| www.zapsolution.com |
'| pterrier@zapsolution.com |
'| |
'+--------------------------------------------------------------------------+
'| Project started on : 00-06-2007 (MM-DD-YYYY) |
'| Last revised : 02-25-2014 (MM-DD-YYYY) |
'+--------------------------------------------------------------------------+
#COMPILE EXE "BBP.exe"
MACRO const = MACRO
const NULL = 0
const WINAPI = 1
const NM_FIRST = 0
const NM_AUDIOCOMPLETION = NM_FIRST - 80
const WM_SETTEXT = &HC
const WM_COPYDATA = 74
const IDC_ARROW = 32512&
const MAX_PATH = 260
const CCHDEVICENAME = 32
const CCHFORMNAME = 32
const PFD_TYPE_RGBA = 0
const PFD_DOUBLEBUFFER = &H00000001
const PFD_DRAW_TO_WINDOW = &H00000004
const PFD_DRAW_TO_BITMAP = &H00000008
const PFD_SUPPORT_OPENGL = &H00000020
const SW_SHOW = 5
const WM_DESTROY = &H2
const WM_SIZE = &H5
const WM_CLOSE = &H10
const WM_TIMER = &H113
const WM_DEVICECHANGE = &H219
const WM_WINDOWPOSCHANGING = &H46
const WS_POPUP = &H80000000
const WS_VISIBLE = &H10000000
const WS_EX_TOOLWINDOW = &H00000080
const WM_NOTIFY = &H4E
const CS_VREDRAW = &H1
const CS_HREDRAW = &H2
const SM_CXSCREEN = 0
const SM_CYSCREEN = 1
const MONITOR_DEFAULTTONEAREST = &H00000002
const HKEY_CURRENT_USER = &H80000001???
const HKEY_LOCAL_MACHINE = &H80000002???
const GL_DEPTH_BUFFER_BIT = &H00000100
const GL_COLOR_BUFFER_BIT = &H00004000
const GL_LIST_BIT = &H00020000
const GL_LINES = &H0001
const GL_TRIANGLE_FAN = &H0006
const GL_UNSIGNED_BYTE = &H1401
const GL_FRONT_AND_BACK = &H0408
const GL_LIGHTING = &H0B50
const GL_COLOR_MATERIAL = &H0B57
const GL_DEPTH_TEST = &H0B71
const GL_NORMALIZE = &H0BA1
const GL_ALPHA_TEST = &H0BC0
const GL_BLEND = &H0BE2
const GL_TEXTURE_2D = &H0DE1
const GL_LIGHT0 = &H4000
const GL_LIGHT1 = &H4001
const GL_LIGHT2 = &H4002
const GL_LIGHT3 = &H4003
const GL_LIGHT4 = &H4004
const GL_LIGHT5 = &H4005
const GL_LIGHT6 = &H4006
const GL_LIGHT7 = &H4007
const GL_DIFFUSE = &H1201
const GL_SPECULAR = &H1202
const GL_SHININESS = &H1601
const GL_MODELVIEW = &H1700
const GL_PROJECTION = &H1701
const GL_SMOOTH = &H1D01
type COPYDATASTRUCT DWORD
dwData as DWORD ' ULONG_PTR
cbData as DWORD ' DWORD
lpData as DWORD ' PVOID
end type
type WINDOWPOS
hWnd as DWORD
hWndInsertAfter as DWORD
x as long
y as long
cx as long
cy as long
flags as DWORD
end type
type NMHDR
hwndFrom as DWORD
idfrom as DWORD
code as long ' used for messages, so needs to be LONG, not DWORD...
end type
type RECT
nLeft as long
nTop as long
nRight as long
nBottom as long
end type
type MONITORINFO
cbSize as DWORD
rcMonitor as RECT
rcWork as RECT
dwFlags as DWORD
end type
type POINTAPI
x as long
y as long
end type
type SIZEL
cx as long
cy as long
end type
type tagMSG
hwnd as DWORD
message as DWORD
wParam as long
lParam as long
time as DWORD
pt as POINTAPI
end type
type OVERLAPPED
Internal as DWORD
InternalHigh as DWORD
offset as DWORD
OffsetHigh as DWORD
hEvent as DWORD
end type
type SECURITY_ATTRIBUTES
nLength as DWORD
lpSecurityDescriptor as long
bInheritHandle as long
end type
type FILETIME
dwLowDateTime as DWORD
dwHighDateTime as DWORD
end type
type WNDCLASSEX
cbSize as DWORD
STYLE as DWORD
lpfnWndProc as long
cbClsExtra as long
cbWndExtra as long
hInstance as DWORD
hIcon as DWORD
hCursor as DWORD
hbrBackground as DWORD
lpszMenuName as ASCIIZ PTR
lpszClassName as ASCIIZ PTR
hIconSm as DWORD
end type
type WIN32_FIND_DATA
dwFileAttributes as DWORD
ftCreationTime as FILETIME
ftLastAccessTime as FILETIME
ftLastWriteTime as FILETIME
nFileSizeHigh as DWORD
nFileSizeLow as DWORD
dwReserved0 as DWORD
dwReserved1 as DWORD
cFileName as ASCIIZ * MAX_PATH
cAlternateFileName as ASCIIZ * 14
end type
type BITMAP
bmType as long
bmWidth as long
bmHeight as long
bmWidthBytes as long
bmPlanes as WORD
bmBitsPixel as WORD
bmBits as BYTE PTR
end type
type RGBQUAD
rgbBlue as BYTE
rgbGreen as BYTE
rgbRed as BYTE
rgbReserved as BYTE
end type
type BITMAPINFOHEADER
biSize as DWORD
biWidth as long
biHeight as long
biPlanes as WORD
biBitCount as WORD
biCompression as DWORD
biSizeImage as DWORD
biXPelsPerMeter as long
biYPelsPerMeter as long
biClrUsed as DWORD
biClrImportant as DWORD
end type
type BITMAPINFO
bmiHeader as BITMAPINFOHEADER
bmiColors as long
end type
type PIXELFORMATDESCRIPTOR
nSize as WORD
nVersion as WORD
dwFlags as DWORD
iPixelType as BYTE
cColorBits as BYTE
cRedBits as BYTE
cRedShift as BYTE
cGreenBits as BYTE
cGreenShift as BYTE
cBlueBits as BYTE
cBlueShift as BYTE
cAlphaBits as BYTE
cAlphaShift as BYTE
cAccumBits as BYTE
cAccumRedBits as BYTE
cAccumGreenBits as BYTE
cAccumBlueBits as BYTE
cAccumAlphaBits as BYTE
cDepthBits as BYTE
cStencilBits as BYTE
cAuxBuffers as BYTE
iLayerType as BYTE
bReserved as BYTE
dwLayerMask as DWORD
dwVisibleMask as DWORD
dwDamageMask as DWORD
end type
type DEVMODE
dmDeviceName as ASCIIZ * CCHDEVICENAME
dmSpecVersion as WORD
dmDriverVersion as WORD
dmSize as WORD
dmDriverExtra as WORD
dmFields as DWORD
dmOrientation as INTEGER
dmPaperSize as INTEGER
dmPaperLength as INTEGER
dmPaperWidth as INTEGER
dmScale as INTEGER
dmCopies as INTEGER
dmDefaultSource as INTEGER
dmPrintQuality as INTEGER
dmColor as INTEGER
dmDuplex as INTEGER
dmYResolution as INTEGER
dmTTOption as INTEGER
dmCollate as INTEGER
dmFormName as ASCIIZ * CCHFORMNAME
dmLogPixels as WORD
dmBitsPerPel as DWORD
dmPelsWidth as DWORD
dmPelsHeight as DWORD
dmDisplayFlags as DWORD
dmDisplayFrequency as DWORD
dmICMMethod as DWORD
dmICMIntent as DWORD
dmMediaType as DWORD
dmDitherType as DWORD
dmICCManufacturer as DWORD
dmICCModel as DWORD
dmPanningWidth as DWORD
dmPanningHeight as DWORD
end type
type BBP64
gdimageID as long
plugin as ASCIIZ * MAX_PATH
nlevel as DWORD
getdata(255) as single
medialength as DWORD
mediapos as DWORD
wimdata(255) as single
end type
declare function zTrace LIB "zTrace.DLL" ALIAS "zTrace" (zMessage as ASCIIZ) as long
declare function GetWindowRect LIB "USER32.DLL" ALIAS "GetWindowRect" (byval hWnd as DWORD, lpRect as RECT) as long
declare function GetWindow LIB "USER32.DLL" ALIAS "GetWindow" (byval hWnd as DWORD, byval wCmd as DWORD) as long
declare function RegisterWindowMessage LIB "USER32.DLL" ALIAS "RegisterWindowMessageA" (lpString as ASCIIZ) as long
declare function SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (byval hWnd as DWORD, byval dwMsg as DWORD, byval wParam as DWORD, byval lParam as long) as long
declare function GetTickCount LIB "KERNEL32.DLL" ALIAS "GetTickCount" () as DWORD
declare function DestroyWindow LIB "USER32.DLL" ALIAS "DestroyWindow" (byval hWnd as DWORD) as long
declare function GetWindowText LIB "USER32.DLL" ALIAS "GetWindowTextA" (byval hWnd as DWORD, lpString as ASCIIZ, byval cch as long) as long
declare function LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (byval hInstance as DWORD, lpCursorName as ASCIIZ) as DWORD
declare function ChoosePixelFormat LIB "GDI32.DLL" ALIAS "ChoosePixelFormat" (byval hDC as DWORD, pPixelFormatDescriptor as PIXELFORMATDESCRIPTOR) as long
declare function CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (byval dwExStyle as DWORD, lpClassName as ASCIIZ, lpWindowName as ASCIIZ, byval dwStyle as DWORD, byval x as long, byval y as long, _
byval nWidth as long, byval nHeight as long, byval hWndParent as DWORD, byval hMenu as DWORD, byval hInstance as DWORD, lpParam as ANY) as DWORD
declare function DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (byval hWnd as DWORD, byval uMsg as DWORD, byval wParam as DWORD, byval lParam as long) as long
declare function DeleteDC LIB "GDI32.DLL" ALIAS "DeleteDC" (byval hdc as DWORD) as long
declare function DeleteObject LIB "GDI32.DLL" ALIAS "DeleteObject" (byval hObject as DWORD) as long
declare function DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg as tagMSG) as long
declare function DragQueryFile LIB "SHELL32.DLL" ALIAS "DragQueryFileA" (byval hDrop as DWORD, byval uiFile as DWORD, lpStr as ASCIIZ, byval cch as DWORD) as DWORD
declare function FindClose LIB "KERNEL32.DLL" ALIAS "FindClose" (byval hFindFile as DWORD) as long
declare function FreeLibrary LIB "KERNEL32.DLL" ALIAS "FreeLibrary" (byval hLibModule as DWORD) as long
declare function GetClassInfoEx LIB "USER32.DLL" ALIAS "GetClassInfoExA" (byval hInst as DWORD, lpszClass as ASCIIZ, lpWndClass as WNDCLASSEX) as long
declare function GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (byval hwnd as DWORD, lpRect as RECT) as long
declare function GetDC LIB "USER32.DLL" ALIAS "GetDC" (byval hWnd as DWORD) as DWORD
declare function GetLastError LIB "KERNEL32.DLL" ALIAS "GetLastError" () as long
declare function GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg as tagMSG, byval hWnd as DWORD, byval uMsgFilterMin as DWORD, byval uMsgFilterMax as DWORD) as long
declare function GetProcAddress LIB "KERNEL32.DLL" ALIAS "GetProcAddress" (byval hModule as DWORD, lpProcName as ASCIIZ) as long
declare function GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (byval nIndex as long) as long
declare function IsWindowVisible LIB "USER32.DLL" ALIAS "IsWindowVisible" (byval hWnd as DWORD) as long
declare function KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (byval hWnd as DWORD, byval nIDEvent as long) as long
declare function LoadLibrary LIB "KERNEL32.DLL" ALIAS "LoadLibraryA" (lpLibFileName as ASCIIZ) as long
declare function RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx as WNDCLASSEX) as WORD
declare function RegisterWindowMessage LIB "USER32.DLL" ALIAS "RegisterWindowMessageA" (lpString as ASCIIZ) as long
declare function ReleaseDC LIB "USER32.DLL" ALIAS "ReleaseDC" (byval hWnd as DWORD, byval hDC as DWORD) as long
declare function SelectObject LIB "GDI32.DLL" ALIAS "SelectObject" (byval hdc as DWORD, byval hObject as DWORD) as DWORD
declare function SetPixelFormat LIB "GDI32.DLL" ALIAS "SetPixelFormat" (byval hDC as DWORD, byval n as long, pcPixelFormatDescriptor as PIXELFORMATDESCRIPTOR) as long
declare function SetRect LIB "USER32.DLL" ALIAS "SetRect" (lpRect as RECT, byval X1 as long, byval Y1 as long, byval X2 as long, byval Y2 as long) as long
declare function SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (byval hWnd as DWORD, byval nIDEvent as long, byval uElapse as DWORD, byval lpTimerFunc as long) as long
declare function ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (byval hWnd as DWORD, byval nCmdShow as long) as long
declare function SwapBuffers LIB "GDI32.DLL" ALIAS "SwapBuffers" (byval hDC as DWORD) as long
declare function TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg as tagMSG) as long
declare function wglCreateContext LIB "OPENGL32.DLL" ALIAS "wglCreateContext" (byval hdc as DWORD) as DWORD
declare function wglDeleteContext LIB "OPENGL32.DLL" ALIAS "wglDeleteContext" (byval hglrc as DWORD) as long
declare function wglMakeCurrent LIB "OPENGL32.DLL" ALIAS "wglMakeCurrent" (byval hdc as DWORD, byval hglrc as DWORD) as long
declare function InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (byval hWnd as DWORD, lpRect as RECT, byval bErase as long) as long
declare function UpdateWindow LIB "USER32.DLL" ALIAS "UpdateWindow" (byval hWnd as DWORD) as long
declare sub PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (byval nExitCode as long)
declare function glGenLists LIB "opengl32.dll" ALIAS "glGenLists" (byval range as long) as DWORD
declare function glGetError LIB "opengl32.dll" ALIAS "glGetError" () as DWORD
declare function glIsEnabled LIB "opengl32.dll" ALIAS "glIsEnabled" (byval cap as DWORD) as BYTE
declare sub glBindTexture LIB "OPENGL32.DLL" ALIAS "glBindTexture" (byval target as DWORD, byval texture as DWORD)
declare sub glTexParameteri LIB "OPENGL32.DLL" ALIAS "glTexParameteri" (byval target as DWORD, byval pname as DWORD, byval param as long)
declare sub glTexImage2D LIB "OPENGL32.DLL" ALIAS "glTexImage2D" (byval DWORD, byval LONG, byval LONG, byval LONG, byval LONG, byval LONG, byval DWORD, byval DWORD, pixels as ANY)
declare sub glBegin LIB "opengl32.dll" ALIAS "glBegin" (byval mode as DWORD)
declare sub glCallLists LIB "opengl32.dll" ALIAS "glCallLists" (byval n as long, byval ntype as DWORD, lists as ANY)
declare sub glClear LIB "opengl32.dll" ALIAS "glClear" (byval mask as DWORD)
declare sub glClearColor LIB "opengl32.dll" ALIAS "glClearColor" (byval red as SINGLE, byval green as SINGLE, byval blue as SINGLE, byval alpha as SINGLE)
declare sub glColor3f LIB "opengl32.dll" ALIAS "glColor3f" (byval red as SINGLE, byval green as SINGLE, byval blue as SINGLE)
declare sub glColor3ub LIB "opengl32.dll" ALIAS "glColor3ub" (byval red as BYTE, byval green as BYTE, byval blue as BYTE)
declare sub glDeleteLists LIB "opengl32.dll" ALIAS "glDeleteLists" (byval list as DWORD, byval range as long)
declare sub glDeleteTextures LIB "opengl32.dll" ALIAS "glDeleteTextures" (byval n as long, textures as ANY)
declare sub glDisable LIB "opengl32.dll" ALIAS "glDisable" (byval cap as DWORD)
declare sub glEnable LIB "opengl32.dll" ALIAS "glEnable" (byval cap as DWORD)
declare sub glEnd LIB "opengl32.dll" ALIAS "glEnd" ()
declare sub glFlush LIB "opengl32.dll" ALIAS "glFlush" ()
declare sub glFrustum LIB "opengl32.dll" ALIAS "glFrustum" (byval nleft as DOUBLE, byval nright as DOUBLE, byval bottom as DOUBLE, byval top as DOUBLE, byval zNear as DOUBLE, byval zFar as DOUBLE)
declare function glIsTexture LIB "opengl32.dll" ALIAS "glIsTexture" (byval texture as DWORD) as BYTE
declare sub glLightfv LIB "opengl32.dll" ALIAS "glLightfv" (byval light as DWORD, byval pname as DWORD, params as ANY)
declare sub glListBase LIB "opengl32.dll" ALIAS "glListBase" (byval nbase as DWORD)
declare sub glLoadIdentity LIB "opengl32.dll" ALIAS "glLoadIdentity" ()
declare sub glMaterialfv LIB "opengl32.dll" ALIAS "glMaterialfv" (byval face as DWORD, byval pname as DWORD, params as ANY)
declare sub glMatrixMode LIB "opengl32.dll" ALIAS "glMatrixMode" (byval mode as DWORD)
declare sub glOrtho LIB "opengl32.dll" ALIAS "glOrtho" (byval nleft as DOUBLE, byval nright as DOUBLE, byval bottom as DOUBLE, byval top as DOUBLE, byval zNear as DOUBLE, byval zFar as DOUBLE)
declare sub glPopAttrib LIB "opengl32.dll" ALIAS "glPopAttrib" ()
declare sub glPopMatrix LIB "opengl32.dll" ALIAS "glPopMatrix" ()
declare sub glPushAttrib LIB "opengl32.dll" ALIAS "glPushAttrib" (byval mask as DWORD)
declare sub glPushMatrix LIB "opengl32.dll" ALIAS "glPushMatrix" ()
declare sub glRasterPos2i LIB "opengl32.dll" ALIAS "glRasterPos2i" (byval x as long, byval y as long)
declare sub glRotated LIB "opengl32.dll" ALIAS "glRotated" (byval angle as DOUBLE, byval x as DOUBLE, byval y as DOUBLE, byval z as DOUBLE)
declare sub glShadeModel LIB "opengl32.dll" ALIAS "glShadeModel" (byval mode as DWORD)
declare sub glTranslated LIB "opengl32.dll" ALIAS "glTranslated" (byval x as DOUBLE, byval y as DOUBLE, byval z as DOUBLE)
declare sub gluLookAt LIB "glu32.dll" ALIAS "gluLookAt" (byval eyex as double, byval eyey as double, byval eyez as double, byval centerx as double, byval centery as double, byval centerz as double, _
byval upx as double, byval upy as double, byval upz as DOUBLE)
declare sub gluPerspective LIB "glu32.dll" ALIAS "gluPerspective" (byval fovy as double, byval aspect as double, byval zNear as double, byval zFar as DOUBLE)
declare sub glVertex3d LIB "opengl32.dll" ALIAS "glVertex3d" (byval x as DOUBLE, byval y as DOUBLE, byval z as DOUBLE)
declare sub glViewport LIB "opengl32.dll" ALIAS "glViewport" (byval x as long, byval y as long, byval nwidth as long, byval height as long)
'declare function IsWindow LIB "USER32.DLL" ALIAS "IsWindow" (byval hWnd as DWORD) as long
'declare function SetParent LIB "USER32.DLL" ALIAS "SetParent" (byval hWndChild as DWORD, BYVAL hWndNewParent as DWORD) as long
type GdiplusStartupInput
GdiplusVersion as long ' Must be 1
DebugEventCallback as long ' Ignored on free builds
SuppressBackgroundThread as long ' FALSE unless you're prepared to call
' the hook/unhook functions properly
SuppressExternalCodecs as long ' FALSE unless you want GDI+ only to use
' its internal image codecs.
end type
declare function GdiplusStartup LIB "gdiplus.dll" ALIAS "GdiplusStartup" (token as long, inputbuf as GdiplusStartupInput, OPTIONAL byval outputbuf as long) as long
declare function GdiplusShutdown LIB "gdiplus.dll" ALIAS "GdiplusShutdown" (byval token as long) as long
const BBP_RENDER = 1 '// Render the scene.
const BBP_CREATE = 2 '// Retrieve Title, Name, Version, Render mode.
const BBP_INIT = 3 '// Init the OpenGL.
const BBP_SIZE = 4 '// The size of the control has changed.
const BBP_KEYBOARD = 5 '// All keyborad message.
const BBP_MOUSE = 6 '// All mouse messages.
const BBP_DESTROY = 7 '// Free Up resources.
const BBP_GDIPLUS = 0 '// GDImage GDIPLUS compatible mode.
const BBP_OPENGL = 1 '// OpenGL mode.
const BBP_DIRECTX = 2 '// DirectX mode (for future extension).
const BBP_SUCCESS = 0
const BBP_ERROR = -1
type BBPLUGIN '// 256 bytes
Msg as long '// The plugin's message (see above constant list).
ParentWindow as long '// The parent window handle.
DC as long '// The parent window DC (while in play mode).
RC as long '// The parent OpenGL RC (while in play mode).
Lpeak as WORD '// The left audio channel peak value (while in play mode).
Rpeak as WORD '// The right audio channel peak value (while in play mode).
Title as ASCIIZ * 32 '// Plugin's name or title.
Author as ASCIIZ * 64 '// Plugin's author name.
Version as DWORD '// LOWRD major, HIWRD minor.
RenderTo as long '// BBP_GDIPLUS, BBP_OPENGL, BBP_DIRECTX.
BackARGB as long '// Default ARGB color background.
FFTdata as DWORD '// DWORD pointer to the FFT() as SINGLE array.
FFTsize as WORD '// Size of the FFT array.
WinMsg as long '// True Windows message.
wParam as long '// wParam
lParam as long '// lParam
WIMdata as DWORD '// DWORD pointer to the wave MM_WIM_DATA.
MediaLength as DWORD '// Media length.
MediaPos as DWORD '// Media pos.
Reserved as ASCIIZ * 98 '// Reserved for future extension.
end type
$CREDIT = " - Visual plugin by "
$Version = "Version 2.53"
declare function prototype_wglSwapIntervalEXT( byval number as long ) as long
declare function wglGetProcAddress LIB "opengl32.dll" ALIAS "wglGetProcAddress" (lpStr as ASCIIZ) as long
declare function DwmIsCompositionEnabled () as long
declare sub apiSleep LIB "KERNEL32.DLL" ALIAS "Sleep" (byval dwMilliseconds as DWORD)
declare function wglSwapBuffers LIB "OPENGL32.DLL" ALIAS "wglSwapBuffers" (byval hdc as DWORD) as DWORD
'// global definitions
const XMIN_SIZE = 254
const YMIN_SIZE = 449
const ID_VISUAL = -1
const VISUAL_TIMER = 2
global glRC, gnCodeID as long
global gnMediaLength, gnMediaPos as DWORD
global gnMain, gnParent as DWORD
function GdipStart() as long
local nRet, hGDIplus as long
'// Load GDIPLUS
DIM GpInput as GdiplusStartupInput
GpInput.GdiplusVersion = 1
nRet = 0: hGDIplus = 0
if (GdiplusStartup(hGDIplus, GpInput) = 0) then nRet = hGDIplus
function = nRet
end function
sub GdipEnd(byval hGDIplus as long)
if (hGDIplus) then GdiplusShutdown(hGDIplus)
end sub
function BBP_ProcHandle(byval hProc as DWORD, byval RW as long) as DWORD
static WasHproc as DWORD
if (RW) then WasHproc = hProc
function = WasHproc
end function
'// Detached plugin
sub BBP_Detached(byval hWnd as long, byref hLib as DWORD)
if (hLib) then
local BBP as BBPLUGIN
BBP.Msg = BBP_DESTROY
BBP.ParentWindow = hWnd
BBP_Plugin(BBP)
' // use brute force to delete any existing texture
local K, Tmax as long
Tmax = 32
REDIM DT(1 TO Tmax) as local LONG
FOR K = 1 TO Tmax: DT(K) = K: NEXT
glDeleteTextures(K, DT(1))
BBP_ProcHandle(0, 1): FreeLibrary(hLib): hLib = 0
end if
end sub
function BBP_ActivePlugin(byval sPluginName as string, byval RW as long) as string
static sWasPluginName as string
if (RW) then sWasPluginName = sPluginName
function = sWasPluginName
end function
'// Load/unload plugin DLL to/from memory
function BBP_LoadPlugin(byval hWnd as long, zPlugin as ASCIIZ) as long
static hLib as DWORD, sLastPlugin as string
local nDone as long
local hProc as DWORD
if (len(zPlugin) and zPlugin <> sLastPlugin) then
if (IsFile(zPlugin)) then
BBP_Detached(hWnd, hLib)
hLib = LoadLibrary(zPlugin)
if (hLib) then
hProc = GetProcAddress(hLib, "BBProc")
if (hProc) then
BBP_ProcHandle(hProc, 1)
sLastPlugin = zPlugin
BBP_ActivePlugin(sLastPlugin, 1)
'// Reset plugin to default
BBP_Reset()
nDone = -1
end if
end if
end if
elseif len(zPlugin) = 0 then
BBP_Detached(hWnd, hLib)
end if
function = nDone
end function
'// Send/recept message to/from plugin
function BBP_Plugin(byref BBP as BBPLUGIN) as long
local hProc as DWORD, nRet as long
nRet = BBP_ERROR
if (glRC) then
hProc = BBP_ProcHandle(0, 0): if (hProc) then CALL DWORD hProc USING BBP_Plugin(BBP) TO nRet
end if
function = nRet
end function
function LoadDWM () as long
static hLib as DWORD, nChecked as long
if (nChecked = 0) then nChecked = -1: hLib = LoadLibrary ("dwmapi.dll")
function = hLib
end function
function zDwmIsCompositionEnabled () as long
local nRet as long, hLib as DWORD
static hProc as DWORD
hLib = LoadDWM()
if (hLib) then
if (hProc = 0) then hProc = GetProcAddress(hLib, "DwmIsCompositionEnabled")
if (hProc) then
CALL DWORD hProc USING DwmIsCompositionEnabled() TO nRet
if (nRet) then function = -1
end if
end if
end function
sub BBP_Reset ()
local BBP as BBPLUGIN
BBP.Msg = BBP_CREATE
BBP_Plugin(BBP)
if (BBP.RenderTo = BBP_OPENGL) then
glDisable(GL_BLEND)
glDisable(GL_TEXTURE_2D)
glDisable(GL_DEPTH_TEST)
glDisable(GL_LIGHT0)
glDisable(GL_LIGHT1)
glDisable(GL_LIGHT2)
glDisable(GL_LIGHT3)
glDisable(GL_LIGHT4)
glDisable(GL_LIGHT5)
glDisable(GL_LIGHT6)
glDisable(GL_LIGHT7)
glDisable(GL_LIGHTING)
glDisable(GL_COLOR_MATERIAL)
glDisable(GL_ALPHA_TEST)
glDisable(GL_NORMALIZE)
local ptr_wglSwapIntervalEXT as DWORD
ptr_wglSwapIntervalEXT = wglGetProcAddress("wglSwapIntervalEXT")
if (ptr_wglSwapIntervalEXT) then
if (zDwmIsCompositionEnabled()) then
CALL DWORD ptr_wglSwapIntervalEXT USING prototype_wglSwapIntervalEXT(0)
else
CALL DWORD ptr_wglSwapIntervalEXT USING prototype_wglSwapIntervalEXT(1)
end if
end if
glGetError()
end if
end sub
function SolvePeak (byval nValue as long, byval nTotal as long) as long
local nRet as long
nRet = 0: if nTotal then nRet = (nValue * 100) \ nTotal
function = nRet
end function
sub ResizeGLwindow (byval hWnd as long)
local rc as RECT
GetClientRect(hWnd, rc)
glViewport(0, 0, rc.nRight, rc.nBottom)
local BBP as BBPLUGIN
BBP.Msg = BBP_SIZE
BBP.ParentWindow = hWnd
BBP_Plugin(BBP)
end sub
function zSetupPixelFormat (byval hDC as long) as long
local pfd as PIXELFORMATDESCRIPTOR
local pixelformat as long
local lRet as long
lRet = -1
pfd.nSize = SIZEOF(pfd)
pfd.nVersion = 1
pfd.dwFlags = PFD_DRAW_TO_WINDOW OR PFD_SUPPORT_OPENGL OR PFD_DOUBLEBUFFER OR PFD_DRAW_TO_BITMAP
pfd.iPixelType = PFD_TYPE_RGBA
pfd.cColorBits = 32
pfd.cDepthBits = 32
pixelformat = ChoosePixelFormat(hDC, pfd)
if (pixelformat) then
if (SetPixelFormat(hDC, pixelformat, pfd) = 0) then lRet = 0
else
lRet = 0
end if
function = lRet
end function
function InitOpenGL (byval hWnd as long) as long
local glDC, nRet as long, BBP as BBPLUGIN
glDC = GetDC(hWnd)
nRet = 0
if (zSetupPixelFormat(glDC)) then
glRC = wglCreateContext(glDC)
if (glRC) then
if (wglMakeCurrent(glDC, glRC)) then
ResizeGLwindow(hWnd)
nRet = -1
end if
end if
end if
ReleaseDC(hWnd, glDC)
function = nRet
end function
sub RenderOpenGL (byval hWnd as long, byval nLevel as DWORD, _
byval medialength as DWORD, byval mediapos as DWORD, _
byval getdata as DWORD, byval wimdata as DWORD)
if (IsWindowVisible(hWnd) = 0) then EXIT sub
local glDC AS DWORD
local BBP as BBPLUGIN
glDC = GetDC(hWnd)
if (glRC) then
BBP.Msg = BBP_RENDER
BBP.ParentWindow = hWnd
BBP.DC = glDC
BBP.RC = glRC
BBP.Lpeak = SolvePeak(LO(WORD, nLevel), 128)
BBP.Rpeak = SolvePeak(HI(WORD, nLevel), 128)
BBP.BackARGB = 0
BBP.FFTdata = getdata ' BassChannelGetData()
BBP.FFTsize = 256
BBP.MediaLength = medialength
BBP.MediaPos = mediapos
BBP.WIMdata = wimdata ' BassChannelGetWimData()
BBP_PLUGIN(BBP)
'// Refresh display
SwapBuffers(glDC)
InvalidateRect(hWnd, byval NULL, 0)
UpdateWindow(hWnd)
end if
ReleaseDC(hWnd, glDC)
end sub
function GetCTLText (byval hCTRL as long) as string
local nLength as long, szText as ASCIIZ * 4096
nLength = GetWindowText(hCTRL, szText, SIZEOF(szText))
if (nLength) then function = UCASE$(LEFT$(szText, nLength))
end function
'DECLARE SUB MoveMemory IMPORT "KERNEL32.DLL" ALIAS "RtlMoveMemory" ( _
' BYVAL Destination AS DWORD _ ' __in PVOID Destination
' , BYVAL Source AS DWORD _ ' __in const VOID* Source
' , BYVAL Length AS DWORD _ ' __in SIZE_T Length
' )
'// Main window procedure
function WndProc (byval hWnd as long, byval Msg as long, byval wParam as long, byval lParam as long) as long
local sMessage, sCodeID as string
DIM ptCDS AS COPYDATASTRUCT POINTER
DIM ptBBP AS BBP64 PTR
local szFile as ASCIIZ * MAX_PATH
local BBP as BBPLUGIN
local nlevel, medialength, mediapos, getdataPTR, wimdataPTR as DWORD
DIM getdata(255) as static single
DIM wimdata(255) as static single
select case long (Msg)
case WM_WINDOWPOSCHANGING:
if (gnParent) then
local wp as WINDOWPOS PTR
wp = lParam
@wp.hWndInsertAfter = GetWindow(gnParent, 2)
function = 0: EXIT function
end if
case WM_COPYDATA:
ptCDS = lParam
select case long (@ptCDS.dwData)
case 0:
ptBBP = @ptCDS.lpData
nlevel = @ptBBP.nlevel
medialength = @ptBBP.medialength
mediapos = @ptBBP.mediapos
getdataPTR = VARPTR(getdata(0))
wimdataPTR = VARPTR(wimdata(0))
MEMORY COPY VARPTR(@ptBBP.getdata(0)), getdataPTR, 1024
MEMORY COPY VARPTR(@ptBBP.wimdata(0)), wimdataPTR, 1024
RenderOpenGL(hWnd, nLevel, medialength, mediapos, getdataPTR, wimdataPTR)
case 1:
gnParent = wParam
'//if (IsWindow(gnParent)) THEN SetParent(hWnd, gnParent)
ptBBP = @ptCDS.lpData
gnCodeID = @ptBBP.gdimageID
case 2:
ptBBP = @ptCDS.lpData
MEMORY COPY VARPTR(@ptBBP.plugin), VARPTR(szFile), 260
'MoveMemory(VARPTR(szFile), VARPTR(@ptBBP.plugin), 260)
if (BBP_LoadPlugin(hWnd, szFile)) then ' Make sure that a different plugin has been selected
BBP.Msg = BBP_INIT
BBP.ParentWindow = hWnd
BBP.DC = GetDC(BBP.ParentWindow)
BBP.RC = glRC
BBP.BackARGB = 0
if (BBP_Plugin(BBP) = BBP_SUCCESS) then
'zTrace(szFile)
ResizeGLwindow(hWnd)
end if
ReleaseDC(BBP.ParentWindow, BBP.DC)
end if
case 3:
DestroyWindow(hWnd)
end select
function = 1: EXIT function
case WM_SIZE:
if (glRC) then
ResizeGLwindow(hWnd)
end if
case WM_DESTROY:
'// Detached active plugin
BBP_LoadPlugin(hWnd, "")
PostQuitMessage(0)
function = 0: EXIT function
end select
function = DefWindowProc(hWnd, Msg, wParam, lParam)
end function
'// Main entry point
function WINMAIN (byval hInstance as long, _
byval hPrevInstance as long, _
byval lpCmdLine as ASCIIZ PTR, _
byval iCmdShow as long) as long
local Msg as tagMsg
local wcx as WndClassEx
local zClass as ASCIIZ * 80
local dwExStyle as DWORD
local dwStyle as DWORD
local rc as RECT
local x as long
local y as long
local sPlugin as string
local IsInitialized as long
local hGDIplus as long ' GDIPLUS
zClass = "ZWALLPAPER"
wcx.cbSize = SIZEOF(wcx)
IsInitialized = GetClassInfoEx(hInstance, zClass, wcx)
if IsInitialized = 0 then
wcx.cbSize = SIZEOF(wcx)
wcx.style = CS_HREDRAW OR CS_VREDRAW
wcx.lpfnWndProc = CODEPTR(WndProc)
wcx.cbWndExtra = 0
wcx.hInstance = hInstance
wcx.hIcon = 0
wcx.hCursor = LoadCursor(0, byval IDC_ARROW)
wcx.hbrBackground = 0
wcx.lpszMenuName = 0
wcx.lpszClassName = VARPTR(zClass)
wcx.hIconSm = 0
if (RegisterClassEx(wcx)) then IsInitialized = -1
end if
if (IsInitialized) then
'// Init GDIPLUS
hGDIplus = GdipStart()
x = MAX&((GetSystemMetrics(SM_CXSCREEN) - XMIN_SIZE) \ 2, 0)
y = 0'-2000
'// Create the window
gnMain = CreateWindowEx(WS_EX_TOOLWINDOW, _ ' Extended Style For The Window
zClass, _ ' Class Name
zClass, _ ' Window Title
WS_POPUP, _ ' Defined Window Style
x, y, _ ' Window Position
XMIN_SIZE, _ ' Window Width
YMIN_SIZE, _ ' Window Height
0, _ ' No Parent Window
0, _ ' No Menu
hInstance, _ ' Instance
byval 0) ' Dont Pass Anything To WM_CREATE
if (gnMain) then
if (InitOpenGL(gnMain)) then
while (GetMessage(Msg, 0, 0, 0))
TranslateMessage(Msg)
DispatchMessage(Msg)
wend
if (glRC) then
wglMakeCurrent(0, 0)
wglDeleteContext(glRC): glRC = 0
end if
function = msg.wParam
end if
end if
'// UNLOAD GDIPLUS
GdipEnd(hGDIplus)
end if
end function