Thread: Example DLL translation from VBA into Xbasic

1. Example DLL translation from VBA into Xbasic

Hi,

I'm i the mood for code translation and espcially from VB(A) into Xbasic with an emphasis on DLL's.

Selwyn Rabins wrote in 2002 a piece of Xbasic code for the sys_shell_wait() routine. Now I found the counter part of it in Visual Basic. It's nice to have two pieces of "heavy" code and see the translation of it (see attachment). We can learn a lot of it. It will help you a lot in translating VB code which calls dll's. There is a tremendous amount of VB code ready for use in Xbasic. Ehhh, at least if you can use it.

Take also a look at the Win32s Programmer's Reference.hlp (API) for the specific functions and structures used and you see a translation-triangle C-VB-Xbasic. Don't forget to read the very good information on "Pie Charts in Alpha Five" by Dr. Peter Wayne http://learnalpha.com/PieCharts/PieCharts.htm.

Regards,

Marcel

2. RE: Example DLL translation from VBA into Xbasic

Marcel,
Thank you, that's very valuable. You should also know that A5 lets you create user-defined types, just like VB, so that it becomes easier to modify VB code. Your code could be compressed like this, and I believe this is clearer, and more similar to VB:
Code:
command="Notepad.exe"
sys_shell_wait(command,.t.)
end

FUNCTION sys_shell_wait AS V (command_line AS C, show_window AS L )

' declare types and hooks to WinAPI

type startupinfo
cb as Integer
lpReserved as C
lpDesktop as C
lpTitle AS C
dwX AS Integer
dwY AS Integer
dwXSize AS Integer
dwYSize AS Integer
dwXCountChars AS Integer
dwYCountChars AS Integer
dwFillAttribute AS Integer
dwFlags AS Integer
wShowWindow AS Integer
cbReserved2 AS Integer
lpReserved2 AS Integer
hStdInput AS Integer
StdOutput AS Integer
hStdError AS Integer
end type

type process_information
hprocess as Integer
dwProcessID as Integer
end type

' hooks to WinAPI
declare KERNEL32 WaitForSingleObject LLL
declare KERNEL32 CreateProcessA LLCLLLLLL(STARTUPINFO)(PROCESS_INFORMATION)
declare KERNEL32 CloseHandle LL

appExec(command_line, show_window)
END FUNCTION

FUNCTION appExec AS V (commandLine AS C, show_window AS L )
CONSTANT NORMAL_PRIORITY_CLASS = hex_to_dec("20")
CONSTANT INFINITE = hex_to_dec("FFFFFFFF")

dim start as {startupinfo}
dim proc as {process_information}
Dim nMilliseconds As N

nMilliseconds = INFINITE
IF show_window
Start.dwFlags = 4
Start.wShowWindow = 1
ELSE
Start.dwFlags = 1
Start.wShowWindow = 0
END IF

CreateProcessA(0,CommandLine, 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, 0, Start, proc)
WaitForSingleObject(proc.hProcess, nMilliseconds)

END FUNCTION
There's also an error, I think, in the VB code that you provide. The CreateProcessA declaration takes a long as its first parameterm, followed by a string. So comparing Lissauer's code with yours (or Selwyn's, I'm not sure whose) doesn't work properly because Lissauer is calling CreateProcessA with the wrong parameter list. At least that's what the Microsoft knowledge base indicates in their description of using CreateProcessA.

3. RE: Example DLL translation from VBA into Xbasic

Hi Peter:

This is great. Hats off to you and Marcel for these examples. I was planning to test Marcel's sys_shell_wait this weekend since I was never able to get Selwyn's original to work for some reason.

Anyhow, the one you posted works perfectly including - and for me this is a real biggie - with CMD files such as copying the contents of a big folder or whatever else one might do in a dos window.

Finian

4. RE: Example DLL translation from VBA into Xbasic

Hi Peter,

First, let me thank you very much for this compressed example you provided here. It's a master piece in my opinion. You gave me with your reply the answer at a question I just wanted to ask. It's about the use of DECLARESTRUCT and TYPE...END TYPE. I was just doing the splits.
The people of Alpha Five told me to use the TYPE..END TYPE construction, however I never managed to get it to work in that way. Therefore I kept using the old DECLARESTRUCTs.

