Tweet
The following code is an example of using classes to wrap around the new PB9 ListView statements and File Open Dialog as well as parsing CSV files.
Not all methods have been tested. Use at your own risk.
CSV_Viewer.zip
Not all methods have been tested. Use at your own risk.
Code:
#PBForms Created
'--------------------------------------------------------------------------------
' CSV_Viewer.bas
'
' Program for viewing CSV files.
' Illustrates use of 3 classes.
'--------------------------------------------------------------------------------
' Created by: Calvin H. Chipman
' Date Created: 05/08/2009
' Last Modified: 05/08/2009
'--------------------------------------------------------------------------------
#Compiler PBWin 9
#Compile Exe
#Dim All
$APP_TITLE = "CSV Viewer"
'--------------------------------------------------------------------------------
' ** Includes **
'--------------------------------------------------------------------------------
#PBForms Begin Includes
#If Not %Def(%WINAPI)
#Include "WIN32API.INC"
#EndIf
#If Not %Def(%COMMCTRL_INC)
#Include "COMMCTRL.INC"
#EndIf
#Include "PBForms.INC"
#PBForms End Includes
#Include "cLV.inc"
#Include "cFileOpenDlg.inc"
#Include "cCSV.inc"
'--------------------------------------------------------------------------------
Global gsFile As String
Global goLV As IListView
'--------------------------------------------------------------------------------
' ** Constants **
'--------------------------------------------------------------------------------
#PBForms Begin Constants
%IDR_ACCELERATOR1 = 103
%DLG_CSVVIEWER = 101
%IDR_MENU1 = 102
%LVIEW = 1001
%MNU_FILE_OPEN = 1002
%MNU_FILE_CLOSE = 1003
%MNU_FILE_EXIT = 1004
#PBForms End Constants
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Declarations **
'--------------------------------------------------------------------------------
Declare Function AttachMENU1(ByVal hDlg As Dword) As Dword
Declare Function AssignAccel(tAccel As ACCELAPI, ByVal wKey As Word, ByVal wCmd _
As Word, ByVal byFVirt As Byte) As Long
Declare Function AttachACCELERATOR1(ByVal hDlg As Dword) As Dword
Declare CallBack Function ShowCSVVIEWERProc()
Declare Function ShowCSVVIEWER(ByVal hParent As Dword) As Long
#PBForms Declarations
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
Function PBMain()
PBFormsInitComCtls (%ICC_WIN95_CLASSES Or %ICC_DATE_CLASSES Or %ICC_INTERNET_CLASSES)
goLV = Class "cListView"
ShowCSVVIEWER %HWND_Desktop
goLV = Nothing
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Menus **
'--------------------------------------------------------------------------------
Function AttachMENU1(ByVal hDlg As Dword) As Dword
#PBForms Begin Menu %IDR_MENU1->%DLG_CSVVIEWER
Local hMenu As Dword
Local hPopUp1 As Dword
Menu New Bar To hMenu
Menu New PopUp To hPopUp1
Menu Add PopUp, hMenu, "&File", hPopUp1, %MF_Enabled
Menu Add String, hPopUp1, "&Open..." + $Tab + "Ctrl+O", %MNU_FILE_OPEN, _
%MF_Enabled
Menu Add String, hPopUp1, "&Close" + $Tab + "Ctrl+F4", %MNU_FILE_CLOSE, _
%MF_Enabled
Menu Add String, hPopUp1, "-", 0, 0
Menu Add String, hPopUp1, "E&xit", %MNU_FILE_EXIT, %MF_Enabled
Menu Attach hMenu, hDlg
#PBForms End Menu
Function = hMenu
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Accelerators **
'--------------------------------------------------------------------------------
#PBForms Begin AssignAccel
Function AssignAccel(tAccel As ACCELAPI, ByVal wKey As Word, ByVal wCmd As Word, _
ByVal byFVirt As Byte) As Long
tAccel.fVirt = byFVirt
tAccel.key = wKey
tAccel.cmd = wCmd
End Function
#PBForms End AssignAccel
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
Function AttachACCELERATOR1(ByVal hDlg As Dword) As Dword
#PBForms Begin Accel %IDR_ACCELERATOR1->%DLG_CSVVIEWER
Local hAccel As Dword
Local tAccel() As ACCELAPI
Dim tAccel(1 To 2)
AssignAccel tAccel(1), Asc("O"), %MNU_FILE_OPEN, %FVIRTKEY Or %FCONTROL Or _
%FNOINVERT
AssignAccel tAccel(2), %VK_F4, %MNU_FILE_CLOSE, %FVIRTKEY Or %FCONTROL Or _
%FNOINVERT
Accel Attach hDlg, tAccel() To hAccel
#PBForms End Accel
Function = hAccel
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** CallBacks **
'--------------------------------------------------------------------------------
CallBack Function ShowCSVVIEWERProc()
Select Case As Long CbMsg
Case %WM_Size
Local rc As RECT
GetClientRect Cb.Hndl, rc
MoveWindow GetDlgItem(Cb.Hndl, %LVIEW), 0, 0, rc.nRight, rc.nBottom, %TRUE
Case %WM_Notify
Select Case Cb.Ctl
Case %LVIEW
Dim pNmLv As NM_LISTVIEW Ptr
pNmLv = Cb.LParam
Select Case @pNmLv.hdr.code
Case %LVN_ColumnClick
goLV.Sort @pNmLv.iSubItem + 1
End Select
End Select
Case %WM_Command
Select Case As Long CbCtl
Case %LVIEW
Case %MNU_FILE_OPEN
FileOpen Cb.Hndl
Case %MNU_FILE_CLOSE
FileClose Cb.Hndl
Case %MNU_FILE_EXIT
Dialog End Cb.Hndl, 0
End Select
End Select
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Dialogs **
'--------------------------------------------------------------------------------
Function ShowCSVVIEWER(ByVal hParent As Dword) As Long
Local lRslt As Long
#PBForms Begin Dialog %DLG_CSVVIEWER->%IDR_MENU1->%IDR_ACCELERATOR1
Local hDlg As Dword
Dialog New hParent, "CSV Viewer", 70, 70, 492, 341, %WS_Popup Or %WS_Border _
Or %WS_DlgFrame Or %WS_ThickFrame Or %WS_SysMenu Or %WS_MinimizeBox Or _
%WS_MaximizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame Or _
%DS_Center Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
%WS_Ex_Windowedge Or %WS_Ex_ControlParent Or %WS_Ex_Left Or _
%WS_Ex_LtrReading Or %WS_Ex_RightScrollbar, To hDlg
Control Add "SysListView32", hDlg, %LVIEW, "SysListView321", 0, 0, 485, 325, _
%WS_Child Or %WS_Visible Or %WS_Border Or %WS_TabStop Or %LVS_Report Or _
%LVS_ShowSelAlways, %WS_Ex_Left Or %WS_Ex_RightScrollbar
AttachMENU1 hDlg
AttachACCELERATOR1 hDlg
#PBForms End Dialog
Dim lStyle As Long
goLV.Init hDlg, %LVIEW
lStyle = goLV.GetStyleEx()
goLV.SetStyleEx lStyle Or %LVS_EX_FULLROWSELECT Or %LVS_EX_GRIDLINES
Dialog Show Modal hDlg, Call ShowCSVVIEWERProc To lRslt
Function = lRslt
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
Function FileOpen(ByVal hDlg As Dword) As Long
Local oFileOpen As IFileOpenDlg
Local sFile As String
Local oCSV As ICSV
oFileOpen = Class "cFileOpenDlg"
oFileOpen.hParent = hDlg
oFileOpen.sTitle = "Select File to Open"
oFileOpen.sFolder = ""
oFileOpen.sFilter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
oFileOpen.sDefExt = "csv"
oFileOpen.lFlags = %OFN_FileMustExist + %OFN_PathMustExist + %OFN_HideReadOnly
sFile = oFileOpen.GetFile()
If Len(sFile) Then
'Load file.
oCSV = Class "cCSV"
If oCSV.Load(sFile) Then
MsgBox "File: " + oCSV.FileName + $Cr + _
"Record Count: " + Format$(oCSV.RecCount) + $Cr + _
"Field Count: " + Format$(oCSV.FldCount) + $Cr + _
"MaxFldLen: " + Format$(oCSV.MaxFldLen)
If LoadData(oCSV) = %FALSE Then
oCSV = Nothing
Exit Function
End If
Else
MsgBox "Failed"
End If
oCSV = Nothing
Dialog Set Text hDlg, $APP_TITLE + " - [" + sFile + "]"
gsFile = sFile
End If
Function = %TRUE
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
Function FileClose(ByVal hDlg As Dword) As Long
If Len(gsFile) Then
goLV.ResetAll
gsFile = ""
Dialog Set Text hDlg, $APP_TITLE
End If
Function = %TRUE
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
Function LoadData(oCSV As ICSV) As Long
Local lRowCnt As Long
Local lColCnt As Long
Local lRow As Long
Local lCol As Long
goLV.ResetAll
lRowCnt = oCSV.RecCount
lColCnt = oCSV.FldCount
If lRowCnt = 0 Or lColCnt = 0 Then
Exit Function
End If
'Add columns.
For lCol = 1 To lColCnt
goLV.InsertColumn lCol, oCSV.GetFld(1, lCol), 100
Next lCol
'Add data.
For lRow = 2 To lRowCnt
For lCol = 1 To lColCnt
If lCol = 1 Then
goLV.InsertItem lRow - 1, oCSV.GetFld(lRow, lCol)
Else
goLV.SetText lRow - 1, lCol, oCSV.GetFld(lRow, lCol)
End If
Next lCol
Next lRow
'Make column widths match data.
For lCol = 1 To lColCnt
goLV.FitColHeader lCol
Next lCol
Function = %TRUE
End Function
'--------------------------------------------------------------------------------
Code:
'--------------------------------------------------------------------------------
' cLV.inc
'
' Class for using the new ListView statements.
' Everything is 1-based instead of 0-based as the original API commands.
'--------------------------------------------------------------------------------
' Created by: Calvin H. Chipman
' Date Created: 05/08/2009
' Last Modified: 05/08/2009
'--------------------------------------------------------------------------------
'Example of Use:
#If 0
#Include "cLV.inc"
Global goLV As IListView
goLV = Class "cListView"
goLV.Init hDlg, %LVIEW
'Other methods go here.
goLV = Nothing
#EndIf
'--------------------------------------------------------------------------------
#Compiler PBWin 9
%LVS_Icon = &H00000000
%LVS_Report = &H00000001
%LVS_SmallIcon = &H00000002
%LVS_List = &H00000003
'Mode Values:
%LV_MODE_ICON = %LVS_Icon
%LV_MODE_REPORT = %LVS_Report
%LV_MODE_SMALLICON = %LVS_SmallIcon
%LV_MODE_LIST = %LVS_List
%LVCFMT_LEFT = &H00000000
%LVCFMT_RIGHT = &H00000001
%LVCFMT_CENTER = &H00000002
'Align Values:
%LV_ALIGN_LEFT = %LVCFMT_LEFT
%LV_ALIGN_RIGHT = %LVCFMT_RIGHT
%LV_ALIGN_CENTER = %LVCFMT_CENTER
'Sort Date Format:
%LB_SORT_DATE_MMDDYYYY = 1
%LB_SORT_DATE_DDMMYYYY = 2
%LB_SORT_DATE_YYYYMMDD = 3
%LB_SORT_DATE_YYYYDDMM = 4
'--------------------------------------------------------------------------------
#If Not %Def(%PROPERTY_MACROS)
%PROPERTY_MACROS = 1
'Property Get must always be directly before Property Set (Paired Set) if using both.
Macro PropGet(PropName, PropType) = Property Get PropName As PropType : Property = PropName : End Property
Macro PropSet(PropName, PropType) = Property Set PropName(ByVal Param As PropType) : PropName = Param : End Property
#EndIf
'--------------------------------------------------------------------------------
Class cListView
Instance mhDlg As Dword
Instance mlID As Long
'Must be placed before Interface.
Class Method Create()
' Do initialization
mhDlg = 0
mlID = 0
End Method
Class Method Destroy()
' Do cleanup
mhDlg = 0
mlID = 0
End Method
Interface IListView
Inherit IUnknown
'------------------------------------------------------------------------
Method Init(ByVal hDlg As Dword, lID As Long)
If hDlg = 0 Or lID = 0 Then
Exit Method
End If
mhDlg = hDlg
mlID = lID
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method IsInit(Optional ByVal sCaption As String) As Long
If mhDlg = 0 Or mlID = 0 Then
MessageBox %HWND_Desktop, "The ListView object has not been initialized.", ByCopy sCaption, %MB_IconInformation
Exit Method
End If
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method DeleteColumn(ByVal lCol As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Delete Column mhDlg, mlID, lCol
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method DeleteItem(ByVal lRow As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Delete Item mhDlg, mlID, lRow
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method Find(ByVal lBeginRow As Long, ByVal sFind As String) As Long
Local lFoundRow As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Find mhDlg, mlID, lBeginRow, sFind To lFoundRow
Method = lFoundRow
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method FindExact(ByVal lBeginRow As Long, ByVal sFind As String) As Long
Local lFoundRow As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Find Exact mhDlg, mlID, lBeginRow, sFind To lFoundRow
Method = lFoundRow
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method FitColContent(ByVal lCol As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Fit Content mhDlg, mlID, lCol
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method FitColHeader(ByVal lCol As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Fit Header mhDlg, mlID, lCol
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetColWidth(ByVal lCol As Long) As Long
Local lWidth As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get Column mhDlg, mlID, lCol To lWidth
Method = lWidth
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetCount() As Long
Local lRowCount As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get Count mhDlg, mlID To lRowCount
Method = lRowCount
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetHeaderText(ByVal lCol As Long) As String
Local sText As String
If me.IsInit() = %FALSE Then Exit Method
ListView Get Header mhDlg, mlID, lCol To sText
Method = sText
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetMode() As Long
'See %LV_MODE_* constants.
Local lMode As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get Mode mhDlg, mlID To lMode
Method = lMode
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetSelCount() As Long
Local lSelCount As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get Selcount mhDlg, mlID To lSelCount
Method = lSelCount
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetSelect(Optional ByVal lBeginRow As Long) As Long
'Finds the next selected row starting at lBeginRow.
Local lSelRow As Long
If me.IsInit() = %FALSE Then Exit Method
If lBeginRow Then
ListView Get Select mhDlg, mlID, lBeginRow To lSelRow
Else
ListView Get Select mhDlg, mlID To lSelRow
End If
Method = lSelRow
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method IsSelected(ByVal lRow As Long, Optional ByVal lCol As Long) As Long
'Specify lCol to test if a subitem is selected.
Local lSelected As Long
If me.IsInit() = %FALSE Then Exit Method
If lCol = 0 Then
lCol = 1
End If
ListView Get State mhDlg, mlID, lRow, lCol To lSelected
Method = lSelected
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetStyleEx() As Long
Local lStyle As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get StyleXX mhDlg, mlID To lStyle
Method = lStyle
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetText(ByVal lRow As Long, ByVal lCol As Long) As String
Local sText As String
If me.IsInit() = %FALSE Then Exit Method
ListView Get Text mhDlg, mlID, lRow, lCol To sText
Method = sText
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetItemData(ByVal lRow As Long) As Long
Local lItemData As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Get User mhDlg, mlID, lRow To lItemData
Method = lItemData
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method InsertColumn(ByVal lCol As Long, ByVal sHeader As String, ByVal lWidth As Long, Optional ByVal lAlign As Long) As Long
'For %LV_MODE_REPORT
'See %LV_ALIGN_* constants.
If me.IsInit() = %FALSE Then Exit Method
ListView Insert Column mhDlg, mlID, lCol, sHeader, lWidth, lAlign
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method InsertItem(ByVal lRow As Long, ByVal sText As String, Optional ByVal lImage As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Insert Item mhDlg, mlID, lRow, lImage, sText
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method Reset() As Long
'Deletes all items, but leaves the columns & column headers.
If me.IsInit() = %FALSE Then Exit Method
ListView Reset mhDlg, mlID
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method ResetAll() As Long
'Deletes all items and deletes columns & column headers also.
Local hLV As Dword
If me.IsInit() = %FALSE Then Exit Method
ListView Reset mhDlg, mlID
'Delete columns.
hLV = GetDlgItem(mhDlg, mlID)
Do While ListView_DeleteColumn(hLV, 0)
Loop
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method Select(ByVal lRow As Long, Optional ByVal lCol As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
If lCol = 0 Then
lCol = 1
End If
ListView Select mhDlg, mlID, lRow, lCol
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetColWidth(ByVal lCol As Long, ByVal lWidth As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set Column mhDlg, mlID, lCol, lWidth
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetHeaderText(ByVal lCol As Long, ByVal sHeader As String) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set Header mhDlg, mlID, lCol, sHeader
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetImage(ByVal lRow As Long, ByVal lImage As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set Image mhDlg, mlID, lRow, lImage
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetImage2(ByVal lRow As Long, ByVal lImage As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set Image2 mhDlg, mlID, lRow, lImage
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetImageList(ByVal hImageList As Dword, ByVal lType As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set ImageList mhDlg, mlID, hImageList, lType
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetMode(ByVal lMode As Long) As Long
'See %LV_MODE_* constants.
If me.IsInit() = %FALSE Then Exit Method
ListView Set Mode mhDlg, mlID, lMode
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetOverlay(ByVal lRow As Long, ByVal lImage As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set Overlay mhDlg, mlID, lRow, lImage
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetStyleEx(ByVal lStyle As Long) As Long
'See %LVS_EX_* constants in Commctrl.inc.
If me.IsInit() = %FALSE Then Exit Method
ListView Set StyleXX mhDlg, mlID, lStyle
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetText(ByVal lRow As Long, ByVal lCol As Long, ByVal sText As String) As Long
'Use InsertItem to add a new row, then use SetText to change text in any column.
If me.IsInit() = %FALSE Then Exit Method
ListView Set Text mhDlg, mlID, lRow, lCol, sText
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SetItemData(ByVal lRow As Long, ByVal lItemData As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Set User mhDlg, mlID, lRow, lItemData
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method Sort(ByVal lCol As Long, Optional ByVal lIsDesc As Long, ByVal lUCase As Long, ByVal lIsNumeric As Long, ByVal lDateFormat As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
If lIsDesc = 0 And lUCase = 0 And lIsNumeric = 0 And lDateFormat = 0 Then
'No Optional parameters specified.
ListView Sort mhDlg, mlID, lCol, Ascend
ElseIf lIsDesc = 0 Then
If lDateFormat Then
Select Case lDateFormat
Case %LB_SORT_DATE_MMDDYYYY
ListView Sort mhDlg, mlID, lCol, Ascend, MMDDYYYY
Case %LB_SORT_DATE_DDMMYYYY
ListView Sort mhDlg, mlID, lCol, Ascend, DDMMYYYY
Case %LB_SORT_DATE_YYYYMMDD
ListView Sort mhDlg, mlID, lCol, Ascend, YYYYMMDD
Case %LB_SORT_DATE_YYYYDDMM
ListView Sort mhDlg, mlID, lCol, Ascend, YYYYDDMM
End Select
ElseIf lIsNumeric Then
ListView Sort mhDlg, mlID, lCol, Ascend, Numeric
Else
If lUCase Then
ListView Sort mhDlg, mlID, lCol, Ascend, UCase
Else
ListView Sort mhDlg, mlID, lCol, Ascend, Alphanum
End If
End If
ElseIf lIsDesc Then
If lDateFormat Then
Select Case lDateFormat
Case %LB_SORT_DATE_MMDDYYYY
ListView Sort mhDlg, mlID, lCol, Descend, MMDDYYYY
Case %LB_SORT_DATE_DDMMYYYY
ListView Sort mhDlg, mlID, lCol, Descend, DDMMYYYY
Case %LB_SORT_DATE_YYYYMMDD
ListView Sort mhDlg, mlID, lCol, Descend, YYYYMMDD
Case %LB_SORT_DATE_YYYYDDMM
ListView Sort mhDlg, mlID, lCol, Descend, YYYYDDMM
End Select
ElseIf lIsNumeric Then
ListView Sort mhDlg, mlID, lCol, Descend, Numeric
Else
If lUCase Then
ListView Sort mhDlg, mlID, lCol, Descend, UCase
Else
ListView Sort mhDlg, mlID, lCol, Descend, Alphanum
End If
End If
End If
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method Unselect(ByVal lRow As Long, Optional ByVal lCol As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
If lCol = 0 Then
lCol = 1
End If
ListView Unselect mhDlg, mlID, lRow, lCol
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method MakeVisible(ByVal lRow As Long) As Long
If me.IsInit() = %FALSE Then Exit Method
ListView Visible mhDlg, mlID, lRow
Method = %TRUE
End Method
'------------------------------------------------------------------------
End Interface
End Class
'--------------------------------------------------------------------------------
Code:
'--------------------------------------------------------------------------------
' cFileOpenDlg.inc
'
' Wrapper for FileOpen Common Dialog implemented using PB's Display Openfile.
'--------------------------------------------------------------------------------
' Created by: Calvin H. Chipman
' Date Created: 10/20/2008
' Last Modified: 10/20/2008
'--------------------------------------------------------------------------------
'Example of Use:
#If 0
#Include "cFileOpenDlg.inc"
Dim oFileOpen As IFileOpenDlg
Dim sFile As String
oFileOpen = Class "cFileOpenDlg"
oFileOpen.hParent = hDlg
oFileOpen.sTitle = "Select File to Open"
oFileOpen.sFolder = ""
oFileOpen.sFilter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
'oFileOpen.sFilter = "Source Files (*.bas,*.inc)|*.bas;*.inc|All Files (*.*)|*.*"
oFileOpen.sStart = "FileName.txt"
oFileOpen.sDefExt = "txt"
oFileOpen.lFlags = %OFN_FileMustExist + %OFN_PathMustExist + %OFN_HideReadOnly
sFile = oFileOpen.GetFile()
#EndIf
'--------------------------------------------------------------------------------
#Compiler PBWin 9
#If Not %Def(%PROPERTY_MACROS)
%PROPERTY_MACROS = 1
'Property Get must always be directly before Property Set (Paired Set) if using both.
Macro PropGet(PropName, PropType) = Property Get PropName As PropType : Property = PropName : End Property
Macro PropSet(PropName, PropType) = Property Set PropName(ByVal Param As PropType) : PropName = Param : End Property
#EndIf
'--------------------------------------------------------------------------------
Class cFileOpenDlg
Instance hParent, lXPos, lYPos, lFlags As Dword
Instance sTitle, sFolder, sFilter, sStart, sDefExt, sFileName As String
Interface IFileOpenDlg
Inherit IUnknown
PropSet(hParent, Dword)
PropSet(lXPos, Dword)
PropSet(lYPos, Dword)
PropSet(lFlags, Dword)
PropSet(sTitle, String)
PropSet(sFolder, String)
PropSet(sFilter, String)
PropSet(sStart, String)
PropSet(sDefExt, String)
Method GetFile() As String
Local sFilterTmp As String
sFilterTmp = sFilter
Replace "|" With Chr$(0) In sFilterTmp
If lXPos <> 0 And lYPos <> 0 Then
Display Openfile hParent, lXPos, lYPos, sTitle, sFolder, sFilterTmp, sStart, sDefExt, lFlags To sFileName
Else
Display Openfile hParent, , , sTitle, sFolder, sFilterTmp, sStart, sDefExt, lFlags To sFileName
End If
Method = sFileName
End Method
End Interface
End Class
'--------------------------------------------------------------------------------
Code:
'--------------------------------------------------------------------------------
' cCSV.inc
'
' Class for reading & using Comma Separated Values (CSV) files.
'--------------------------------------------------------------------------------
' Created by: Calvin H. Chipman
' Date Created: 04/30/2009
' Last Modified: 05/08/2009
'--------------------------------------------------------------------------------
'Example of Use:
#If 0
#Include "cCSV.inc"
Local oCSV As ICSV
Local sFile As String
sFile = EXE.Path$ + "TEST.csv"
oCSV = Class "cCSV"
If oCSV.Load(sFile) Then
MsgBox "File: " + oCSV.FileName + $Cr + _
"Record Count: " + Format$(oCSV.RecCount) + $Cr + _
"Field Count: " + Format$(oCSV.FldCount) + $Cr + _
"MaxFldLen: " + Format$(oCSV.MaxFldLen)
Else
MsgBox "Failed"
End If
oCSV = Nothing
#EndIf
'--------------------------------------------------------------------------------
#Compiler PBWin 9
'--------------------------------------------------------------------------------
#If Not %Def(%PROPERTY_MACROS)
%PROPERTY_MACROS = 1
'Property Get must always be directly before Property Set (Paired Set) if using both.
Macro PropGet(PropName, PropType) = Property Get PropName As PropType : Property = PropName : End Property
Macro PropSet(PropName, PropType) = Property Set PropName(ByVal Param As PropType) : PropName = Param : End Property
#EndIf
'--------------------------------------------------------------------------------
Class cCSV
Instance FileName As String
Instance RecCount As Long
Instance FldCount As Long
Instance MaxFldLen As Long
Instance asData() As String
'Must be placed before Interface.
Class Method Create()
' Do initialization
FileName = ""
RecCount = 0
FldCount = 0
MaxFldLen = 0
End Method
Class Method Destroy()
' Do cleanup
FileName = ""
RecCount = 0
FldCount = 0
MaxFldLen = 0
Erase asData()
End Method
Interface ICSV
Inherit IUnknown
PropGet(FileName, String)
PropGet(RecCount, Dword)
PropGet(FldCount, Dword)
PropGet(MaxFldLen, Dword)
'------------------------------------------------------------------------
Method Load(ByVal sFile As String) As Long
Local lRecCnt As Long
Local lFldCnt As Long
Local lMaxFldLen As Long
Local lRec As Long
Local lFld As Long
Local pSrc As Byte Ptr
Local pDst As Byte Ptr
Local sFld As String
Local lIsQuote As Long
Local lPriorChar As Long
Local sBuf As String
If IsFile(sFile) = %FALSE Then
Exit Method
End If
sBuf = me.GetFileContents(sFile)
If Len(sBuf) = 0 Then
Exit Method
End If
lRecCnt = me.CountRecords(sBuf, lFldCnt, lMaxFldLen)
If lRecCnt = 0 Or lFldCnt = 0 Then
Exit Method
End If
If UBound(asData, 1) <> lRecCnt Or UBound(asData, 2) <> lFldCnt Then
Dim asData(1 To lRecCnt, 1 To lFldCnt)
End If
sFld = Space$(lMaxFldLen + 1)
pDst = StrPtr(sFld)
pSrc = StrPtr(sBuf)
Do While @pSrc > 0
Select Case @pSrc
Case 13, 10 'CR or LF.
'Record Delimiter, if not within quotes.
If lIsQuote = %FALSE Then
Incr lFld
Incr lRec
asData(lRec, lFld) = Left$(sFld, pDst - StrPtr(sFld))
pDst = StrPtr(sFld)
lFld = 0
If @pSrc = 13 And @pSrc[1] = 10 Then
Incr pSrc 'Skip over LF.
End If
Else
@pDst = @pSrc
Incr pDst
End If
Case 34 'Quote.
lIsQuote = Not lIsQuote
If lPriorChar = 34 And lIsQuote Then
'Copy if prior character was a quote and lIsQuote = %TRUE.
@pDst = @pSrc
Incr pDst
End If
Case 44 'Comma.
'Field Delimiter, if not within quotes.
If lIsQuote = %FALSE Then
Incr lFld
asData(lRec + 1, lFld) = Left$(sFld, pDst - StrPtr(sFld))
pDst = StrPtr(sFld)
Else
@pDst = @pSrc
Incr pDst
End If
Case Else
@pDst = @pSrc
Incr pDst
End Select
lPriorChar = @pSrc
Incr pSrc
Loop
'Assign Instance variables if completed successfully.
FileName = sFile
RecCount = lRecCnt
FldCount = lFldCnt
MaxFldLen = lMaxFldLen
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method CountRecords(ByRef sBuf As String, ByRef lFldCnt As Long, ByRef lMaxFldLen As Long) As Long
Local lRecCnt As Long
Local pSrc As Byte Ptr
Local lIsQuote As Long
Local lIsFirstRec As Long
Local lFldLen As Long
lFldCnt = 0
lIsFirstRec = %TRUE
pSrc = StrPtr(sBuf)
Do While @pSrc > 0
Select Case @pSrc
Case 13, 10 'CR or LF.
'Record Delimiter, if not within quotes.
If lIsQuote = %FALSE Then
If lIsFirstRec Then
Incr lFldCnt
lIsFirstRec = %FALSE
End If
Incr lRecCnt
lMaxFldLen = Max&(lMaxFldLen, lFldLen)
lFldLen = 0
Else
Incr lFldLen
End If
'This makes it so the options of $CrLf, $Cr, $Lf as record delimiters all work.
If @pSrc = 13 And @pSrc[1] = 10 Then
Incr pSrc
End If
Case 34 'Quote.
lIsQuote = Not lIsQuote
Incr lFldLen
Case 44 'Comma.
'Field Delimiter, if not within quotes.
If lIsQuote = %FALSE Then
If lIsFirstRec Then
Incr lFldCnt
End If
lMaxFldLen = Max&(lMaxFldLen, lFldLen)
lFldLen = 0
Else
Incr lFldLen
End If
Case Else
Incr lFldLen
End Select
Incr pSrc
Loop
Method = lRecCnt
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetFileContents(ByVal sFile As String) As String
Local sBuf As String
Local hFile As Long
hFile = FreeFile
Open sFile For Binary Access Read Lock Shared As hFile
If Err Then
Exit Method
End If
sBuf = Space$(Lof(hFile))
Get hFile, 1, sBuf
Close hFile
Method = sBuf
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method SaveToFile(ByVal sFile As String, ByVal sBuf As String) As Long
Local hFile As Long
hFile = FreeFile
Open sFile For Output Access Write As hFile
If Err Then
Exit Method
End If
Print# hFile, sBuf;
Close hFile
Method = %TRUE
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetRec(ByVal lRecNum As Long, Optional ByVal sDelimiter As String) As String
Local i As Long
Local sBuf As String
If RecCount <= 0 Or lRecNum <= 0 Or lRecNum > RecCount Then
'Invalid request.
Exit Method
End If
If Len(sDelimiter) = 0 Then
'Default delimiter.
sDelimiter = ","
End If
For i = 1 To FldCount
sBuf += asData(lRecNum, i) + sDelimiter
Next i
'Drop the last delimiter.
sBuf = Left$(sBuf, Len(sBuf) - Len(sDelimiter))
Method = sBuf
End Method
'------------------------------------------------------------------------
'------------------------------------------------------------------------
Method GetFld(ByVal lRecNum As Long, ByVal lFldNum As Long) As String
If RecCount <= 0 Or lRecNum <= 0 Or lRecNum > RecCount Then
'Invalid request.
Exit Method
End If
If lFldNum <= 0 Or lFldNum > FldCount Then
'Invalid request.
Exit Method
End If
Method = asData(lRecNum, lFldNum)
End Method
'------------------------------------------------------------------------
End Interface
End Class
'--------------------------------------------------------------------------------