Hello All
Can someone please show me how to highlight a single cell in a listview when i click on a particular cell ?
the below is the program of my testing with NM_CUSTOMDRAW which did not work
' CListview_SCS.o2bas
' Updated Dec 15 2018
'====================================================================
' Color Listview example, nested modeless dialog. modified Nov 9 2018
' which you can change fonts and color of text and background
' Allows for Single Cell selection
' Uses the latest Dialogs.inc file from
' https://www.oxygenbasic.org/forum/index.php?topic=1525.30
' message #37 Thanxx to Roland
'====================================================================
$ filename "CListview_SCS.exe"
use rtl64
#lookahead
%review
uses O2Common
uses dialogs
uses O2ListView
'Identifier for ListView
% IDC_LSV1 4001
' The program logo icon is obtained from the resource file
' the 1000 must corespondence to the 1000 in the rc file
% IDI_LOGO 1000
% ICON_BIG=1
% WM_SETICON=0x80
' Number of rows in the ListView
% NumRow = 100
' Number of columns in the ListView meaning 3 +1 = 4 columns
% NumCol = 3
' Handle for the Main Dialog and ListView
sys hDlg , hListview
' Fonts
sys hFont
' Current column and row numbers
Long CurrentRow, CurrentCol
' ========================================================================================
' Changes the state of an item in a list-view control.
SUB ListView_SetItemState (BYVAL hwndLV AS sys, BYVAL i AS LONG, BYVAL dwState AS uint , BYVAL mask AS uint )
LOCAL lvi AS LVITEM
lvi.stateMask = mask
lvi.state = dwState
SendMessage hwndLV, LVM_SETITEMSTATE, i, VARPTR(lvi)
END SUB
' ========================================================================================
' Selects a ListView item.
' Windows does not provide a separate message or function to set the current selection in
' a listview. Instead, it defines item states or LVIS_* values that determine the listview
' item's appearance and functionality. LVIS_FOCUSED and LVIS_SELECTED in particular are
' the states that determine a listview item's selection state.
' Note that the last parameter passed to this macro is a mask specifying which bits are
' about to change. LVIS_FOCUSED and LVIS_SELECTED are defined in commctrl.inc as &H0001
' and &H0002 respectively, so you need to set the last four bits of the mask.
' See the following Microsoft article: How To Select a Listview Item Programmatically
' http://support.microsoft.com/kb/131284
' ========================================================================================
SUB ListView_SelectItem (BYVAL hwndLV AS sys, BYVAL iIndex AS LONG)
ListView_SetItemState(hwndLV, iIndex, LVIS_FOCUSED OR LVIS_SELECTED, &H000F)
END SUB
'==================================
' Display the Listview
Sub DispListView
LV_COLUMN lvc
LV_ITEM lvi
int i , j
string txtStr
' Setup the fonts for the ListView
SendMessage(hListview,%WM_SETFONT,hFont,0)
'Setup the ListView Column Headers
' The first column must have a wider width to accomodate the checkbox
lvc.mask = LVCF_WIDTH or LVCF_ORDER
' Need to add some blanks behind the header string label
' inorder to get a wider column
txtStr="Column #" & str(1) + " "
lvc.pszText = txtStr
lvc.iorder = 0
ListView_InsertColumn(hListview, 0, &lvc)
' All the other columns to have a narrower width
For i = 1 To NumCol
lvc.mask = LVCF_FMT OR LVCF_WIDTH OR LVCF_TEXT OR LVCF_SUBITEM
If i = NumCol then
' Leave the last column header blank as we are NOT putting data
' into this last column ( it act like a buffer )
txtStr = ""
Else
txtStr="Column #" & str(i+1)
txtStr = Trim(txtStr)
End if
lvc.pszText = txtStr
lvc.iorder = i
ListView_InsertColumn(hListview, i, &lvc)
Next i
' Setup the Listview data Rows
For i=1 To NumRow
'First column
lvi.mask = LVIF_TEXT
txtStr = "Row #" & str(NumRow-i+1) ", Col # 1"
lvi.pszText = txtStr
lvi.iSubItem = 0
ListView_InsertItem(hListview, &lvi)
'Remaining columns
for j=2 to NumCol
txtStr = "Row #" & str(NumRow-i+1) ", Col # " & str(j)
lvi.pszText = txtStr
lvi.iSubItem = j-1
ListView_SetItem(hListview, &lvi)
next j
Next i
' Set the column widths according to width of each column header
for i = 0 to NumCol -1
ListView_SetColumnWidth(hListview,i,LVSCW_AUTOSIZE_USEHEADER)
next i
' make the last column a very narrow width as it is only a buffer column
' this would display as a double line
ListView_SetColumnWidth(hListview,NumCol,3)
' Place in the extended style for the listview
sys LVStyleEX = LVS_EX_FULLROWSELECT or LVS_EX_CHECKBOXES or _
LVS_EX_GRIDLINES
SendMessage(hListview, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVStyleEX)
' Shade those unused background portions of the main ListView to Alice Blue
' while the text color is Navy
SendMessage(hListView, LVM_SETTEXTCOLOR, 0,O2c_Navy)
SendMessage(hListView, LVM_SETBKCOLOR, 0,o2c_Alice_Blue)
' Select the first item (ListView items are zero based)
ListView_SelectItem(hListView, 0)
' Set the focus in the ListView
SetFocus hListView
End Sub
'=================================================
' Main callback function
Function DlgProc( hDlg,uint uMsg, sys wParam, lParam ) as sys callback
Select Case uMsg
Case WM_INITDIALOG
' display the program icon
sys hInstance = GetModuleHandle(NULL)
sys hIcon = LoadIcon(hInstance, IDI_Logo)
'Set Icon to Main Window
SendMessage(hDlg, WM_SETICON, ICON_BIG, hIcon)
' Create the font for the Listview
hFont = O2ApiCreateFont("Arial",9, FW_Bold)
' Handle for the ListView
hListview = GetDlgItem(hDlg, IDC_LSV1)
' Display the ListView
DispListView
Case WM_COMMAND
Select Case LOword(wParam)
case IDCANCEL
' exit
DeleteObject(hFont)
DestroyWindow( hDlg )
End Select
Case WM_NOTIFY
NMHDR pnm at lParam
If pnm.hwndFrom = hListview then
' inside the ListView
NM_LISTVIEW LpLvNm at lParam
Select Case pnm.code
Case LVN_COLUMNCLICK
mbox "Column header is clicked"
CASE LVN_ITEMCHANGED
'turn off entire row selection here
' https://forum.powerbasic.com/forum/user-to-user-discussions/programming/774914-add-checkbox-into-a-virtual-listview?p=775009#post775009
NM_LISTVIEW LpLvNm at lParam
@LpLvNm = lParam
ListView_SetItemState hListView, LpLvNm.iItem, 0, LVIS_Focused Or LVIS_Selected
CASE LVN_ITEMCHANGING
FUNCTION = True
CASE NM_CLICK
' click on a cell
NM_LISTVIEW LpLvNm at lParam
@LpLvNm = lParam
CurrentRow = LpLvNm.iiTem + 1
CurrentCol = LpLvNm.iSubItem + 1
printl " Row " CurrentRow " Col " CurrentCol
CASE NM_CUSTOMDRAW
NM_LISTVIEW LpLvNm at lParam
@LpLvNm = lParam
CurrentRow = LpLvNm.iiTem + 1
CurrentCol = LpLvNm.iSubItem + 1
NMLVCUSTOMDRAW PTR lplvcd at lParam
@lplvcd = lParam
SELECT CASE lplvcd.nmcd.dwDrawStage
CASE CDDS_PREPAINT , CDDS_ITEMPREPAINT
FUNCTION = CDRF_NOTIFYSUBITEMDRAW
CASE CDDS_ITEMPREPAINT OR CDDS_SUBITEM
IF lplvcd.nmcd.dwItemSpec = CurrentRow - 1 THEN
IF lpLvCd.iSubItem = CurrentCol - 1 THEN
' highlight the selected row
lpLvCd.clrTextBk = O2c_GREEN
ELSE
lpLvCd.clrTextBk = O2c_WHITE
END IF
END IF
InvalidateRect(hListview, null, true)
' control draws itself
FUNCTION = CDRF_DODEFAULT ' CDRF_NEWFONT
END SELECT
End Select
End If
Case WM_SIZE
RECT rcClient
// Calculate remaining height and size edit
GetClientRect(hDlg, &rcClient)
SetWindowPos(hListview, NULL, 0, rcClient.top, rcClient.right, rcClient.bottom, SWP_NOZORDER)
Case WM_CLOSE
' we need this case otherwise prog remains in memory
If hFont Then
DeleteObject(hFont)
End if
DestroyWindow( hDlg )
Case WM_DESTROY
' we need this case otherwise prog remains in memory
If hFont Then
DeleteObject(hFont)
End if
PostQuitMessage( null )
End Select
' return 0
End Function
'================================================
' Display the Main Dialog
Function DispMainDialog
Sys DlgStyle = WS_OVERLAPPEDWINDOW or DS_CENTER or WS_VISIBLE
Dialog( 10,10,250,250, "Listview Single Cell Selection ", DlgStyle , _
8,"MS Sans Serif" )
' Add in the listview
Sys LVStyle = WS_VISIBLE or WS_TABSTOP or WS_BORDER or LVS_REPORT _
or LVS_SINGLESEL or LVS_EX_DOUBLEBUFFER
CONTROL "",IDC_LSV1,"SysListView32", LVStyle , _
10,10,233,100, WS_EX_CLIENTEDGE
hDlg = CreateModalDialog( 0, @DlgProc, 0 )
End Function
'------------------------------------
' Start of program
init_common_controls()
DispMainDialog
Any ideas Brian ?
as i got the idea from this PB program
'https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/56151-simple-listview-grid-cell-selection?p=675400#post675400
' LV Single cell selection.bas
#COMPILER PBWIN 10
#COMPILE EXE
#DIM ALL
%Unicode=1
#INCLUDE "win32api.inc" 'Jose Roca includes
ENUM Equates SINGULAR
IDC_ListView = 500
END ENUM
GLOBAL hDlg, hListView AS DWORD, SortDirection AS LONG
GLOBAL MaxRow, MaxCol, CurrentRow, CurrentCol, OrigLVProc AS LONG
'==============================
FUNCTION PBMAIN() AS LONG
DIALOG NEW PIXELS, 0, "ListView Cell selection",_
300,300,400,220, %WS_OVERLAPPEDWINDOW TO hDlg
CreateListView
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
'====================================
CALLBACK FUNCTION DlgProc() AS LONG
LOCAL i,j AS LONG
LOCAL lplvcd AS NMLVCUSTOMDRAW PTR
LOCAL LpLvNm AS NM_LISTVIEW PTR
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
'initialize data/location
CreateLVData
CurrentRow = 1 : CurrentCol = 1
UpdateTitleBar
'subclass LV
OrigLVProc = SetWindowLong(hListView, %GWL_WndProc, CODEPTR(NewLVProc))
CASE %WM_DESTROY
SetWindowLong hListView, %GWL_WNDPROC, OrigLVProc
CASE %WM_NOTIFY
SELECT CASE CB.NMID
CASE %IDC_ListView
SELECT CASE CB.NMCODE
CASE %LVN_ITEMCHANGING
FUNCTION = %True
CASE %NM_CLICK
LpLvNm = CB.LPARAM
CurrentRow = @LpLvNm.iiTem + 1
CurrentCol = @LpLvNm.iSubItem + 1
CONTROL REDRAW hDlg, %IDC_ListView
UpdateTitleBar
CASE %NM_CUSTOMDRAW
lpLvCd = CBLPARAM
SELECT CASE @lplvcd.nmcd.dwDrawStage
CASE %CDDS_PREPAINT, %CDDS_ITEMPREPAINT
FUNCTION = %CDRF_NOTIFYSUBITEMDRAW
CASE %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM
IF @lplvcd.nmcd.dwItemSpec = CurrentRow-1 THEN
IF @lpLvCd.iSubItem = CurrentCol-1 THEN
' highlight the selected row
@lpLvCd.clrTextBk = %GREEN
ELSE
@lpLvCd.clrTextBk = %WHITE
END IF
END IF
FUNCTION = %CDRF_NEWFONT
END SELECT
END SELECT
END SELECT
END SELECT
END FUNCTION
'===========================
SUB CreateListView
CONTROL ADD LISTVIEW, hDlg, %IDC_ListView,"", 10,10,380,200, _
%LVS_REPORT OR %WS_TABSTOP OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_CLIENTEDGE
CONTROL HANDLE hDlg, %IDC_ListView TO hListView
LISTVIEW SET STYLEXX hDlg, %IDC_ListView,%LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT OR %LVS_EX_CHECKBOXES
END SUB
'=========================
SUB CreateLVData
LOCAL i,j AS LONG
MaxRow = 50 : MaxCol = 10
FOR i = 1 TO MaxCol
LISTVIEW INSERT COLUMN hDlg, %IDC_ListView, i, "Col" + TRIM$(STR$(i)), 100, 0
NEXT i
FOR i = 1 TO MaxRow
LISTVIEW INSERT ITEM hDlg, %IDC_ListView, i,0, "Row " + TRIM$(STR$(i))
FOR j = 1 TO MaxCol
LISTVIEW SET TEXT hDlg, %IDC_ListView, i, j, "Row" + TRIM$(STR$(i)) + " Col" + TRIM$(STR$(j))
NEXT j
NEXT i
END SUB
'==================
SUB UpdateTitleBar
DIALOG SET TEXT hDlg, "ListView Grid Demo: " + STR$(CurrentRow) + STR$(CurrentCol)
END SUB
'======================
' Subclass ListView procedure
FUNCTION NewLVProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
SELECT CASE Msg
CASE %WM_KEYDOWN
SELECT CASE wParam
CASE %VK_Up
CurrentRow = MAX(1,CurrentRow-1)
UpdateTitleBar
CONTROL REDRAW hDlg, %IDC_ListView
CASE %VK_Down
CurrentRow = MIN(MaxRow,CurrentRow+1)
UpdateTitleBar
CONTROL REDRAW hDlg, %IDC_ListView
CASE %VK_Left
CurrentCol = MAX(1,CurrentCol-1)
UpdateTitleBar
CONTROL REDRAW hDlg, %IDC_ListView
CASE %VK_Right
CurrentCol = MIN(MaxCol,CurrentCol+1)
UpdateTitleBar
CONTROL REDRAW hDlg, %IDC_ListView
CASE %VK_Home
CurrentCol = 1
IF GetKeyState(%VK_Control) THEN CurrentRow = 1
CONTROL REDRAW hDlg, %IDC_ListView
UpdateTitleBar
CASE %VK_End
CurrentCol = MaxCol
IF GetKeyState(%VK_Control) THEN CurrentRow = MaxRow
CONTROL REDRAW hDlg, %IDC_ListView
UpdateTitleBar
END SELECT
END SELECT
FUNCTION = CallWindowProc(OrigLVProc, hWnd, Msg, wParam, lParam)
END FUNCTION
I still havent add stock code for the LISTVIEW statements, but i will give it a try. :)
Hi Brian
please look at my O2ListView.inc it already has all the relevant constants and macros for the listview
i bet that's what you mean by STOCK code ?
Listviews are important components for any viable programing language, i think you should focus your efforts
in developing your Pluribasic IDE on this
Hello Chris, i just got around to finishing the stock code for the listview features used in this example (more are missing).
I had to do other stuff first, besides an issue with CODEPTR + functions was a small speedbump. No changes to the
original code were made, only changed:
#COMPILER PBWIN 10
to:
#COMPILER OXYGEN 1.0
Attached is what PluriBASIC is now generating for the code you posted.
Thanxx Brian
but when i compile it , there's an error at line 378 in GenLv.o2bas ( similar to gen0001.txt)
see the attached files
i'm using the OxygenBasicProgress.zip of Jul 21,2018
maybe that's causes the error ?
The error is probably caused by a version difference, lately Oxygen has been updated.
:)
Hello Brian
I was able to compile and run your code using OxygenBasicProgress.zip of Jan 14 2019.
It is running well in 32bit (uses Rtl32 )
But if i change it to 64bit (uses Rtl64) it will GPF !
so do you have a 64bit version of the code?
[code]
' By Brian
' http://www.jose.it-berater.org/smfforum/index.php?topic=5438.0
' Reply#4
' Note that we cannot compile to rtl64 as the program will GPF
'Generated with PluriBASIC 6.0.123201.0
$ filename "GenLV.exe"
uses rtl32
MACRO _10ONERR(l, e)
Err.err = e
IF (Err.err>0) THEN
Err.ers = Err.erp
Err.erl = l
IF Err.Oe1 THEN
JMP Err.Oe1
ELSEIF Err.Oe2 THEN
CALL Err.Oe2
END IF
else
Err.ers = ""
Err.erl = 0
END IF
END MACRO
MACRO ERRCLEAR
Err.err = 0
Err.erl = 0
Err.ers = ""
END MACRO
CLASS _10SYSERR
public sys Oe1 = 0
public sys Oe2 = 0
public int err = 0
public int erl = 0
public string erp = ""
public string ers = ""
END CLASS
DECLARE function _10InitCommonControlsEx lib "Comctl32.dll" alias "InitCommonControlsEx"
TYPE _10INITCOMMONCONTROLSEX
DWORD dwSize
DWORD dwICC
END TYPE
_10INITCOMMONCONTROLSEX _10ICCE
_10ICCE.dwSize = sizeof(_10INITCOMMONCONTROLSEX)
_10ICCE.dwICC = 0xffff
_10InitCommonControlsEx(&_10ICCE)
TYPE _10RECT
long left
long top
long right
long bottom
END TYPE
DECLARE FUNCTION _10GetParent LIB "USER32.DLL" ALIAS "GetParent" (BYVAL hWnd AS SYS) AS SYS
DECLARE FUNCTION _10GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS SYS) AS SYS
DECLARE function _10GetStockObject lib "GDI32.DLL" alias "GetStockObject"
DECLARE function _10GetSystemMetrics lib "USER32.DLL" ALIAS "GetSystemMetrics"
DECLARE function _10GetDeviceCaps lib "GDI32.DLL" alias "GetDeviceCaps" (byval hdc as sys, byval nIndex as int) as int
DECLARE function _10ReleaseDC lib "USER32.DLL" alias "ReleaseDC" (byval hWnd as sys, byval hDC as sys) as INT
Declare Function _10CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (byval dwExStyle AS INT,byval lpClassName AS STRING,byval lpWindowName AS STRING,byval dwStyle AS INT,byval x AS INT,byval y AS INT,byval nWidth AS INT,byval nHeight AS INT,byval hWndParent AS INT,byval hMenu AS INT,byval hInstance AS INT,byval lpParam AS INT) as INT
Declare Function _10CreateSolidBrush Lib "gdi32.dll" Alias "CreateSolidBrush"(ByVal crColor As INT) As INT
Declare Function _10GetSysColor Lib "user32.dll" Alias "GetSysColor" (ByVal nIndex As INT) As INT
Declare Function _10LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As INT, ByVal lpIconName As Any) As INT
Declare Function _10LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As INT, ByVal lpCursorName As Any) As INT
Declare Function _10GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (int lpModuleName) as SYS
Declare Function _10CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (byval hProc as sys, ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT
Declare Function _10DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT
Declare Function _10DefWindowProcCallBack Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT
Declare Function _10GetSysColor Lib "user32.dll" Alias "GetSysColor" (ByVal nIndex As INT) As INT
Declare Function _10GetDialogBaseUnits LIB "User32.dll" ALIAS "GetDialogBaseUnits" () AS INT
Declare Function _10MulDiv LIB "KERNEL32.DLL" ALIAS "MulDiv" (BYVAL nNumber AS INT, BYVAL nNumerator AS INT, BYVAL nDenominator AS INT) AS INT
Declare Function _10MapDialogRect LIB "user32.DLL" ALIAS "MapDialogRect" (ByVal hWnd As SYS, Byref RC AS _10RECT) AS SYS
Declare Function _10GetDesktopWindow LIB "user32.DLL" ALIAS "GetDesktopWindow" () AS SYS
Declare Function _10GetLastError LIB "Kernel32.DLL" ALIAS "GetLastError" () AS SYS
Declare Function _10FormatMessage LIB "Kernel32.dll" ALIAS "FormatMessageA" (BYVAL dwFlags AS DWORD, BYVAL lpSource AS DWORD, BYVAL dwMessageId AS DWORD, BYVAL dwLanguageId AS DWORD, lpBuffer AS ASCIIZ, BYVAL nSize AS DWORD, BYVAL Arguments AS DWORD) AS DWORD
DECLARE FUNCTION _10CreateDialogIParam LIB "user32.dll" ALIAS "CreateDialogIndirectParamA" (sys hInstance, lpTemplate, hWndParent, lpDialogFunc, lParamInit) as sys
DECLARE SUB _10PostQuitMessage LIB "User32.dll" ALIAS "PostQuitMessage"
DECLARE SUB _10DestroyWindow LIB "User32.dll" ALIAS "DestroyWindow"
DECLARE FUNCTION _10GetDlgItem LIB "User32.dll" ALIAS "GetDlgItem" (BYVAL hDlg AS SYS, BYVAL nIDDlgItem AS sys) AS SYS
DECLARE FUNCTION _10RedrawWindow LIB "User32.dll" ALIAS "RedrawWindow"
DECLARE FUNCTION _10SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD, BYVAL hAddr AS DWORD) AS SYS
DECLARE FUNCTION _10GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS
DECLARE FUNCTION _10SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS
DECLARE FUNCTION _10RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS
'DECLARE FUNCTION _10GetProcessHeap Lib "kernel32.dll" Alias "GetProcessHeap" () As SYS
'DECLARE FUNCTION _10HeapAlloc Lib "kernel32.dll" Alias "HeapAlloc" (ByVal hProc As DWORD, ByVal mMode As dword, byval mSize as DWORD) AS SYS
'DECLARE FUNCTION _10HeapFree Lib "kernel32.dll" Alias "HeapFree" (ByVal hProc As DWORD, ByVal mMode As dword, byval hObj as DWORD) AS SYS
TYPE _10DLGTEMPLATE
dword style
dword eStyle
word cdit
short x
short y
short cx
short cy
END TYPE
_10RECT _10RC
sys _10LPPI = 0
SYS _10HPPA = 0
_10DLGTEMPLATE _10LPDT
_10LPDT.style = 2155872320
_10LPDT.eStyle = 1
_10LPDT.cdit = 0
_10LPDT.x = 1
_10LPDT.y = 1
_10LPDT.cx = 2
_10LPDT.cy = 2
' Create a dummy dialog to retrieve dialog units.
sys _10TODL = _10CreateDialogIParam(_10GetModuleHandle(0), @_10LPDT, _10HPPA, @_10DEFAULT_CALLBACK_PROC, _10LPPI)
_10RC.right = 1
_10RC.bottom = 1
_10MapDialogRect(_10TODL, _10RC) ' returns 0
TYPE _10WNDCLASSEX ' 32 bit headers for use with DIALOG NEW
cbSize as int
Style as int
lpfnwndproc as sys
cbClsextra as int
cbWndExtra as int
hInstance as int
hIcon as int
hCursor as int
hbrBackground as int
lpszMenuName as int
lpszClassName as int
hIconSm AS int
END TYPE
Declare Function _10RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as _10WNDCLASSEX) as INT
_10WNDCLASSEX _10WClass
_10WClass.cbSize = SizeOf(_10WNDCLASSEX)
_10WClass.style = 40
_10WClass.lpfnWndProc = &_10DefWindowProcCallBack
_10WClass.hInstance = _10GetModuleHandle(0)
_10WClass.hIcon = _10LoadIcon(0, ByVal 32512) 'loads an icon for use by the program
_10WClass.hCursor = _10LoadCursor(0, ByVal 32512) 'loads a mouse cursor for use by the program
_10WClass.hbrBackground = _10CreateSolidBrush(_10GetSysColor(15))
_10WClass.lpszMenuName = STRPTR("")
_10WClass.lpszClassName = STRPTR("DDTDialog")
_10WClass.hIConSm = _10LoadIcon(0, ByVal 32512) 'loads an icon for use by the program
Call _10RegisterClassEx(_10WClass) 'registers a window class for the program window
'print _10RC.right " - " _10RC.bottom
TYPE _10MSG
hwnd as int
message as int
wParam as int
lParam as int
time as dword
'part of pointapi.
X as INT
Y as INT
END TYPE
Declare Function _10ShowWindow Lib "user32.dll" Alias "ShowWindow" (ByVal hWnd As INT, ByVal nCmdShow As INT) As INT
Declare Function _10TranslateMessage Lib "user32.dll" Alias "TranslateMessage" (byref lpMsg as _10MSG) as INT
Declare Function _10DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as _10MSG) as INT
Declare Function _10GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As _10MSG, ByVal hWnd As INT, ByVal wMsgFilterMin As INT, ByVal wMsgFilterMax As INT) As INT
DECLARE FUNCTION _10IsWindow LIB "USER32.DLL" ALIAS "IsWindow" (BYVAL hWnd AS DWORD) AS int
DECLARE FUNCTION _10SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT, BYVAL lNewLong AS QUAD) AS INT
DECLARE FUNCTION _10SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS INT) AS INT
DECLARE FUNCTION _10SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT, BYVAL lNewLong AS INT) AS INT
DECLARE FUNCTION _10GetWindowLong LIB "USER32.DLL" ALIAS "GetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT) AS INT
TYPE _10HPROP
long elem
long dmode
sys oldProc
sys curProc
'long user1
'long user2
END TYPE
Function _10DEFAULT_CALLBACK_PROC(sys hwnd, wMsg, wParam, lParam) as sys callback
sys retval = 0
_10HPROP *hdata
_10HPROP *hdat2
sys hWnd2 = 0
CHAR dtt[10] = "DATA" + chr(0)
@hData = _10GetProp(hwnd, byval @dtt)
If @hData Then
if hData.curProc then
if hData.elem = 2 then
Select case wMsg
case 273, 78
sys hControl = _10GetDlgItem(hwnd, loword(wParam))
@hdat2 = _10GetProp(hControl, byval @dtt)
if @hDat2 then
if hDat2.curProc then
retval = _10CallWindowProc(hDat2.curProc, hWnd, wMsg, wParam, lParam)
goto DoneWithNotifications
end if
end if
end select
end if
retval = _10CallWindowProc(hData.curProc, hWnd, wMsg, wParam, lParam)
DoneWithNotifications:
end if
end if
if retval=0 then
if @hData then
if hData.elem = 2 then
IF hData.curProc=0 then
hWnd2 = _10GetParent(hWnd)
@hdat2 = _10GetProp(hWnd2, byval @dtt)
if @hdat2 then
if hdat2.curProc then
retval = _10CallWindowProc(hDat2.curProc, hWnd, wMsg, wParam, lParam)
end if
END IF
END IF
if retval=0 then
retval = _10CallWindowProc(hData.oldProc, hWnd, wMsg, wParam, lParam)
end if
else
retval = _10DefWindowProc(hwnd,wMsg,wParam,lParam)
end if
if wMsg=2 then ' WM_DESTROY
If hData.oldProc then
_10SetWindowLong(hWnd, -4, hData.oldProc)
end if
freememory(@hData)
_10RemoveProp(hWnd, byval @dtt)
end if
else
retval = _10DefWindowProc(hwnd, wMsg, wParam, lParam)
end if
end if
return retval
End Function
' STARTS PLURIBASIC_PREPARE.BIN
' This code is executed before anything else, if you want to do something after defining other things, see PLURIBASIC_INIT
TYPE _10LV_ITEM
mask AS DWORD
iitem AS LONG
isubitem AS LONG
state AS DWORD
statemask AS DWORD
psztext AS ZSTRING PTR
cchtextmax AS LONG
iimage AS LONG
lparam AS LONG
iindent AS LONG
END TYPE
TYPE _10LV_COLUMN
mask AS DWORD
fmt AS LONG
cx AS LONG
pszText AS ZSTRING PTR
cchTextMax AS LONG
iSubItem AS LONG
iImage AS LONG
iOrder AS LONG
cxMin AS LONG
cxDefault AS LONG
cxIdeal AS LONG
END TYPE
macro _01USET(vu, ai, of, dt, nv, ln a, c)
sys a = vu.p(ai) + of
dt c = nv
copy a, @c, ln
end macro
macro _01MSET(vu, of, dt, nv, ln c)
dt c = nv
copy @vu + of, @c, ln
end macro
macro sys_return_data_type_function(nm, dt)
function nm(sys hBuffer, of) as dt
sys a = hBuffer + of
dt r
copy @r, a, sizeof(dt)
return r
end function
end macro
macro sys_return_data_type_func_len(nm, dt)
function nm(sys hBuffer, of) as char*
sys a = (hBuffer + of)
return a
end function
end macro
TYPE _10NMHDR
hwndFrom AS DWORD
idFrom AS DWORD
Code AS LONG
END TYPE
class system_functions
int LRNGN ' Last Random number generated.
int LRNUB ' Last RND upper bound.
int LRNLB ' Last RND lower bound.
' Default UDT member bounds...
function m(int d1) as long {return d1}
function m(int d1, d2) as long {return (d1 * d2)}
function m(int d1, d2, d3) as long {return ((d1 * d2) + d3)}
' Custom UDT member bounds...
' Some ddt functions.
function nmcode(sys cbMsg, lParam) as long
if cbMsg = 78 then
_10NMHDR nh at lParam
return nh.code
end if
end function
function nmhwnd(sys cbMsg, lParam) as long
if cbMsg = 78 then
_10NMHDR nh at lParam
return nh.hwndFrom
end if
end function
function nmid(sys cbMsg, lParam) as long
if cbMsg = 78 then
_10NMHDR nh at lParam
return nh.idFrom
end if
end function
function nmhdr(sys cbMsg, lParam) as sys
if cbMsg = 78 then
return lparam
end if
end function
function nmhdrs(sys cbMsg, lParam) as string
if cbMsg = 78 then
string bs = news(12)
copy strptr(bs), lparam, 12
return bs
end if
end function
function nmhwnd(sys cbMsg, lParam) as sys
end function
' UDT member readers.
sys_return_data_type_function(byt, byte)
sys_return_data_type_function(wrd, word)
sys_return_data_type_function(int, int)
sys_return_data_type_function(lng, long)
sys_return_data_type_function(dwd, dword)
sys_return_data_type_function(qud, quad)
sys_return_data_type_function(ext, extended)
sys_return_data_type_function(cur, extended)
sys_return_data_type_function(cux, extended)
sys_return_data_type_function(sng, single)
sys_return_data_type_function(dbl, double)
sys_return_data_type_func_len(asz, char)
end class
new system_functions _s_f()
' END OF PLURIBASIC_PREPARE.BIN
' STARTS TRIM$.BIN
' STARTS LTRIM$.BIN
// returns a trimed string
FUNCTION LTRIM(string src, long a = 0, string ch = " ") as string
if len(src) = 0 then return ""
if len(ch) = 0 then return ""
byte srcchar at strptr(src)
byte trichar at strptr(ch)
long p1 = 1
long index
long cha
if a then
for index = 1 to len(src)
for cha = 1 to len(ch)
if srcchar[index] = trichar[cha] then
goto checknextchar
end if
next
p1 = index
exit for
checknextchar:
next
return mid(src, p1)
else
for index = 1 to len(src)
for cha = 1 to len(ch)
if srcchar[index+cha-1] <> trichar[cha] then
goto nomorematches
end if
next
p1 += len(ch)
next
nomorematches:
return mid(src, p1)
end if
END FUNCTION
' END OF LTRIM$.BIN
' CONTINUES (1) TRIM$.BIN
' STARTS RTRIM$.BIN
// returns a trimed string
FUNCTION RTRIM(string src, long a = 0, string ch = " ") as string
if len(src) = 0 then return ""
if len(ch) = 0 then return ""
byte srcchar at strptr(src)
byte trichar at strptr(ch)
long p1 = len(src)
long index
long cha
if a then
for index = len(src) TO 1 step -1
for cha = 1 to len(ch)
if srcchar[index] = trichar[cha] then
goto checknextchar
end if
next
p1 = index
exit for
checknextchar:
next
return mid(src, 1, p1)
else
for index = len(src)-len(ch) TO 1 step -1
for cha = 1 to len(ch)
if srcchar[index+cha-1] <> trichar[cha] then
goto nomorematches
end if
next
p1 = index-1
next
nomorematches:
return mid(src, 1, p1)
end if
END FUNCTION
' END OF RTRIM$.BIN
' CONTINUES (2) TRIM$.BIN
// returns a trimed string
FUNCTION TRIM(string inp, long a = 0, string chrs = " ") as string
RETURN RTRIM(LTRIM(inp, a, chrs), a, chrs)
END FUNCTION
' END OF TRIM$.BIN
' STARTS STR$.BIN
' Enter the stock code and functions here.
FUNCTION _STR(double v, long d = 8) as string
long d2 = d-1
if v < 0 then
return str(v, d2)
else
string ss = str(v, d2)
if instr(ss, ".") then
return " " & LTRIM(ss, 0, "0")
else
return " " & ltrim(ss)
end if
end if
END FUNCTION
' END OF STR$.BIN
' STARTS PLURIBASIC_INIT.BIN
' This code is executed before anything else, if you want to do something before nything else, see PLURIBASIC_PREPARE
' END OF PLURIBASIC_INIT.BIN
' STARTS MIN.BIN
//returns the smallest value in the list of values.
FUNCTION MIN(long vl[], n) AS LONG
int i
int r = vl[1]
for i = 2 to n
if vl < r then r = vl
next i
return r
END FUNCTION
' END OF MIN.BIN
' STARTS MAX.BIN
//returns the highest value in the list of values.
FUNCTION MAX(long vl[], n) AS LONG
int i
int r = vl[1]
for i = 2 to n
if vl > r then r = vl
next i
return r
END FUNCTION
' END OF MAX.BIN
' STARTS LOWRD.BIN
def LOWRD ((%1) and 0xffff)
' END OF LOWRD.BIN
' STARTS LISTVIEWSETTEXT.BIN
' Sets the text on a listview cell
SUB LISTVIEWSETTEXT(sys hwnd, int id, crow, ccol, string Expr)
int row = crow
int col = ccol
_10LV_ITEM lvi
if col<1 then col = 1
if col=1 then
lvi.mask = 13 'LVIF_TEXT or LVIF_STATE or lVIF_PARAM
else
lvi.mask = 9 'LVIF_TEXT or LVIF_STATE
end if
lvi.pszText = Expr
lvi.iItem = row-1
lvi.iSubItem = col-1
_10SendMessage(_10GetDlgItem(hwnd, id), 4102, 0, byval @lvi)
END SUB
' END OF LISTVIEWSETTEXT.BIN
' STARTS LISTVIEWSETSTYLEXX.BIN
' Sets the extended styles for a listview
FUNCTION LISTVIEWSETSTYLEXX(sys hwnd, int id, dword xxstyle) AS LONG
_10SendMessage(_10GetDlgItem(hwnd, id), 4150, 0, xxstyle)
END FUNCTION
' END OF LISTVIEWSETSTYLEXX.BIN
' STARTS LISTVIEWINSERTITEM.BIN
' Inserts a new item in a listview
SUB LISTVIEWINSERTITEM(sys hwnd, int id, crow, img, string Expr)
int row = crow
_10LV_ITEM lvi
lvi.stateMask = 1 'LVIF_TEXT
lvi.pszText = Expr
lvi.iItem = row
lvi.iSubItem = 0
if @img then
lvi.iImage = img
end if
lvi.mask = 5 'LVIF_TEXT or LVIF_PARAM
_10SendMessage(_10GetDlgItem(hwnd, id), 4103, 0, byval @lvi)
END SUB
' END OF LISTVIEWINSERTITEM.BIN
' STARTS LISTVIEWINSERTCOLUMN.BIN
' Inserts a new column in a listview.
SUB LISTVIEWINSERTCOLUMN(sys hwnd, int id, col, string Expr, int cWidth, fFormat)
_10LV_COLUMN lvc
lvc.mask = 15 'LVCF_FMT Or LVCF_WIDTH Or LVCF_TEXT Or LVCF_SUBITEM
lvc.pszText = Expr
lvc.fmt = fFormat
lvc.CX = cWidth
lvc.iSubItem = 0
_10SendMessage(_10GetDlgItem(hwnd, id), 4123, 0, byval @lvc)
END SUB
' END OF LISTVIEWINSERTCOLUMN.BIN
' STARTS HIWRD.BIN
def HIWRD(((%1)>>16) and 0xffff)
' END OF HIWRD.BIN
' STARTS DIALOGSETTEXT.BIN
' Sets the caption text for a dialog.
SUB DIALOGSETTEXT(sys hWnd, string sText)
CHAR bctxt[2048] = sText + chr(0)
_10SetWindowText(hWnd, byval @bctxt)
END SUB
' END OF DIALOGSETTEXT.BIN
' STARTS CONTROLREDRAW.BIN
' Redraws a control.
SUB ControlRedraw(sys hWnd, int id)
_10RedrawWindow(_10GetDlgItem(hwnd, id), byval 0, byval 0, 1)
END SUB
' END OF CONTROLREDRAW.BIN
' STARTS CONTROLHANDLE.BIN
' Returns the handle of a control.
SUB CONTROLHANDLE(sys hwnd, long id, byref sys hhandle)
hhandle = _10GetDlgItem(hwnd, id)
return hhandle
END SUB
' END OF CONTROLHANDLE.BIN
' STARTS ASCIIZ.BIN
//Returns a truncated null terminated string.
FUNCTION ____ASCIIZ(string ss, int l) AS STRING
if l < 2 then
return chr(0)
else
return left(ss, l-1) & chr(0)
end if
END FUNCTION
' END OF ASCIIZ.BIN
' STARTS DIALOGSHOW.BIN
Function DialogShow(BYVAL dMode AS LONG, BYVAL hDlg AS SYS, BYVAL hCallback AS DWORD, BYREF Result AS DWORD) AS LONG
Dim wm as _10MSG
dword rr = 0
_10HPROP *hdata
CHAR dtt[10] = "DATA" + chr(0)
@hData = _10GetProp(hDlg, byval @dtt)
If @hData Then
hData.curProc = hCallback
end if
If @hData Then
hData.oldProc = _10GetWindowLong(hDlg, -4)
end if
_10SetWindowLong(hDlg, -4, @_10DEFAULT_CALLBACK_PROC)
_10SendMessage(hDlg, 272, hDlg, 0)
_10ShowWindow(hDlg, 5)
if @Result then
Result = 0
end if
if dMode = 1 then
while _10GetMessage(wm,0,0,0)
rr = _10TranslateMessage(wm)
_10DispatchMessage(wm)
IF _10IsWindow(hDlg) = 0 THEN
if @Result then
Result = rr
end if
EXIT DO
end if
Wend
end if
end function
' END OF DIALOGSHOW.BIN
' STARTS DIALOGNEW.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
' CONTINUES (1) DIALOGNEW.BIN
FUNCTION DialogNew(BYVAL dMode AS LONG, byval hParent AS DWORD, BYVAL sCaption AS STRING, BYREF Xt AS LONG, BYREF Yt AS LONG, BYVAL W AS LONG, BYVAL H AS LONG, BYVAL dStyle AS DWORD, BYVAL exStyle AS DWORD, BYREF Result AS DWORD) AS LONG
' Im clueless, dont ask me.
single ratioX = 1.58
single ratioY = 1.82
'=========================
sys hFont = _10GetStockObject(17)
long DX = 0
long dy = 0
long dw = 0
long dH = 0
SELECT CASE dMode
case 0, 6 ' UNITS.
dw = w * RatioX
dh = h * RatioY
IF @Xt=0 THEN
dx = (_10GetSystemMetrics(0)/2) - (dw/2)
ELSE
dx = Xt * RatioX
END IF
if @Yt=0 then
dy = (_10GetSystemMetrics(1)/2) - (dh/2)
else
dy = Yt * RatioY
end if
case 5 ' PIXELS
if @Xt=0 then
DX = (_10GetSystemMetrics(0)/2) - (w/2)
ELSE
DX = Xt
end if
if @Yt=0 then
dy = (_10GetSystemMetrics(1)/2) - (h/2)
ELSE
dy = Yt
end if
dw = w
Dh = h
case 7 ' DPIAWARE
END SELECT
Result = _10CreateWindowEx(exStyle,_ 'extended styles
"DDTDialog", _ 'window class name
sCaption,_ 'window caption
dStyle,_ 'window style
DX, _ 'initial x position
dy, _ 'initial y position
dw, _ 'initial x size
DH, _ 'initial y size
hParent, _ 'parent window handle
0, _ 'window menu handle
_10GetModuleHandle(0), _ 'program instance handle
0) 'creation parameter
if Result then
_10SendMessage(Result, 48, hFont, 0)
_10HPROP *hdata
@hData = getmemory(SizeOf(_10HPROP))
If @hData Then
hData.elem = 1
hData.dMode = dMode
CHAR dtt[10] = "DATA" + chr(0)
_10SetProp(Result, byval @dtt, @hData)
end if
end if
END FUNCTION
' END OF DIALOGNEW.BIN
' STARTS CONTROLADD.BIN
FUNCTION ControlAdd(string tControl, sys hParent, long cID, string sCaption, long X, Y, W, H, sys dStyle, sys exStyle, sys hCallback) AS sys
int Result
local dMode = 0
sys hDC = _10GetDC(0)
single ratioX = (_10GetDeviceCaps(hDC, 88) / 96)
single ratioY = (_10GetDeviceCaps(hDC, 90) / 96)
_10ReleaseDC(0, hDC)
_10HPROP *hdata
CHAR dtt[10] = "DATA" + chr(0)
@hData = _10GetProp(hParent, byval @dtt)
If @hData Then
dMode = hData.dMode
end if
int dx = X
int dy = Y
int dW = W
int dH = H
SELECT CASE dMode
case 0, 6 ' UNITS.
dw = dw * RatioX
dh = dh * RatioY
dx = dw * RatioX
dy = dy * RatioY
case 5 ' PIXELS
' they are already fine.
case 7 ' DPIAWARE
END SELECT
'int dx = (X * RatioX) * 1.53
'int dy = (Y * RatioY) * 1.7
'int dW = (W * RatioX) * 1.53
'int dH = (H * RatioY) * 1.7
sys defStyle = 1073741824 or 268435456
sys hFont = _10GetStockObject(17)
string tctrl = lcase(Ltrim(rtrim(tControl)))
if tCtrl = "label" then
tCtrl = "Static"
elseif tCtrl = "textbox" then
tCtrl = "Edit"
elseif tCtrl = "listview" then
tCtrl = "SysListView32"
end if
IF dStyle = 0 THEN
dStyle = defStyle
END IF
dStyle = ((dStyle or 1073741824) OR 268435456) ' WS_CHILD, ws_visible always!
Result = _10CreateWindowEx(exStyle,_ 'extended styles
tCtrl, _ 'control class name
sCaption,_ 'control caption
dStyle,_ 'control style
DX, _ 'initial x position
DY, _ 'initial y position
DW, _ 'initial x size
DH, _ 'initial y size
hParent, _ 'parent window handle
cID, _ 'control ID
_10GetModuleHandle(0), _ 'program instance handle
0) 'creation parameter
if Result then
_10SendMessage(Result, 48, hFont, 0)
_10HPROP *hdata
@hData = getmemory(SizeOf(_10HPROP)) ' _10HeapAlloc(_10GetProcessHeap(), 8, SizeOf(_10HPROP))
If @hData Then
hData.elem = 2
hData.oldProc = _10GetWindowLong(Result, -4)
hData.curProc = hCallback
CHAR dtt[10] = "DATA" + chr(0)
_10SetProp(Result, byval @dtt, @hData)
end if
if hCallback then
_10SetWindowLong(Result, -4, @_10DEFAULT_CALLBACK_PROC)
end if
end if
return Result
END FUNCTION
' END OF CONTROLADD.BIN
% TRUE = 1
% VK_CONTROL = 17
% VK_END = 35
% VK_HOME = 36
% VK_LEFT = 37
% VK_UP = 38
% VK_RIGHT = 39
% VK_DOWN = 40
% GWL_WNDPROC = -4
% WM_DESTROY = 2
% WM_NOTIFY = 78
% WM_KEYDOWN = 256
% WM_INITDIALOG = 272
% WS_TABSTOP = 65536
% WS_OVERLAPPEDWINDOW = 13565952
% WS_EX_CLIENTEDGE = 512
% NM_CLICK = -2
% NM_CUSTOMDRAW = -12
% CDRF_NEWFONT = 2
% CDRF_NOTIFYSUBITEMDRAW = 32
% CDDS_PREPAINT = 1
% CDDS_ITEMPREPAINT = 65537
% CDDS_SUBITEM = 131072
% LVS_REPORT = 1
% LVS_SINGLESEL = 4
% LVS_SHOWSELALWAYS = 8
% LVS_EX_GRIDLINES = 1
% LVS_EX_CHECKBOXES = 4
% LVS_EX_FULLROWSELECT = 32
% LVN_ITEMCHANGING = -100
% FD_SETSIZE = 64
% IDC_LISTVIEW = 500
TYPE POINT
INT x
INT y
END TYPE
TYPE LV_ITEM
DWORD mask
INT iitem
INT isubitem
DWORD state
DWORD statemask
CHAR* psztext[255]
INT cchtextmax
INT iimage
INT lparam
INT iindent
END TYPE
TYPE TVITEM
DWORD mask
DWORD hitem
DWORD state
DWORD statemask
CHAR* psztext[255]
INT cchtextmax
INT iimage
INT iselectedimage
INT cchildren
INT lparam
END TYPE
TYPE NMHDR
DWORD hwndfrom
DWORD idfrom
INT code
END TYPE
UNION RECT
INT nleft
INT ntop
INT nright
INT nbottom
INT left
INT top
INT right
INT bottom
END UNION
TYPE NMCUSTOMDRAW
NMHDR hdr
DWORD dwdrawstage
DWORD hdc
RECT rc
DWORD dwitemspec
DWORD uitemstate
INT litemlparam
END TYPE
TYPE NMLVCUSTOMDRAW
NMCUSTOMDRAW nmcd
DWORD clrtext
DWORD clrtextbk
INT isubitem
END TYPE
TYPE NM_LISTVIEW
NMHDR hdr
INT iitem
INT isubitem
DWORD unewstate
DWORD uoldstate
DWORD uchanged
POINT ptaction
INT lparam
END TYPE
' SYSTEM DECLARES FOR ARRAYS
DECLARE FUNCTION CALLWINDOWPROC LIB "User32.dll" ALIAS "CallWindowProcW" (BYVAL P1 AS DWORD, BYVAL P2 AS DWORD, BYVAL P3 AS DWORD, BYVAL P4 AS DWORD, BYVAL P5 AS INT) AS LONG
DECLARE FUNCTION GETKEYSTATE LIB "User32.dll" ALIAS "GetKeyState" (BYVAL P1 AS INT) AS INTEGER
DECLARE FUNCTION SETWINDOWLONG LIB "User32.dll" ALIAS "SetWindowLongW" (BYVAL P1 AS DWORD, BYVAL P2 AS INT, BYVAL P3 AS INT) AS LONG
DECLARE FUNCTION PBMAIN() AS LONG
DECLARE FUNCTION DLGPROC() AS LONG
DECLARE SUB CREATELISTVIEW()
DECLARE SUB CREATELVDATA()
DECLARE SUB UPDATETITLEBAR()
DECLARE FUNCTION NEWLVPROC(BYVAL P1 AS INT, BYVAL P2 AS INT, BYVAL P3 AS INT, BYVAL P4 AS INT) AS LONG
DWORD hdlg
DWORD hlistview
INT sortdirection
INT maxrow
INT maxcol
INT currentrow
INT currentcol
INT origlvproc
' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION PBMAIN() AS INT
INT _05RETVAL = 0
CALL PluriBASIC_Initialize()
_10SYSERR Err
DialogNew(5, 0, "ListView Cell selection", 300, 300, 400, 220, WS_OVERLAPPEDWINDOW, 0, hdlg)
CREATELISTVIEW()
DialogShow(1, hdlg, @DLGPROC, byval 0)
END FUNCTION
PBMAIN() ' invoke entry point
FUNCTION DLGPROC(sys cbhndl, uint cbMsg, sys wParam, sys lParam) as int callback
INT _05RETVAL = 0
_10SYSERR Err
INT i
INT j
NMLVCUSTOMDRAW PTR lplvcd
NM_LISTVIEW PTR lplvnm
INT _SC61 = cbMsg
IF _SC61 = WM_INITDIALOG THEN
CREATELVDATA()
currentrow = 1
currentcol = 1
UPDATETITLEBAR()
origlvproc = SETWINDOWLONG(hlistview, GWL_WNDPROC, (@NEWLVPROC))
ELSEIF _SC61 = WM_DESTROY THEN
SETWINDOWLONG hlistview, GWL_WNDPROC, origlvproc
ELSEIF _SC61 = WM_NOTIFY THEN
INT _SC62 = _s_f.nmid(cbMsg, lParam)
IF _SC62 = IDC_LISTVIEW THEN
INT _SC63 = _s_f.nmcode(cbMsg, lParam)
IF _SC63 = LVN_ITEMCHANGING THEN
_05RETVAL = TRUE
ELSEIF _SC63 = NM_CLICK THEN
@lplvnm = lParam
currentrow = _s_f.lng(@lplvnm, 12) + 1
currentcol = _s_f.lng(@lplvnm, 16) + 1
ControlRedraw(hdlg, IDC_LISTVIEW)
UPDATETITLEBAR()
ELSEIF _SC63 = NM_CUSTOMDRAW THEN
@lplvcd = lParam
DWORD _SC64 = _s_f.dwd(@lplvcd, 0 + 12)
IF _SC64 = CDDS_PREPAINT || _SC64 = CDDS_ITEMPREPAINT THEN
_05RETVAL = CDRF_NOTIFYSUBITEMDRAW
ELSEIF _SC64 = CDDS_ITEMPREPAINT OR CDDS_SUBITEM THEN
IF (_s_f.dwd(@lplvcd, 0 + 36)=currentrow - 1) THEN
IF (_s_f.lng(@lplvcd, 56)=currentcol - 1) THEN
_01MSET(lplvcd, (52), DWORD, 65280, 4)
ELSE
_01MSET(lplvcd, (52), DWORD, 16777215, 4)
END IF
END IF
_05RETVAL = CDRF_NEWFONT
END IF
END IF
END IF
END IF
RETURN _05RETVAL
END FUNCTION
SUB CREATELISTVIEW()
_10SYSERR Err
ControlAdd("listview", hdlg, IDC_LISTVIEW, "", 10, 10, 380, 200, LVS_REPORT OR WS_TABSTOP OR LVS_SHOWSELALWAYS OR LVS_SINGLESEL, WS_EX_CLIENTEDGE, 0)
ControlHandle(hdlg, IDC_LISTVIEW, hlistview)
ListviewSetStylexx(hdlg, IDC_LISTVIEW, LVS_EX_GRIDLINES OR LVS_EX_FULLROWSELECT OR LVS_EX_CHECKBOXES)