With your information I start changing my code.

About the fact that there could be an error in the VB code, yes it's possible. I didn't run this code, I used it only for comparison and I was in the middle of a study of it. I would probably overlooked the error ;-)

Let me be clear about the source of the code. This isn't mine. The Xbasic code is written by Selwyn and the VB code is Lissauers and I found it by accidental on a VB site.

Peter you helped me a lot.

Regards,

Marcel

5. RE: Example DLL translation from VBA into Xbasic

Finnian, what would the syntax be for copying the contents of
c:\alpha\newha\Practice Before Multiple States\*.*
to
c:\alpha\newha\test33\*.*

6. RE: Example DLL translation from VBA into Xbasic

Martin:

xcopy "c:\alpha\newha\Practice Before Multiple States\*.*"
"c:\alpha\newha\test33\*.*" /E /Y

On one line should do it. Iy will copy all files and folders and overwrite existing files without a prompt.

Finian

7. RE: Example DLL translation from VBA into Xbasic

Finnian, I meant using the sys_shell_wait()

otherwise I just use batch files

I was referring to what you mentioned:

Anyhow, the one you posted works perfectly including - and for me this is a real biggie - with CMD files such as copying the contents of a big folder or whatever else one might do in a dos window.

I can see the obvious benefits of this function when you want to stop processing until notepad or word or excel was closed, but for issuing other dos commands I can't get the syntax correct, as it apparently all has to be enclosed in quotes.

for example, the following works (where all words are 8 or fewer characters in length):
sys_shell_wait("xcopy c:\alpha\newha\test33\*.* c:\alpha\newha\test34\*.* /E /Y",.t.)

whereas the following won't:
sys_shell_wait("xcopy c:\alpha\newha\Practice Before Multiple States\*.* c:\alpha\newha\test34\*.* /E /Y",.t.)

I was wondering how to write the second one.

8. RE: Example DLL translation from VBA into Xbasic

Martin,

Have you tried single quotes around the paths with spaces in them?

I've never tried this but I wonder if you sys_shell would accept a path in a variable. This would be worth knowing.

Bill

9. RE: Example DLL translation from VBA into Xbasic

thanks Bill - yes I tried several possibilities, but can't get it to work.

usually, I do this in bat files, and use sys_shell to call them

10. RE: Example DLL translation from VBA into Xbasic

try this, Martin:
"pre"
sys_shell_wait("xcopy c:\alpha\newha\Practic~\*.* c:\alpha\newha\test34\*.* /E /Y",.t.) "/pre"

11. RE: Example DLL translation from VBA into Xbasic

sorry, forget to check the "use html" box:
Code:
sys_shell_wait("xcopy c:\alpha\newha\Practic~\*.* c:\alpha\newha\test34\*.* /E /Y",.t.)

12. RE: Example DLL translation from VBA into Xbasic

Martin:

Duh! Sorry.

I use this stuff in our upgrade application. I need to get the upgrade path and source files path from the user. I then create batch (cmd) files in xbasic to run the various processes. This is where sys_shell_wait will be a great simplifier. I think sys_shell_wait is built in to V6 but all my stuff is still in V5.

Anyway, I created a cmd file in Textpad called "copyfiles.cmd". In my test it has just one line:
xcopy "C:\OSOM Data\OMSCompV5\*.*" "C:\OSOM Data\temp\*.*" /E /Y

I used Peter's script pretty much as is:

command="C:\OSOM Data\OMSCompv5\copyfiles.cmd"
sys_shell_wait(command,.F.)
ui_msg_box("","Copyfiles was closed")
end

When run, this copies the files with no window showing.

Finian

with the command lines. Sometimes they are just one line

13. RE: Example DLL translation from VBA into Xbasic

Thanks to you both.
Peter, it doesn't work.
The solution may be to have single word, max 8 character length folder names

14. RE: Example DLL translation from VBA into Xbasic

Martin:

In the cmd files I always enclose the path to the files within quotes, whether they contain spaces or not and regardless of the length. This seems to work fine.

