Announcement

Collapse
No announcement yet.

posting

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

  • posting

    canx
    Dale

  • #2
    no longer needed
    Dale

    Comment


    • #3
      canx
      Dale

      Comment


      • #4
        source available
        Attached Files
        Dale

        Comment


        • #5
          Hello Dale,

          Can you post the source code? I found the application quite cool!

          Very thanks,

          Arthur.
          "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

          Comment


          • #6
            Used this channel so it would disappear when Adam, and/or company, clear the old posts out. So grab the source code quick; clean up could be later today or next year (who knows).

            Have fun -
            Code:
            #compile exe
            #dim all
            #messages notify
            #resource icon, 101, "DY032.ico"
            #resource manifest, 1, "XPTheme.xml"
            #resource versioninfo
              #resource productversion 0, 0, 0, 1
              #resource stringinfo "0409", "04B0"
              #resource version$ "Comments", "Specific purpose for my son and I."
              #resource version$ "ProductVersion", "v0.0.0.1"
              #resource version$ "LegalCopyright", "Copyright 2019 Dale Yarker"
            #include "ComDlg32.inc"
            $cma = chr$(&h2C?) 'comma
            %ID_NetSumLV = 1001
            %ID_ChooseFileBtn = 1011
            %ID_DoSumBtn =     1012
            %ID_HelpBtn =      1013
            %ID_ExitBtn =      1014
            global gTheData() as string
            '-------------------------------------------------------------------------------
            function pbmain () as long
              local hDlg as dword
              dialog default font "MS Sans Serif", 10, 0, 1
              dialog new 0, "Read CSV from PayPal", , , 300, 250, _
                 %ds_3dlook or %ds_modalframe or %ds_nofailcreate or %ds_setfont or _
                 %ws_border or %ws_caption or %ws_clipsiblings or %ws_dlgframe or _
                 %ws_popup or %ws_sysmenu, %ws_ex_left or %ws_ex_ltrreading to hDlg
              dialog set icon hDlg, "#101"
              control add button, hDlg, %ID_ChooseFileBtn, "Choose File", 2, 228, 50, 18
              control add button, hDlg, %ID_DoSumBtn, "Do Sums", 54, 228, 50, 18
              control add button, hDlg, %ID_HelpBtn, "Help", 214, 228, 40, 18
              control add button, hDlg, %ID_ExitBtn, "Exit", 256, 228, 40, 18
              control disable hDlg, %ID_DoSumBtn
              '
              dialog show modal hDlg call DlgCB
            end function
            ' Main dialog callback - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
            callback function DlgCB() as long
              local pNMHdr as nmhdr pointer  'Notification UTD var pointer
              local ItemNum, ItemCnt as long 'num ids LV row, also used a temp long 2 places
              local YN_Str, TmpStr as string
              local PaidAmnt, FeeAmnt, NetAmnt as currencyx 'fixed 2 decimals for Amounts
              local FilePathName, StartPath as string
              local OFStyle as dword
              select case as long cb.msg
                case %wm_command
                  select case as long cb.ctl
                    case %ID_ChooseFileBtn
                      StartPath = "c:"
                      FilePathName = "*.csv"
                      OFStyle = %ofn_explorer or %ofn_filemustexist or %ofn_hidereadonly
                      if OpenFileDialog(cb.hndl, _                  'parent window
                                        "Choose CSV from PayPal", _ 'caption
                                        FilePathName, _          '(byref, so also is result)
                                        StartPath, _                'start directory
                                        "Data Files|*.csv|All Files|*.*", _ 'FilePath filter
                                        "csv", _                    'default extension
                                        OFStyle) then               'flags
                        ItemNum = LoadData(FilePathName)
                        if ItemNum then
                          control disable cb.hndl, %ID_DoSumBtn
                          msgbox "Some kind of error loading the file." + $crlf + $crlf + _
                                 "Error number is " + str$(ItemNum) + $crlf + $crlf + _
                                 "You may close this and try "+ $dq + "Choose File" + _
                                 $dq + " again.", _
                             %mb_ok or %mb_taskmodal or %mb_iconerror, "Load Error"
                        else
                          control enable cb.hndl, %ID_DoSumBtn
                        end if
                        NetSumListView(cb.hndl)
                      end if
                    case %ID_DoSumBtn
                      listview get count cb.hndl, %ID_NetSumLV to ItemCnt
                      decr ItemCnt 'remove "Sums>" line from count
                      for ItemNum = 1 to ItemCnt
                        listview get text cb.hndl, %ID_NetSumLV, ItemNum, 2 to YN_Str
                        if YN_Str = "Y" then
                          listview get text cb.hndl, %ID_NetSumLV, ItemNum, 5 to TmpStr
                          PaidAmnt += val(TmpStr)
                          listview get text cb.hndl, %ID_NetSumLV, ItemNum, 6 to TmpStr
                          FeeAmnt += val(TmpStr)
                          listview get text cb.hndl, %ID_NetSumLV, ItemNum, 7 to TmpStr
                          NetAmnt += val(TmpStr)
                        else
                          iterate for
                        end if
                      next
                      incr ItemCnt
                      TmpStr = format$(PaidAmnt, "\ ####0.00;-####0.00")
                      listview set text cb.hndl, %ID_NetSumLV, ItemCnt, 5, TmpStr
                      TmpStr = format$(FeeAmnt, "\ ###0.00;-###0.00")
                      listview set text cb.hndl, %ID_NetSumLV, ItemCnt, 6, TmpStr
                      TmpStr = format$(NetAmnt, "\ ####0.00;-####0.00")
                      listview set text cb.hndl, %ID_NetSumLV, ItemCnt, 7, TmpStr
                    case %ID_HelpBtn
                      if cb.ctlmsg = %bn_clicked then
                        HelpPopup(cb.hndl)
                      end if
                    case %ID_ExitBtn
                      if cb.ctlmsg = %bn_clicked then
                        dialog post cb.hndl, %wm_syscommand, %sc_close, 0
                      end if
                  end select
                case %wm_notify
                  if cb.nmid = %ID_NetSumLV then
                    pNMHdr = cb.nmhdr
                    if @pNMHdr.code = %nm_dblclk then
                      listview get select cb.hndl, %ID_NetSumLV to ItemNum
                      listview get text cb.hndl, %ID_NetSumLV, ItemNum, 2 to YN_Str
                      if YN_Str = "Y" then
                        listview set text cb.hndl, %ID_NetSumLV, ItemNum, 2, "N"
                      elseif YN_Str = "N" then
                        listview set text cb.hndl, %ID_NetSumLV, ItemNum, 2, "Y"
                      end if
                    end if
                  end if
                case %wm_syscommand
                  if cb.wparam = %sc_close then
                    ItemNum = msgbox("Are you sure you want to exit the program?" + _
                                     $crlf + $crlf + $dq + "Yes" + $dq + " to exit, " + _
                                     $dq + "No" + $dq + " to continue in program.", _
                       %mb_yesno or %mb_defbutton2 or %mb_taskmodal or %mb_iconquestion, _
                       "Verify Exit")
                    if ItemNum = %idyes then
                      function = 0
                    elseif ItemNum = %idno then
                      function = -1
                    end if
                  end if
            
            
              end select
            end function
            '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
            '
            function LoadData(byref FilePathName as string) as long
              local nFile as dword 'File number
              local TmpRec as string 'Temporary record holder, also whole file for check.
              local RecCnt as long 'Record Count
              local FldCnt as long 'Field Count
              local CurRec as long 'Current Record being worked on
              local CurFld as long 'Current Field being worked on
              local StartNum, EndNum as long 'character positions in TmpRec
              local NeedsSave as long 'a change was made, save to file on function exit.
              ' Check/correct source CSV file (re: $CRLF) -  -  -  -  -  -  -  -  -  -  -  -
              nFile = freefile
              open FilePathName for binary as #nFile
              get$ #nFile, lof(#nFile), TmpRec
              ' Remove trailing $LF, $CR or $CRLF to prevent blank record.  .  .  .  .  .  .
              if right$(TmpRec, 1) = $lf then
                TmpRec = clip$(right TmpRec, 1)
                NeedsSave = -1
              end if
              if right$(TmpRec, 1) = $cr then
                TmpRec = clip$(right TmpRec, 1)
                NeedsSave = -1
              end if
              ' Replace lone $LFs, or $CRs, with $CRLFs.  .  .  .  .  .  .  .  .  .  .  .  .
              if instr(TmpRec, $crlf) then
                exit if
              elseif instr(TmpRec, $lf) then
                replace $lf with $crlf in TmpRec
                NeedsSave = -1
              elseif instr(TmpRec, $cr) then
                replace $cr with $crlf in TmpRec
                NeedsSave = -1
              end if
              if NeedsSave then
                seek #nFile, 1
                put$ #nFile, TmpRec
                seteof #nFile
              end if
              close #nFile
              ' Open file, load records, parse to array   -  -  -  -  -  -  -  -  -  -  -  -
              ' first open and size the array .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
              nFile = freefile
              open FilePathName for input as #nFile
              filescan #nFile, records to RecCnt
              decr RecCnt
              line input #nFile, TmpRec
              FldCnt = parsecount(TmpRec) '(no embedded commas in fields)
              dim gTheData(FldCnt, RecCnt)
              'Put field names in record 0 fields   .  .  .  .  .  .  .  .  .  .  .  .  .  .
              for CurFld = 1 to FldCnt
                gTheData(CurFld, 0) = parse$(TmpRec, CurFld)
              next
              ' Get each record, put fields in array elements   .  .  .  .  .  .  .  .  .  .
              '  (To allow for embedded commas did not use PARSE() or PARSE$().)
              for CurRec = 1 to RecCnt
                line input #nFile, TmpRec
                StartNum = 1
                for CurFld = 1 to FldCnt
                  if mid$(TmpRec, StartNum, 1) = $dq then
                    incr StartNum                              'char after $dq
                    EndNum = instr(StartNum, TmpRec, $dq) - 1  'char before next $dq
                    gTheData(CurFld, CurRec) = mid$(TmpRec, StartNum to EndNum)
                  else
                    EndNum = instr(StartNum, TmpRec, $cma) - 1
                    gTheData(CurFld, CurRec) = mid$(TmpRec, StartNum to EndNum)
                  end if
                  StartNum = instr(EndNum, TmpRec, $cma) + 1
                  if StartNum = 0 then
                    exit for
                  end if
                next
              next
              close #nFile
            end function
            ' Create and populate listview - - - - - - - - - - - - - - - - - - - - - - - - -
            function NetSumListView(byval hDlg as dword) as long
              local RecCnt, CurRec, CurCol as long
              local TmpCell, TmpDate as string
              local TmpAmnt as currencyx
              RecCnt = ubound(gTheData (2))
              ' Listview and columns with header labels   .  .  .  .  .  .  .  .  .  .  .  .
              control add listview, hDlg, %ID_NetSumLV, "", 2,2, 296, 224, %lvs_report or _
                 %lvs_showselalways or %lvs_singlesel or %ws_tabstop
              listview set stylexx hDlg, %ID_NetSumLV, %lvs_ex_gridlines or _
                                                       %lvs_ex_fullrowselect
                listview insert column hDlg, %ID_NetSumLV, 1, "Rec#",   27, 0
                listview insert column hDlg, %ID_NetSumLV, 2, "In Sum", 27, 2
                listview insert column hDlg, %ID_NetSumLV, 3, "ddmmyear", 42, 2
                listview insert column hDlg, %ID_NetSumLV, 4, "Name",   75, 0
                listview insert column hDlg, %ID_NetSumLV, 5, "Paid",   35, 1
                listview insert column hDlg, %ID_NetSumLV, 6, "Fee",    30, 1
                listview insert column hDlg, %ID_NetSumLV, 7, "Net",    35, 1
              ' Rows  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
              for CurRec = 1 to RecCnt
                'insert a row for each record, fill column 1 with record number
                TmpCell =  format$(CurRec, "\ 0000")
                listview insert item hDlg, %ID_NetSumLV, CurRec,  0, TmpCell
                'fill rest of columns in the row
                for CurCol = 2 to 7
                  select case as const CurCol
                    case 2  'In Sum
                      TmpCell = "Y"                       'pre filled
                    case 3  'Date
                      TmpDate = gTheData(1, CurRec)        '1st field is CSV
                      TmpCell = mid$(TmpDate,4, 3) + mid$(TmpDate, 1, 3) + _
                                right$(TmpDate, 4)
                    case 4  'Name
                      TmpCell = gTheData(4, CurRec)        '4th field in CSV
                    case 5  'Paid
                      TmpAmnt = val(gTheData(8, CurRec))   '8th field in CSV
                      TmpCell = format$(TmpAmnt, "\ ###0.00;-###0.00")
                    case 6  'Fee
                      TmpAmnt = val(gTheData(9, CurRec))   '9th field in CSV
                      TmpCell = format$(TmpAmnt, "\ ##0.00;-##0.00")
                    case 7  'Net
                      TmpAmnt = val(gTheData(10, CurRec))  '10th field in CSV
                      TmpCell = format$(TmpAmnt, "\ ###0.00;-###0.00")
                  end select
                  listview set text hDlg, %ID_NetSumLV, CurRec, CurCol, TmpCell
                next
              next
              'add row for sums   .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
              listview insert item hDlg, %ID_NetSumLV, RecCnt + 1, 0, "Sums>
            
            end function
            ' Help Popup window  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
            %ID_HelpExitBtn = 1020
            %ID_HelpTxtBx   = 1021
            %ID_HelpLbl     = 1022
            callback function HelpCB() as long
              if (cb.msg = %wm_command) and (cb.ctl = %ID_HelpExitBtn) and _
                                                            (cb.ctlmsg = %bn_clicked) then
                dialog end cb.hndl
              end if
            end function
            '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
            sub HelpPopup(byval hParent as dword)
              local hHelp, hFont14 as dword
              local TmpStr as wstring
              dialog new hParent, "", %CW_USEDEFAULT, %CW_USEDEFAULT, 204, 204, _
                 %ds_3dlook or %ds_nofailcreate or %ds_setfont or %ws_border or _
                 %ws_clipsiblings or %ws_popup, %ws_ex_left or %ws_ex_ltrreading or _
                 %ws_ex_rightscrollbar to hHelp
                dialog set color hHelp, -1, &h0070E0F0&
              control add label, hHelp, %ID_HelpLbl, "Help Notes", 2, 2, 200, 14, _
                 %ss_center, %ws_ex_left
                control set color hHelp, %ID_HelpLbl, &h00404040&, &h0070E0F0&
                font new "MS Sans Serif", 14, 0, 1, 0, 0 to hFont14
                control set font hHelp, %ID_HelpLbl, hFont14
              control add textbox, hHelp, %ID_HelpTxtBx, "", 2, 18, 200, 160, _
                 %es_autohscroll or %es_left or %es_multiline or %ws_border or _
                 %ws_tabstop or %es_readonly, %ws_ex_clientedge or %ws_ex_left
              control add button, hHelp, %ID_HelpExitBtn, "Exit Help", 82, 180, 40, 18
              ' -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
              TmpStr = _
              "  This program will load any CSV file, but the displayed columns " + _
              $$crlf + _
              "only make sense with reports from PayPal. A side benefit of this is" + _
              $$crlf + _
              "that any CSV file will be changed from having LF only for a new line" + _
              $$crlf + _
              "to Windows standard of CRLF for new lines. Just choose, then exit," + _
              $$crlf + $$crlf + _
              "  First press " + $$dq + "Choose File" + $$dq + " to pick and load " + _
              "a file. A successful load" + $$crlf + _
              "will enable the " + $$dq + "Do Sums" + $$dq + " button." + _
              $$crlf + $$crlf + _
              "  Not all lines will be transactions that you want in the sum. To " + _
              $$crlf + "cause a line to be not included in the sums calculation, double" + _
              $$crlf + "click on the line. That changes the " + $$dq + "Y" + $$dq + _
              " for yes in column 2 for that" + $$crlf + _
              "line to " + $$dq + "N" + $$dq + " for no, do not include in sum " + _
              "calculation. Press the" + $$crlf + _
              $$dq + "Do Sums" + $$dq + " button to update the Paid, Fee and Net " + _
              "sums. You may" + $$crlf + _
              "change included lines, and click " + $$dq + "Do Sums" + $$dq + _
              " as many times as you" + $$crlf + _
              " want." + $$crlf + $$crlf + _
              " You may load another file without exiting the program." + _
              $$crlf + $$crlf + _
              "From Dale to Y. Dale                           © 2019 Dale Yarker"
              ' -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
            
              control set text hHelp, %ID_HelpTxtBx, TmpStr
              control set focus hHelp, %ID_HelpExitBtn
              dialog show modal hHelp call HelpCB
            end sub
            '
            '
            Yours for free to use or modify, just no redistribution. Cheers,
            Dale

            Comment


            • #7
              Icon if you don't have one. DY032.ico
              Dale

              Comment


              • #8
                Hello Dale,

                Thanks for posting your code followed by the icon. I learn a lot by looking at the solutions and techniques used and my analysis is made much easier since your code is full of comments.

                Sorry for my delay in answering but we had big storms of rain and wind that hit my residence. The damage has already been mitigated and resolved.

                Thank you again!

                Arthur.
                "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

                Comment


                • #9
                  You're welcome.
                  Dale

                  Comment

                  Working...
                  X