PT Forum

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 18:35

I've found a way of accessing the windows file requester via DBPro. I don't know if it's of any use to anyone because there are a couple niggling problems with it, but it does work.

It could be handy for testing purposes.

The is one major requirement, you need MrTAToad's Handles.dll installed in the '\Compiler\plugins-user' folder. This can be found at his site http://www.nickk.nildram.co.uk/ under DBPro plugins.

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 18:37

First up is the include file. Save this as FileReq_Include.dba.

+ Code Snippet

Rem *** Include File: FileReq_Include.dba ***
Rem Created with Patch 3.1

remstart
  REQUIREMENTS:
  1) reqptr as REQUESTER_PTRDATA  and  InitFileReq()  should both be placed
     at the top of your program.
  2) Handles.dll in the `\Compiler\plugins-user` folder. This can be found at
     http://www.nickk.nildram.co.uk/  under DBPro plugins.

  LIMITATIONS:
  1) Cannot be used in Fullscreen Exclusive Mode. You won't see anything if
     you try because the requester will open behind these displays, if that
     happens then press the Escape key to cancel the requester.
  2) Moving the requester will upset the DBPro display underneath it until
     the next SYNC/FASTSYNC call. A bit annoying that.

  TIPS:
  1) If/When your program exists properly don't forget to call
     UnloadFileReq() to free up areas of memory.
remend

#CONSTANT MAXSTRINGSIZE 256

TYPE REQUESTER_PTRDATA
  DllNumber as integer
  ptrRequester as dword
  ptrFilter as dword
  ptrCustomFilter as dword
  ptrFile as dword
  ptrFileTitle as dword
  ptrInitialDir as dword
  ptrTitle as dword
  ptrDefExt as dword
  ptrTemplateName as dword
ENDTYPE

` ---------------------------------------------------------------------------
Function InitFileReq(DllNum)
  ` DllNum = an unused dll number for Comdlg32.dll (1 - 255)

  reqptr.DllNumber = DllNum
  load dll "Comdlg32.dll",reqptr.DllNumber

  if dll exist(reqptr.DllNumber)
    rem --- store memory pointers
    reqptr.ptrRequester = make memory(80)
    reqptr.ptrFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrCustomFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrFile = make memory(MAXSTRINGSIZE)
    reqptr.ptrFileTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrInitialDir = make memory(MAXSTRINGSIZE)
    reqptr.ptrTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrDefExt = make memory(MAXSTRINGSIZE)
    reqptr.ptrTemplateName = make memory(MAXSTRINGSIZE)

    rem --- set values in memory (ptrRequester)
    SetReqLongValue(0,76)
    SetReqLongValue(3,reqptr.ptrFilter)
    SetReqLongValue(4,reqptr.ptrCustomFilter)
    SetReqLongValue(5,255)
    SetReqLongValue(6,0)
    SetReqLongValue(7,reqptr.ptrFile)
    SetReqLongValue(8,255)
    SetReqLongValue(9,reqptr.ptrFileTitle)
    SetReqLongValue(10,255)
    SetReqLongValue(11,reqptr.ptrInitialDir)
    SetReqLongValue(12,reqptr.ptrTitle)
    SetReqLongValue(13,0)
  else
    set current bitmap 0 : cls rgb(0,0,0) : ink rgb(255,255,255),0
    print "Unable to load Comdlg32.dll"
    print "Press any key to exit."
    sync : wait key : end
  endif
endfunction

function UnloadFileReq()
  rem --- erase memory
  delete memory reqptr.ptrRequester
  delete memory reqptr.ptrFilter
  delete memory reqptr.ptrCustomFilter
  delete memory reqptr.ptrFile
  delete memory reqptr.ptrFileTitle
  delete memory reqptr.ptrInitialDir
  delete memory reqptr.ptrTitle
  delete memory reqptr.ptrDefExt
  delete memory reqptr.ptrTemplateName

  delete dll reqptr.DllNumber
endfunction
` ---------------------------------------------------------------------------
function StringToMemory(ptr,s$,zerochr$)
  fill memory ptr, 0, MAXSTRINGSIZE

  if len(s$) = 0 then exitfunction 0
  if zerochr$="" then zero = 0 else zero = asc(zerochr$)

  bt as byte
  index = 1

  repeat
    bt = asc(mid$(s$,index))
    if bt &lt;&gt; zero then *ptr = bt
    inc index,1 : inc ptr,1
  until index &gt; len(s$) or index = MAXSTRINGSIZE
endfunction 1
` ---------------------------------------------------------------------------
function ReadMemoryString(ptr)
  bt as byte
  s$ = "" : index = 1
  repeat
    bt = *ptr
    if bt &gt; 0 then s$ = s$ + chr$(bt)
    inc index,1 : inc ptr,1
  until bt = 0 or index = MAXSTRINGSIZE