Finian

15. RE: Example DLL translation from VBA into Xbasic

Marcel,
Maybe you would like to try your hand at something that has stumped me since yesterday. I want to change the display resolution from within A5. Here is what I have done so far, but it doesn't work properly:

Code:
declarestruct charbuf C32charbuf
declarestruct charbufx C32charbufx

type DEVMODE
dmDeviceName as charbuf
dmSpecVersion as Integer
dmDriverVersion as Integer
dmSize as Integer
dmDriverExtra as Integer
dmFields as Integer
dmOrientation as Integer
dmPaperSize 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 charbufx
dmLogPixels as Integer
dmBitsPerPel as Integer
dmPelsWidth as Integer
dmPelsHeight as Integer
dmDisplayFlags as Integer
dmDisplayFrequency as Integer
end type

declare USER32 EnumDisplaySettings@EnumDisplaySettingsA LLL(DEVMODE)
declare USER32 ChangeDisplaySettings@ChangeDisplaySettingsA L(DEVMODE)L

change_res(800, 600)
end

function change_res(width as n, height as n)
CONSTANT DM_PELSWIDTH = hex_to_dec("80000")
constant DM_PELSHEIGHT = hex_to_dec("100000")

dim DevM as {DEVMODE}

'dim displaymodes[100] as c

dim disp as n
disp=1
i=0
while disp>0 '.and. i
disp= EnumDisplaySettings(0,i,DevM)
i=i+1
'displaymodes[i]=property_to_string(DevM)
end while
'for j=1 to i
'	ui_msg_box(""+(j-1),displaymodes[j])
'next
DevM.dmFields = DM_PELSWIDTH .or. DM_PELSHEIGHT
DevM.dmPelsWidth = width
DevM.dmPelsHeight = height
b = ChangeDisplaySettings(DevM, 0)
'ui_msg_box("b",""+b)
end function
If you uncomment the commented sections you wll see that EnumDisplaySettings does not return all properties--particularly, the BitsPerPel (PerPixel) is zero. So I'm clearly doing something wrong in the calling convention.

16. RE: Example DLL translation from VBA into Xbasic

Peter,

In the meantime I post here some stuff where I don't know why I can't get WIN32_FIND_DATA structure filled. I'm translating this from the Win32 Programmer's Reference. It was code I'd examined several months ago to overcome some problems with the File Attributes command. Here are some problems such as translating the array[] construction in a c-type declaration. Xbasic doesn't do this job. Another point is how can I pass the WIN32_FIND_DATA by reference so the function can fill the structure.

It is also possible that I'm trying something to do that can't be done in Xbasic simple because the structure translating lacks. However here some premature code.

Code:
'Purpose
'Trying to get the structure WIN32_FIND_DATA filled by dll function FindFirstFileA().
'Possible problems will arise with the array based structure members.
'Question:
'- How is a - TCHAR cAlternateFileName[14] - structure part handled by Xbasic.
'  in C this is a array of 14 characters closed with a \0

constant MAX_PATH = 260
'#define INVALID_HANDLE_VALUE	(HANDLE)(0xffffffff) 'This is C
constant INVALID_HANDLE_VALUE = hex_to_dec("ffffffff")

'C-code
'The FILETIME structure is a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC).

'typedef struct _FILETIME {
'	DWORD dwLowDateTime;
'	DWORD dwHighDateTime;
'} FILETIME, *PFILETIME;

'Xbasic version
type FILETIME
dwLowDateTime as Integer
dwHighDateTime as Integer
end type

'C-code
'The WIN32_FIND_DATA structure describes a file found by the FindFirstFile, FindFirstFileEx, or FindNextFile function.

'typedef struct _WIN32_FIND_DATA {
'  DWORD dwFileAttributes;
'  FILETIME ftCreationTime;
'  FILETIME ftLastAccessTime;
'  FILETIME ftLastWriteTime;
'  DWORD nFileSizeHigh;
'  DWORD nFileSizeLow;
'  DWORD dwReserved0;'
'  DWORD dwReserved1;
'  TCHAR cFileName[MAX_PATH];
'  TCHAR cAlternateFileName[14];
'} WIN32_FIND_DATA, *PWIN32_FIND_DATA;

