how to highlight a single cell in a listview

[Chris Chancellor]

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

Code Select Expand




'  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






[Chris Chancellor]

Any ideas Brian ?

as i got the idea from this PB program

Code Select Expand


'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


[Brian Alvarez]

I still havent add stock code for the LISTVIEW statements, but i will give it a try.

[Chris Chancellor]

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

[Brian Alvarez]

 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:

Code Select Expand

#COMPILER PBWIN 10

to:

Code Select Expand

#COMPILER OXYGEN 1.0

Attached is what PluriBASIC is now generating for the code you posted.

[Chris Chancellor]

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 ?

[Brian Alvarez]

 The error is probably caused by a version difference, lately Oxygen has been updated.

[Chris Chancellor]

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 = 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)