endfunction s$
` ---------------------------------------------------------------------------
function SetReqLongValue(pos, v as dword)
  ptr as dword
  ptr = reqptr.ptrRequester + (pos * 4)
  *ptr = v
endfunction
` ---------------------------------------------------------------------------
function PrepareReq(title$,path$,filter$)
  StringToMemory(reqptr.ptrTitle, title$, "")
  if path$="" or StringToMemory(reqptr.ptrInitialDir, path$, "")= 0
    StringToMemory(reqptr.ptrInitialDir, "C:\", "")
  endif
  if filter$="" or StringToMemory(reqptr.ptrFilter, filter$, "|")= 0
    StringToMemory(reqptr.ptrFilter, "All Files (*.*)|*.*", "|")
  endif

`  StringToMemory(reqptr.ptrCustomFilter, "", "")
  StringToMemory(reqptr.ptrFile, space$(254), "")
  StringToMemory(reqptr.ptrFileTitle, space$(254), "")

`  SetReqLongValue(1, 0)
  SetReqLongValue(1, getHWND())
  SetReqLongValue(2, getHINSTANCE())
endfunction

function FileReqOpen(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllNumber, "GetOpenFileNameA", reqptr.ptrRequester)
endfunction r

function FileReqSave(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllNumber, "GetSaveFileNameA", reqptr.ptrRequester)
endfunction r
` ---------------------------------------------------------------------------
function ReqFileName()
  f$ = ReadMemoryString(reqptr.ptrFile)
endfunction f$

function ReqFileTitle()
  f$ = ReadMemoryString(reqptr.ptrFileTitle)
endfunction f$

function ReqFolderName()
  fn$ = ReqFileName() : ft$ = ReqFileTitle()
  f$ = left$(fn$,len(fn$) - len(ft$))
endfunction f$

Now a small demo. Run this in any Windowed display.
Remember! Add FileReq_Include.dba in the Included Source Files list.

+ Code Snippet

sync on : sync rate 60

rem --- Iniatialise requester
reqptr as REQUESTER_PTRDATA
InitFileReq(1)

r = FileReqOpen("DBPro Open File","C:\","Text Files (*.txt)|*.txt|All Files (*.*)|*.*|")

if r
  ink rgb(255,255,0),0   : print "Full Open File Name:"
  ink rgb(255,255,255),0 : print ReqFileName()
  print
  ink rgb(255,255,0),0   : print "Selected Folder Name:"
  ink rgb(255,255,255),0 : print ReqFolderName()
  print
  ink rgb(255,255,0),0   : print "File Title:"
  ink rgb(255,255,255),0 : print ReqFileTitle()
else
  ink rgb(255,128,0),0 : print "User canceled Open File"
endif

sync
print : print

r = FileReqSave("DBPro Save File","C:\","Text Files (*.txt)|*.txt|All Files (*.*)|*.*|")

if r
  ink rgb(0,255,255),0   : print "Full Save File Name:"
  ink rgb(255,255,255),0 : print ReqFileName()
  print
  ink rgb(0,255,255),0   : print "Selected Folder Name:"
  ink rgb(255,255,255),0 : print ReqFolderName()
  print
  ink rgb(0,255,255),0   : print "File Title:"
  ink rgb(255,255,255),0 : print ReqFileTitle()
else
  ink rgb(255,128,0),0 : print "User canceled Save File"
endif

sync : wait key

rem --- clean up requester and exit
UnloadFileReq()
end

The major problem with this is when you move or resize the requester, it screws up the DBPro display until you exit the requester and call the next SYNC/FASTSYNC. Unfortunatly I don't think it's possible to solve this. pity.

Unless, one of you boffins knows a way of locking the requester in the center of the display without resizing. That would be a good compromise.

IanM Joined: 11th Sep 2002
Location: In my moon base

Posted: 19th Jan 2003 19:28

Nice one. A few suggestions though.

1) My utility plugin has peeking and poking for strings that might simplify things a bit. MrTAToad's peek/poke plugin might also have them - I'm not sure, I haven't checked it.
2) You do not have to free the memory at the end if you don't want to - windows will automatically reclaim all memory that has been allocated.
3) You can leave the window handle as 0 if you don't have MrTAToad's plugin.
4) You are misunderstanding the hinstance value - leave it zero.

I might have a way to keep the display refreshed

DLL only I'm afraid, and I'll have to try it for certain.

*sigh* The list just gets longer and longer...

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 20:43

1) My utility plugin has peeking and poking for strings...
I believe MrTAToad's peek/poke does handle strings, but I wanted to minimise the use of external plugins just in case (for one reason or another) no one uses them or does not have access to them.

2) You do not have to free the memory at the end if you don't want to...
Are you absolutly sure about this? I thought it wise to do so, because I thought you were responsible for memory clean up if you use the Make Memory command (well, in this case anyway).

3) You can leave the window handle as 0...
Hmmm, the problem with that is the requester becomes detatched from the window, as a result you will be able to click in the DBPro window and the requester will disapear behind it. I'd like to keep it on top.

4) You are misunderstanding the hinstance value...
I thought I was forced to use a value here, OK zero it is.

What is HINSTANCE anyway?

Considering points 3 & 4, is there away of reading a windows handle by using any of the system dll's ? This way I can make this free of user plugins for the time being (no insult to MrTAToad intended), then I will be able make an update of the Include file.

IanM Joined: 11th Sep 2002
Location: In my moon base

Posted: 19th Jan 2003 21:16

You only need to free memory to make it available for further memory allocations, but as the intention is to create the structure once, continually reallocating memory will just complicate things. All memory allocated in the standard way will be reclaimed automatically by windows when the process ends.

The use of HINSTANCE varies. Follow this link for the specifics of this usage : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/WinUI/WindowsUserInterface/UserInput/CommonDialogBoxLibrary/CommonDialogBoxReference/CommonDialogBoxStructures/OPENFILENAME.asp

There is a way to get the window handle through an API call ... but I forget for now what it is. I'll have a look around.

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 21:19

Ye Gods! What a big link!

IanM Joined: 11th Sep 2002
Location: In my moon base

Posted: 19th Jan 2003 22:13

All part of the MS plan to take over the world - crash all those browsers out there by making them run out of memory

Try this:

+ Code Snippet

hwnd as DWORD
load dll "user32.dll",1
hwnd=call dll(1, "GetActiveWindow")
print hwnd
delete dll 1

Or substitute 'GetForegroundWindow' instead. These both work because DBPro only has one window that can be active or forground. I know that there is a better way to get the primary window, but this should work for now.

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 23:22

Thankyou, That works fine.

So here is the updated Include file.

+ Code Snippet

Rem *** Include File: FileReq_Include.dba ***
Rem Created: 17/01/01 14:42:40  with Patch 3.1

remstart
  REQUIREMENTS:
  1) reqptr as REQUESTER_PTRDATA  and  InitFileReq()  should both be placed
     at the top of your program. InitFileReq() only needs to be called once.

  LIMITATIONS:
  1) Cannot be used in Fullscreen Exclusive Mode. You won't see anything if
     you try because the requester will open behind these displays, if that
     happens then press the Escape key to cancel the requester.
  2) Moving the requester will upset the DBPro display underneath it until
     the next SYNC/FASTSYNC call. A bit annoying that.
remend

#CONSTANT MAXSTRINGSIZE 256

TYPE REQUESTER_PTRDATA
  ReqInit as integer
  DllUser32 as integer
  DllComdlg32 as integer
  ptrRequester as dword
  ptrFilter as dword
  ptrCustomFilter as dword
  ptrFile as dword
  ptrFileTitle as dword
  ptrInitialDir as dword
  ptrTitle as dword
  ptrDefExt as dword
  ptrTemplateName as dword
ENDTYPE

` ---------------------------------------------------------------------------
function ReqError(e$)
  set current bitmap 0 : cls rgb(0,0,0) : ink rgb(255,255,255),0
  print "File Requester Error!"
  print e$ : print
  print "Press any key to exit."
  sync : wait key : end
endfunction

function GetFreeDll()
  rem --- finds a free dll slot
  dllnum = 256
  repeat : dec dllnum,1 : until dll exist(dllnum) = 0 or dllnum = 0
endfunction dllnum

Function InitFileReq()
  rem --- check if we have not initailised already
  if reqptr.ReqInit = 0
    reqptr.DllUser32 = GetFreeDll()
    if reqptr.DllUser32 = 0 then ReqError("Unable to find free Dll slot for User32.dll")
    load dll "User32.dll",reqptr.DllUser32

    reqptr.DllComdlg32 = GetFreeDll()
    if reqptr.DllComdlg32 = 0 then ReqError("Unable to find free Dll slot for Comdlg32.dll")
    load dll "Comdlg32.dll",reqptr.DllComdlg32

    if dll exist(reqptr.DllUser32) = 0 then ReqError("Unable to load User32.dll")
    if dll exist(reqptr.DllComdlg32) = 0 then ReqError("Unable to load Comdlg32.dll")

    rem --- store memory pointers
    reqptr.ptrRequester = make memory(80)
    reqptr.ptrFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrCustomFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrFile = make memory(MAXSTRINGSIZE)
    reqptr.ptrFileTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrInitialDir = make memory(MAXSTRINGSIZE)
    reqptr.ptrTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrDefExt = make memory(MAXSTRINGSIZE)
    reqptr.ptrTemplateName = make memory(MAXSTRINGSIZE)

    rem --- set values in memory (ptrRequester)
    SetReqLongValue(0,76)
    SetReqLongValue(2, 0)
    SetReqLongValue(3,reqptr.ptrFilter)
    SetReqLongValue(4,reqptr.ptrCustomFilter)
    SetReqLongValue(5,255)
    SetReqLongValue(6,0)
    SetReqLongValue(7,reqptr.ptrFile)
    SetReqLongValue(8,255)
    SetReqLongValue(9,reqptr.ptrFileTitle)
    SetReqLongValue(10,255)
    SetReqLongValue(11,reqptr.ptrInitialDir)
    SetReqLongValue(12,reqptr.ptrTitle)
    SetReqLongValue(13,0)

    reqptr.ReqInit = 1
  endif
endfunction

function UnloadFileReq()
  rem --- erase memory
  delete memory reqptr.ptrRequester
  delete memory reqptr.ptrFilter
  delete memory reqptr.ptrCustomFilter
  delete memory reqptr.ptrFile
  delete memory reqptr.ptrFileTitle
  delete memory reqptr.ptrInitialDir
  delete memory reqptr.ptrTitle
  delete memory reqptr.ptrDefExt
  delete memory reqptr.ptrTemplateName

  delete dll reqptr.DllUser32
  delete dll reqptr.DllComdlg32
  reqptr.ReqInit = 0
endfunction
` ---------------------------------------------------------------------------
function StringToMemory(ptr,s$,zerochr$)
  fill memory ptr, 0, MAXSTRINGSIZE

  if len(s$) = 0 then exitfunction 0
  if zerochr$="" then zero = 0 else zero = asc(zerochr$)

  bt as byte
  index = 1

  repeat
    bt = asc(mid$(s$,index))
    if bt &lt;&gt; zero then *ptr = bt
    inc index,1 : inc ptr,1
  until index &gt; len(s$) or index = MAXSTRINGSIZE
endfunction 1
` ---------------------------------------------------------------------------
function ReadMemoryString(ptr)
  bt as byte
  s$ = "" : index = 1
  repeat
    bt = *ptr
    if bt &gt; 0 then s$ = s$ + chr$(bt)
    inc index,1 : inc ptr,1
  until bt = 0 or index = MAXSTRINGSIZE
endfunction s$
` ---------------------------------------------------------------------------
function SetReqLongValue(pos, v as dword)
  ptr as dword
  ptr = reqptr.ptrRequester + (pos * 4)
  *ptr = v
endfunction
` ---------------------------------------------------------------------------
function PrepareReq(title$,path$,filter$)
  StringToMemory(reqptr.ptrTitle, title$, "")
  if path$="" or StringToMemory(reqptr.ptrInitialDir, path$, "")= 0
    StringToMemory(reqptr.ptrInitialDir, "C:\", "")
  endif
  if filter$="" or StringToMemory(reqptr.ptrFilter, filter$, "|")= 0
    StringToMemory(reqptr.ptrFilter, "All Files (*.*)|*.*", "|")
  endif

`  StringToMemory(reqptr.ptrCustomFilter, "", "")
  StringToMemory(reqptr.ptrFile, space$(254), "")
  StringToMemory(reqptr.ptrFileTitle, space$(254), "")

  hwnd as dword
  hwnd = call dll(reqptr.DllUser32, "GetActiveWindow")
  SetReqLongValue(1, hwnd)
endfunction

function FileReqOpen(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllComdlg32, "GetOpenFileNameA", reqptr.ptrRequester)
endfunction r

function FileReqSave(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllComdlg32, "GetSaveFileNameA", reqptr.ptrRequester)
endfunction r
` ---------------------------------------------------------------------------
function ReqFileName()
  f$ = ReadMemoryString(reqptr.ptrFile)
endfunction f$

function ReqFileTitle()
  f$ = ReadMemoryString(reqptr.ptrFileTitle)
endfunction f$

function ReqFolderName()
  fn$ = ReqFileName() : ft$ = ReqFileTitle()
  f$ = left$(fn$,len(fn$) - len(ft$))
endfunction f$

Changes:
InitFileReq() no longer needs a dll value as this function will now scan for any free dll slots.

If IanM is correct (I sure he is, he's smarter than me) you're no longer forced to use UloadFileReq() at the end of your program, I leave it there in case you want it.

ToDo:
Well, if I can solve that display problem....hmmmm.

Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)

Posted: 19th Jan 2003 23:24

...Oh! And no user plugins required for this one either.

<1 >

Sign In