'Xbasic version
'Note Using Arrays are not allowed in a structure.. Is this sitting Duck or not?
type WIN32_FIND_DATA
dwFileAttributes as Integer
ftCreationTime as {FILETIME}
ftLastAccessTime as {FILETIME}
ftLastWriteTime as {FILETIME}	'This is allowed
nFileSizeHigh as Integer
nFileSizeLow as Integer
dwReserved0 as Integer
dwReserved1 as Integer
cFileName as C
cAlternateFileName as C
'  cAlternateFileName[14] as Byte 'This doesn't work.
end type

'Declare the external functions in KERNEL32.DLL
'The FindFirstFile function searches a directory for a file whose name matches the specified file name.
'FindFirstFile examines subdirectory names as well as file names. The FindFirstFile function opens a search
'handle and returns information about the first file whose name matches the specified pattern. It searches
'both the long and short file names. After the search handle has been established, use the FindNextFile
'function to search for other files that match the same pattern. When the search handle is no longer needed,
'close it by using the FindClose function

declare KERNEL32 FindFirstFileA LC(WIN32_FIND_DATA)

'The FindClose function closes the specified search handle. The FindFirstFile, FindFirstFileEx, and FindNextFile
'functions use the search handle to locate files with names that match a given name.

declare KERNEL32 FindClose LL

dim hFind as N	'Search handle
dim filepointer as P 'Create a pointer for passing the filename to the function.

'Give the WIN32_FIND_DATA structure a memory mask.
dim findfiledata as {win32_find_data}
dim filepointer.filename as C
dim findfiledata.wFileAttributes as N
dim findfiledata.ftCreationTime as {FILETIME}
dim findfiledata.ftLastAccessTime as {FILETIME}
dim findfiledata.ftLastWriteTime as {FILETIME}
dim findfiledata.nFileSizeHigh as N
dim findfiledata.nFileSizeLow as N
dim findfiledata.dwReserved0 as N
dim findfiledata.dwReserved1 as N
dim findfiledata.cAlternateFileName as C

'Initialize.
filepointer.filename = ""
findfiledata.wFileAttributes = 0
findfiledata.ftCreationTime.dwLowDateTime = 0
findfiledata.ftCreationTime.dwHighDateTime = 0
findfiledata.ftLastAccessTime.dwLowDateTime = 0
findfiledata.ftLastAccessTime.dwHighDateTime = 0
findfiledata.ftLastWriteTime.dwLowDateTime = 0
findfiledata.ftLastWriteTime.dwHighDateTime = 0
findfiledata.nFileSizeHigh = 0
findfiledata.nFileSizeLow = 0
findfiledata.dwReserved0 = 0
findfiledata.dwReserved1 = 0
findfiledata.cAlternateFileName = ""

'debug(1)
filepointer.filename = "C:\\*.*"	'Whatever there is find the first.

hFind = FindFirstFileA(filepointer,findfiledata) '

if hFind = INVALID_HANDLE_VALUE then

ui_msg_box("Error", "INVALID_HANDLE_VALUE")

else

ui_msg_box("Succeed", "HANDLE_VALUE_OK")
ui_msg_box("hFind", convert_type(hFind, "C"))
ui_msg_box("Filename", convert_type(findfiledata.cFileName, "C"))
ui_msg_box("INVALID_HANDLE_VALUE", convert_type(INVALID_HANDLE_VALUE, "C"))
ui_msg_box("wFileAttributes", convert_type(findfiledata.wFileAttributes, "C"))
ui_msg_box("dwLowDateTime", convert_type(findfiledata.ftCreationTime.dwLowDateTime, "C"))

FindClose(hFind)

end if

undeclare FindFirstFile
undeclare FindClose

End

17. RE: Example DLL translation from VBA into Xbasic

Marcel,
I doubt the problem is that we can't do it in Xbasic, but rather that we don't know how to do it in Xbasic. The syntax is, as you know, obscure!
- Peter

