Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Simple Report Viewer Using Listview Control

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Simple Report Viewer Using Listview Control

    Code:
    '-------------------------------------------------------------------------------
    '   RPTVIEW1.BAS
    '   Demo of listview control with text callback to show a report.
    '   Creates font, too
    '   As written, needs a GLOBAL or STATIC array containing the text,
    '   but that would not be too hard to change.
    '   AUTHOR: Michael Mattias Racine WI
    '   USE AND DISTRIBUTION
    '    Placed in public domain by author 11/23/02
    '   HISTORY
    '   10/07/01 for PB.DLL 6.0
    '   11/23/02 Migrate to PB/WIN 7.0 and clean up source code, add comments, etc.
    '-------------------------------------------------------------------------------
    #COMPILE EXE
    #DEBUG ERROR ON
    #REGISTER NONE
    '#RESOURCE GOES HERE IF USED
    '===[Windows API Header Files]=========================================
    '  If you don't need all of the functionality supported by these APIs
    '  (and who does?), you can selectively turn off various modules by putting
    '  the following constants in your program BEFORE you #include "win32api.inc":
    '
    '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
    '  %NOMMIDS = 1   ' no Multimedia ID definitions
    '
    %NOMMIDS  = 1
    #INCLUDE "WIN32API.INC"
    %SKEL_USE_COMMONCONTROL = 1
    #IF %SKEL_USE_COMMONCONTROL
    ' THE '%NOxxx' EQUATES MUST BE COMMENTED OUT - NOT SET TO ZERO - TO ACTIVIATE THE PARTICULAR CONTROL
        %NOANIMATE       = 1
        %NOBUTTON        = 1
        %NOCOMBO         = 1
        %NODATETIMEPICK  = 1
        %NODRAGLIST      = 1
        %NOHEADER        = 1
        %NOHOTKEY        = 1
        %NOIMAGELIST     = 1
        %NOPIADDRESS     = 1
        %NOLIST          = 1
       ' %NOLISTVIEW      = 1
        %NOMONTHCAL      = 1
        %NONATIVEFONTCTL = 1
        %NOPAGESCROLLER  = 1
        %NOPROGRESS      = 1
        %NOREBAR         = 1
        %NOSTATUSBAR     = 1
        %NOTABCONTROL    = 1
        %NOTOOLBAR       = 1
        %NOTOOLTIPS      = 1
        %NOTRACKBAR      = 1
        %NOTREEVIEW      = 1
        %NOUPDOWN        = 1
       #INCLUDE "COMMCTRL.INC"
    #ENDIF
    '==============================================================
    ' UNION used for WM_NOTIFY handling from all Listview controls
    '==============================================================
     UNION LvUnion
        NMHDR  AS NMHDR
        NMLV   AS NMLISTVIEW
        NMIA   AS NMITEMACTIVATE
        LVDI   AS LV_DISPINFO
        LVCD   AS NMLVCUSTOMDRAW
        NMLVK  AS NMLVKEYDOWN
     END UNION
    ' === END OF COMMON CONTROLS INCLUDE ==========
    DECLARE FUNCTION ReportFont (BYVAL hwndLv AS LONG) AS LONG
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      lpCmdLine           AS ASCIIZ PTR, _
                      BYVAL iCmdShow      AS LONG) AS LONG
    
      LOCAL  Msg         AS tagMsg
      LOCAL  wcex        AS WndClassEx
      LOCAL  szAppName   AS ASCIIZ * 80
      STATIC szMenuName  AS ASCIIZ * 80
      LOCAL  hWnd         AS LONG
      
      LOCAL iccex AS Init_Common_ControlsEx
            iccex.dwSize = SIZEOF(iccex)
            iccex.dwICC  = %ICC_LISTVIEW_CLASSES
            InitCommonControlsEx iccex
      szAppName          = "rptView"
      szMenuName         = ""
      wcex.cbSize        = SIZEOF(wcex)
      wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
      wcex.lpfnWndProc   = CODEPTR( WndProc )
      wcex.cbClsExtra    = 0
      wcex.cbWndExtra    = 0
      wcex.hInstance     = hInstance
      wcex.hIcon         = LoadIcon( 0&,  BYVAL %IDI_ASTERISK )
      wcex.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
      wcex.hbrBackground = GetStockObject( %WHITE_BRUSH )
      wcex.lpszMenuName  = VARPTR (szMenuName)
      wcex.lpszClassName = VARPTR(szAppName )
      wcex.hIconSm       = LoadIcon( 0&, BYVAL %IDI_ASTERISK )
      RegisterClassEx wcex
      ' Create a window using the registered class
      hWnd = CreateWindowEx(0&, szAppName, _               ' window exStyle and class name
                          "ListView Report Viewer Demo Using Text Callbacks", _     ' window caption
                          %WS_OVERLAPPEDWINDOW, _    ' window style
                          %CW_USEDEFAULT, _          ' initial x position
                          %CW_USEDEFAULT, _          ' initial y position
                          %CW_USEDEFAULT, _          ' initial x size
                          %CW_USEDEFAULT, _          ' initial y size
                          %NULL, _                   ' parent window handle
                          %NULL, _                   ' window menu handle
                          hInstance, _               ' program instance handle
                          BYVAL %NULL)               ' creation parameters
    
      ' Display the window on the screen
      ShowWindow hWnd, iCmdShow
      UpdateWindow hWnd
      ' Main message loop:
      WHILE GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
      WEND
      FUNCTION = msg.wParam
    END FUNCTION  ' WinMain
    
    FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                      BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    
      LOCAL hDC       AS LONG
      LOCAL LpPaint   AS PaintStruct
      LOCAL R         AS Rect
      LOCAL Stat AS LONG, I AS LONG, J AS LONG
      LOCAL szText   AS ASCIIZ * %MAX_PATH
      ' listview support
      LOCAL lvStyle AS DWORD, lvExStyle AS DWORD, hWndLv AS LONG
      LOCAL plvu AS LvUnion PTR
      LOCAL sText AS STRING
      LOCAL  lvc AS lvcolumn
      LOCAL  lvi AS LvItem, lvWidth AS LONG
      STATIC LVID AS LONG
             lvid = 101     '<<< ID FOR LISTVIEW CONTROL
    
      SELECT CASE AS LONG wMsg   ' MUST USE 'AS LONG' WITH WIN7 & LISTVIEWS!
    
        CASE %WM_CREATE
             ' create a listview control as a child of this window
               lvStyle   = %WS_CLIPSIBLINGS OR %WS_CHILDWINDOW OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_NOSORTHEADER OR %DS_SETFONT
               lvExStyle = %WS_EX_CLIENTEDGE OR %LVS_EX_FULLROWSELECT
               ' Size and locate this window based on the current size of the parent window
         '      LOCAL cx AS LONG, cy AS LONG, fWidth AS LONG, fheight AS LONG
               GetClientRect hWnd, R
               hWndLv = CreateWindowEx( lvExStyle, _              ' any extended style bits
                          "syslistview32", _               ' window class name
                          "Listview", _                  ' window caption
                           lvStyle, _                     ' window style
                           0, _                     ' initial x position
                           0, _                     ' initial y position
                          R.nright - R.nleft + 1, _                        ' initial x size
                          r.nBottom - r.ntop + 1, _                        ' initial y size
                          hWnd, _                        ' parent window handle
                          Lvid, _         ' window menu handle or ID ; the first menu is the "main" menu
                          GetWindowLong(hWnd, %GWL_HINSTANCE), _               ' program instance handle
                          BYVAL %NULL)               ' creation parameters (which I might need? via subclass?)
    
              IF hWndLv = 0 THEN
                 MSGBOX "CreateWindowExFailed"
              END IF
             ' Set LV extended style:
             SendMessage hWndLv,%LVM_SETEXTENDEDLISTVIEWSTYLE, lvExStyle, lvExStyle
             lvWidth = 800   ' could figure out exactly with GetTextExtent AFTER setting the font...
             ' ===================================================
             ' add the columns and column headers to the listview
             ' ===================================================
             ' initialize the column structure and set the column headers
             lvc.mask        =  %LVCF_FMT OR %LVCF_TEXT OR %LVCF_WIDTH
             lvc.pszText     = VARPTR(szText)
             lvc.cchTextMax  = SIZEOF(szText) - 1
             lvc.iSubItem    = 0
             lvc.iImage      = 0
             lvc.iOrder      = 0
             szText          = "This is the header text of the report listview"
             lvc.fmt         = %LVCFMT_LEFT
             lvc.cx          = lvWidth
             J = SendMessage (hWndLv,%LVM_INSERTCOLUMN, 0, BYVAL VARPTR(lvc))
             IF J <> 0 THEN
                MSGBOX "Insert Column Header Failed "
             END IF
             ' Create the report lines for the demo
             LOCAL pRL AS ASCIIZ PTR * 136, nRL AS LONG
             nRL = 1000   ' << number of report lines for demo (actually, -1)
             stext = STRING$(133, "X") + "4"
             REDIM RL (nRL) AS STATIC ASCIIZ * 136
             FOR I = 0 TO nRL
                 MID$(sText, 50) = "This is actual report line #" & FORMAT$(I, " ##### ")
                 RL(I) = sText
             NEXT I
            ' set the item count for the listview, as this is more efficient when adding stuff
             nRL = UBOUND(RL,1) - LBOUND(RL,1) + 1
             I = SendMessage(hWndLv, %LVM_SETITEMCOUNT, nRl, 0&)
            ' use callbacks for label text to keep the control's space usage to a minimum.
            ' this means we must process the WM_NOTIFY/LVN_GETDISPINFO message
            ' lparam will be ASCIIZ pointer to the text for this item
             lvi.mask    = %LVIF_TEXT  OR %LVIF_PARAM   '
             lvi.pszText = %LPSTR_TEXTCALLBACK       ' for all columns, we supply the text..
             pRL = VARPTR(Rl(0))                     ' we start with item zero
             FOR I = 0 TO nRL -1
                lvi.iItem  = I
                lvi.lparam = pRL
                J          = SendMessage (hWndLv,%LVM_INSERTITEM, 0, BYVAL VARPTR(lvi))
                IF J < 0 THEN
                    MSGBOX "Insert Item Failed for #" & STR$(I)
                END IF
                INCR pRL
             NEXT I
             ' Change the font to fixed for any report
             STATIC hFont AS LONG    ' static so I can delete it
             hFont = ReportFont (HwndLv)
             IF ISTRUE hFont THEN
                SendMessage hWndLv, %WM_SETFONT, hFont, %TRUE
             ELSE
                MSGBOX "Create our own font failed"
             END IF
    
             FUNCTION = 0: EXIT FUNCTION
    
         CASE %WM_SIZE
              ' resize the listview to fit our client area unless isIconic
              IF ISFALSE isIconic(hWnd) THEN
                  GetClientRect Hwnd, R
                  MoveWindow GetDlgItem(hWnd, lvid), 0,0, R.nRight - R.nLeft + 1, r.nBottom -r.ntop + 1, %TRUE
                  FUNCTION = 0: EXIT FUNCTION
              END IF
    
         CASE %WM_NOTIFY
                plvu = lparam
                SELECT CASE AS LONG @plvu.nmhdr.idfrom
                     CASE LvId                  ' notify message from the listview control
                         SELECT CASE AS LONG @pLVU.NMHDR.Code
                                  ' CASE %LVN_COLUMNCLICK      ' pointer is to NM_LISTVIEW
                                 '  CASE %LVN_ITEMACTIVATE     ' pointer is to NMITEMACTIVATE                             MSGBOX "COLUMN CLICK on column " & STR$(@pLvu.NMLV.iSubITem)
                                 '  CASE %NM_CLICK             ' pointer is to NMITEMACTIVATE
                                 '  CASE %NM_DBLCLK            ' pointer is to NMITEMACTIVATE
                                 '  CASE %NM_RCLICK
                                 '  CASE %NM_SETFOCUS          ' NMHDR
                             CASE  %LVN_GETDISPINFO    ' returns LVDI
                                  IF ISTRUE (@plvu.LVDI.item.mask AND %LVIF_TEXT) THEN  ' it wants text
                                      @plvu.LVDI.item.pszText     = @plvu.LVDI.item.lparam  ' return pointer to text
                                  END IF    ' if this is a trip wanting text
                                  FUNCTION = 0: EXIT FUNCTION
                         END SELECT  ' of which message the listview control is sending
               END SELECT ' of control ID for WM_NOTIFY
               
        CASE %WM_DESTROY
          deleteobject hFont
          PostQuitMessage 0
          FUNCTION = 0
          EXIT FUNCTION
    
       END SELECT
    
      FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
    
    END FUNCTION
    
    FUNCTION ReportFont (BYVAL hwndLv AS LONG) AS LONG
     ' returns: handle to a font
     ' if zero, function failed
     ' what I want is Courier New fixed pitch, 8 pt high but condensed
     LOCAL nHeight AS LONG, nWidth AS LONG, nEscapement AS LONG, nOrientation AS LONG, _
           fdwCharset AS LONG, _
           fnWeight AS LONG, fdwItalic AS LONG, fdwUNderLine AS LONG, fdwStrikeOut AS LONG, _
           fdwOutputPrecision AS LONG, _
           fdwClipPrecision   AS LONG, _
           fdwQuality         AS LONG, _
           fdwPitchAndFamily  AS LONG,_
           lpszFace           AS ASCIIZ * 48
     LOCAL PointSizeHeight AS LONG, HDc AS LONG, hFont AS LONG
           PointSizeHeight  = 10
           hDC = GetDc(hwndLv)
           nHeight       =  -MulDiv(PointSizeHeight, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
           nWidth        =  nHeight * .5    ' guess
           nEscapement   = 0
           nOrientation  = 0
           fnWeight      = %FW_NORMAL
           fdwItalic     = %FALSE
           fdwUnderline  = %FALSE
           fdwStrikeout  = %FALSE
           fdwCharset    = %ANSI_CHARSET
           fdwOutputPrecision = %OUT_DEFAULT_PRECIS
           fdwClipPrecision   = %CLIP_DEFAULT_PRECIS
           fdwQuality         = %DEFAULT_QUALITY
           lpszFace           = "Courier New"
          ' lpszFace           = "Terminal"
          ' lpszFace           = "MS Sans Serif"  ' no good at 10, .5 PROPORTIONAL FONT
          ' terminal is proportional
          ' courier new, point 8, w= height * .5 is pretty good
          ' Ditto point 10 is OK, too. Need to narrow and/or LIMIT the size of the column to 135??
           hFont = CreateFont(nHeight,_
                              nWidth, _
                              nEscapement,_
                              nOrientation,_
                              fnWeight,_
                              fdwItalic,_
                              fdwUnderline,_
                              fdwStrikeOut,_
                              fdwCharSet,_
                              fdwOutputPrecision,_
                              fdwClipPrecision,_
                              fdwQuality,_
                              fdwPitchAndFamily,_
                              lpszFace)
    
      IF ISTRUE hDc THEN
         ReleaseDc hWndLv, hDc
      END IF
      FUNCTION = hFont
    END FUNCTION
    
    ' ** END OF FILE **


    [This message has been edited by Michael Mattias (edited November 23, 2002).]
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    update only. see detailed comments in programming forum at
    http://www.powerbasic.com/support/pb...ad.php?t=21430

    Code:
    '-------------------------------------------------------------------------------
    '   RPTVIEW3.BAS
    '   Report/File Viewer using ListView Control
    '   Author: Michael Mattias Racine WI USA
    '   Use and Distribution: Placed in the public domain by the author 5/29/05; author expressly waives any claim
    '   of copyright or patent available.
    '
    '   COMPILER    : PowerBASIC compiler for Windows version 7.02
    '   WIN32API.INC: May 9 2002
    '   COMMCTRL.INC: April 8 2002
    '   HISTORY
    '   10/07/01 for PB.DLL 6.0 as RPTVIEW1
    '   11/23/01 Migrate to PB/WIN 7.0 and clean up source code, add comments, etc.
    '   01/04/03 Try to add "greenbar" background image...using bitmap set background. Failed.
    '   05/15/05 As RPTVIEW3, add greenbar using NM_CUSTOMDRAW. Works terrific.
    '   05/29/05 Big upgrade to create 'postable' demo.
    '     add: if filename received on command line, load it, else prompt for it.
    '          status bar
    '          keyboard interface
    '          column for line numbers
    '          eliminate all globals and statics
    '          Handle unix or pc-delimited files transparently
    '          compile time option to preserve or discard blank lines
    '     clean up: source code (a lot).
    '-------------------------------------------------------------------------------
    #COMPILE   EXE
    #DEBUG     ERROR ON
    #REGISTER  NONE
    
    '#RESOURCE GOES HERE IF USED
    '===[Windows API Header Files]=========================================
    '  If you don't need all of the functionality supported by these APIs
    '  (and who does?), you can selectively turn off various modules by putting
    '  the following constants in your program BEFORE you #include "win32api.inc":
    '
    '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
    '  %NOMMIDS = 1   ' no Multimedia ID definitions
    '
    %NOMMIDS  = 1
    #INCLUDE "WIN32API.INC"
    ' COMMON CONTROLS
    ' THE '%NOxxx' EQUATES MUST BE COMMENTED OUT - NOT SET TO ZERO - TO ACTIVATE THE PARTICULAR CONTROL
        %NOANIMATE       = 1
        %NOBUTTON        = 1
        %NOCOMBO         = 1
        %NODATETIMEPICK  = 1
        %NODRAGLIST      = 1
        %NOHEADER        = 1
        %NOHOTKEY        = 1
        %NOIMAGELIST     = 1
        %NOPIADDRESS     = 1
        %NOLIST          = 1
       ' %NOLISTVIEW      = 1
        %NOMONTHCAL      = 1
        %NONATIVEFONTCTL = 1
        %NOPAGESCROLLER  = 1
        %NOPROGRESS      = 1
        %NOREBAR         = 1
    '    %NOSTATUSBAR     = 1
        %NOTABCONTROL    = 1
        %NOTOOLBAR       = 1
        %NOTOOLTIPS      = 1
        %NOTRACKBAR      = 1
        %NOTREEVIEW      = 1
        %NOUPDOWN        = 1
       #INCLUDE "COMMCTRL.INC"
    
    ' to use OpenFileDialog we need this for definition of OPENFILENAME stucture
    #INCLUDE "COMDLG32.INC"
    ' OpenFileDialog with an explorer-style hook we use to center the window when it appears
    ' Same exact parameter string as used by 'OpenFileDialog'
    FUNCTION OpenFileDialogCentered (BYVAL hWnd AS DWORD, _   ' parent window
                             BYVAL Caption AS STRING, _       ' caption
                             Filespec AS STRING, _            ' filename
                             BYVAL InitialDir AS STRING, _    ' start directory
                             BYVAL Filter AS STRING, _        ' filename filter
                             BYVAL DefExtension AS STRING, _  ' default extension
                             Flags AS DWORD _                 ' flags
                            ) AS LONG
    
        LOCAL Ofn            AS OPENFILENAME
        LOCAL szFile         AS ASCIIZ * %MAX_PATH
        LOCAL szFileTitle    AS ASCIIZ * %MAX_PATH
        LOCAL szInitialDir   AS ASCIIZ * %MAX_PATH
        LOCAL szTitle        AS ASCIIZ * %MAX_PATH
        LOCAL szDefExt       AS ASCIIZ * %MAX_EXT
    
        REPLACE "|" WITH CHR$(0) IN Filter
    
        IF LEN(InitialDir) = 0 THEN
            InitialDir = CURDIR$
        END IF
    
        szInitialDir = InitialDir
        szFile       = Filespec
        szDefExt     = DefExtension
        szTitle      = Caption
    
        ofn.lStructSize      = SIZEOF(ofn)
        ofn.hWndOwner        = hWnd
        ofn.lpstrFilter      = STRPTR(Filter)
        ofn.nFilterIndex     = 1
        ofn.lpstrFile        = VARPTR(szFile)
        ofn.nMaxFile         = SIZEOF(szFile)
        ofn.lpstrFileTitle   = VARPTR(szFileTitle)
        ofn.nMaxFileTitle    = SIZEOF(szFileTitle)
        ofn.lpstrInitialDir  = VARPTR(szInitialDir)
        IF LEN(szTitle) THEN
            ofn.lpstrTitle   = VARPTR(szTitle)
        END IF
        ofn.Flags            = Flags
        ' -------------------------------------------------------------------------------------
        ' Since callback (hook proc) is an explorer-style hook proc, we must set the OFN_ENABLEHOOK
        ' flag **and** must use the Explorer Style flag...and when using a hook proc you must
        ' set the OFN_ENABLESIZING flag or or the dialog will not be resizable.
        ' So make sure those flags are set...regardless of what got sent in....
        ' -------------------------------------------------------------------------------------
        ofn.flags            = ofn.flags OR %OFN_EXPLORER OR %OFN_ENABLEHOOK OR %OFN_ENABLESIZING
        '.. and set the callback procedure
        ofn.lpfnhook         = CODEPTR(OpenFileDialog_CenterProc)
        ofn.lpstrDefExt      = VARPTR(szDefExt)
    
        FUNCTION             = GetOpenFilename(ofn)
    
        Filespec             = szFile
        Flags                = ofn.Flags   ' << presumably this is returned only so user can test
                                           ' if read-only was checked and is not checking the
                                            ' ENABLEHOOK, ENABLESIZING or EXPLORER bits.
    
    END FUNCTION
    
    ' ExplorerStyle hook: hWnd [in] is handle to a child window of the dialog; that is, hDLG = GetParent(hWnd)
    FUNCTION OpenFileDialog_CenterProc (BYVAL hWnd AS LONG, BYVAL uMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    
        LOCAL rdw  AS RECT, rDlg AS RECT
    
        SELECT CASE AS LONG uMSG
    
              CASE %WM_INITDIALOG
                  ' return: 0 to allow default proc to handle.
                  ' center the window on the desktop and make sure it's on top:
    
                   GetClientRect GetDesktopWindow, Rdw
                   GetWindowRect GetParent(hWnd), rDlg
                  ' I "suppose"  I could make this dialog bigger here if I wanted;
                  ' the default size is kind of small
                  ' but simply making the dialog bigger does not resize the rest of the controls
                  ' and the dialog looks pretty darn crummy that way
    
                   SetWindowPos GetParent(hWnd),_
                                %HWND_TOP,_
                               ((rDW.nright   - rDW.nleft + 1) - (rDlg.nright - rDlg.nleft +1)) \2, _
                               ((rDw.nBottom  - rDW.nTop + 1) - (rDlg.nbottom - rDlg.nTop + 1)) \ 2, _
                                %NULL, _
                                %NULL, _
                                %SWP_NOSIZE             ' zorder and location parameters are valid
    
    
                  FUNCTION = 0  ' allow default processing to occur, too.
    
         END SELECT  ' of uMSG
    
    END FUNCTION
    
    
    ' useful stuff
    MACRO Redraw_Off (hCtrl)
      SendMessage hCtrl, %WM_SETREDRAW, %FALSE, 0&
    END MACRO
    MACRO Redraw_On (hCtrl)
      SendMessage hCtrl, %WM_SETREDRAW, %TRUE, 0&
    END MACRO
    
    ' ---------------------------------------
    ' GET HEIGHT OF A LISTVIEW ROW
    ' Assumes all rows are the same height.
    ' ---------------------------------------
    FUNCTION Listview_GetItemHeight (BYVAL hWnd AS LONG) AS LONG
    
     LOCAL R AS RECT, nRowDisplayed AS LONG, cy AS LONG
    
     nRowDisplayed           = Listview_getCountPerPage(hWnd)
     GetClientRect             hWnd, R
     cy                      = R.nBottom - R.nTop
     FUNCTION               =  cy\nRowDisplayed    ' integer divide to truncate rather than round..
                                                   ' better to page 'one too few' than 'one too many' lines
    
    END FUNCTION
    
    ' returns: true if file selected and filename is in szFile
    FUNCTION GetUserFile (szFile AS ASCIIZ * %MAX_PATH) AS LONG
    
     LOCAL hWnd AS LONG, caption AS STRING, filespec AS STRING, InitialDir AS STRING, filter AS STRING, _
           defextension AS STRING, flags AS DWORD
     LOCAL iret AS LONG
    
      hWnd         =  GetDesktopWindow()
      caption      =  "Greenbar Viewer - Select File to View"
      Filespec     =  "*.*"
      InitialDir   =  ""
      Filter       =  ""
      DefExtension =  ""
      Flags        =  %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY
    
      iRet      = OpenFiledialogCentered (hwnd, Caption, filespec, InitialDir, Filter, defextension, flags)
      IF ISTRUE   iret THEN
          szFile  = FileSpec
      ELSE
          szFile  = ""
      END IF
    
    FUNCTION    = iRet
    
    END FUNCTION
    '==============================================================
    ' UNION used for WM_NOTIFY handling from Listview control
    '==============================================================
     UNION LvUnion
        NMHDR  AS NMHDR
        NMLV   AS NMLISTVIEW
        NMIA   AS NMITEMACTIVATE
        LVDI   AS LV_DISPINFO
        LVCD   AS NMLVCUSTOMDRAW
        NMLVK  AS NMLVKEYDOWN
     END UNION
    ' === END OF COMMON CONTROLS INCLUDE ==========
    
    ' ===[ PROGRAM CONSTANTS] ==========================================
    
    ' ===[ COMPILE TIME OPTION TO REMOVE OR PRESERVE BLANK LINES IN VIEWED FILE] =====
    %PRESERVE_BLANK_LINES  =  %TRUE   ' false removes blank lines
    
    '==[ WINDOW/CONTROL IDs AND OTHER REQUIRED CONSTANTS] ====
    %ID_LV          = 101&    ' listview for text display
    ' columns of the listview
    %COL_TEXT       =   0&    ' although this will appear on the right, column zero must be a left-justified col
    %COL_LINE_NO    =   1&
    %COL_MAX        =   1&
    
    %ID_STATUSBAR   =  102&    ' status bar for showing info
    
    ' Until my new feature suggestion to allow equates to take the form of %COLOR_WHATEVER= RGB(red, blue, green)
    ' we are stuck with using a MACRO or a FUNCTION to get the R,G,B colors somewhere in the source code where they
    ' can be tweaked without digging thru the code. Or, I could do this using a 4 byte hex string in the form
    ' "00bbggrr' except convering decimal (which is what my color selector gives me) to hex on the fly is not my strong suit.
    MACRO m_Color_greenBar    =  RGB (156,247,169)
    
    
    DECLARE FUNCTION ReportFont (BYVAL hwndLv AS LONG) AS LONG
    
    ' -----------------------------------
    ' PROGRAM ENTRY POINT
    ' -----------------------------------
    
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      BYVAL lpCmdLine           AS ASCIIZ PTR, _
                      BYVAL iCmdShow      AS LONG) AS LONG
    
      LOCAL  Msg         AS tagMsg
      LOCAL  wcex        AS WndClassEx
      LOCAL  szClass     AS ASCIIZ * 80
      LOCAL  hWnd        AS LONG
      LOCAL  szWindowText AS ASCIIZ * %MAX_PATH
    
    
      LOCAL iccex AS Init_Common_ControlsEx
            iccex.dwSize = SIZEOF(iccex)
            iccex.dwICC  = %ICC_LISTVIEW_CLASSES OR %ICC_BAR_CLASSES
            InitCommonControlsEx iccex
    
      LOCAL szFilename AS ASCIIZ  * %MAX_PATH, iRet AS LONG
    
    
      '-----------------------------------------------
      ' Don't do anything unless user specifies a file, either by command-line parameter or by
      ' selecting a file from an openfiledialog
      ' ---------------------------------------------
    
      szFilename        = @lpCmdLine
      IF lstrLen(szFileName) = 0 THEN            ' no param (passed filename)
          iret   = GetUserFile (szFilename)      ' so prompt the user
          IF ISFALSE iret THEN                   ' he canceled..
              EXIT FUNCTION
          END IF
      ELSE                                       ' we got something on command line
          IF LEN(DIR$(szFileName)) = 0 THEN      ' but can we  find a file by that name?
              MSGBOX "File '" & szFilename & "' not found'", %MB_ICONHAND OR %MB_TASKMODAL, "Command Line Error"
              EXIT FUNCTION
          END IF
    
      END IF
    
      ' if we get this far, the file to be viewed is in szFileName and we need our window, so....
      ' ...register our window class...
    
      szClass            = "greenbar_report_viewer_class"
      wcex.cbSize        = SIZEOF(wcex)
      wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
      wcex.lpfnWndProc   = CODEPTR( WndProc )
      wcex.cbClsExtra    = 0
      wcex.cbWndExtra    = 0
      wcex.hInstance     = hInstance
      wcex.hIcon         = LoadIcon( BYVAL %NULL,  BYVAL %IDI_ASTERISK )
      wcex.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
      wcex.hbrBackground = GetStockObject( %WHITE_BRUSH )
      wcex.lpszMenuName  = %NULL  '   no menu here
      wcex.lpszClassName = VARPTR(szClass)
      wcex.hIconSm       = LoadIcon( 0&, BYVAL %IDI_ASTERISK )
      RegisterClassEx wcex
      ' ..create the main application window using that registered class...
      szWindowText       = "ListView File Viewer Demo Using Text Callbacks and Greenbar Effect"
      hWnd = CreateWindowEx(0&, szClass,  _               ' window exStyle and class name
                          szWindowText , _               ' window caption/Control text
                          %WS_OVERLAPPEDWINDOW, _    ' window style
                          %CW_USEDEFAULT, _          ' initial x position
                          %CW_USEDEFAULT, _          ' initial y position
                          %CW_USEDEFAULT, _          ' initial x size
                          %CW_USEDEFAULT, _          ' initial y size
                          %NULL, _                   ' parent window handle
                          %NULL, _                   ' window menu handle
                          hInstance, _               ' program instance handle
                          BYVAL VARPTR (szFilename)) ' creation parameters ==> pointer to szFilename
    
      ' .. Display the window on the screen....
      ShowWindow hWnd, iCmdShow
      UpdateWindow hWnd
      ' .. and go sit in a message loop until a quit message is posted
      WHILE GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
      WEND
      FUNCTION = msg.wParam
    END FUNCTION  ' WinMain
    
    
    
    FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                      BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    
      LOCAL R         AS Rect, I AS LONG, J AS LONG
      LOCAL szText    AS ASCIIZ * %MAX_PATH
      LOCAL szClass   AS ASCIIZ * 64
      LOCAL hCtrl     AS LONG
    
      LOCAL lvStyle AS DWORD, lvExStyle AS DWORD, hWndLv AS LONG
      LOCAL plvu AS LvUnion PTR
      LOCAL  lvc AS lvcolumn
      LOCAL  lvi AS LvItem
      LOCAL  hFont AS LONG
      ' statusbar support
      LOCAL  sbht AS LONG
      ' to process the parameter
      LOCAL pCreateStruct AS CREATESTRUCT PTR, pszFilename AS ASCIIZ PTR
      ' to process the file load, data filtering and text display
      LOCAL psz AS ASCIIZ PTR, hGlobal AS LONG, lstr AS LONG
      LOCAL iRow AS LONG, iCol AS LONG
      LOCAL wFileData AS STRING, hFile AS LONG
      LOCAL inText AS LONG
      LOCAL pSRC AS BYTE PTR , iChar AS LONG, nchar AS LONG, nRL AS LONG
      LOCAL pDATA AS DWORD, dwOffset AS DWORD
      ' keyboard handling
      LOCAL iTopIndex AS LONG, nRowperPage AS LONG, iLineHeight AS LONG, nRowToScroll AS LONG
      LOCAL ColOrder () AS LONG
    
      ' ===[ END DIM START CODE]=======
    
    
      SELECT CASE AS LONG wMsg   ' MUST USE 'AS LONG' WITH WIN7 & LISTVIEWS AND MY VERSION OF COMMCTRL.INC!
    
        CASE %WM_CREATE
             ' get passed file name so we can load it and show it in the header control
             pCreateStruct  = lparam
             pszFilename    = @pCreateStruct.lpCreateParams
    
             ' create a StatusBar control
             szClass      = $STATUSCLASSNAME
             lvStyle      = %WS_CHILD OR %WS_VISIBLE OR %CCS_BOTTOM OR %SBARS_SIZEGRIP
             lvExStyle    = %NULL
    
             hCtrl        = CreateWindowEx (lvExStyle, szClass, "", lvStyle, %NULL, %NULL, %NULL, %NULL, _
                            hWnd, %ID_STATUSBAR, GetWindowLong (hWnd, %GWL_HINSTANCE), BYVAL %NULL)
             IF hCtrl = %NULL THEN
                 MSGBOX "CreateWindowEx for Status bar control failed"
             END IF
    
    
             ' create a listview control
              szClass      = $WC_LISTVIEW
              lvStyle      = %WS_CLIPSIBLINGS OR %WS_CHILDWINDOW OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_NOSORTHEADER OR %DS_SETFONT OR %WS_TABSTOP
              ' lvExStyle in CreateWindowEx is only for "WS_EX_" styles; "LVS_EX_" styles are set
              ' with the LVM_SETEXTENDEDLISTVIEWSTYLE message.
              lvExStyle    = %WS_EX_CLIENTEDGE
               ' get area of window to fit..  (gets resized anyway)
               GetClientRect hWnd, R
               hWndLv = CreateWindowEx( lvExStyle, _              ' any extended style bits
                          szClass, _                              ' window class name
                          "", _                                   ' window text (listview does not use)
                           lvStyle, _                             ' window style
                           1, _                                   ' initial x position
                           1, _                                   ' initial y position
                           R.nright - R.nleft -2, _               ' initial x size
                           r.nBottom - r.ntop -2, _               ' initial y size
                           hWnd, _                                ' parent window handle
                           %ID_LV, _                              ' window menu handle or child ID
                           GetWindowLong(hWnd, %GWL_HINSTANCE), _ ' program instance handle
                           BYVAL %NULL)                           ' creation parameters
    
              IF hWndLv = 0 THEN
                 MSGBOX "CreateWindowEx for listview control failed"
              END IF
             ' Set LV extended style:
             lvExStyle                           = %LVS_EX_INFOTIP   ' using %LVS_EX_BORDERSELECT screws up painting..
             Listview_SetExtendedListviewStyleEx   hWndLv, lvExStyle, lvExStyle
    
             ' ===================================================
             ' add the columns and column headers to the listview
             ' ===================================================
             ' insert column zero, the text
             lvc.mask        =  %LVCF_FMT OR %LVCF_TEXT OR %LVCF_WIDTH OR %LVCF_SUBITEM OR %LVCF_ORDER
             lvc.pszText     = VARPTR(szText)
             lvc.cchTextMax  = SIZEOF(szText) - 1
             lvc.iSubItem    = %COL_TEXT
             lvc.iImage      = 0
             lvc.iOrder      = %COL_TEXT
             szText          = "File:" & @pszFileName
             lvc.fmt         = %LVCFMT_LEFT
             lvc.cx          = 600
             J               = Listview_InsertColumn (hWndLv,%COL_TEXT, lvc)
             IF J < 0 THEN
                MSGBOX "Insert Column Header (text) Failed "
                EXIT FUNCTION
             'ELSE
             '    MSGBOX "Inserted Text column as col" & STR$(J)
             END IF
             ' add a column for the line number
             lvc.mask        =  %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_SUBITEM OR %LVCF_ORDER OR %LVCF_TEXT
             lvc.pszText     = VARPTR(szText)
             lvc.cchTextMax  = SIZEOF(szText) - 1
             lvc.iSubItem    = %COL_LINE_NO
             lvc.iImage      = 0
             lvc.iOrder      = %COL_LINE_NO
             lvc.fmt         = %LVCFMT_RIGHT
             lvc.cx          = 60
             szText          = "Line"
             J               = ListView_insertColumn  (hWndLv, %COL_LINE_NO, lvc)
             IF J < 0 THEN
                MSGBOX "Insert Column Header (line no) Failed "
                EXIT FUNCTION
            ' ELSE
            '     MSGBOX "Inserted Column line no as col " & STR$(J)
             END IF
    
    
             ' -----------------------------------------------------------------------------------
             ' load the file and fix it up
             ' we'll support either PC or unix-delimited files. What we will do is read in the
             ' file and change all CR to space and all LF to $NUL, meaning we can use the offset in the original
             ' file as an ASCIIZ PTR when the control wants text .
             ' Note different handling depending on if we want to preserve blank lines or not
             ' ------------------------------------------------------------------------------------
             ' OK, so I could have done this with filemapping. Sue me.
             hFile   = FREEFILE
             OPEN      @pszFilename FOR BINARY ACCESS READ LOCK SHARED AS hFile BASE=0
             SEEK      hFile, 0&
             nChar   = LOF(hFile)
             GET$      hFile, nChar, wFileData
             CLOSE     hFile
    
             ' put the file data into a memory block
             hGlobal    = GlobalAlloc (%GHND, nChar +1)  ' allow for a extra trailing null since we will be
                                                         ' treating the lines as ASCIIZ string and we may
                                                         ' not get an ending CR or null in input file
             ' save the global handle in user area of this window so we can read it
              'on LVN_GETDISPINFO and free it on WM_DESTROY
             SetWindowLong    hWnd, %GWL_USERDATA, hGlobal
             ' move the file data ...
             pData           = GlobalLock (hGlobal)
             CopyMemory        BYVAL pData, BYVAL STRPTR(wFileData), nChar
            ' we need the pData pointer a few more times in WM_CREATE
            ' which is why we do not free it as soon as we are done here.
    
             ' --------------------------------------------------------------------------------------------
             ' convert all CR to space or null and all LF to null; collect a line count while we are at it
             ' ---------------------------------------------------------------------------------------------
             nRL       = 0            ' number of Report Lines found so far
             inText    = %FALSE       ' not yet, anyway
             pSrc      = pData        ' start at the beginning of the file data
    
             FOR iCHAR = 1 TO nChar
    
               ' if file is PC-delimited we convert CR to space,
               ' we always treat LF as newline
    
                 SELECT CASE AS CONST @pSRC
                     CASE 13?              ' carriage return
                         #IF %PRESERVE_BLANK_LINES
                             @psrc       = &h20      ' change to space
                         #ELSE
                             @psrc          = 0      ' change to null
                         #ENDIF
    
                     CASE 10?              ' line feed, always marks end of a line
                         @pSRC              = 0      ' change to null
    
                         #IF %PRESERVE_BLANK_LINES
                              'we want to preserve blank lines, so lf ALWAYS marks the end of a line
                             INCR nRL
                             InText =     %FALSE
                         #ELSE
                          ' an LF is only a new line if we are currently in a line
                           IF ISTRUE inText THEN
                               INCR nRL                ' we've reached the end of a line
                               InText     = %FALSE
                           END IF
                         #ENDIF
                     CASE ELSE                        ' all other characters are "text"
                         inText         = %TRUE
                 END SELECT
                 INCR pSrc                ' next character
             NEXT
    
             ' our file data is now a series of ASCIIZ Strings, end to end; each 'line'
             ' is separated by one or more CHR$(0). (more will only occur in 'nix-delimited files with blank
             ' lines suppressed).
    
             ' set the status bar text to show total file size and number of lines we will display
             ' also show blank line status
             szText         = USING$ ("###,###,### bytes    ###,### lines ", nChar, nRL)
             szText         = szText & "   Blank lines " & IIF$(%PRESERVE_BLANK_LINES, "included", "removed")
             SetWindowText   GetDlgITem(hWnd, %ID_STATUSBAR), szText
    
            ' Load up the listview. We will store the offset from start of file for each line
            ' as our row lparam.
             Redraw_off (hWndLv) ' so control does not ask for text while loading
    
            ' Set the item count for the listview, as this is more efficient when adding rows
             I              = SendMessage(hWndLv, %LVM_SETITEMCOUNT, nRl, 0&)
    
             lvi.pszText    = %LPSTR_TEXTCALLBACK       ' for all text we want to be notified
             dwOffset       =       0                   ' first string starts at file offset zero (start of the data)
    
             FOR I = 0 TO nRL -1        ' for each line of the report (counted earlier)
                ' insert column zero (the text)
                lvi.mask       = %LVIF_TEXT  OR %LVIF_PARAM   '
                lvi.iItem      = Listview_getITemCount (hWndLv)   ' returns "next"
                lvi.iSubItem   = %COL_TEXT
                lvi.lparam     = dwOffset           ' set parm to offset in file data where current line starts
                J              = Listview_insertItem (hWndLv,lvi)
                IF J < 0 THEN
                    MSGBOX "Insert Item Failed for #" & STR$(I)
                    EXIT FUNCTION
                END IF
                ' length of this line of text?
                psz      =  pData  + dwOffset         '  Asciiz string starts here (start of data+offset)
                lStr     =  lstrLen(@psz)             '  Length of this string(number of characters before next null)
                dwOffset =  dwOffset + lStr           ' advance offset by length of current string
    
               ' .. and advance past any extra nulls (remember, CRLF was converted to space, LF to null),
               ' but only if we are suppressing blank lines. Otherwise just advance to first character
               ' after the null.
    
               #IF %PRESERVE_BLANK_LINES
                  ' we are at the null, so advance one
                   INCR dwOffset
               #ELSE       ' we must advance beyond all consecutive nulls
                ' set byte ptr to the null..
                  pSrc            = pData + dwOffset    ' point at null following current string
                  WHILE @psrc = 0
                       INCR pSrc
                       INCR dwOffset
                  WEND
               #ENDIF
                ' insert column 1 the line number. We'll call back for this one, too.
                lvi.iSubItem  = %COL_LINE_NO
                lvi.mask      = %LVIF_TEXT      ' no param allowed except when subitem=0
                J             = Listview_SetItem (hWndLv, lvi)
    
             NEXT I
    
            ' Change the font in the listview to fixed pitch
             hFont                   = ReportFont (HwndLv)
             IF ISTRUE hFont THEN
                SendMessage hWndLv, %WM_SETFONT, hFont, %TRUE
             ELSE
                MSGBOX "Create our own font failed"
             END IF
    
             ' we can unlock (but not free!) our memory block now
             GlobalUnlock  hGlobal
    
             ' reorder the columns to put line number on the left
             REDIM                           ColOrder (1)
             ColOrder  (0)                =  %COL_LINE_NO
             ColOrder  (1)                =  %COL_TEXT
             Listview_SetColumnOrderArray   (hWndlv, 2&, BYVAL VARPTR(ColOrder(0)))
             ' and let's not forget to re-enable drawing. If you forget this this becomes
             ' a VERY boring demo
             Redraw_on (hWndLv)
    
    
             FUNCTION = 0: EXIT FUNCTION
    
         CASE %WM_SETFOCUS
             ' Don't let this window get focus: if it does set the focus to our listview control
             ' so it gets all keystrokes (which we pick up on WM_NOTIFY/LVN_KEYDOWN).
             SetFocus GetDlgITem(hWnd, %ID_LV)
    
         CASE %WM_SIZE
              ' resize the listview to fit our client area unless minimized
              IF ISFALSE isIconic(hWnd) THEN
                  ' send WM_SIZE to the statusbar so it resizes itself
                  SendDlgItemMessage    hWnd, %ID_STATUSBAR, wMsg, wParam, lparam
                  ' get size of statusbar so we can figure out how big the listview must be
                  GetWindowRect       GetDlgItem(hWnd, %ID_STATUSBAR), R
                  sbht              = R.nBottom - R.nTop
                  ' get available real estate:
                  GetClientRect Hwnd, R
                  ' change bottom of available real estate to subtract status bar at bottom
                  R.nBottom      = R.nBottom - sbht
                  ' fit the listview control in remaining space
                  SetWindowPos   GetDlgItem (hWnd, %ID_LV), %NULL, %NULL, %NULL, R.nRight- R.nLeft -2, R.nBottom - R.nTop -2, %SWP_NOZORDER OR %SWP_NOMOVE
                  ' and autosize the last column (the text) of the listview to fill available control space
                  ListView_SetColumnWidth GetDlgItem(hWnd, %ID_LV), %COL_TEXT, %LVSCW_AUTOSIZE_USEHEADER
                  FUNCTION = 0: EXIT FUNCTION
              END IF
    
         CASE %WM_NOTIFY
                plvu = lparam
                SELECT CASE AS LONG @plvu.nmhdr.idfrom
                     CASE %ID_LV                  ' notify message from the listview control
                         SELECT CASE AS LONG @pLVU.NMHDR.Code
    
                             ' look for navigation keys (up/down arrows and page up/down)
                             CASE %LVN_KEYDOWN      ' lparam = *nmlvkeydown
                                 SELECT CASE AS LONG  @plvu.nmlvk.wVKey
                                     CASE %VK_PRIOR
                                        ' scroll up one page or to top, whichever occurs first
                                         iTopIndex   =  ListView_GettopIndex (@plvu.nmhdr.hwndFrom)
                                         IF iTopIndex = 0 THEN   ' already at top, make noise to wake up the user
                                             MessageBeep  %MB_ICONHAND
                                         ELSE
                                            ' not at top, so we have to back up one pagefull or until row 0 is visible
                                             nRowToScroll    = Listview_GetCountPerPage (@plvu.nmhdr.hWndfrom)
                                             IF iTopIndex - nRowToscroll <  0 THEN  'would scroll too far...
                                                Listview_EnsureVisible  @plvu.nmhdr.hWndFrom, 0&, %FALSE   ' make sure row zero is visible, fully
                                             ELSE
                                                 iLineHeight      =  ListView_getItemHeight (@plvu.nmhdr.hwndFrom)
                                                 Redraw_off         (@plvu.nmhdr.hWndFrom)
                                                 ListView_Scroll     @plvu.nmhdr.hwndfrom, %NULL, -1& * iLineHeight * nRowToScroll
                                                 Redraw_on          (@plvu.nmhdr.hWndFrom)
                                             END IF
    
                                         END IF
                                          FUNCTION = 0
                                          EXIT FUNCTION
    
                                      CASE %VK_NEXT
                                          ' if the last item is visible, no 'down' available
                                          iRow         = Listview_getItemCount (@plvu.nmhdr.hWndfrom) -1  ' index of last row
                                          nRowPerPage  = Listview_GetCountPerPAge (@plvu.nmhdr.hwndFrom)
                                          iTopIndex    = Listview_GetTopIndex (@plvu.nmhdr.hwndFrom)
                                          IF  iTopIndex + nRowPerPage > iRow THEN
                                              ' the last row is already visible, no we tell user via sound
                                              MessageBeep  %MB_ICONHAND
                                          ELSE
                                              IF nRowPerPage + iTopIndex > iRow THEN   ' we'd scroll beyond end
                                                  nRowToScroll =  iRow - iTopIndex     ' so only scroll enough to put last rowp="nbottom
                                              ELSE
                                                  nRowToScroll = nRowPerPage
                                              END IF
                                              iLineHeight      = ListView_getItemHeight (@plvu.nmhdr.hwndfrom)
                                              Redraw_off         (@plvu.nmhdr.hWndFrom)
                                              Listview_Scroll    @plvu.nmhdr.hWndFrom, %NULL, nRowToScroll * iLineHeight
                                              Redraw_on          (@plvu.nmhdr.hWndFrom)
                                          END IF
                                          FUNCTION = 0
                                          EXIT FUNCTION
    
    
                                       CASE %VK_UP
                                         ' if row zero is at top already, nowhere to go!
                                         iTopIndex       =  ListView_GettopIndex (@plvu.nmhdr.hwndFrom)
                                         IF iTopIndex    = 0 THEN       ' already at top
                                             MessageBeep  %MB_ICONHAND
                                         ELSE
                                             ' scroll up one line
                                             iLineHeight      = Listview_getItemHeight (@plvu.nmhdr.hWndFrom)
                                             Listview_scroll    @plvu.nmhdr.hwndFrom, %NULL, -1& * iLineHeight
                                         END IF
                                         FUNCTION = 0
                                         EXIT FUNCTION
    
    
                                      CASE %VK_DOWN
                                          ' if the last item is visible, no 'down' available
                                          iRow         = Listview_getItemCount (@plvu.nmhdr.hWndfrom) -1  ' index of last row
                                          iTopIndex    = Listview_GetTopIndex (@plvu.nmhdr.hwndFrom)
                                          nRowPerPage  = Listview_GetCountPerPAge (@plvu.nmhdr.hwndFrom)
                                          IF  iTopIndex + nRowPerPage >= iRow THEN
                                              ' the last row is already visible, so we just beep
                                              MessageBeep  %MB_ICONHAND
                                          ELSE
                                              iLineHeight      = ListView_getItemHeight (@plvu.nmhdr.hwndfrom)
                                              Listview_Scroll    @plvu.nmhdr.hWndFrom, %NULL, iLineHeight
                                          END IF
                                          FUNCTION = 0
                                          EXIT FUNCTION
    
                                 END SELECT  ' of which virtual key was pressed
                                ' I am going to allow DefWindowPRoc handle this message, too.. we may need that one
                                ' to cause the thumb to move (I think that's right. it works, anyway)
    
    
                             CASE %LVN_ITEMCHANGING
                                     ' Prevent any selection since..
                                     ' A) it looks like hell;  and
                                     ' B) Selecting a row makes no sense on a report
                                     ' C) we have line numbers anyway
    
                                      IF ISTRUE (@plvu.NMLV.uChanged AND %LVIF_STATE)  THEN ' an item's state will change
                                      ' will this item's selected, unselected state changed to selected?
                                           IF ISTRUE (@plvu.nmlv.uNewState AND %LVIS_SELECTED) THEN  ' this is a selection change notify
                                           ' return TRUE to prevent the change
                                             FUNCTION = %TRUE
                                             EXIT FUNCTION
                                           END IF
                                      END IF
    
                             ' ------------------------------------------
                             ' supply the text to be used when requested
                             ' ------------------------------------------
                             CASE  %LVN_GETDISPINFO          ' returns LVDI
                                  IF ISTRUE (@plvu.LVDI.item.mask AND %LVIF_TEXT) THEN  ' does control wants text?
                                       ' does it want the text for the line number or for the actual text of file
                                       IF @plvu.lvdi.item.iSubItem = %COL_TEXT THEN
                                            ' wants the file text,  so get a pointer to the start of the file data
                                             hGlobal       = GetWindowLong(hwnd, %GWL_USERDATA)
                                             pSRC          = GlobalLock (hGlobal)          ' pointer to start of file data
                                            ' add the offset; this will give us pointer to the start of the line to be displayed
                                              psz          = pSrc + @plvu.LVDI.item.lparam
                                             ' Will this line of text fit in the Windows-supplied buffer?
                                             ' I am getting a buffer of about 264 chars, plenty for this demo file
                                             ' but let's be safe, shall we?
                                             IF lStrLen (@psz) > @plvu.LVDI.item.cchTextMax THEN
                                                 ' no it won't. We will truncate the text by only copying what will fit
                                                 CopyMemory   BYVAL @plvu.lvdi.item.pszText, BYVAL psz, @plvu.lvdi.item.cchTextMax -1
                                             ELSE  ' windows=supplied buffer is fine, so just copy the text
                                                 @[email protected]     = @psz
                                              END IF
                                             ' and free the lock
                                              GlobalUnlock hGlobal
                                         ELSEIF @plvu.lvdi.item.iSubItem = %COL_LINE_NO THEN
                                             ' send formatted one-based 'line number" which is row number + 1:
                                              @[email protected]   = FORMAT$(@plvu.lvdi.item.iItem +1, "#,")
                                         END IF  '
                                  END IF    ' if this is a trip wanting text
                                  ' If we really wanted to we could tell Windows to start managing the text
                                  ' but setting the appropriate mask.. but that would result in double-storage
                                  ' of the file data, so we will leave well enough alone.
                                  ' What happens is if you tell Windows to manage the text, it will only ask
                                  ' once for the particular text, the first time it needs it. After that
                                  ' it just uses what you gave it the first time.
                                  FUNCTION = 0: EXIT FUNCTION
    
                            ' ----------------------------------------------------------------------
                            ' Add Greenbar effect when text is painted in the listview
                            ' by making each group of three lines either green or white to form bands
                            ' ----------------------------------------------------------------------
    
                            CASE %NM_CUSTOMDRAW   'lparam = * NMLVCUSTOMDRAW
                                   SELECT CASE AS LONG @plvu.LVCD.nmcd.dwDrawStage
                                     '
                                      CASE %CDDS_PREPAINT      ' Tell Windows we want sep notify for each item. true of all our controls
                                          FUNCTION             =  %CDRF_NOTIFYITEMDRAW
                                          EXIT FUNCTION
                                       ' so when windows notifies us about an item....
                                       CASE %CDDS_ITEMPREPAINT
                                        ' we need to get subitem notifications so we can use different colors
                                        ' for the line number and actual text colums based in column
                                          FUNCTION          = %CDRF_NOTIFYSUBITEMDRAW
                                          EXIT                FUNCTION
    
                                       ' When we get that notification for each subitem,,,
                                       ' ... we set the text and background colors based on which subitem (column)
                                       CASE (%CDDS_SUBITEM OR %CDDS_ITEMPREPAINT)
                                          iRow          = @plvu.lvcd.nmcd.dwItemSpec
                                          icol          = @plvu.lvcd.iSubItem
                                          IF iCol       = %COL_LINE_NO  THEN
                                              ' set the background color to standard gray
                                              @plvu.lvcd.clrtextbk =  %LTGRAY
                                              ' and text itself to blue NOT WORKING!
                                              ' %YELLOW works, looked crummy but it worked
                                              ' %RED works. Looks OK but not much more than that.
                                              ' But %BLUE won't work; Nor will RGB(0,0,&hFF). Mystery!
                                              @plvu.lvcd.clrText   = %RED
                                            ' and tell windows we have a new font
                                              FUNCTION = %CDRF_NEWFONT
                                          ELSEIF icol    = %COL_TEXT  THEN
                                              ' is this row 0-2, 3-5, 6-8, etc???
                                               IF (iRow MOD 6)  < 3 THEN
                                                 ' set the background color to light green "greenbar" flavor
                                                   @plvu.lvcd.clrtextbk =  m_color_greenbar
                                                   @plvu.lvcd.clrtext   =  %BLACK
                                                  ' and tell windows we have a new font
                                                   FUNCTION = %CDRF_NEWFONT
                                               ELSE  ' use the white background
                                                   @plvu.lvcd.clrTextbk  = %WHITE
                                                   @plvu.lvcd.clrtext   =  %BLACK
                                                   FUNCTION = %CDRF_NEWFONT
                                               END IF
    
                                           END IF   ' which subitem (column) is being drawn
    
                                           EXIT FUNCTION
                                    END SELECT   ' of drawstage under NM_CUSTOMDRAW
    
    
                         END SELECT  ' of which message the listview control is sending
               END SELECT ' of control ID for WM_NOTIFY
    
        CASE %WM_DESTROY
          ' delete the font object we created on WM_CREATE
          hFont     =  SendDlgItemMessage (hWnd, %ID_LV, %WM_GETFONT, %NULL, %NULL)
          IF GetObjectType (HFont) <> %OBJ_FONT THEN
              MSGBOX "Did not get font handle from listview correctly",,"WM_DESTROY"
          ELSE
              DeleteObject hFont
          END IF
          ' free our global memory block
          GlobalFree    GetWindowLong (hWnd, %GWL_USERDATA)
          ' and end the program .
          PostQuitMessage 0
          'Technically, Of course, posting a quit message does not end the program, it
          ' simply is the only means to cause GetMessage to return FALSE, which causes a standard
          ' message loop to end.
          FUNCTION = 0
          EXIT FUNCTION
    
       END SELECT
    
      ' and if we have not precluded it by EXIT FUNCTION, pass the message to the Windows default handler.
      FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
    
    END FUNCTION
    
    FUNCTION ReportFont (BYVAL hwndLv AS LONG) AS LONG
     ' returns: handle to a font
     ' if zero, function failed
     ' What I want is Courier New (fixed pitch), condensed (skinnier)
     LOCAL nHeight AS LONG, nWidth AS LONG, nEscapement AS LONG, nOrientation AS LONG, _
           fdwCharset AS LONG, _
           fnWeight AS LONG, fdwItalic AS LONG, fdwUNderLine AS LONG, fdwStrikeOut AS LONG, _
           fdwOutputPrecision AS LONG, _
           fdwClipPrecision   AS LONG, _
           fdwQuality         AS LONG, _
           fdwPitchAndFamily  AS LONG,_
           lpszFace           AS ASCIIZ * 48
     LOCAL PointSizeHeight AS LONG, HDc AS LONG, hFont AS LONG
    
    
     ' to play with point size..
           PointSizeHeight     = 10
           hDC                 =  GetDc(hwndLv)
           nHeight             =  -MulDiv(PointSizeHeight, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
           ' when nHeight < 0
           ' "The font mapper transforms this value into device units and matches its absolute value
           '  against the character height of the available fonts."
           ' set a skinnier width without changing face or size
           'nWidth        =  nHeight * .5    ' guess  ' kind hard to read at .5
           'nWidth        =  nHeight * .6    ' too wide does not fit size 800 listview
           'nWidth        =  nHeight * .55   ' still too wide
           'nWidth        =  nHeight * .52   ' still too wide
           'nWidth        =  nHeight * .50
           nWidth        =  nHeight * .51    ' as good as anything else. we'll go with it
           nEscapement   = 0
    
           nOrientation  = 0
           ' play with font weight...
           'fnWeight      = %FW_NORMAL           ' NORMAL=400 looks a little thin
          ' lets try this a little bolder
           fnweight           = %FW_MEDIUM       ' MEDIUM = 500
          ' fnweight          = %FW_SEMIBOLD     ' SEMIBOLD=DEMIBOLD=600  WAY TOO THICK
           fdwItalic          = %FALSE
           fdwUnderline       = %FALSE
           fdwStrikeout       = %FALSE
           fdwCharset         = %ANSI_CHARSET
           fdwOutputPrecision = %OUT_DEFAULT_PRECIS
           fdwClipPrecision   = %CLIP_DEFAULT_PRECIS
           fdwQuality         = %DEFAULT_QUALITY
           lpszFace           = "Courier New"
          ' lpszFace           = "Arial"          ' Just to see what it looks like..hmm, 'different' applies
          ' lpszFace           = "Terminal"       ' Terminal is proportional
          ' lpszFace           = "MS Sans Serif"  ' PROPORTIONAL FONT
          ' terminal is proportional
          ' courier new, point 8, w= height * .5 is pretty good
           fdwPitchandFamily   =  %FF_SWISS  ' var stroke width, with or without serifs
           hFont = CreateFont(nHeight,_
                              nWidth, _
                              nEscapement,_
                              nOrientation,_
                              fnWeight,_
                              fdwItalic,_
                              fdwUnderline,_
                              fdwStrikeOut,_
                              fdwCharSet,_
                              fdwOutputPrecision,_
                              fdwClipPrecision,_
                              fdwQuality,_
                              fdwPitchAndFamily,_
                              lpszFace)
    
      IF ISTRUE hDc THEN
         ReleaseDc hWndLv, hDc
      END IF
      FUNCTION = hFont
    END FUNCTION
    ' ** END OF FILE **
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Hi Michael;

      I think I found a small bug.

      Instead of:
      FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
      BYVAL hPrevInstance AS LONG, _
      lpCmdLine AS ASCIIZ PTR, _
      BYVAL iCmdShow AS LONG) AS LONG

      Perhaps?
      FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
      BYVAL hPrevInstance AS LONG, _
      BYVAL lpCmdLine AS ASCIIZ PTR, _
      BYVAL iCmdShow AS LONG) AS LONG



      ------------------

      Comment


      • #4
        True, it is a bug.. a bug in the PB/7x compiler.

        "BYVAL x AS ASCIIZ PTR" is PB/8x syntax. This is BROKEN in 7x (compiler will not not accept BYVAL .. AS ASCIIZ PTR).

        But fortunately I included the compiler version in the header area of the source code.

        LATER:
        Found this note in my skeleton program:
        Code:
        '   02/28/05 CHanged Winmain param 3 to "BYVAL" lpScmLine AS ASCIIZ PTR... it works on 7.x, and
        '            this is only situation where BYVAL whatever as ASCIIZ PTR (no length) works in 7x.
        So that bug exists 7x <U>except for</U> any function named "WinMain". Updated code above to include "BYVAL" for param 3 of WinMain




        [This message has been edited by Michael Mattias (edited May 31, 2005).]
        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


        • #5
          Oops, posted in wrong thread...
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment

          Working...
          X