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

Listview: User-Friendly replacement for GetOpenFileName

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

  • Listview: User-Friendly replacement for GetOpenFileName

    Code:
    '-------------------------------------------------------------------------------
    '   PB_LVSEL.BAS
    '   03.02.02 Created.
    '   03.03 02.As written, keyboard interface does not work.
    '   03.05.02 Oh, well, I was unable to get the keyboard and mouse interface
    '   working the way I wanted it to, so I wimped out and just handled "available/not available"
    '   by enabling disabling the OK button. Made it a bit more efficient, but I would have
    '   preferred to not allow 'selection' of 'unavailable' files.
    '   PURPOSE: Demonstrate a way to use the Listview Control to present to a user
    '   a list of "all" and "what is currently available."
    '   Essentially, this demo is a "GetOpenFileName" where the user is limited to some
    '   predefined set of files from which to choose, with visual highlighting to indicate
    '   which of those files actually has data to process.
    '   In this demo, the business situation might be that different customers send the
    '   seller files (by FTP, VAN, floppy disk, email, etc), and the seller (user) wants
    '   to select by customer name rather than file name, and only select files if
    '   there is a file available from a customer.
    '   Certainly many users would rather select "Smith Company's file" instead of
    '   "E:\Applications\Data\Customers\batchOE\HYUT54.Dat" ; and sometimes those users
    '   feel better seeing "the whole list" so that they know that "Smith did not
    '   send us any orders today."
    '   TO SET UP THE DEMO: In the procedure GetCustFile, make some of the
    '   files physically present, others not present. You will get an interesting
    '   visual effect.  The demo uses files some of which should be present on
    '   all systems as well as files which probably do not exist.
    '   AUTHOR: Michael Mattias Racine WI
    '   COPYRIGHT: This code placed in the public domain by the author 03/02/02.
    '   BONUS #1: Shows how to use the lparam provided in the listview common control
    '     as well as the parameter available to any dialog created "SDK style".
    '   BONUS #2: Look ma, no GLOBALs!!  VERY ADAPTABLE!!! (Try doing this with DDT!).
    
    #COMPILE EXE
    #DEBUG ERROR ON
    #REGISTER NONE
    #INCLUDE "WIN32API.INC"
    #RESOURCE "PB_LVSEL.PBR"
    
    ' ==== COMMON CONTROLS INCLUDE =============
    '  You can disable support (and code) for the various common controls by
    '  defining the following constants in your code *before* the #INCLUDE  statement.
    ' NOTE THAT THE VALUE DOES NOT HAVE TO BE 1 AS COMMCTRL.INC bases everything on #IF DEF(%NOANIMATE) .. etc
    ' COMPILE STATISTICS 3/27/01 with PB/DLL v 6.0
    ' WITH COMMCTRL.INC, but none of these equates included
    '   Code 21504   RTL 5624  Disk 32768 Memory 8168
    ' WITHOUT COMMCTRL.INC
    '   Code 1488   RTL 4698  Disk 10752 Memory 5298
    ' WITH COMMCTRL.INC, But with all the %NO
    '   Code 3552   RTL 5624  Disk 13312 Memory 6736
    %SKEL_USE_COMMONCONTROL = 1
    ' THESE CONSTANTS MUST BE COMMENTED OUT, NOT SET TO ZERO TO ACTIVATE THE PARTICULAR CONTROL
    #IF %SKEL_USE_COMMONCONTROL
        %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
    ' === END OF COMMON CONTROLS INCLUDE ==========
    
    ' TEXT MESSAGES FROM GETLASTERROR
    DECLARE FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
    FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
      LOCAL Buffer AS ASCIIZ * 255
      FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
      FUNCTION = FORMAT$(ECode, "##### ") & Buffer
    END FUNCTION
    
    ' The listview control in the resource file in dialog "LVSEL"
    %IDSBP_LV  = 101
    ' The record type from which we get the data to present to user
    TYPE CustomerFileType
         CId   AS STRING * 10
         CName AS STRING * 30
         CFile AS ASCIIZ * %MAX_PATH
    END TYPE
    DECLARE FUNCTION GetCustFile (BYVAL hWnd AS LONG, C() AS CustomerFileType) AS LONG
    
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      lpCmdLine           AS ASCIIZ PTR, _
                      BYVAL iCmdShow      AS LONG) AS LONG
    
      LOCAL Stat AS LONG, C AS CustomerFileType, szDlgName AS ASCIIZ * 32,_
      iccex as Init_Common_ControlsEx, szMsgBoxTitle AS ASCIIZ * 64, MsgBoxStyle AS LONG
    
      iccex.dwSize = SIZEOF(iccex)
      iccex.dwICC  = %ICC_LISTVIEW_CLASSES
      InitCommonControlsEx iccex
      szMsgBoxTitle = "Select File By Customer Message"
      msgBoxStyle   = %MB_APPLMODAL OR %MB_ICONINFORMATION
    
      szDlgName = "LVSEL"
    
      Stat = DialogBoxParam (hInstance, szDlgName, GetDesktopWindow, CODEPTR(SelByCustomerDialogProc), BYVAL VARPTR(C))
      IF Stat = -1& THEN
         Stat = GetLastError
         MSGBOX SystemErrorMessageText (Stat),%MB_APPLMODAL OR %MB_ICONSTOP,"Dialog Creation Failed"
      ELSEIF Stat <> 0 THEN  ' user selected something
         MSGBOX "User picked file for " & C.CName & $CRLF & TRIM$(C.CFile), MsgBoxStyle, szMsgBoxTitle
      ELSE
         MSGBOX "User cancelled without selecting a customer/file", MsgBoxStyle,szMsgBoxTitle
      END IF
    
      FUNCTION = 0
    
    END FUNCTION  ' WinMain
    
    ' UNION used to handle the various types of pointers returned by WM_NOTIFY
    UNION LvUnion
       NMHDR  AS NMHDR
       NMLV   AS NMLISTVIEW
       NMIA   AS NMITEMACTIVATE
       LVDI   AS LV_DISPINFO
       LVCD   AS NMLVCUSTOMDRAW
    END UNION
    
    '==================================================================
    ' SelByCustomerDialogProc, DIALOG PROC FOR "Select File By Customer"
    ' RESOURCENAME = "LVSEL"
    ' CALL WITH:   Stat = DialogBoxParam (hInstance, szDlgName, hWndParent, CODEPTR(SelByCustomerDialogProc), BYVAL VARPTR(R))
    ' Parameter is Pointer to a variable of type CustomerFileType.
    '==================================================================
    ' USES: %IDSBP_LV = 101&  to locate the list view control, IDOK, IDCANCEL
    
    ' Define the columns in the listview
    %LV_COL_CUST_ID    = 0
    %LV_COL_CUST_NAME  = 1
    %LV_COL_FILE_DATE  = 2
    %LV_COL_FILE_SIZE  = 3
    %LV_COL_FILE_NAME  = 4
    %LV_COL_MAX = %LV_COL_FILE_NAME
    
    FUNCTION SelByCustomerDialogProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG,_
                      BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    ' created with dialogboxparam; param (lparam of WM_INITDIALOG) = Pointer to CustomerFileRecord
       LOCAL plvu AS LvUnion PTR
       LOCAL szText AS ASCIIZ * %max_Path   ' we re-use this, a lot
       LOCAL I AS LONG, J AS LONG, K AS LONG    ' just counters
      ' for the listview setup
       LOCAL  lvc AS lvcolumn
       LOCAL  lvi AS LvItem
       LOCAL  LvExStyle AS DWORD
       LOCAL  NumRows  AS LONG
       STATIC Cust() AS CustomerFileType
       STATIC PassedParm AS CustomerFileType PTR
       LOCAL w32 as Win32_Find_Data, hSearch AS LONG, szFile AS ASCIIZ * %MAX_PATH
       LOCAL SysTime AS SystemTime, DtFormat AS STRING
       LOCAL DateFormat AS ASCIIZ * 30, TimeFormat AS ASCIIZ * 30, sizeFormat AS ASCIIZ * 12
       LOCAL  hWndLV AS LONG, StateMask AS LONG, CurrentIndex AS LONG
       LOCAL  szDf AS ASCIIZ * 24, szTf AS ASCIIZ * 24  ' date and time formats
    
      SELECT CASE wMSG
         CASE %WM_INITDIALOG
              ' set the extended style of listview control
               passedParm = lparam
               lvExStyle = %LVS_EX_FULLROWSELECT OR %LVS_EX_LABELTIP OR %WS_EX_STATICEDGE
               I = SendDlgItemMessage (hWnd, %IDSBP_LV, %LVM_SETEXTENDEDLISTVIEWSTYLE, lvExStyle, lvExStyle)
               ' Load the customer file
               REDIM Cust(0) 'so we can put the stuff in the listview
               I = GetCustFile(hWnd, Cust()) ' load the file to elements 1-UBOUND
               ARRAY SORT Cust(1)  ' alpha by ID
               ' NOTE: Array is DIMed with LBOUND of ZERO, but actual data
               ' are located in elements 1 through UBOUND
               ' set up the listview.
                 ' we are going to use NM_CUSTOMDRAW so we can print "not found files"
                 ' in grayed video. LOWRD(lparam) tells us if the file exists for this customer.
                 ' Will disable ability to select if file not found
              ' add the column headers to the listview control
              ' initialize the column structure and set the column headers
                lvc.mask =  %LVCF_FMT OR %LVCF_TEXT OR %LVCF_WIDTH
                lvc.pszText = VARPTR(szText)
                lvc.iSubItem = 0
                lvc.iImage =   0
                lvc.iOrder =   0
                FOR I = 0 TO %LV_COL_MAX
                  SELECT CASE I
                     CASE %LV_COL_CUST_ID
                          szText = "Customer ID"
                          lvc.fmt = %LVCFMT_LEFT
                          lvc.cx = 120
                     CASE %LV_COL_CUST_NAME
                          szText = "Customer Name"
                          lvc.fmt = %LVCFMT_LEFT
                          lvc.cx = 120
                     CASE %LV_COL_FILE_NAME
                          szText = "File Name"
                          lvc.fmt = %LVCFMT_LEFT
                          lvc.cx = 220
                     CASE %LV_COL_FILE_DATE
                          szText = "File Date and Time"
                          lvc.fmt = %LVCFMT_LEFT
                          lvc.cx = 130
                     CASE %LV_COL_FILE_SIZE
                          szText = "Size"
                          lvc.fmt = %LVCFMT_RIGHT
                          lvc.cx = 70
    
                  END SELECT
                  J = SendDlgItemMessage (hWnd, %IDSBP_LV, %LVM_INSERTCOLUMN, I, BYVAL VARPTR(lvc))
               NEXT I
              ' now add items to control
               NumRows = UBOUND(Cust,1)
               I = SendDlgItemMessage (hWnd, %IDSBP_LV, %LVM_SETITEMCOUNT, NumRows&, 0&)
               szDF = "MM'/'dd'/'yy"     ' the formats in which file date and time are displayed
               szTF = "hh':'mm':'ss tt"
               lvi.pszText = VARPTR(szText)
               FOR I = 0 TO Numrows - 1        ' For each customer row
                    lvi.iItem = SendDlgItemMessage(hWnd, %IDSBP_LV,%LVM_GETITEMCOUNT, 0,0)
                    lvi.lparam = MAKLNG(0&, I+1) ' put arrayindex (item) number in high word of lparam
                    szFile = TRIM$(Cust(I+1).CFile)
                    sizeFormat = ""
                    DateFormat = "File not found"
                    TimeFormat = ""
                   ' if file IS available, make LOWRD of lparam non-zero and get file info
                    IF DIR$(szFile) <> "" THEN
                       lvi.lparam = lvi.lparam + 1
                      ' get formatted date and time
                       hSearch = FindFirstFile(szFile, W32)
                       IF ISTRUE hSearch  THEN  ' the file was found, info is in W32
                          sizeFormat = FORMAT$(W32.nFileSizeLow, "###,###,###")
                          FileTimeToSystemTime W32.ftLastWriteTime, SysTime                                  ' we can use created, written, accessed, will use written
                          GetDateFormat BYVAL %NULL, BYVAL %NULL, SysTime, szDf, DateFormat, SIZEOF (DateFormat)
                          GetTimeFormat BYVAL %NULL, BYVAL %NULL, SysTime, szTF, TimeFormat, SIZEOF (TimeFormat)
                          FindClose hSearch
                       ELSE
                          sizeFormat = "FindFirstFile Failed"
                          DateFormat = "FindFirstFile Failed"
                          TimeFormat = ""
                       END IF
                    END IF  ' if we found a file for this row
                    ' do the columns for this row
                    FOR J = 0 TO %LV_COL_MAX
                        lvi.iSubItem = J
                        SELECT CASE J
                          CASE %LV_COL_CUST_ID
                            szText = TRIM$(Cust(I+1).CId)
                          CASE %LV_COL_CUST_NAME
                            szText = TRIM$(Cust(I+1).Cname)
                          CASE %LV_COL_FILE_NAME
                            szText = TRIM$(Cust(I+1).CFile)
                            ' file name can be real long, so it make make sense to remove path
                            ' or maybe make a separate columns for "folder" and/or "full file name"
                          CASE %LV_COL_FILE_SIZE
                               szText = sizeFormat
                          CASE %LV_COL_FILE_DATE
                               szText = DateFormat & SPACE$(2) & TimeFormat
    
                       END SELECT   ' of column for this row
                       lvi.pszText = VARPTR(szText)
                       IF J = 0 THEN                    ' adding the row, subitem=0
                            lvi.mask = %LVIF_TEXT OR %LVIF_PARAM
                            K = SendDlgItemMessage (hWnd, %IDSBP_LV, %LVM_INSERTITEM, 0, VARPTR(lvi))
                            IF K < 0 THEN
                               MSGBOX "LVM_INSERTITEM FAILURE when I=" & STR$(I)
                            END IF
                       ELSE ' updating the row, subitem > 0
                            lvi.mask = %LVIF_TEXT
                            K = SendDlgItemMessage (hWnd, %IDSBP_LV, %LVM_SETITEM,0, VARPTR(lvi))
                       END IF
                    NEXT J  ' next column
               NEXT I       ' next row
    
               ' when we first start out, there is no item selected, so select item zero
               lvi.StateMask = %LVIS_SELECTED
               lvi.State     = %LVIS_SELECTED
               SendDlgItemMessage hWnd, %IDSBP_LV, %LVM_SETITEMSTATE, 0, BYVAL VARPTR(lvi)
    
              ' END WM_INITDIALOG PROCESSING
              FUNCTION = %TRUE:  EXIT FUNCTION
    
         CASE %WM_COMMAND
    
                   SELECT CASE LOWRD(wParam)
                          CASE %IDOK
                           ' Find currently selected, return true and store Cust Record at passed address
                              GOSUB IDSBP_CurrentSelection
                              IF CurrentIndex > 0 THEN   ' user selected something
                                    ' GPFing on this..FIXED
                                    IF isBadWritePtr (passedparm, SIZEOF(Cust(0))) THEN
                                       MSGBOX "Passedparm is an invalid ptr"
                                    ELSE  ' store customer record at passed address
                                       @passedParm = Cust(CurrentIndex)
                                       EndDialog hWnd, 1
                                    END IF
                                    FUNCTION = %TRUE
                                    EXIT FUNCTION
                               END IF
    
                          CASE %IDCANCEL
                                EndDialog hWnd, 0
                                EXIT FUNCTION
                   END SELECT
         CASE %WM_NOTIFY
                     plvu = lparam
                     SELECT CASE @plvu.nmhdr.idfrom
                       CASE %IDSBP_LV
                            SELECT CASE @plVU.nmhdr.code
                              CASE %LVN_ITEMCHANGED  ' if this is the message for a new 'selected'
                                      IF ISTRUE @plvu.NMLV.uNewState AND %LVIS_SELECTED THEN
                                        EnableWindow GetDlgITem (hwnd, %IDOK), ISTRUE LOWRD(@plvu.NMLV.lparam)
                                      END IF
                                      EXIT FUNCTION
                                     'save in case I need..
                                     'CASE %NM_RCLICK        ' NMHDR
                                    ' CASE %NM_SETFOCUS      ' NMHDR
                               CASE  %NM_CUSTOMDRAW  ' returns LVCD ( *NMLVCUSTOMDRAW)
                                  ' We handle the text color in all cases.
                                  SELECT CASE @plvu.LVCD.nmcd.dwDrawStage
                                     CASE %CDDS_PREPAINT            ' tell Windows we want to be notified for each item
                                           SetWindowLong hWnd, %DWL_MSGRESULT, %CDRF_NOTIFYITEMDRAW
                                           FUNCTION = 1
                                           EXIT FUNCTION
                                     CASE %CDDS_ITEMPREPAINT
                                         If ISTRUE LOWRD(@plvu.LVCD.nmcd.lItemlParam) THEN ' we have a file
                                               @plvu.LVCD.clrtext = %BLACK
                                               @plvu.LVCD.clrtextBk = %WHITE
                                               SetWindowLong hWnd, %DWL_MSGRESULT, %CDRF_NEWFONT
                                               FUNCTION = 1
                                         else
                                               @plvu.LVCD.clrtext = %LTGRAY
                                               @plvu.LVCD.clrtextBk = %WHITE
                                               SetWindowLong hWnd, %DWL_MSGRESULT, %CDRF_NEWFONT
                                               FUNCTION = 1
                                         END IF
                                     
                                   END SELECT
                                   EXIT FUNCTION
    
                         END SELECT  ' of code when WM_NOTIFY is for %IDSBP_LISTVIEW
    
               END SELECT ' of control ID idfrom for WM_NOTIFY
    
       END SELECT     ' of wMSG
       FUNCTION = %FALSE
       EXIT FUNCTION
    
    IDSBP_CurrentSelection:
    ' Used on IDOK to find which item is selected.
    ' returns CurrentIndex = current selection (1 based). If no selection, returns 0 (but that
    ' should never happen).
     LOCAL JJ AS LONG, KK AS LONG
         hWndLV = GetDlgItem(hWnd, %IDSBP_LV)
         numRows = SendMessage(HwndLV,%LVM_GETITEMCOUNT, 0, 0)
         CurrentIndex = 0
         lvi.isubitem = 0                       ' get base record
         lvi.mask = %LVIF_STATE OR %LVIF_PARAM  ' we need state and lparam
         lvi.statemask = %LVIS_SELECTED         ' we are only interested in selected status
         FOR KK = 0 TO numRows -1               ' convert to zero-based index
              lvi.iitem = KK
              JJ = SendMessage(HwndLV, %LVM_GETITEM, 0, BYVAL VARPTR(lvi))
              IF ISTRUE JJ THEN
                IF ISTRUE (lvi.State AND %LVIS_SELECTED) THEN  ' this is the selected item
                   IF ISTRUE LOWRD(lvi.lParam) THEN            ' is a file available?
                      CurrentIndex = HIWRD(lvi.lparam)         ' get the array index
                   END IF
                   EXIT FOR
                END IF
              END IF
        NEXT KK
        RETURN
    
    
    END FUNCTION
    
    FUNCTION GetCustFile (BYVAL hWnd AS LONG, C() AS CustomerFileType) AS LONG
    ' returns LONG, number of Customer records loaded.
    ' This procedure would be replaced by something which would load the
    ' real data from a file or database
    
     LOCAL nITEMS AS LONG, I AS LONG, J AS LONG
    
     nItems = DATACOUNT \ 3   ' three pieces data per item
     REDIM C (nItems)         ' resize the array for actual data
     J = 1                    ' where the DATA read pointer is at
     FOR I = 1 to nItems
         C(I).Cid = READ$(J)
         INCR J
         C(I).CName = READ$(J)
         INCR J
         C(I).CFile = READ$(J)
         INCR J
     NEXT
     FUNCTION = nItems
     EXIT FUNCTION
    
    
    ' DATA FORMAT:
    ' custId, Custname, CustFileName
    DATA EDGAR004,"Edgar Bergen", "C:\windows\command.com"
    DATA CHARL002, "Charlie McCarthy", "C:\So_whats_on_your_mind.bub"
    DATA ABER0001, Abercrombie,"C:\Here-we-go-loop-de-lie.txt"
    DATA BARNES02, Barnes & Noble, "C:\Here-we-go-loop-de-loop.txt"
    DATA CARR0010, Carruthers Brothers, "C:\config.sys"
    DATA DOGGY004, Lassie,"C:\autoexec.bat"
    END FUNCTION
    
    #IF 0
    
    // PB_LVSEL.RC
    // AUTHOR: Michael Mattias Racine WI
    // Resource Script accompanying program PB_LVSEL
    #include "resource.h"
    
    #define IDSBP_LV   101
    
    LVSEL DIALOG 20,20,410,250
    STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION |WS_BORDER
    CAPTION " Select Order File by Customer"
    FONT 8, "MS Sans Serif"
    BEGIN
        CONTROL         "", IDSBP_LV, "SysListView32", LVS_REPORT |LVS_SINGLESEL|WS_VISIBLE |LVS_SHOWSELALWAYS|LVS_NOSORTHEADER, 4, 4, 400, 210
        CONTROL         "OK"    , IDOK,     "Button", WS_TABSTOP, 151, 226, 40, 14
        CONTROL         "Cancel", IDCANCEL, "Button", WS_TABSTOP, 221, 226, 40, 14
    END
    
    #ENDIF
    ------------------
    Michael Mattias
    Racine WI USA
    [email protected]

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

  • #2
    please see http://www.powerbasic.com/support/pb...ad.php?t=18845


    ------------------
    lance
    powerbasic support
    mailto:[email protected][email protected]</a>
    Lance
    mailto:[email protected]

    Comment

    Working...
    X