18. RE: Example DLL translation from VBA into Xbasic

Hi Peter,

Yes, I'm aware of it, it's very obscure.

From which version of Windows Software Development Kit (WINAPI) did you get the structure information? I have two versions.

1 The Microsoft Plaform SDK February 2003.
2 The Win32 programmers Reference from Borland C++ Builder 6.

Both are different. Number 1 (newer) shows a union in it which is not precent at 2 (older). The union differs because it is a structure which is used for screen or printer. The union can make the problem. The size depends on the biggest member(s) in it.

I think the structure is incomplete. I added - dmPaperLength as Integer - to the structure.

I'll continue my investigation.

Marcel

19. RE: Example DLL translation from VBA into Xbasic

Peter, do you also getting DISP_CHANGE_BADMODE (-2) in b back as a result?

20. RE: Example DLL translation from VBA into Xbasic

Marcel,
You're right, I left out a member of the structure. I got the specs from the Microsoft site and I left out that member.
I may try to rewrite the type...end type as a structure, but I find the structure syntax so confusing that I try to avoid it whenever possible.
When I run the EnumDisplaySettings, I get the video card adapter name, and the next 2 parameters, but everything else is blank or zero. Is that what you get as well?
And yes, I get -2 back when I try to change the settings, but of course, I'm trying to change them to blank settings, for the most part, which causes the error.
- Peter

21. RE: Example DLL translation from VBA into Xbasic

Ditto.

You hit the same wall as I do. In your case you get the first few parameters. That's something to celebrate. I miss the clear and exact way of declaring structures from C. A byte is a byte and an Int is a integer.

Here in Xbasic I really don't know what I am doing. I'm complete blind. No function to support this constructs and working with it. Too much asuming that it will fit into the structure (mask) you declare. No differences between byte (BYTE) 8bit, short(WORD) 16bit, integer(DWORD) 32bit. I've no idea how this is done insite Xbasic.

I miss such tools as sizeof(DEVMODE) to get the real size of structures. Some structures need that. This one does also. Here some explanation from the SDK.

Quote....
dmSize
Specifies the size, in bytes, of the DEVMODE structure, not including any private driver-specific data that might follow the structure's public members. Set this member to sizeof(DEVMODE) to indicate the version of the DEVMODE structure being used.
...QuteEnd

So far I have no solution. Maybe that Selwyn, Aaron or Lenny can clearify something. It cost too much time to puzzle this out in Xbasic. Sometimes I build a dll in PureBasic and handle such stuff in a simplyfied external function like I did in PbAttrib.dll. There I can get the right members back in structures or there are some functions defined that do the job.

I'll still take a look at your code.

Marcel

22. RE: Example DLL translation from VBA into Xbasic

Marcel,
I agree with you, it's almost impossible in Xbasic. I'm going to give up for now. We need some guidance from the developers.

23. RE: Example DLL translation from VBA into Xbasic

Thanks Peter, I'll inform you if I do have some progress to this matter.

Sometimes my progress is 10 bytes longs and a structure backwards ;-)

Regards,

Marcel

24. RE: Example DLL translation from VBA into Xbasic

Peter,

Is it possible to use BLOB's? A blob can be peeked and poked in byte, word and dword to investigate its contents.

A blob can be used in a TYPE..END TYPE. But can it also get the raw binary data?

Just some ideas..

Marcel

25. RE: Example DLL translation from VBA into Xbasic

Hi Peter,

Try this one....

Code:
'Date Created: 27-Jun-2004 07:55:33 PM
'Last Updated: 28-Jun-2004 08:37:03 PM
'Created By  :
'Updated By  :

constant DISP_CHANGE_SUCCESSFUL	= 0
constant DISP_CHANGE_RESTART	= 1
constant DISP_CHANGE_FAILED	= (-1)
constant DISP_CHANGE_NOTUPDATED	= (-3)

declarestruct _charbuf C32charbuf
declarestruct _charbufx C32charbufx

'typedef struct _POINTL {
'  LONG x;
'  LONG y;
'} POINTL, *PPOINTL;

type POINTL
x as I
y as I
end type

