- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#21
Windows API Headers / Re: PathYetAnotherMakeUniqueNa...
Last post by José Roca - May 22, 2025, 05:22:01 AMThanks. I have modified it.
#22
Windows API Headers / PathYetAnotherMakeUniqueName a...
Last post by Pierre Bellisle - May 22, 2025, 02:03:18 AMHi José,
in ShlObj.inc a little misspell on the alias "PathYetAnoterMakeUniqueName"
instead of "PathYetAnotherMakeUniqueName"
in ShlObj.inc a little misspell on the alias "PathYetAnoterMakeUniqueName"
instead of "PathYetAnotherMakeUniqueName"
#23
OxygenBasic Examples / Re: get o2 version
Last post by Charles Pegge - May 16, 2025, 12:19:15 AMHi Pierre,
Have you come across Named Shared Memory? This allows different processes to share a block of memory, and treat it like a file. It requires only 2 function calls, and a static variable mapping (bind .. end bind) in o2. In the example below, a 64bit server shares global variables directly with a 32bit client, in the same memory space.
SERVER: (run first, without clicking "ok")
CLIENT:
Remember to "ok" on the SERVER MessageBox to close it when done.
Have you come across Named Shared Memory? This allows different processes to share a block of memory, and treat it like a file. It requires only 2 function calls, and a static variable mapping (bind .. end bind) in o2. In the example below, a 64bit server shares global variables directly with a 32bit client, in the same memory space.
SERVER: (run first, without clicking "ok")
Code Select
'-----------------------------------------
'NAMED SHARED MEMORY
'=========================================
'derived from:
'Creating Named Shared Memory
'http://msdn.microsoft.com/en-us/library/aa366551(VS.85).aspx
'==============
'SERVER PROCESS
'==============
$filename "server4.exe"
uses RTL64
uses CoreWin
' from winbase.h and winnt.h
% PAGE_NOACCESS 0x01
% PAGE_READONLY 0x02
% PAGE_READWRITE 0x04
% PAGE_WRITECOPY 0x08
' Token Specific Access Rights.
% TOKEN_ASSIGN_PRIMARY 0x0001
% TOKEN_DUPLICATE 0x0002
% TOKEN_IMPERSONATE 0x0004
% TOKEN_QUERY 0x0008
% TOKEN_QUERY_SOURCE 0x0010
% TOKEN_ADJUST_PRIVILEGES 0x0020
% TOKEN_ADJUST_GROUPS 0x0040
% TOKEN_ADJUST_DEFAULT 0x0080
% TOKEN_ADJUST_SESSIONID 0x0100
% SECTION_QUERY 0x0001
% SECTION_MAP_WRITE 0x0002
% SECTION_MAP_READ 0x0004
% SECTION_MAP_EXECUTE 0x0008
% SECTION_EXTEND_SIZE 0x0010
% SECTION_ALL_ACCESS 0x001F
% SECTION_MAP_EXECUTE_EXPLICIT 0x0020
% STANDARD_RIGHTS_REQUIRED 0x000F0000L
% FILE_MAP_ALL_ACCESS SECTION_ALL_ACCESS
sys INVALID_HANDLE_VALUE = -1 'as ptr
% TRUE 1
% FALSE 0
string szName="Local\MyFileMappingObject" 'GLOBAL\ NOT SUPPOERTED
string szMsg="This is a Message from the SERVER process."
string cr=chr(13)+chr(10)
% BUF_SIZE 0x1000
======================
sys hMapFile
sys pBuf
hMapFile = CreateFileMapping(
INVALID_HANDLE_VALUE, ' use paging file
NULL, ' default security
PAGE_READWRITE, ' read/write access
0, ' maximum object size (high-order DWORD)
BUF_SIZE, ' maximum object size (low-order DWORD)
szName) ' name of mapping object
if hMapFile == 0
print "Could not create file mapping object" + cr + GetLastError()
jmp fwd done
endif
' 0x7 read/write permission
pBuf = MapViewOfFile( hMapFile, 0x7, 0, 0, BUF_SIZE)
if pBuf == 0
print "Could not map view of file" + cr +
GetLastError()
CloseHandle(hMapFile)
jmp fwd done
endif
'
bind pBuf
sys p
int i1,i2
float f1,f2
char c1[0x100]
end bind
'
i1=123
i2=456
f1=pi()
c1=szMsg
print "SERVER: " cr +
c1 cr +
i1 " / " i2 ", " f1 cr cr +
"Press OK to terminate"
UnmapViewOfFile(pBuf)
CloseHandle(hMapFile)
jmp fwd done
'
'
=====
done:
=====
CLIENT:
Code Select
'-------------------
'NAMED SHARED MEMORY
'===================
'derived from:
'Creating Named Shared Memory
'http://msdn.microsoft.com/en-us/library/aa366551(VS.85).aspx
'==============
'CLIENT PROCESS
'==============
uses CoreWin
' from winbase.h and winnt.h
% PAGE_NOACCESS 0x01
% PAGE_READONLY 0x02
% PAGE_READWRITE 0x04
% PAGE_WRITECOPY 0x08
' Token Specific Access Rights.
% TOKEN_ASSIGN_PRIMARY 0x0001
% TOKEN_DUPLICATE 0x0002
% TOKEN_IMPERSONATE 0x0004
% TOKEN_QUERY 0x0008
% TOKEN_QUERY_SOURCE 0x0010
% TOKEN_ADJUST_PRIVILEGES 0x0020
% TOKEN_ADJUST_GROUPS 0x0040
% TOKEN_ADJUST_DEFAULT 0x0080
% TOKEN_ADJUST_SESSIONID 0x0100
% SECTION_QUERY 0x0001
% SECTION_MAP_WRITE 0x0002
% SECTION_MAP_READ 0x0004
% SECTION_MAP_EXECUTE 0x0008
% SECTION_EXTEND_SIZE 0x0010
% SECTION_ALL_ACCESS 0x001F
% SECTION_MAP_EXECUTE_EXPLICIT 0x0020
% STANDARD_RIGHTS_REQUIRED 0x000F0000L
% FILE_MAP_ALL_ACCESS SECTION_ALL_ACCESS
sys INVALID_HANDLE_VALUE = -1 'as ptr
% TRUE 1
% FALSE 0
string Name="Local\MyFileMappingObject" 'GLOBAL\ NOT SUPPORTED
string cr=chr(13)+chr(10)
% BUF_SIZE 0x200
function main() as int
======================
sys hMapFile
sys pBuf
hMapFile = OpenFileMapping( FILE_MAP_ALL_ACCESS, FALSE, Name)
if hMapFile == 0
print "Could not open file mapping object" + chr(13) + GetLastError()
return 1
endif
pBuf = MapViewOfFile(hMapFile, FILE_MAP_ALL_ACCESS, 0, 0, BUF_SIZE)
if pBuf == 0
print "Could not map view of file" + chr(13) + GetLastError()
CloseHandle(hMapFile)
return 1
endif
'char*s : strptr(s)=pbuf
bind pBuf
sys p
int i1,i2
float f1,f2
char c1[0x100]
end bind
print "CLIENT: " cr +
c1 cr +
i1 " / " i2 ", " f1 cr cr
UnmapViewOfFile(pBuf)
CloseHandle(hMapFile)
return 0
end function
main
Remember to "ok" on the SERVER MessageBox to close it when done.
#24
OxygenBasic Examples / Re: get o2 version
Last post by Pierre Bellisle - May 14, 2025, 08:36:25 PMHi Charles,
If you see things that could be done in an easier way in o2,
do not hesitate to suggest, the possibilities are vast
and I have the natural tendency to fall back in pb track.
If you see things that could be done in an easier way in o2,
do not hesitate to suggest, the possibilities are vast
and I have the natural tendency to fall back in pb track.
#25
OxygenBasic Examples / Re: get o2 version
Last post by Charles Pegge - May 13, 2025, 12:19:36 PMThanks Pierre.
#26
OxygenBasic / Re: word WordValue at strptr(s...
Last post by Charles Pegge - May 12, 2025, 12:08:46 PMQuotethat "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
O2 automatically converts string parameters into numbers and numbers into strings to match the function prototype.
This is what happens with string(Charcount,n): In this case n gets converted into a string, as if you had used string(Charcount,str(n) )
O2 performs automatic type conversion for all primitive types in an expression, including integers, floats and strings. It works well in most instances but occasionally produces unintended results!
#27
OxygenBasic Examples / get o2 version
Last post by Pierre Bellisle - May 12, 2025, 09:44:45 AMhere are two exe that get o2 version.
the first one is 32 bit, the second one is 64 bit to get 64 bit dll version.
the interprocess communication is done via the simple WM_SETTEXT.
app is drag and drop aware and command line aware.
the first one is 32 bit, the second one is 64 bit to get 64 bit dll version.
the interprocess communication is done via the simple WM_SETTEXT.
app is drag and drop aware and command line aware.
Code Select
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -32 //compile to 32bit
//KickExeArgument "D:\Dev\Oxygen\o2\oxygen.dll" "D:\Dev\Oxygen\o2\oxygen64.dll" //send this command line to the exe
//KickExeFileName "o2version.exe" // Optional exe/dll FileName
//KickEnd //optional, end of kick instructions
'D:\Dev\Oxygen\o2\demos\Unicode\
'in this 32bit exe you have:
' make use of interprocess WM_SETTEXT to get 64bit exe data
' dynamic api loader
' subclassed edit
' read command line arguments with CommandLineToArgvW
' can receive multi dropped files
' FileExist
' SetWindowPos(HWND_NOTOPMOST)
uses dialogs
$ FileName "o2version.exe"
$ o2version64 = "o2version64.exe" 'other exe that use interprocess WM_SETTEXT for 64 bit dll
% Edit 101
% EditHidden 102
% CheckboxTopMost 201
% Grip 301
% SIZE_MINIMIZED 1
% DEFAULT_GUI_FONT 17
% GCL_HICON -14
% MAXDWORD 0xFFFFFFFF
% WM_NCDESTROY 0x082
% SWP_NOSIZE 1
% HWND_DESKTOP 0
% HWND_NOTOPMOST 0xFFFFFFFE
% SIZE_MAXIMIZED 2
% SBS_SIZEGRIP 0x0010
% SM_CXVSCROLL 2
% SM_CYHSCROLL 3
% SEM_FAILCRITICALERRORS = 0X0001
! SetWindowTheme lib "UxTheme.dll" alias "SetWindowTheme"
(byval hwnd as sys, pszSubAppName as wzstring, pszSubIdList as wzstring) as long
'______________________________________________________________________________
sub TextDel(sys hEdit)
'Erase all, Microsoft recommended way
SendMessage(hEdit, WM_SETTEXT, 0, BYVAL 0)
end sub
'_____________________________________________________________________________
sub TextAdd(sys hEdit, byref string sText)
'Move the caret to the end of text
SendMessage(hEdit, EM_SETSEL, -1, -1)
sText += chr(13) + chr(10) 'Add a CRLF if needed
'Insert the string at caret position
SendMessage(hEdit, EM_REPLACESEL, TRUE, sText)
end sub
'_____________________________________________________________________________
function FileExist(string sFileName) as long
dword Attribute = GetFileAttributes(strptr(sFileName))
if Attribute <> INVALID_HANDLE_VALUE then
if (Attribute AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
function = 1
end if
end if
end function
'_____________________________________________________________________________
sub Dynamic_O2_version(sys hEdit, string sFileName)
if right(lcase(sFileName), 4) = ".dll"
dword ExErrMode = SetErrorMode(SEM_FAILCRITICALERRORS) 'prevent pop-up dialogs if device is not present or loaded
sys hLib = LoadLibrary(sFileName)
SetErrorMode(ExErrMode) 'return to old mode
if hLib then
sys pProc = GetProcAddress(hLib, "o2_version")
if pProc then
char* oTwoVer = call pProc
TextAdd(hEdit, "32-bit " & oTwoVer + " - " + sFileName)
else
TextAdd(hEdit, "no o2_version procedure pointer returned - " + sFileName)
endif
FreeLibrary(hLib)
else
sys hEditHidden = GetDlgItem(GetParent(hEdit), EditHidden)
string sCmdLine = "0x" & hex(hEditHidden, 8) & " " & sFileName
ShellExecute(hwnd_desktop, "", o2version64, sCmdLine, "", 0)
endif
else
TextAdd(hEdit, "not a .dll - " + sFileName)
endif
end sub
'_____________________________________________________________________________
function EditProc(sys hEdit, uint wMsg, sys wParam, sys lParam) as sys callback
static sys pEditProc
long index
select case wMsg
case WM_NULL
if hEdit = 0 and pEditProc = 0 then pEditProc = wParam : return(0)
CASE WM_NCDESTROY
SetWindowLongPtr(hEdit, GWL_WNDPROC, pEditProc) 'Unsubclass edit
CASE WM_DROPFILES
sys hDrop = wParam
long DroppedFileCount = DragQueryFileW(hDrop, 0xFFFFFFFF, byval 0, 0)
zstring zFileName[max_path]
for index = 0 to DroppedFileCount - 1
DragQueryFile(hDrop, index, zFileName, MAX_PATH)
Dynamic_O2_version(hEdit, zFileName)
next
DragFinish(hDrop) 'Releases memory that Windows allocated
end select
function = CallWindowProc(pEditProc, hEdit, wMsg, wParam, lParam)
end function
'_____________________________________________________________________________
function DialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as sys callback
static sys hEdit, hIcon, hFont
static rect ButtonRect
static point GripSize
select case uMsg
case WM_INITDIALOG
ShowWindow(GetDlgItem(hDlg, EditHidden), SW_HIDE)
GripSize.x = GetSystemMetrics(SM_CXVSCROLL) 'Width of grip
GripSize.y = GetSystemMetrics(SM_CYHSCROLL) 'Height of grip
SetWindowTheme(GetDlgItem(hDlg, Grip), " ", " ") 'use old theme grip
hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o
SetClassLongPtr(hDlg, GCL_HICON, hIcon)
hEdit = GetDlgItem(hDlg, Edit)
'subclass listbox with a a one liner and no variables needed...
EditProc(0, WM_NULL, SetWindowLongPtr(hEdit, GWL_WNDPROC, @EditProc), 0)
hFont = CreateFont(14, 0, 'height 14 = 9, 16=12, 15=11, 14=11, width usually 0,
0, 0, 'escapement(angle), orientation
0, 0, 0, 0, 'bold, italic, underline, strikeThru
0, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, FF_DONTCARE, "Consolas") 'fixed width font ("Segoe UI", 9 Arial Consolas)
SendMessage(hEdit, WM_SETFONT, hFont, 0)
SendMessage(GetDlgItem(hDlg, IDCANCEL), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, CheckboxTopMost), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
GetWindowRect(GetDlgItem(hDlg, IDCANCEL), ButtonRect) 'keep PushButton size as defined in winmain()
ButtonRect.right = ButtonRect.right - ButtonRect.left : ButtonRect.left = 0
ButtonRect.bottom = ButtonRect.bottom - ButtonRect.top : ButtonRect.top = 0
TextDel(hEdit)
TextAdd(hEdit, "from windows explorer, drag one or more 32 or 64 bit oxygen .dll here")
TextAdd(hEdit, "(or you may add dll filename to this exe command line)")
TextAdd(hEdit, "-----------------------------------")
long ArgumentCount, index
wchar** ppwArgument 'pointer to the first pointer item of an array of wzstring pointers, same as 'wchar ptr ptr ppwArgument'
@@ppwArgument = (sys) CommandLineToArgvW(GetCommandLineW(), @ArgumentCount)
if ArgumentCount > 1
for index = 2 to ArgumentCount
Dynamic_O2_version(hEdit, ppwArgument[index])
next
endif
if GlobalFree(@@ppwArgument) then Beep(5500, 50) 'use GlobalFree() or LocalFree(), if the function succeeds, the return value is NULL
PostMessage(hEdit, EM_SETSEL, -1, 0) 'set caret at the end of text
return true
case WM_COMMAND
select case loword(wParam)
case IDCANCEL
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
EndDialog(hDlg, null)
endif
case EditHidden
if hiword(wParam) = EN_CHANGE
'message was sent by o2version64
word CharCount = SendMessageW(GetDlgItem(hDlg, EditHidden), EM_LINELENGTH, 0, 0)
if CharCount
if CharCount = 1 then CharCount = 2
string sText = string(CharCount, chr(0))
word WordLen at strptr(sText)
WordLen = CharCount
SendDlgItemMessage(hDlg, EditHidden, EM_GETLINE, 0, BYVAL STRPTR(sText))
TextAdd(hEdit, sText)
endif
endif
case CheckboxTopMost
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
if IsDlgButtonChecked(hDlg, CheckboxTopMost) then
SetWindowPos(hDlg, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
else
SetWindowPos(hDlg, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
endif
endif
end select
case WM_SIZE 'dialog size have changed
'wParam = Resizing requested: SIZE_MAXHIDE SIZE_MAXIMIZED SIZE_MAXSHOW SIZE_MINIMIZED SIZE_RESTORED
'loword lParam is client area width in pixels
'hiword lParam is client area height in pixels
if wParam <> SIZE_MINIMIZED
long ClientSizeX = loword(lParam)
long ClientSizeY = hiword(lParam)
if wparam = SIZE_MAXIMIZED then
SetWindowPos(GetDlgItem(hDlg, Grip), NULL, 0, 0, 0, 0, SWP_NOZORDER) 'size it to zero by zero
else
SetWindowPos(GetDlgItem(hDlg, Grip), NULL, ClientSizeX - GripSize.x,
ClientSizeY - GripSize.y, GripSize.x, GripSize.y, SWP_NOZORDER)
endif
long posY = ClientSizeY - ButtonRect.bottom - 15
MoveWindow(hEdit, 5, 5, ClientSizeX - 10, posY, TRUE)
MoveWindow(GetDlgItem(hDlg, IDCANCEL), (ClientSizeX - ButtonRect.right) \ 2, posY + 10,
ButtonRect.right, ButtonRect.bottom, TRUE)
MoveWindow(GetDlgItem(hDlg, CheckboxTopMost), 10, posY + 10,
ButtonRect.right, ButtonRect.bottom, TRUE)
endif
case WM_CLOSE
EndDialog(hDlg, null)
case WM_DESTROY
DeleteObject(hFont)
DestroyIcon(hIcon)
end select
return 0
end function
'______________________________________________________________________________
sub winmain()
if sizeof(sys) = 8
mbox "This code must be compiled in 32 bit"
else
if FileExist(o2version64) then
Dialog(0, 0, 280, 100, "oxygenbasic version", WS_OVERLAPPEDWINDOW | DS_CENTER)
MultiLineText("", Edit, 1, 1, 198, 80)
PushButton("&close" , IDCANCEL, 80, 85, 40, 12)
AutoCheckBox("&topmost" , CheckboxTopMost, 5, 85, 40, 12)
SCROLLBAR("", Grip, 270, 90, 10, 10, WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP | SBS_SIZEBOXBOTTOMRIGHTALIGN)
EditText("", EditHidden, "", 0, 0, 100, 20)
CreateModalDialog(null, @DialogProc, 0)
else
mbox o2version64 & " not found !"
endif
endif
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
Code Select
//K ickUseDirectivesFrom "D:\Dev\Oxygen\o2\o2_version3264-01.o2bas"
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -64 //compile to 32bit
//K ickExeArgument "D:\Dev\Oxygen\o2\oxygen.dll" "D:\Dev\Oxygen\o2\oxygen64.dll" //send this command line to the exe
//K ickHelp //show kick help
//KickExeFileName "o2version64.exe" // Optional exe/dll FileName
//KickEnd //optional, end of kick instructions
'in this 64bit exe you have:
' dynamic api loader
' GetCommandLine()
' FileExist
uses corewin
$ FileName "o2version64.exe"
$ o2version = "o2version.exe" 'other exe with dialog for 32 bit dll
% EditHidden 102
% SEM_FAILCRITICALERRORS = 0X0001
macro makdwd(lo, hi)
dword (hi << 16) + lo
end macro
'_____________________________________________________________________________
function FileExist(string sFileName) as long
dword Attribute = GetFileAttributes(strptr(sFileName))
if Attribute <> INVALID_HANDLE_VALUE then
if (Attribute AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
function = 1
end if
end if
end function
'_____________________________________________________________________________
function Dynamic_O2_version(string sFileName) as string
dword ExErrMode = SetErrorMode(SEM_FAILCRITICALERRORS) 'prevent pop-up dialogs if device is not present or loaded
sys hLib = LoadLibrary(sFileName)
SetErrorMode(ExErrMode) 'return to old error mode
if hLib then
sys pProc = GetProcAddress(hLib, "o2_version")
if pProc then
char* oTwoVer = call pProc
function = "64-bit " & oTwoVer + " - " + sFileName
else
function = "no o2_version procedure pointer returned - " + sFileName
endif
FreeLibrary(hLib)
endif
end function
'______________________________________________________________________________
sub winmain()
if sizeof(sys) = 4
mbox "This code must be compiled in 64 bit"
else
if fileExist(o2version) then
zstring ptr pCommandLine = GetCommandLine()
string sCommandLine = pCommandLine
long charPos = instr(2, sCommandLine, chr(34))
if charPos then
sCommandLine = mid(sCommandLine, charPos + 2, len(sCommandLine) - charPos - 1)
if left(sCommandLine, 2) = "0x" then
sys h = val(sCommandLine)
charPos = instr(sCommandLine, chr(32))
sCommandLine = mid(sCommandLine, charPos + 1)
if isWindow(getParent(h)) then
if len(sCommandLine) then
string sResult = Dynamic_O2_version(sCommandLine)
'send text to o2version 32 bit
SendMessage(h, WM_SETTEXT, 0, strptr(sResult))
PostMessage(GetParent(h), WM_COMMAND, MAKDWD(EditHidden, EN_CHANGE), h)
endif
endif
else
mbox "use " & o2version & " !"
endif
endif
else
mbox o2version & " not found !"
endif
endif
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
#28
OxygenBasic / Re: word WordValue at strptr(s...
Last post by Pierre Bellisle - May 12, 2025, 12:19:19 AMHi Charles and Aurel,
I work with both wstring and string.
For this question I wrote a demo that do not use wide character.
I made different variation of "word WordLen at strptr(sText) = CharCount"
Look for "choice" in code
I got a non assigned value in one case, I got a gpf on reassigment try,
and a good result which the normal behavior, now that I'm aware of it.
Thank for the answer.
Note: If you revisit the help file, might be good to say
that "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
and to obtain a string made of nul like
"sText = nuls(CharCount)" you have to add "chr()" like in
"sText = string(CharCount, chr(0))"
I work with both wstring and string.
For this question I wrote a demo that do not use wide character.
I made different variation of "word WordLen at strptr(sText) = CharCount"
Look for "choice" in code
I got a non assigned value in one case, I got a gpf on reassigment try,
and a good result which the normal behavior, now that I'm aware of it.
Thank for the answer.
Note: If you revisit the help file, might be good to say
that "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
and to obtain a string made of nul like
"sText = nuls(CharCount)" you have to add "chr()" like in
"sText = string(CharCount, chr(0))"
Code Select
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -32 //compile to 32bit
//KickEnd //optional, end of kick instructions
% Edit01 102
% lText01 201
% CheckboxTopMost 301
% DEFAULT_GUI_FONT 17
% GCL_HICON -14
% SWP_NOSIZE 1
% HWND_NOTOPMOST 0xFFFFFFFE
uses dialogs
'____________________________________________________________________________
function DialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as int callback
select case uMsg
case WM_INITDIALOG
sys hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o
SetClassLongPtr(hDlg, GCL_HICON, hIcon)
sys hEdit = GetDlgItem(hDlg, Edit01)
sys hFont = CreateFont(14, 0, 'Height 14 = 9, 16=12, 15=11, 14=11, Width usually 0,
0, 0, 'Escapement(angle), Orientation
0, 0, 0, 0, 'Bold, Italic, Underline, Strikethru
0, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, FF_DONTCARE, "Consolas") 'Fixed width font ("Segoe UI", 9 Arial Consolas)
SendMessage(hEdit, WM_SETFONT, hFont, 0)
SendMessage(GetDlgItem(hDlg, IDCANCEL), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, lText01), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, CheckboxTopMost), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
PostMessage(hEdit, %EM_SETSEL, -1, 0) 'Set caret at the end of text
return true
case WM_COMMAND
select case loword(wParam)
case IDCANCEL
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
EndDialog(hDlg, null)
end if
case Edit01
if hiword(wParam) = EN_CHANGE 'OR hiword(wParam) = 1
word CharCount = SendMessage(GetDlgItem(hDlg, Edit01), EM_LINELENGTH, 0, 0)
string sText = nuls(CharCount)
if CharCount = 1 then CharCount = 2 'EM_GETLINE need at least 2 to work on a one char string,
'--------------------------------------
long choice = 2 'try 1, 2, or 3
'-
if choice = 1 'bad, value is not assigned to CharCount
word WordLen at strptr(sText) = CharCount
end if
'-
if choice = 2 'ok, value is assigned to CharCount
word WordLen at strptr(sText)
WordLen = CharCount
end if
'-
if choice = 3 'gpf, reassigmnet will gpf
word WordLen at strptr(sText) = CharCount
WordLen = CharCount
end if
'--------------------------------------
long retval = SendDlgItemMessage(hDlg, Edit01, EM_GETLINE, 0, STRPTR(sText))
SetWindowText(GetDlgItem(hDlg, lText01), "[" + sText + "] len " & str(len(sText)) & ", count from em_getline " & str(retval))
end if
case CheckboxTopMost
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
if IsDlgButtonChecked(hDlg, CheckboxTopMost) then
SetWindowPos(hDlg, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
else
SetWindowPos(hDlg, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
end if
end if
end select
case WM_CLOSE
EndDialog(hDlg, null)
case WM_DESTROY
DeleteObject(hFont)
DestroyIcon(hIcon)
end select
return 0
end function
'______________________________________________________________________________
sub winmain()
Dialog(0, 0, 155, 30, "edit EM_GETLINE", WS_CAPTION | WS_MINIMIZEBOX | WS_SYSMENU | DS_CENTER, WS_EX_LEFT)
EditText("123456", Edit01, 05, 05, 80, 10)
Ltext("try choice 1, 2, 3 in code", lText01, 5, 18, 100, 10, SS_NOTIFY, ws_ex_staticedge, 0) 'ws_ex_windowedge) 'ws_ex_clientedge) 'ws_ex_staticedge)
PushButton("&close" , IDCANCEL, 110, 5, 40, 10)
AutoCheckBox("topmost" , CheckboxTopMost, 110, 18, 40, 10)
CreateModalDialog(null, @DialogProc, 0)
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
#29
OxygenBasic / Re: word WordValue at strptr(s...
Last post by Charles Pegge - May 11, 2025, 11:11:59 AMYes Pierre, this is normal behavior when setting up a pointer variable, then assigning values to it. Are you working with wide strings?
#30
