Oxygen Basic
Programming => Problems & Solutions => Topic started by: Aurel on April 11, 2012, 07:02:35 AM
-
I have made a search how to implement properly standard FileDialog frame in Oxygen .
And i found only this from one VB site.
'***************** Code Start **************
' This code was originally written by Ken Getz.
' It is not to be altered or distributed, 'except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code originally courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996
' Revised to support multiple files:
' 28 December 2007
Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000
Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
"*.MDA;*.MDB")
strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
' Uncomment this line to try the example
' allowing multiple file names:
' lngFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER
Dim result As Variant
result = ahtCommonFileOpenSave(InitialDir:="C:\", _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!")
If lngFlags And ahtOFN_ALLOWMULTISELECT Then
If IsArray(result) Then
Dim i As Integer
For i = 0 To UBound(result)
MsgBox result(i)
Next i
Else
MsgBox result
End If
Else
MsgBox result
End If
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
Debug.Print Hex(lngFlags)
End Function
Function GetOpenFile(Optional varDirectory As Variant, _
Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If
' Define the filter string and allocate space in the "c"
' string Duplicate this line with changes as necessary for
' more file templates.
strFilter = ahtAddFilterItem(strFilter, _
"Access (*.mdb)", "*.MDB;*.MDA")
' Now actually call to get the file name.
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function
Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
' Didn't think most people would want to deal with
' these options.
.hInstance = 0
'.strCustomFilter = ""
'.nMaxCustFilter = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If
' The function call filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
If Flags And ahtOFN_ALLOWMULTISELECT Then
' Return the full array.
Dim items As Variant
Dim value As String
value = OFN.strFile
' Get rid of empty items:
Dim i As Integer
For i = Len(value) To 1 Step -1
If Mid$(value, i, 1) <> Chr$(0) Then
Exit For
End If
Next i
value = Mid(value, 1, i)
' Break the list up at null characters:
items = Split(value, Chr(0))
' Loop through the items in the "array",
' and build full file names:
Dim numItems As Integer
Dim result() As String
numItems = UBound(items) + 1
If numItems > 1 Then
ReDim result(0 To numItems - 2)
For i = 1 To numItems - 1
result(i - 1) = FixPath(items(0)) & items(i)
Next i
ahtCommonFileOpenSave = result
Else
' If you only select a single item,
' Windows just places it in item 0.
ahtCommonFileOpenSave = items(0)
End If
Else
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
End If
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function
Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.
If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
Private Function FixPath(ByVal path As String) As String
If Right$(path, 1) <> "\" Then
FixPath = path & "\"
Else
FixPath = path
End If
End Function
'************** Code End *****************
Im not sure how to replace type Variant ?
Do i can use Any ?
Like you see code is quite complex for ordinary file dialog ::)
Is there a maybe simplier solution?
-
My god! what for an ancient shit.
Aurel, you must not take ANY, you must drop it in the trashcan.
-
Yeah ,this will be really cool :P
:D :D :D
-
I think most of those variants can be translated to long. or zstring* if they are used as strings.
The c header commdlg.h looks dreadful but I will see if Oxygen is able to swallow it whole.
MSDN:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms646829(v=vs.85).aspx#open_file
Charles
-
Hi Charles...
Yes it looks little bit like nightmare... ::)
But hey, i found this version which i will try to translate.
it looks little bit nice then first:
Show the 'File Open' Common Dialog via API calls
To display a file open common dialog use the following routine (an example routine
can be found at the bottom of this post):
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long
Private Type OpenFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'Purpose : Allows the user to select a file name from a local or network directory.
'Inputs : sInitDir The initial directory of the file dialog.
' sFileFilters A file filter string, with the following format:
' eg. "Excel Files;*.xls|Text Files;*.txt|Word Files;*.doc"
' [sTitle] The dialog title
' [lParentHwnd] The handle to the parent dialog that is calling this function.
'Outputs : Returns the selected path and file name or a zero length string if the user pressed cancel
Function BrowseForFile(sInitDir As String, Optional ByVal sFileFilters As String, Optional sTitle As String = "Open File", Optional lParentHwnd As Long) As String
Dim tFileBrowse As OpenFileName
Const clMaxLen As Long = 254
tFileBrowse.lStructSize = Len(tFileBrowse)
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", vbNullChar)
sFileFilters = Replace(sFileFilters, ";", vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
'Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If
'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle
'No flags
tFileBrowse.flags = 0
'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
'Remove trailing null
BrowseForFile = Left$(BrowseForFile, Len(BrowseForFile) - 1)
End If
End If
End Function
Sub Test()
BrowseForFile "c:\", "Excel File (*.xls);*.xls", "Open Workbook"
End Sub
As you see much clear, only im not sure what might be vbNullChar ?
-
Hi Aurel,
vbNullChar = Chr(0)
vbNullString= character string with value 0
I am your helper. :D
-
Hi Aurel,
vbNullChar = Chr(0)
vbNullString= character string with value 0
I am your helper. Cheesy
Hey Peter :)
Vielen Dank Herr Wirlauber :D
-
dein Deutsch ist fantastisch
Du warst Gastarbeiter in Deutschland.
your German is fantastic
You were guest workers in Germany.
-
Du warst Gastarbeiter in Deutschland.
Nein.
Ich studierte in der Schule Deutsch.
this translation is with a little help of GoogleTransalte but truth is that i am
really lern German in school. ;)
-
After reading your post, I got this face.
-
Hi,
Question.
-
Haa... :D
Cool question, no
I was to busy with work today ,i hope will be soon. :-\
-
Huston,we have a problem.... ???
I don't know how to properly replace in oxygen syntax:
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", chr(0))
Is this string function exists in oxygen basic ?
-
Hi Aurel, here is a simple replace function
'---------------------------------------
function replace(string t,w,r) as string
'=======================================
'
sys a,b,lw,lr
string s=t
'
lw=len(w)
lr=len(r)
a=1
'
do
a=instr(a,s,w)
if a=0 then exit do
s=left(s,a-1)+r+mid(s,a+lw)
a+=lr
end do
return s
end function
Charles
-
Thanks Charles.. ;)
It works fine, but now i have a problem with Right(str,len) function inside
this:
If right(sFileFilters, 1) <> chr(0)
'Add final delimiter
sFileFilters = sFileFilters & chr(0)
End If
Why Right or Right$ not work?
Or this string function is not built in ???
Charles ,this is complete function which i must implement:
Function BrowseForFile(sInitDir As String, ByVal sFileFilters As String, sTitle As String , lParentHwnd As Long) As String
Dim tFileBrowse As OpenFileName
dim clMaxLen As Long = 254
tFileBrowse.lStructSize = Len(tFileBrowse)
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", chr(0))
sFileFilters = Replace(sFileFilters, ";", chr(0))
If right$(sFileFilters, 1) <> chr(0)
'Add final delimiter
sFileFilters = sFileFilters & chr(0)
End If
'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & "All Files (*.*)" & chr(0) & "*.*" & chr(0)
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle
'No flags
tFileBrowse.flags = 0
'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = chr(0) Then
'Remove trailing null
BrowseForFile = Left(BrowseForFile, Len(BrowseForFile) - 1)
End If
End If
End Function
As you can see there are few other string functions to...
-
Use mid() with a negative index instead:
print mid ("1234567890",-2) 'result: 90
Charles
-
Ok Charles ...this way work even looks weird to me :-\
Oh i must say that i hate when i must write all this function but this is exercise right? :)
Another thing is Triming function.
I found from baCon james functions but it looks that not work in Oxygen as espected.
FUNCTION LTrim(Main$ As string,Match$ As string) As String
INT mlen,mtlen,i,j
i = 0
j = 0
mlen = LEN(Main$)
mtlen = LEN(Match$)
IF (mlen = 0) or (mtlen = 0)
RETURN Main$
END IF
FOR i = 1 TO mlen
IF INSTR(Match$,Mid (Main$,i,1),1) = 0
RETURN Mid(Main$,-(mlen-j))
ELSE
j = j + 1
END IF
NEXT
RETURN Main$
END FUNCTION
string s,r
r=""
s = " James Fuller"
r = LTrim(s," ")
print "res:" + r
So for Trim$ i need both Ltrim & Rtrim functions ,but there is still same problem with Right ::)
Charles , don't get me wrong but i think that would be good to built in into Oxygen all this string functions.
-
There is ltrim and rtrim
print ">" ltrim (" abc ") "<"
print ">" rtrim (" abc ") "<"
The core string functions are:
news / frees
nuls
space
error
(compile) oxygen-dependent
ltrim
rtrim
lcase
ucase
string
print
asc / unic
len
chr / wchr
str
hex
guidval
guidtxt
val
mid (function)
mid (command)
left
instr
getfile
putfile
Charles
-
Oh my ,i don't know that ,sorry...
I even write my own LTRIM ::)
REM' remove all left blank spaces
FUNCTION LTrim(Main$ As string) As String
String blank$= " "
INT mlen,mtlen,i,j
i = 0
j = 0
mlen = LEN(Main$)
mtlen = LEN(blank$)
IF (mlen = 0) or (mtlen = 0)
RETURN Main$
END IF
FOR i = 1 TO mlen
IF j=0
IF Mid(Main$,i,1) <> blank$
j = i
END IF
END IF
NEXT
RETURN Mid(Main$,j,mlen)
END FUNCTION
string s,r
r=""
s = " James"
r = LTrim(s)
print "res:" + r :D
ok.. ;)
-
What to say...
This file dialog looks like nightmare .
I espect some problems but i will try one more option.
Then i will see what to do.
-
I simply don't get it what i do wrong ???
I try way from Freebasic ,and some C examples and no one of options not work.
Here is structure in include file:
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Int
nFileExtension As Int
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
then here is declared function by api which is same as in VB or C example:
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
And here is Function FileDialog which return nothing in my case: :-\
'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )
Function FileDialog(iDir As String, filter As String, Title As String, pHwnd As Long,Flags As Long) As String
Dim ofn As OPENFILENAME
String NULL = chr(0)
Dim filename As zstring * 255
INT retval
' Allow only existing files and hide the read-only check box
'IF tFlag = 0
'print "TFLAG:"+ str(tFlag)
'filebox.flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
'END IF
'IF tFlag = 1
'filebox.flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
'END IF
ofn.lStructSize = sizeof(OPENFILENAME)
ofn.hwndOwner = phWnd
ofn.hInstance = GetModuleHandle( 0 )
ofn.lpstrFilter = filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 1
ofn.lpstrFile = filename
ofn.nMaxFile = LEN( filename )
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = NULL
ofn.lpstrTitle = title
ofn.Flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = NULL
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
' Execute the dialog box
retval = GetOpenFileName(ofn)
'IF retval <> 0 ' if the dialog box completed successfully
' Remove null space from the file name
'fname = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, chr(0)) - 1)
'Print "The selected file: " + filename
'RETURN filename
'ELSE
'RETURN print "FileBox Not Open!"
'END IF
RETURN filename
End Function
Is anyone have a idea what might be wrong?
-
Hi Aurel,
This is not perfect, but it works.
#define OFN_READONLY 0x00000001
#define OFN_OVERWRITEPROMPT 0x00000002
#define OFN_HIDEREADONLY 0x00000004
#define OFN_NOCHANGEDIR 0x00000008
#define OFN_SHOWHELP 0x00000010
#define OFN_ENABLEHOOK 0x00000020
#define OFN_ENABLETEMPLATE 0x00000040
#define OFN_ENABLETEMPLATEHANDLE 0x00000080
#define OFN_NOVALIDATE 0x00000100
#define OFN_ALLOWMULTISELECT 0x00000200
#define OFN_EXTENSIONDIFFERENT 0x00000400
#define OFN_PATHMUSTEXIST 0x00000800
#define OFN_FILEMUSTEXIST 0x00001000
#define OFN_CREATEPROMPT 0x00002000
#define OFN_SHAREAWARE 0x00004000
#define OFN_NOREADONLYRETURN 0x00008000
#define OFN_NOTESTFILECREATE 0x00010000
#define OFN_NONETWORKBUTTON 0x00020000
#define OFN_NOLONGNAMES 0x00040000 // force no long names for 4.x modules
#define OFN_EXPLORER 0x00080000 // new look commdlg
#define OFN_NODEREFERENCELINKS 0x00100000
#define OFN_LONGNAMES 0x00200000 // force long names for 3.x modules
#define OFN_ENABLEINCLUDENOTIFY 0x00400000 // send include message to callback
#define OFN_ENABLESIZING 0x00800000
#define OFN_DONTADDTORECENT 0x02000000
#define OFN_FORCESHOWHIDDEN 0x10000000 // Show All files including System and hidden files
/*
typedef struct tagOFNA {
DWORD lStructSize;
HWND hwndOwner;
HINSTANCE hInstance;
LPCSTR lpstrFilter;
LPSTR lpstrCustomFilter;
DWORD nMaxCustFilter;
DWORD nFilterIndex;
LPSTR lpstrFile;
DWORD nMaxFile;
LPSTR lpstrFileTitle;
DWORD nMaxFileTitle;
LPCSTR lpstrInitialDir;
LPCSTR lpstrTitle;
DWORD Flags;
WORD nFileOffset;
WORD nFileExtension;
LPCSTR lpstrDefExt;
LPARAM lCustData;
LPOFNHOOKPROC lpfnHook;
LPCSTR lpTemplateName;
} OPENFILENAMEA, *LPOPENFILENAMEA;
*/
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter as sys 'string
lpstrCustomFilter As sys 'string
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As sys 'string
nMaxFile As Long
lpstrFileTitle As sys 'string
nMaxFileTitle As Long
lpstrInitialDir As sys 'string
lpstrTitle As sys 'string
flags As Long
nFileOffset As word
nFileExtension As word
lpstrDefExt As sys 'string
lCustData As Long
lpfnHook As sys
lpTemplateName As sys 'string
End Type
'76 bytes
def NULL 0
Declare GetModuleHandle lib "kernel32.dll" alias "GetModuleHandleA" (sys n) as sys
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As sys
Declare CommDlgExtendedError Lib "comdlg32.dll" () as dword
'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )
Function FileDialog(string iDir, filter, Title, sys Hwnd, Flags) As String
'==================
Dim ofn As OPENFILENAME
Dim filename[255] As zstring
int retval
' Allow only existing files and hide the read-only check box
'IF tFlag = 0
'print "TFLAG:"+ str(tFlag)
'filebox.flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
'END IF
'IF tFlag = 1
'filebox.flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
'END IF
ofn.lStructSize = sizeof(OPENFILENAME)
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = ?filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = @filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ?idir
ofn.lpstrTitle = ?title
ofn.Flags = OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = NULL
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
'
retval = GetOpenFileName(ofn)
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms646916(v=vs.85).aspx
'if retval=0 then print "Dialog Error " CommDlgExtendedError
return filename
'
End Function
'dir="C:\cevp\projects\opcode\OxygenBasic\examples\GUI"
dir=""
sep=chr(0)
'filter=""
filter="text"+sep+"*.txt"+sep+
"basic"+sep+"*.bas;*.o2bas"+sep+
"include"+sep+"*.inc"+sep+
"header"+sep+"*.h"+sep+
sep
title="Test File Opening Dialog"
hwnd=0
print FileDialog(dir,filter,title,hwnd,OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY)
Charles
-
Thank you Charles... ;)
So that's why don't work, insted of string must be pointer sys.
In Dlib for example is used adress of string like :
OPENFILENAME\lStructSize = 76
OPENFILENAME\hwndOwner = _hwnd
OPENFILENAME\lpstrFilter = _filefilter
OPENFILENAME\lpstrFile = @_result
OPENFILENAME\nMaxFile = #MAX_PATH
OPENFILENAME\lpstrTitle = @_title
OPENFILENAME\lpstrInitialDir = @_directory
OPENFILENAME\Flags = _flags
OPENFILENAME\lpstrDefExt = @_defext
And structsize is 76 bytes.
Another thing is which i don't know what to use is :
Dim filename[255] As zstring - array of characters.... ::)
Again thanks ,without your help i will be still in dark... :-[
-
Yes, the string pointer issue was one of the main problems, and I think Oxygen should allow a zstring pointer member to accept a string directly, so I will try to resolve this today.
zstring is the equivalent of C char, so the dimension in square brackets is the number of bytes reserved for it.
2 members of the structure were word, not int, so the length has come down from 80 to 76 bytes.
Anyway, the other dialogs should be a lot easier to get working now.
Charles
-
Ok.
After few hours (in a free time) and some troubles with figuring what is what .
Hmm ,i don't espect such a complications with this 'file dialogs' stuff.
Here is what i have done that work as is ( im not still quite hapy how work ).
But i think that work for you too.
'#Include "awinh.inc"
'#include "../../inc/awinh.inc"
Include "awinh.inc"
#lookahead ' for procedures
% LR_LOADTRANSPARENT = &H20
% LR_LOADMAP3DCOLORS = &H1000
INT TransparentMap3D = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
INT win
INT winstyle
INT button1,button2,button3
INT edit1,edit2,edit3
INT Lbox,static1,static2,static3,richedit1
INT ed1ID,ed2ID,ed3ID
INT b1ID,b2ID,b3ID,b4ID,b5ID,b6ID,b7ID
INT LboxID = 300
INT st1ID,st2ID
INT reID
b1ID=100
b2ID=101
b3ID=102
'-----------------
ed1ID=200
ed2ID=201
ed3ID=202
'----------------
st1ID=350
st2ID=351
st3ID=352
'----------------
reID=400
'loadbmp
'##########################################
INT bmpB1,bmpS1
bmpB1 = LoadImage(0,"data/xpBopen.bmp",0,76,20,16)
bmpS1 = LoadImage(0,"data/xpStatic.bmp",0,82,82,16)
'##########################################
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
'create window **************************************************
win = SetWindow("Test AwinH",100,100,640,480,winstyle)
'****************************************************************
'create buttons ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
button1 = SetButton(win,280,20,100,24,"OpenFileDialog",0x50000000,0x200,b1ID)
'set bitmap on button 1
SendMessage button1 , BM_SETIMAGE, 0, bmpB1
button2 = SetButton(win,390,20,80,24,"Run Counter",0x50000000,0x200,b2ID)
button3 = SetButton(win,490,20,80,24,"Load Text",0x50000000,0x200,b3ID)
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'create edit control
edit1 = SetEditBox(win,100,80,380,23,"edit 1",0x50004000,0x200,ed1ID)
'create listbox
Lbox = SetListBox(win,100,140,180,150,"LB 1",0x50000140,0x200,LboxID)
'create static control
static1 = SetStatic(win,10,20,254,16," This is a STATIC text control with EX_CLIENTEDGE",0,0x200,st1ID)
static2 = SetStatic(win,10,40,254,13," This is a STATIC text control without ex_ClientEdge ",0,0,st1ID)
'crete static control with bitmap
static3 = SetStatic(win,10,60,82,82,"",0x5000030E,0,st3ID)
SendMessage static3 ,370, 0, bmpS1
'create Rich Edit control
INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4
richedit1 = SetRichEdit(win,300,120,300,200,"Text in Richedit...",reStyle ,0x200,reID)
'---------------------------------------------------------------------
GoSub AddListboxItems
'WHILE GetMessage (&wm,0,0,0)<>0
'TranslateMessage &wm
'DispatchMessage &wm
'WEND
sys bRet
'
Do While bRet := GetMessage (&wm, 0, 0, 0)
If bRet = -1 then
'show an error message
Else
TranslateMessage &wm
DispatchMessage &wm
End If
Wend
Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
SELECT wMsg
'----------------------------
CASE WM_DESTROY
PostQuitMessage 0
'-------------------------------------------------------------
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message
Select controlID
CASE b1ID
If notifycode=0
'Beep(1660,50)
'Print "Button 1 Clicked!"
Gosub Test
End If
CASE b2ID
If notifycode=0
UpdateWindow(win)
SetControlText()
End If
CASE b3ID
If notifycode=0
LoadFromFile()
End If
End Select
'-----------------------------------------------------
END SELECT
FUNCTION = DefWindowProc hwnd,wMsg,wParam,lParam
END FUNCTION
'########################################################
SUB AddListboxItems
bstring i$ : i$=""
For n = 0 To 100
i$=Str(n) + "..listbox item"
SendMessage Lbox,LB_ADDSTRING,0,i$
Next n
END SUB
'#########################################################
SUB SetControlText
bstring n$
n$=""
'loop
For i = 0 To 10000
n$ = Str(i)
SendMessage edit1,WM_SETTEXT,0,n$
UpdateWindow(edit1)
Next
END SUB
'#########################################################
SUB LoadFromFile
string fName = "richtext.txt"
bstring source = getfile fName
SendMessage richedit1,WM_SETTEXT,0,source
if not source
print fName " file not found"
end if
END SUB
'************************************************************
Sub Test
bstring fR
dir=""
bstring sep=chr 0
filter="Text files"+sep+"*.txt"+ sep+"All Files"+sep+"*.*"+sep
'filter="text"+sep+"*.txt"+sep+
'"basic"+sep+"*.bas;*.o2bas"+sep+
'"include"+sep+"*.inc"+sep+
'"header"+sep+"*.h"+sep+
'sep
title="Test File Opening Dialog"
hwnd=0
fR = FileDialog(dir,*filter,*title,0,0,"txt")
SendMessage edit1,WM_SETTEXT,0,fR
End Sub
awinh.inc is in attachment....
-
Just a small addition to Sub Test.
Use returned file path from function FileDialog()
and load selected file into richedit control.
Seems that work fine.... ;)
Sub Test
bstring fR
dir=""
bstring sep=chr 0
filter="Text files"+sep+"*.txt"+ sep+"All Files"+sep+"*.*"+sep
'filter="text"+sep+"*.txt"+sep+
'"basic"+sep+"*.bas;*.o2bas"+sep+
'"include"+sep+"*.inc"+sep+
'"header"+sep+"*.h"+sep+
'sep
title="Test File Opening Dialog"
hwnd=0
fR = FileDialog(dir,*filter,*title,0,0,"txt")
'show file path in edit control
SendMessage edit1,WM_SETTEXT,0,fR
'load file into richedit control -------------
bstring tx = getfile fR
SendMessage richedit1,WM_SETTEXT,0,tx
'---------------------------------------------
End Sub
-
Next step...
I have tested api GetLineCount message.
Use this constants:
'edit messages
% EM_GETLINECOUNT = 0xBA
% EM_LINEINDEX = 0xBB
% EM_LINELENGTH = 0xC1
% EM_GETLINE = 0xC4
Add new button on window:
first add new global vars:
INT button4,b4ID
b4ID=103
button4 = SetButton(win,500,80,84,24,"Get Line Count",0x50000000,0x200,b4ID)
Then add new subroutine:
SUB GetLineCount
INT LCount = 0
LCount = SendMessage richedit1,EM_GETLINECOUNT,0,0
bstring count$ = ""
count$ = Str(LCount)
SendMessage edit1,WM_SETTEXT,0,count$
END SUB
If you do everything ok...load any text into richedit control.
Then click new button named 'Get Line Count'.
You will see number of visible lines in richedit control written as number in EDIT control.
Aurel
-
Uf after lookin' into many examples for GETLINE api finally i get
how GetLine work.
Here is complete code with GetLine() subroutine.
'#Include "awinh.inc"
'#include "../../inc/awinh.inc"
Include "awinh.inc"
#lookahead ' for procedures
% LR_LOADTRANSPARENT = &H20
% LR_LOADMAP3DCOLORS = &H1000
INT TransparentMap3D = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
INT win
INT winstyle
INT button1,button2,button3,button4,button5
INT edit1,edit2,edit3
INT Lbox,static1,static2,static3,richedit1
INT ed1ID,ed2ID,ed3ID
INT b1ID,b2ID,b3ID,b4ID,b5ID,b6ID,b7ID
INT LboxID = 300
INT st1ID,st2ID
INT reID
b1ID=100
b2ID=101
b3ID=102
b4ID=103
b5ID=104
'-----------------
ed1ID=200
ed2ID=201
ed3ID=202
'----------------
st1ID=350
st2ID=351
st3ID=352
'----------------
reID=400
'loadbmp
'##########################################
INT bmpB1,bmpS1
bmpB1 = LoadImage(0,"data/xpBopen.bmp",0,76,20,16)
bmpS1 = LoadImage(0,"data/xpStatic.bmp",0,82,82,16)
'##########################################
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
'create window **************************************************
win = SetWindow("Test AwinH",100,100,640,480,winstyle)
'****************************************************************
'create buttons ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
button1 = SetButton(win,280,20,100,24,"OpenFileDialog",0x50000000,0x200,b1ID)
'set bitmap on button 1
SendMessage button1 , BM_SETIMAGE, 0, bmpB1
button2 = SetButton(win,390,20,80,24,"Run Counter",0x50000000,0x200,b2ID)
button3 = SetButton(win,490,20,80,24,"Load Text",0x50000000,0x200,b3ID)
button4 = SetButton(win,490,50,84,24,"Get Line Count",0x50000000,0x200,b4ID)
button5 = SetButton(win,490,80,84,24,"Get Line 2",0x50000000,0x200,b5ID)
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'create edit control
edit1 = SetEditBox(win,100,80,380,23,"edit 1",0x50004000,0x200,ed1ID)
'create listbox
Lbox = SetListBox(win,100,140,180,150,"LB 1",0x50000140,0x200,LboxID)
'create static control
static1 = SetStatic(win,10,20,254,16," This is a STATIC text control with EX_CLIENTEDGE",0,0x200,st1ID)
static2 = SetStatic(win,10,40,254,13," This is a STATIC text control without ex_ClientEdge ",0,0,st1ID)
'crete static control with bitmap
static3 = SetStatic(win,10,60,82,82,"",0x5000030E,0,st3ID)
SendMessage static3 ,370, 0, bmpS1
'create Rich Edit control
INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4
richedit1 = SetRichEdit(win,300,120,300,200,"Text in Richedit...",reStyle ,0x200,reID)
'---------------------------------------------------------------------
GoSub AddListboxItems
'WHILE GetMessage (&wm,0,0,0)<>0
'TranslateMessage &wm
'DispatchMessage &wm
'WEND
sys bRet
'
Do While bRet := GetMessage (&wm, 0, 0, 0)
If bRet = -1 then
'show an error message
Else
TranslateMessage &wm
DispatchMessage &wm
End If
Wend
Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
SELECT wMsg
'----------------------------
CASE WM_DESTROY
PostQuitMessage 0
'-------------------------------------------------------------
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message
Select controlID
CASE b1ID
If notifycode=0
'Beep(1660,50)
'Print "Button 1 Clicked!"
Gosub Test
End If
CASE b2ID
If notifycode=0
UpdateWindow(win)
SetControlText()
End If
CASE b3ID
If notifycode=0
LoadFromFile()
End If
CASE b4ID
If notifycode=0
GetLineCount()
End If
CASE b5ID
If notifycode=0
GetLine()
End If
End Select
'-----------------------------------------------------
END SELECT
FUNCTION = DefWindowProc hwnd,wMsg,wParam,lParam
END FUNCTION
'########################################################
SUB AddListboxItems
bstring i$ : i$=""
For n = 0 To 100
i$=Str(n) + "..listbox item"
SendMessage Lbox,LB_ADDSTRING,0,i$
Next n
END SUB
'#########################################################
SUB SetControlText
bstring n$
n$=""
'loop
For i = 0 To 10000
n$ = Str(i)
SendMessage edit1,WM_SETTEXT,0,n$
UpdateWindow(edit1)
Next
END SUB
'#########################################################
SUB LoadFromFile
string fName = "richtext.txt"
bstring source = getfile fName
SendMessage richedit1,WM_SETTEXT,0,source
if not source
print fName " file not found"
end if
END SUB
'************************************************************
Sub Test
bstring fR
dir=""
bstring sep=chr 0
filter="Text files"+sep+"*.txt"+ sep+"All Files"+sep+"*.*"+sep
'filter="text"+sep+"*.txt"+sep+
'"basic"+sep+"*.bas;*.o2bas"+sep+
'"include"+sep+"*.inc"+sep+
'"header"+sep+"*.h"+sep+
'sep
title="Test File Opening Dialog"
hwnd=0
fR = FileDialog(dir,*filter,*title,0,0,"txt")
SendMessage edit1,WM_SETTEXT,0,fR
bstring tx = getfile fR
SendMessage richedit1,WM_SETTEXT,0,tx
End Sub
'*************************************************************
SUB GetLineCount
INT LCount = 0
LCount = SendMessage richedit1,EM_GETLINECOUNT,0,0
bstring count$ = ""
count$ = Str(LCount)
SendMessage edit1,WM_SETTEXT,0,count$
END SUB
'*************************************************************
SUB GetLine
INT Lpos = 2
INT LLen
LLen = SendMessage richedit1, EM_LINELENGTH,Lpos, 0
print "LineLen;" + str(LLen)
pText = Space (LLen)
SendMessage richedit1,EM_GETLINE,Lpos,*pText
print "LineText;" + pText
'convert to bstring & show line in edit control
bString LText = pText
SendMessage edit1,WM_SETTEXT,0,LText
END SUB
PS.Line counter use zero-based index,so first line have index NULL.
-
Thanks Aurel,
The latest Oxygen has a built-in strptr and also null, which I hope will make OS strings easier to handle. No need to figure out the indirection level of different strings using @ ? or *
Charles
-
Hi Charles,
if I have the latest OB version, must I write
wc.lpszMenuName = NULL
wc.lpszClassName = StrPtr "Oxygen"
-
Thanks Charles... ;)
As you can see controls like bstring as type of string which is show properly.
What is bstring2 ???
I also try extract strings from line with GetLine subroutine with FOR loop but seems that
not work, infact crush :-\ ( old friend - DrWatson jump like crazy ;D )
-
Hi ...
I get it to work defining Space(255).
Here is testing subroutine.On the end of subrotine is comment.
I think that speed is very good...cca 7 second,file long 12560 lines of text... :)
SUB GetLine
INT Lpos
INT LLen
bstring LText=""
string pText
FOR Lpos = 0 TO LCount-1
LLen = SendMessage richedit1, EM_LINELENGTH,Lpos, 0 ' not important
'print "LineLen;" + str(LLen)
pText = Space (255) ' it use 255 without error
SendMessage richedit1,EM_GETLINE,Lpos,*pText
'print "LineText;" + pText
'convert to bstring & show line in edit control
LText = pText
SendMessage edit1,WM_SETTEXT,0,LText
UpdateWindow(edit1)
Next
'test - load file
'with 12560 lines of text
'read line by line ,finished
'cca 7 seconds
END SUB
-
I still have a problem with strptr in one of my test programs. It is not quite there yet. But low level access to string pointers will remain.
Charles
-
Hi Charles ...
Just take your time , will be... ;)
Yes you right sometimes this work around strings & pointers , huh is tuff :-\
And yea, i just compare speed of Oxygen with(with same load) :
PureBasic - cca 13 seconds
Emergence Basic - cca 10 seconds
So o2 is faster ... ;)
And looks to me that work far smooth then PB,EB.
I mean in first place to updating edit control each time is content changed ...cool
-
Just a small addition to filter creation.
sep=chr(0)
filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
On this way first visible filter is Text files *.txt .
;)
-
Good idea!
This my latest effort, with a cleaned-up header. I've included it in the latest Oxygen in examples/GUI/.
'no case sensitivity
% OFN_READONLY 0x00000001
% OFN_OVERWRITEPROMPT 0x00000002
% OFN_HIDEREADONLY 0x00000004
% OFN_NOCHANGEDIR 0x00000008
% OFN_SHOWHELP 0x00000010
% OFN_ENABLEHOOK 0x00000020
% OFN_ENABLETEMPLATE 0x00000040
% OFN_ENABLETEMPLATEHANDLE 0x00000080
% OFN_NOVALIDATE 0x00000100
% OFN_ALLOWMULTISELECT 0x00000200
% OFN_EXTENSIONDIFFERENT 0x00000400
% OFN_PATHMUSTEXIST 0x00000800
% OFN_FILEMUSTEXIST 0x00001000
% OFN_CREATEPROMPT 0x00002000
% OFN_SHAREAWARE 0x00004000
% OFN_NOREADONLYRETURN 0x00008000
% OFN_NOTESTFILECREATE 0x00010000
% OFN_NONETWORKBUTTON 0x00020000
% OFN_NOLONGNAMES 0x00040000 '// force no long names for 4.x modules
% OFN_EXPLORER 0x00080000 '// new look commdlg
% OFN_NODEREFERENCELINKS 0x00100000
% OFN_LONGNAMES 0x00200000 '// force long names for 3.x modules
% OFN_ENABLEINCLUDENOTIFY 0x00400000 '// send include message to callback
% OFN_ENABLESIZING 0x00800000
% OFN_DONTADDTORECENT 0x02000000
% OFN_FORCESHOWHIDDEN 0x10000000 '// Show All files including System and hidden files
type OPENFILENAMEA
DWORD lStructSize
SYS hwndOwner
SYS hInstance
CHAR* lpstrFilter
CHAR* lpstrCustomFilter
DWORD nMaxCustFilter
DWORD nFilterIndex
CHAR* lpstrFile
DWORD nMaxFile
CHAR* lpstrFileTitle
DWORD nMaxFileTitle
CHAR* lpstrInitialDir
CHAR* lpstrTitle
DWORD Flags
WORD nFileOffset
WORD nFileExtension
CHAR* lpstrDefExt
LONG lCustData
SYS lpfnHook
CHAR* lpTemplateName
end type
typedef OPENFILENAMEA OPENFILENAME
Declare GetModuleHandle lib "kernel32.dll" alias "GetModuleHandleA" (optional char*n) as sys
Declare GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME*opfn) As sys
Declare CommDlgExtendedError Lib "comdlg32.dll" () as dword
'FileDialog( $ iDir , $ filter ,$ title , % parent , flag )
Function FileDialog(string iDir, filter, Title, sys Hwnd, Flags) As String
'==================
def FileNameLen 256
OPENFILENAME ofn
char filename[FileNameLen]
int retval
ofn.lStructSize = sizeof(OPENFILENAME)
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle
ofn.lpstrFilter = filter
ofn.lpstrCustomFilter = null
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 1
ofn.lpstrFile = FileName 'coupling to char buffer
ofn.nMaxFile = FileNameLen
ofn.lpstrFileTitle = null
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = idir
ofn.lpstrTitle = title
ofn.Flags = flags
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = null
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = null
sys retval = GetOpenFileName(ofn)
'
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms646916(v=vs.85).aspx
'if retval=0 then print "Dialog Error " CommDlgExtendedError
return filename
'#recordof FileDialog
'
End Function
'dir="C:\cevp\projects\opcode\OxygenBasic\examples\GUI"
sys hwnd
string dir=""
string sep=chr(0)
string filter=
"all files"+sep+"*.*"+sep+
"text"+sep+"*.txt"+sep+
"basic"+sep+"*.bas;*.o2bas"+sep+
"include"+sep+"*.inc"+sep+
"header"+sep+"*.h"+sep+
sep
string title = "Test File Opening Dialog"
sys flags = OFN_EXPLORER or OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY
string fi = FileDialog(dir,filter,title,hwnd,flags)
if fi then print fi
-
Thanks Charles...
Do i can ask you something ?
This is just suggestion...
Do you can put somwhere here on forum one board or topic in
which we can found latest (bugfixed or improved) oxygen.dll & latest gxo2.exe.
I think that this will be remove any confusion and conflicts with headers for GUI
or anthing else .
I have for example one version of o2h on disk C and one on disk D.
And sometimes i have made mess up which is which.
i hope that i don't ask to much.
-
Hi Aurel,
All the major release go onto the Website downloads page, then onto SourceForge. I'm currently checking the latest with thinBasic examples. When all is well, I will release it as A039.
Unfortunately backwards-compatibility is not assured with these Alpha releases, so the examples from earlier versions may lose compatibility. But I do my best to avoid breakages.
For instance null should no longer be defined in headers.
Charles
-
Ok.
Yes i see that null is not in header,which is ok for me ;)
I think that i will wait for 039... :)
-
Charles...
what a heck is now wrong with FileDialog function and with last oxygen dll >:(
string pointers are not properly detected?
-
I don't see any file dialog problems, Aurel. Could you please demo.
-
Charles
I think that main problem is in FileDialog function connected with string pointers.
When you do some internal changes in core dll then this function not work properly .
So what to use now?
Function FileDialog(char Dir, filter , Title , sys Hwnd, Flags, defext) As String
Dim ofn As OPENFILENAME
Dim filename[255] As zstring
INT retval
ofn.lStructSize = 76
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = ?filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = @filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ?dir
ofn.lpstrTitle = title
IF Flags = 0 then ofn.Flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
IF Flags = 1 then ofn.Flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = @defext
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
' Execute the dialog box
IF Flags = 0 then retval = GetOpenFileName(ofn)
IF Flags = 1 then retval = GetSaveFileName(ofn)
Return filename
End Function
and here is structure...
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As sys
lpstrCustomFilter As sys
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As sys
nMaxFile As Long
lpstrFileTitle As sys
nMaxFileTitle As Long
lpstrInitialDir As sys
lpstrTitle As sys
flags As Long
nFileOffset As word
nFileExtension As word
lpstrDefExt As sys
lCustData As Long
lpfnHook As Long
lpTemplateName As sys
End Type
problematic parts are:
ofn.lpstrFilter = ?filter
ofn.lpstrFile = @filename ' the most critical member
ofn.lpstrInitialDir = ?dir
ofn.lpstrDefExt = ?defext
-
The Defext param should be a string, not sys.
We picked this up before, do you must be working with an older version.
from awinh.inc
'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )
Function FileDialog(String Dir, filter , Title , long Hwnd, Flags, string defext) As String
Dim ofn As OPENFILENAME
Dim filename[255] As zstring
INT retval
ofn.lStructSize = 76
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = strptr filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = strptr filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = strptr dir
ofn.lpstrTitle = strptr title
IF Flags = 0 then ofn.Flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
IF Flags = 1 then ofn.Flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = strptr defext
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL
' Execute the dialog box
IF Flags = 0 then retval = GetOpenFileName(ofn)
IF Flags = 1 then retval = GetSaveFileName(ofn)
Return filename
-
No Charles
I use latest awinh so defext must be string ....and i really don't know how then
work like sys with old oxygen dll ...looks like a mistery...ok
i will try new version. ;)
-
sorry Charles but someting is wrong ..I look again into include for EBasic
TYPE OPENFILENAME
DEF lStructSize AS INT
DEF hwndOwner AS INT
DEF hInstance AS INT
DEF lpstrFilter AS POINTER
DEF lpstrCustomFilter AS POINTER
DEF nMaxCustFilter AS INT
DEF nFilterIndex AS INT
DEF lpstrFile AS POINTER
DEF nMaxFile AS INT
DEF lpstrFileTitle AS POINTER
DEF nMaxFileTitle AS INT
DEF lpstrInitialDir AS POINTER
DEF lpstrTitle AS POINTER
DEF flags AS INT
DEF nFileOffset AS WORD
DEF nFileExtension AS WORD
DEF lpstrDefExt AS POINTER
DEF lCustData AS INT
DEF lpfnHook AS INT
DEF lpTemplateName AS POINTER
ENDTYPE
and we have in oxygen this:
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As string
lpstrCustomFilter As string
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As string
nMaxFile As Long
lpstrFileTitle As string
nMaxFileTitle As Long
lpstrInitialDir As string
lpstrTitle As string
flags As Long
nFileOffset As word
nFileExtension As word
lpstrDefExt As string
lCustData As Long
lpfnHook As Long
lpTemplateName As string
End Type
i will add in attachment awinh and AsciEdit so you can try and see what a heck is wrong ::)
-
An lpstr is a char ptr, not an Oxygen string. The pointer must be set, rather than performing a string character copy.
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As sys
lpstrCustomFilter As sys
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As sys
nMaxFile As Long
lpstrFileTitle As sys
nMaxFileTitle As Long
lpstrInitialDir As sys
lpstrTitle As sys
flags As Long
nFileOffset As word
nFileExtension As word
lpstrDefExt As sys
lCustData As Long
lpfnHook As Long
lpTemplateName As sys
End Type
-
Ok Charles
I copy OPENFILE structure as you suggest and what is now in conflict.
FileDialog function is also fixed as you suggested.
I compile ASciEdit and o2 said OK.
I run program and looks that work fine,then i click on toolbar button Open
looks ok again file is loaded...then i click again button Open
and program is closed why is that ?
I simply cannot figured reason why ASciEdit close :-\
Do you can try compile Asciedit.o2bas ?
-
Do you can try compile Asciedit.o2bas ?
We picked this up before, do you must be working with an older version.
Hey Charles,
Your British English is obviously deteriorating. Too much of Aurel lately?
:D
-
;D I should attend some of your English classes, Mike.
Aurel,
Unfortunately, I can't spare the time for this one. May I suggest using some print tracers to check each param and to find out where the program fails.
-
Too much of Aurel lately?
Can you imagine being Aurel's roommate, living in the same town, ... :o
-
where
in Canada or in Bjelorusija ;D
-
Unfortunately, I can't spare the time for this one. May I suggest using some print tracers to check each param and to find out where the program fails.
ok
-
John,
I think I could manage in the same town, yes. But I would certainly die of creak and rattle of Aurel's aging computer, so not in the same room, no. :)
Aurel,
Byelorussia died 21 years ago together with the USSR, and let bygones be bygones. My country is called Belarus' ("s" palatalized).
-
Charles...
I have found what is a problem with ASciEdit function doOpen()
'open file
Sub doOpen
INT hsize=0
fName=""
string dir=""
string script
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
filter = "All files "+sep+"*.*"+sep+"Oxygen files "+sep+"*.o2bas"
title="Open File... "
hwnd=0
fName = FileDialog(dir,filter,title,0,0,"rub")
fileName = fName
print "FNAME IS: " + fName
'IF fName = "" Then Return
SendMessage edit1,SCI_SETTEXT,0,strptr(fName)
print "EDIT(FilePath)...OK!"
tx = GetFile fName
print "FILE-LEN: " + LEN(tx) 'OK!
print "GETFILE(load)...OK!"
script = tx '
SendMessage hsci,SCI_SETTEXT,0, strptr script ' tx is in direct conflict with scintilla why?
'SendMessage hsci,SCI_SETSAVEPOINT, 0, 0
'SendMessage hsci,SCI_EMPTYUNDOBUFFER,0,0
'If fName <> ""
'FindNewTab()
'End If
End Sub
as you can see i tested step by step and check everything in awinh.inc
it looks that scintilla simply don't load file and program is closed ???
i have try to change type of tx variable ( default is char[] ) to bstring,zstring etc..etc
but nothing
How is then possible that work with older version of dll ?
-
Charles
In my testing WM_SETTEXT work in RichEdit control but SCI_SETTEXT not in scintilla but
work in old release.
Infact i have found that small file under 400 bytes is loaded ...
so i think that something is wrong with oxygen internal string buffer or memory allocation.
-
@Charles:
filter = "All files "+sep+"*.*"+sep+"Oxygen files "+sep+"*.o2bas"
Is this sort of concatenation possible in OxygenBasic at all if sep is a chr(0)? :o
@Aurel:
The filter string in a File Open/Save dialog must explicitly end in two zero bytes (http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839%28v=vs.85%29.aspx). Your filter string will end only in one zero byte at best even if such concatenation is allowed in O2 at all.
This may cause all sorts of memory corruption in other data used in conjunction with such a malformed function call.
-
Mike
Yes filter string looks like a crazy train... ;D
But that is because i cannot create most standard way used in VB like style.
and i think that problem is not in filter even look crazy...
If you look again in SUB doOpen...
main problem is with scintilla SCI_SETTEXT message
which work in old version of oxygen BUT not in last release...why ?
i don't know :o
-
main problem is with scintilla SCI_SETTEXT message
which work in old version of oxygen BUT not in last release...why ?
Aurel,
You shouldn't underestimate the gravity of your filter string problem. It's nature is unpredictable and it may change its behavior randomly under different Oxygen versions that generate different data layouts in the process heap.
The two zero bytes at the end of it are a formal attribute of the end of filter string that signals the File dialog function to stop chopping the string into zero terminated chunks for the dialog's file type prompt combo. If the process heap memory that surrounds your malformed filter string is (unpredictably) tightly packed with meaningful data and there are no two successive zeros found, the function will carry on chopping memory in pieces until it finds (asolutely unpredictably again) a succession of at least two consecutive zero bytes somewhere else. God knows how much valuable data, possibly including that which is related to your edit or Scintilla control calls/messages, may get corrupted in this process.
To kill the bug reliably, you should eliminate all possible bottlenecks that are evident from your code analysis.
i don't know
To be absolutely sure it won't happen, I'd suggest you do it according to the classic and safest C-style algo:
1. Count the sum of lengths of all the file descriptions and extension patterns that will form up your final filter string.
2. Add the number of zero bytes in between the descriptions and patterns and the two trailing bytes to the above sum.
3. Allocate a fixed-length string buffer (or a byte array) filled with zeros to a length at least equal to the above sum.
4. Use RtlCopyMemory() from kernel32.dll or memcpy() from msvcrt.dll to copy your file description strings and extension patterns successively one after another into that buffer allowing for exactly one zero byte in between them and make sure there are at least two trailing zero bytes at the end of the buffer.
5. Assign the pointer to that string (or byte array) buffer to the lpstrFilter member of OPENFILENAME structure.
Hope this helps to at least make your File Open dialog call programmatically clean.
-
OR
You could use IUP that is known to work.
(http://www.tecgraf.puc-rio.br/iup/en/ctrl/images/iupscintilla.png)
We have enough wheels in stock, thank you.
-
OxygenBasic's dynamic string system is based on bstr (olestrings), which are terminated by at least one null. So to ensure 2 nulls, add one more at the end of the filter train.
-
Hi Charles,
Should I understand your remark as an indication that
filter = "All files "+sep+"*.*"+sep+"Oxygen files "+sep+"*.o2bas"
concatenation is valid for sep = chr(0) in OxygenBasic?
-
Mike
I don't know why you insist on Filter string .
In your Eclecta( FBSL IDE) filter string is standard...
FilterString = "FBSL Script Files (*.fbs;*.inc)|*.fbs;*.inc|All Files (*.*)|*.*"
which is the most standard way with separator char " | " ..right ?
It is used in many other languages ..right ?
But this symbol not work in Oxygen ::)
soo.
Ok i will try again...
-
Sure Mike. The string concatenator uses length encoding and is not null-aware, except for zstring / char* operands which rely on null terminators.
PS: I've got the remedy (Toy Interp), and I'm going through various related permutations - like compound comparing string functions. Should be ready to post this evening.
-
@Aurel:
Hi,
You're seeing the user side of FBSL's filter string only. The inner engine examines this string for the "|" characters (in fact, placeholders) which may not appear in file description and extension pattern strings and substitutes them with zero bytes. Two terminating nulls are also added transparently.
Judging by what Charles says, your O2 filter string concatenation must look like this:
filter = "All files "+sep+"*.*"+sep+"Oxygen files "+sep+"*.o2bas"+sep
@Charles:
Thanks for the clarification. FBSL's dynamic strings are ASCIIZ only so concatenation with chr(0) is not possible. That's why I was asking so insistently.
And thanks for the string comparison remedy too. :)
-
John,
What's your impression of Windows 8(.1)?
-
What's your impression of Windows 8(.1)?
Sorry Mike, haven't tried it yet. (too scary)
-
Sorry Mike, haven't tried it yet. (too scary)
Sorry John,
I mistook your Tecgraf Scintilla snapshot for one of your own again. :-[
-
I add one more separator on the end and still nothing ::)
-
I add one more separator on the end and still nothing ::)
Don't despair Aurel,
At any rate, you're one step closer to the solution. You absolutely had to straighten that thing out with the filter string anyway.
Let's see what else might be the problem.
[EDIT]
tx variable ( default is char[] )
If your tx is a char (byte) array then IMHO depending on the O2 peculiarities, its reference may be:
-- tx, or
-- VarPtr(tx) or &tx, or
-- VarPtr(tx[0]) or &tx[0] if indexbase is 0, or
-- VarPtr(tx[1]) or &tx[1] if indexbase is 1,
but not StrPtr(tx). Can you please check these options out with a direct call to SCI_SETTEXT?
-
if your tx is a char (byte) array then IMHO depending on the O2 peculiarities
i am almost sure about that .
ok Mike i will tray again.. ;)
edit:
OMG
Mike...thank you it work with:
SendMessage hsci,SCI_SETTEXT,0, &script ' BINGO?
Charles
may i ask ..since when we must use & prefix for string pointer or is this just addres of
byte pointer?
-
Aurel,
How have you defined tx ?
-
I am now really pissed off >:(
when i try :
SendMessage hsci,SCI_SETTEXT,0, tx
it work... :o
how ?
half of string functions not work properly
Charles i really don't have a clue what you do wrong in this last release.
And you tell me before that you have version of ASciEdit which work for you...
how?
char tx[500000]
in attachment is all...
-
Thanks Mike
If you pass a string to an unprototyped procedure, it will pass the string pointer by default: the equivalent of strptr tx
strptr is used to resolve the string pointer for any Oxygen string type, dynamic or otherwise.
And because Aurel has defined tx as char, strptr tx is equivalent to &tx.
If the procedure has a prototype, Oxygen will convert the string type to match the type spec in the prototype.
This part of Oxygen is well exercised, so I think the problem is more concealed, but I recommend using dynamic strings for buffers, since they can be sized to any length
Still performing my testing ceremony for today's work ...
-
Thanks Charles,
This pretty much nullifies my entire message so I'm deleting it. But then I must admit I don't understand either why, according to Aurel, his proxy
string script
script = tx
SendMessage hsci,SCI_SETTEXT,0, strptr script
works while his direct
SendMessage hsci,SCI_SETTEXT,0, strptr tx
doesn't.
-
That is a symptom of string corruption somewhere.
-
Oh...
That means we should go on searching.
[EDIT] Oh again. I've noticed Charles edited his previous message so Aurel, it means we (or rather you) should abandon your fixed length buffer char tx[500000] and use a dynamic string tx instead to load the file. Then if you need to traverse this string and evaluate separate chars in it later on, you can define
sys p = strptr(tx) // define pointer
p++ // increment pointer
P-- // decrement pointer
.... = *p // get value at pointer
*p = .... // set value at pointer
and use the p pointer to traverse the file buffer similar to how you used the (i) index in your former fixed-length array.
Hopefully Charles will fix this inconsistency with time.
-
That is a symptom of string corruption somewhere.
exactly...
I don't know how many times i repeat
that all string oprations in old dll which i use for my interpreter (which require lot of string
mumbo-jumbo) work as is suposed to be but in new dll not...
yeah i hope to....and because of constnat changes how we can build larger program without
annoying problems ...
-
Aurel,
It doesn't help Charles by you saying it's broken and how upset you are about it.
It would be more helpful if you could create repeatable small snippets of broken O2 code. I don't know of any other BASIC developer that is more responsive to issues than Charles.
-
Aurel,
Stop that please, will you? OxygenBasic is a few orders of magnitude more complex than AB and infinitely more complex than the Toy interpreter. There are hundreds if not thousands of cross references in it and it takes time to debug and test each minor fixup until it doesn't affect everything else it's related to. That's quite a piece of work for a lone developer however bright he might be.
If you want to be stable, you should select some O2 build that suits you and use it alone to develop your own product. That's what I've been doing for years with GCC v4.3.3 in FBSL while everybody else was using v4.4, v4.5 .. and now, v4.8.1.
Oxygen is under constant development and a lot of features can't always be 100% backward compatible. That's not a curse but rather a tremendous benefit. Look at all those hundreds of abandoned BASIC's that nobody's gonna develop any more, ever. You can find some stable one among them too. Say, PowerBASIC or FreeBasic for example -- they are very, very good, fast, stable, and field proven to be usable for language development. You might try out those ones for a change and still remain an OxygenBasic tester of small snippets of code.
Then in the end, when an official stable build of Oxygen is out, you can try and port your product to it and be sure that nobody's gonna change its functionality any more.
Please be reasonable.
-
If you want to be stable, you should select some O2 build that suits you and use it alone to develop your own product
and what i am doing ?
what i want to see is much stable & bug-fixing & less new features and experiments.
do you can explain to me why such a bang as qb64 is more used that o2?
i know ...becuse is more traditional and simple to use (even is a ...)
for example just look into PureBasic ..sites..etc
and you will figured very quickly why is good...
ok maybe i babeling this time too much..... :-X
i will use older version ok..ok..ok ::)
-
John,
Yes I agree, that small pieces of broken code are ideal for tracking bugs. You can get most of them very quickly this way.
Aurel,
Using today's Oxygen, AsciEdit2 opens & saves files, no problem, but will not run, compile, or save-as - from the desktop.
Mike,
The best way to access bytes by pointer or index, is to use an overlay.
Unlike C, Oxygen indexes are direct offsets.
byte b at strptr tx
equivalent:
byte*b=strptr tx
later setting:
@b=strptr tx
'moving pointers
@b++
@b--
'pointer arithmetic
@b+=10
'simple
b=65 'A
'indexed
b[n]=65 'A
-
@Aurel:
All I want to say is: Rome wasn't built in one day. Neither is Oxygen; it's under construction now. It isn't very reasonable to build any solid projects on top of it yet and try to keep them in sync with the ever evolving OxygenBasic, and demand its full compliance with your vision of what is right and what isn't. You'll be doing this totally at your own risk and you shouldn't expect any obligations on behalf of the language developer yet. This will last until Charles announces a stable version as soon as he gets his creation where he wants it to be. It's his own indisputable prerogative and noone else's.
In the meantime, do use the older DLL whichever you think is most suitable for your needs. There are still a hell of a lot of things you need to do in your interpreter before the potential of the older DLL is exhausted.
@Charles:
Thanks a lot again for your input. I don't claim any knowledge of OxygenBasic worth mentioning and I was simply trying to avoid jumping into false conclusions again. I know that my suggestion would work 100% sure in O2 but if you say that "overlays" will work better and/or easier and/or more naturally for the language then so be it.
Indeed I'm more familiar with the C methods of doing things than Oxygen's. But I promise to behave better. :)
-
Mike,
OxygenBasic was first conceived without reference to C as a language. So there a few deviations as far as pointers and arrays are concerned :)
Oxygen's explicit pointers are rather primitive, which is why I recommend overlays. They are are intrinsically cast as sys type, unless an explicit cast is used. Left-side and right side casts are supported though.
sys p=strptr tx
(byte) *p=x
x= (byte) *p
-
Hi Charles,
Are you calling them "primitive" only because they are void and as such don't support full-scale pointer arithmetics? I'm not noticing any inconvenience. In fact, I'm so fascinated by having pointers at all that switching back to VB6 to implement some of my freelance jobs makes me feel uneasy as if I'm having one of my hands chopped off with an axe. :)
-
Yes pointers, plain and simple. 'Primitive' means primordial rather than backward :)
I am glad you don't miss pointer arithmetic.