type DEVMODE
dmDeviceName as _charbuf
dmSpecVersion as Integer
dmDriverVersion as Integer
dmSize as Integer
dmDriverExtra as Integer
dmFields as Integer
dmOrientation as Integer
dmPaperSize as Integer
dmPaperWidth as Integer
dmScale as Integer
dmCopies as Integer
dmDefaultSource as Integer
dmPrintQuality as Integer
dmPosition as {POINTL}
dmDisplayOrientation as Integer
dmDisplayFixedOutput as Integer
dmColor as Integer
dmDuplex as Integer
dmYResolution as Integer
dmTTOption as Integer
dmCollate as Integer
dmFormName as _charbufx
dmLogPixels as Integer
dmBitsPerPel as Integer
dmPelsWidth as Integer
dmPelsHeight as Integer
dmDisplayFlags as Integer
dmDisplayFrequency as Integer
end type

'BOOL EnumDisplaySettings(
'  LPCTSTR lpszDeviceName,  // display device
'  DWORD iModeNum,          // graphics mode
'  LPDEVMODE lpDevMode      // graphics mode settings
');
declare USER32 EnumDisplaySettings@EnumDisplaySettingsA LLL(DEVMODE)

'LONG ChangeDisplaySettings(
'  LPDEVMODE lpDevMode,  // graphics mode
'  DWORD dwflags         // graphics mode options
');
declare USER32 ChangeDisplaySettings@ChangeDisplaySettingsA L(DEVMODE)L

change_res(800, 600)
undeclare EnumDisplaySettings
undeclare ChangeDisplaySettings
end

function change_res(width as n, height as n)
CONSTANT DM_PELSWIDTH = hex_to_dec("80000")
constant DM_PELSHEIGHT = hex_to_dec("100000")

dim DevM as {DEVMODE}

dim displaymodes[100] as c
'debug(1)
dim disp as n
disp=1
i=0
while disp > 0 .and. i
disp= EnumDisplaySettings(0,i,DevM)
i=i+1
displaymodes[i]=property_to_string(DevM)
end while
for j=1 to i
ui_msg_box(""+(j-1),displaymodes[j])
next
DevM.dmFields = DM_PELSWIDTH .or. DM_PELSHEIGHT
DevM.dmPelsWidth = width
DevM.dmPelsHeight = height
b = ChangeDisplaySettings(DevM, 0)
ui_msg_box("b",""+b)
end function
My screen got black and came back with DISP_CHANGE_FAILED. This is a good start.

Marcel

26. RE: Example DLL translation from VBA into Xbasic

The union in this structure is a|the problem. For a union is as many room reserverd as its largest member of the union. In case of the first union: the struct {..} is valid or dmPosition or dmDisplayOrientation or dmDisplayFixedOutput. Obvious the struct is the largest and if a short is 16 bit there must be room for 8 x 16 = 128 bits (16 bytes). So we must create a patchwork for this.

The last part of the structure are conditional compiler directives and must be examined it may be part of the structure in our case.

If I am wrong please correct me.

Regards,

Marcel

Code:
typedef struct _devicemode {
BCHAR  dmDeviceName[CCHDEVICENAME];
WORD   dmSpecVersion;
WORD   dmDriverVersion;
WORD   dmSize;
WORD   dmDriverExtra;
DWORD  dmFields;
union {
struct {
short dmOrientation;
short dmPaperSize;
short dmPaperLength;
short dmPaperWidth;
short dmScale;
short dmCopies;
short dmDefaultSource;
short dmPrintQuality;
};
POINTL dmPosition;
DWORD  dmDisplayOrientation;
DWORD  dmDisplayFixedOutput;
};

short  dmColor;
short  dmDuplex;
short  dmYResolution;
short  dmTTOption;
short  dmCollate;
BYTE  dmFormName[CCHFORMNAME];
WORD  dmLogPixels;
DWORD  dmBitsPerPel;
DWORD  dmPelsWidth;
DWORD  dmPelsHeight;
union {
DWORD  dmDisplayFlags;
DWORD  dmNup;
}
DWORD  dmDisplayFrequency;
#if(WINVER >= 0x0400)
DWORD  dmICMMethod;
DWORD  dmICMIntent;
DWORD  dmMediaType;
DWORD  dmDitherType;
DWORD  dmReserved1;
DWORD  dmReserved2;
#if (WINVER >= 0x0500) || (_WIN32_WINNT >= 0x0400)
DWORD  dmPanningWidth;
DWORD  dmPanningHeight;
#endif
#endif /* WINVER >= 0x0400 */
} DEVMODE;

