'Generated with PluriBASIC 6.0.123201.0

$ filename "C:\Users\Diamante\Documents\PluriBASIC\projects\ex_listview.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[i] < r then r = vl[i]
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[i] > r then r = vl[i]
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) 
END SUB

SUB CREATELVDATA()
   _10SYSERR Err
   INT i
   INT j
   maxrow = 50
   maxcol = 10
   FOR i = 1 TO maxcol
      ListviewInsertColumn(hdlg, IDC_LISTVIEW, i, "Col" + TRIM(_STR(i, byval 0), byval 0), 100, 0) 
   IterLabel0387:
   NEXT 
   FOR i = 1 TO maxrow
      ListviewInsertItem(hdlg, IDC_LISTVIEW, i, 0, "Row " + TRIM(_STR(i, byval 0), byval 0)) 
      FOR j = 1 TO maxcol
         ListviewSetText(hdlg, IDC_LISTVIEW, i, j, "Row" + TRIM(_STR(i, byval 0), byval 0) + " Col" + TRIM(_STR(j, byval 0), byval 0)) 
      IterLabel0389:
      NEXT 
   IterLabel0388:
   NEXT 
END SUB

SUB UPDATETITLEBAR()
   _10SYSERR Err
   DialogSetText(hdlg, "ListView Grid Demo:  " + _STR(currentrow, byval 0) + _STR(currentcol, byval 0)) 
END SUB

EXTERN
FUNCTION NEWLVPROC(INT _ByValue_hwnd, INT _ByValue_msg, INT _ByValue_wparam, INT _ByValue_lparam) AS INT
   INT _05RETVAL = 0
   _10SYSERR Err
   INT hwnd = _ByValue_hwnd
   INT msg = _ByValue_msg
   INT wparam = _ByValue_wparam
   INT lparam = _ByValue_lparam
   INT _SC65 = msg
   IF _SC65 = WM_KEYDOWN THEN
      INT _SC66 = wparam
      IF _SC66 = VK_UP THEN
         currentrow = MAX(INT {1, currentrow - 1}, countof)
         UPDATETITLEBAR() 
         ControlRedraw(hdlg, IDC_LISTVIEW) 
      ELSEIF _SC66 = VK_DOWN THEN
         currentrow = MIN(INT {maxrow, currentrow + 1}, countof)
         UPDATETITLEBAR() 
         ControlRedraw(hdlg, IDC_LISTVIEW) 
      ELSEIF _SC66 = VK_LEFT THEN
         currentcol = MAX(INT {1, currentcol - 1}, countof)
         UPDATETITLEBAR() 
         ControlRedraw(hdlg, IDC_LISTVIEW) 
      ELSEIF _SC66 = VK_RIGHT THEN
         currentcol = MIN(INT {maxcol, currentcol + 1}, countof)
         UPDATETITLEBAR() 
         ControlRedraw(hdlg, IDC_LISTVIEW) 
      ELSEIF _SC66 = VK_HOME THEN
         currentcol = 1
         IF GETKEYSTATE(VK_CONTROL) THEN
            currentrow = 1
         END IF
         ControlRedraw(hdlg, IDC_LISTVIEW) 
         UPDATETITLEBAR() 
      ELSEIF _SC66 = VK_END THEN
         currentcol = maxcol
         IF GETKEYSTATE(VK_CONTROL) THEN
            currentrow = maxrow
         END IF
         ControlRedraw(hdlg, IDC_LISTVIEW) 
         UPDATETITLEBAR() 
      END IF
   END IF
   _05RETVAL = CALLWINDOWPROC(origlvproc, hwnd, msg, wparam, lparam)
   RETURN _05RETVAL
END FUNCTION
END EXTERN