27. RE: Example DLL translation from VBA into Xbasic

Well, Marcel, I got it to work, but I can't explain why.
Here it goes, for my notebook, which supports 1024x768 or 800x600 mode with either 16 or 32 bits/pixel:
Code:
constant DISP_CHANGE_SUCCESSFUL	= 0
constant DISP_CHANGE_RESTART	= 1
constant DISP_CHANGE_FAILED	= (-1)
constant DISP_CHANGE_NOTUPDATED	= (-3)

declarestruct _charbuf C32charbuf

type DEVMODE
dmDeviceName as _charbuf
dmSpecVersion as Integer
dmDriverVersion as Integer
dmSize as Integer
dmDriverExtra as Integer
dmFields as Integer
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
dmBitsPerPel as Integer
dmPelsWidth as Integer
dmPelsHeight as Integer
dmDisplayFlags as Integer
dmDisplayFrequency as Integer
dmICMMethod as Integer
dmICMIntent as Integer
dmMediaTYpe as Integer
dmDitherTYpe as Integer
dmReserved1 as Integer
dmReserved2 as Integer
dmPanningWidth as Integer
dmPanningHeight as Integer
end type

declare USER32 EnumDisplaySettings@EnumDisplaySettingsA LLL(DEVMODE)

declare USER32 ChangeDisplaySettings@ChangeDisplaySettingsA L(DEVMODE)L

change_res(800, 600)
undeclare EnumDisplaySettings
undeclare ChangeDisplaySettings
end

function change_res(width as n, height as n)
CONSTANT DM_PELSWIDTH = hex_to_dec("80000")
constant DM_PELSHEIGHT = hex_to_dec("100000")
CONSTANT DM_BITSPERPEL = hex_to_dec("40000")

dim DevM as {DEVMODE}

'dim displaymodes[100] as c
'debug(1)
dim disp as n
disp=1
i=0
while disp > 0
disp= EnumDisplaySettings(0,i,DevM)
i=i+1
'displaymodes[i]=property_to_string(DevM)
end while
'	for j=23 to i
'		ui_msg_box(""+(j-1),displaymodes[j])
'	next
DevM.dmFields = DM_PELSWIDTH .or. DM_PELSHEIGHT .or. DM_BITSPERPEL
DevM.dmPelsWidth = width
DevM.dmPelsHeight = height
DevM.dmSize=8126592
DevM.dmbitsperpel=32
DevM.dmDisplayFrequency=60
b = ChangeDisplaySettings(DevM, 0)
ui_msg_box("b",""+b)
end function
As you can see I removed a number of elements from the C structure. Don't ask me why it works, because I don't know. Maybe at another time I can figure it out.

28. RE: Example DLL translation from VBA into Xbasic

Hi Peter,

Indeed, very strange but it works well on my Dell desktop. It need some backwards investigation as you said. The solution will be somewhere in the API text and is always a matter of reading...

Thanks, I learned a lot because your example brought the solution to mine. I used the properties function to examine the structure. It works now.

Regards,

Marcel

29. RE: Example DLL translation from VBA into Xbasic

Marcel,

I think the issue may be the sizes of variables in Xbasic and C. I think that the confusion arises because they each use the same words for different things. In that case, all I did was keep hacking away at the structure of DEVMODE until I got one where the width and height were in the right place.

Thanks for your help on this one.
Regards,
Peter

30. RE: Example DLL translation from VBA into Xbasic

Aha. The issue is that the Xbasic integer is 4 bytes long, while the VB integer is 2 bytes long. The structure I came up with was just the right size to compensate, even though the individual elements of the structure make no sense between the display name and near the end where bits/pixel and height and width are stored.

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•