Announcement

Collapse
No announcement yet.

Shopping List

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

  • #21
    Originally posted by Tim Lakinir View Post
    ... how do I place in a Print button to print the selection to a printer?
    Just define another rect on the GW somewhere outside the products array, create bitmaps for it (selected, without focus, with focus) and make tests for mouseover and click. when the mouse is moved over the print button, display the selected bitmap, when it is clicked display the clicked bitmap, and at other times, including after printing, display the selected or unselected bitmap depending on the cursor position at that time. And action your print routine when the print button is clicked.

    Comment


    • #22
      Chris, are you able to give me a link or two l to some codes that can select a printer and print some graphics? Sadly, I'm only a novice in PB

      Comment


      • #23
        Originally posted by Tim Lakinir View Post
        Chris, are you able to give me a link or two l to some codes that can select a printer and print some graphics?
        Sorry Tim, I'm the wrong person to ask, printing Graphics is not my thing... I tend to output text not graphics.

        Plenty of help around though, why don't you give it a try and ask for help with problems which you encounter?

        Comment


        • #24
          Tim , the following code is all that you would need to have a Print button and print the graphics screen.
          With special thanks to Dave Biggs who previously contributed to the Print Graphics screen routine

          Code:
          ' Shopping List.bas
          ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/780162-shopping-list?p=780424#post780424
          
           ' Added Print Button to print the screen
          
          
          #DEBUG DISPLAY
          #COMPILE EXE
          #DIM ALL
          #INCLUDE ONCE "WIN32API.INC"
          
          
          %bkcolour = %RGB_CORNSILK
          %textcolour = %BLACK
          %focusbkcolour = %RGB_LAVENDER
          %tickcolour = %RED
          
          
          
          
          GLOBAL product() AS STRING ' array of grocery products
          GLOBAL boxen()   AS rect   ' array of bounding rects for products, same index as products()
          GLOBAL selected() AS LONG  ' array of selected statuses, same index as products()
          GLOBAL hfocusbmp() AS LONG   ' array of bitmaps for active(under cursor) products
          GLOBAL hunfocusbmp() AS LONG ' array of bitmaps for inactive(not under cursor) products
          GLOBAL NumProd ,NumRows,NumCols  AS LONG
          GLOBAL hGW AS LONG ' graphic window handle
          
          
          '====================
          MACRO mprintprod
              GRAPHIC SET POS (4*cw, (cellY-ch)/2)
              GRAPHIC PRINT product(n)
              GRAPHIC SET FONT 0
          END MACRO
          
          
          '======================
          MACRO FUNCTION mpointinrect(r, pt)
              MACROTEMP lp
              DIM lp AS LONG
                  lp = ptinrect(r, pt)
          END MACRO = lp
          
          
          '===============================
          ' make little bitmap containing no tick symbol
          MACRO FUNCTION mmakenoticksymbolbmp(colour)
              MACROTEMP bmp
              DIM bmp AS LONG
              '
              GRAPHIC BITMAP NEW 2*cw, ch TO bmp
              GRAPHIC ATTACH bmp, 0
              GRAPHIC CLEAR colour
          END MACRO = bmp
          
          
          
          ' ===================================
          ' make little bitmap containing a tick symbol
          MACRO FUNCTION mmaketicksymbolbmp(colour)
              MACROTEMP bmp
              DIM bmp AS LONG
          
              GRAPHIC BITMAP NEW 2*cw, ch TO bmp
              GRAPHIC ATTACH bmp, 0
              GRAPHIC CLEAR colour
              GRAPHIC WIDTH 2
              GRAPHIC COLOR %tickcolour
              GRAPHIC LINE (2*cw, 0)-(cw/2, ch)
              GRAPHIC LINE (0, ch/2)-(cw/2, ch)
          END MACRO = bmp
          
          
          
          '===========================
          FUNCTION PBMAIN AS LONG
              ' bitmaps for tick symbol
              LOCAL htickbmpNS AS LONG ' no focus, selected
              LOCAL htickbmpFS AS LONG ' focus, selected
              LOCAL htickbmpNN AS LONG ' neither with focus nor selected
              LOCAL htickbmpFN AS LONG ' focus, not selected
              '
          
              LOCAL hfont AS LONG ' font handle
              LOCAL CellX, CellY AS LONG ' X and Y dimensions of cell containing a single product
              LOCAL cw, ch AS LONG' character cell dimensions
              LOCAL focussedproduct AS LONG ' the index of the prduct currently under the cursor
              LOCAL W, H, X, Y, n, cl, m , Clk AS LONG ' ephemerals
              LOCAL skey AS STRING
              LOCAL pt AS POINT
              LOCAL CX!, CY!
              LOCAL FlagPrin AS LONG
          
              ' Load array with shopping list
                NumProd = 45
                NumRows = 12
                NumCols = 4
                AsgnProduct
          
              DIM boxen(0 TO NumProd)
              DIM selected(0 TO NumProd)
              DIM hfocusbmp(0 TO NumProd)
              DIM hunfocusbmp(0 TO NumProd)
          
          
          
          
              DESKTOP GET CLIENT TO W, H
              GRAPHIC WINDOW "", 0, 0, W, H TO hGW
              GRAPHIC ATTACH hGW, 0
              GRAPHIC CLEAR %RGB_CORNSILK
              FONT NEW "Comic Sans MS", 12 TO hfont
              GRAPHIC SET FONT hfont
              GRAPHIC CHR SIZE TO cw, ch
              GRAPHIC SET FONT 0
          
              ' calculate size of cell, same for all product names
              cellX = W/(NumCols + 2)
              DECR CellX ' cells must not overlap
              cellY = H/(NumRows + 2)
              DECR CellY ' cells must not overlap
          
              ' make little bitmap containing a tick symbol, no focus
              htickbmpNS = mmaketicksymbolbmp(%bkcolour)
          
              ' make little bitmap containing a tick symbol, with focus
              htickbmpFS = mmaketicksymbolbmp(%focusbkcolour)
          
              ' make little bitmap containing no tick symbol, no focus
              htickbmpNN = mmakenoticksymbolbmp(%bkcolour)
          
              ' make little bitmap containing no tick symbol with focus
              htickbmpFN = mmakenoticksymbolbmp(%focusbkcolour)
          
          
          
              '
              ' make little bitmaps for each product
              n = 1
              FOR y = 1 TO NumRows
                  FOR x = 1 TO NumCols
                      INCR n
                      IF n > UBOUND(product) THEN EXIT FOR
                      setrect(boxen(n), X* cellX, Y*cellY, (X+1)* cellX, (Y+1) * cellY + 1)
                      ' ...one for the product with focus
                      GRAPHIC BITMAP NEW cellX, cellY TO hfocusbmp(n)
                      GRAPHIC ATTACH hfocusbmp(n), 0
                      GRAPHIC SET FONT hfont
                      GRAPHIC COLOR %textcolour, %focusbkcolour
                      GRAPHIC CLEAR %focusbkcolour
                      GRAPHIC BOX(0,0)-(cellX, cellY), 20, %BLACK, -2
                      mprintprod
                      '... and one for when the product doesn't have focus
                      GRAPHIC BITMAP NEW cellX, cellY TO hunfocusbmp(n)
                      GRAPHIC ATTACH hunfocusbmp(n), 0
                      GRAPHIC SET FONT hfont
                      GRAPHIC COLOR %textcolour, %bkcolour
                      GRAPHIC CLEAR %bkcolour
                      mprintprod
                  NEXT
              NEXT
          
          
          
          
              GRAPHIC ATTACH hGW, 0, REDRAW
              GRAPHIC COLOR %textcolour, %bkcolour
              ' display initial array of products, none selected yet
              n = 1
              FOR y = 1 TO NumRows
                  FOR x = 1 TO NumCols
                      INCR n
                      IF n > UBOUND(product) THEN
                           EXIT FOR
                      END IF
                      GRAPHIC COPY cl, 0 TO (boxen(n).nleft, boxen(n).ntop)
                  NEXT
              NEXT
          
          
          
          
              GRAPHIC REDRAW
              ' loop waiting for a mouse click to toggle product's selected state
              ' or ESC key to end
              focussedproduct = 0
              DO
                  GRAPHIC INSTAT TO Clk  ' keypress detector
                  IF Clk THEN
                       EXIT LOOP
                  END IF
          
                  GRAPHIC WINDOW CLICK TO Clk, pt.X, pt.Y
                  IF Clk THEN
                       CX = pt.X
                       CY = pt.Y
                       GOTO clicked
                  END IF
                  getcursorpos(pt)
                  FOR n = 1 TO UBOUND(product)
                      X = boxen(n).nleft + cw
                      Y = boxen(n).ntop + ch
                      IF mpointinrect( boxen(n), pt) THEN
                        ' was the click inside nth product's bounding rect?
                          IF n = focussedproduct THEN
                     '        avoid repainting if move within focussed cell
                              ITERATE LOOP
                          END IF
                          focussedproduct = n
                          cl = hfocusbmp(n)
                          m = IIF(selected(n), htickbmpFS, htickbmpFN)
                      ELSE
                          cl = hunfocusbmp(n)
                          m = IIF (selected(n), htickbmpNS, htickbmpNN)
                          focussedproduct = 0
                      END IF
                      GRAPHIC COPY cl, 0 TO (boxen(n).nleft, boxen(n).ntop )
                      ' set tick symbol
                      GRAPHIC COPY m, 0 TO (boxen(n).nleft + cw, boxen(n).ntop + ch/2)
                  NEXT
          
          
          
               '  Display the instruction labels
                  GRAPHIC COLOR %BLUE,%WHITE
                  GRAPHIC SET POS (60, 50)
                  GRAPHIC PRINT " Click on item to select "
                  GRAPHIC SET POS (60, 70)
                  GRAPHIC PRINT " Press ESC to EXIT "
          
               '  Display the Print Button
                  GRAPHIC BOX (488,650)-(530,680),30,%RED,%WHITE
                  GRAPHIC COLOR %BLUE,%WHITE
                  GRAPHIC SET POS (500, 660)
                  GRAPHIC PRINT "Print"
          
                  GRAPHIC REDRAW
                  SLEEP 0
                  ITERATE LOOP
          
          
          
          clicked:
          '   User has clicked a point on the screen
          
          
              IF CX>488 AND CX<530 AND CY>650 AND CY<680 THEN
           '      When the Print Button has been clicked
           '      we print and exit the program
                  FlagPrin = 1
                  GOTO ExitPrin
              END IF
          
          
                  FOR n = 1 TO UBOUND(product)
                      IF mpointinrect( boxen(n), pt) THEN
                          ' the click was inside nth product's bounding rect?
                          IF selected(n) = 0 THEN
                          '   Focus with Tick symbol
                              selected(n) = 1
                              cl = htickbmpFS
                          ELSE
                           '  Not focus with tick symbol
                              selected(n) = 0
                              cl = htickbmpFN
                          END IF
                         ' set or clear tick symbol
                          GRAPHIC COPY cl, 0 TO (boxen(n).nleft + cw, boxen(n).ntop + ch/2)
                      END IF
                  NEXT
                  SLEEP 0
              LOOP
          
          
          
          
          
          
          
          
          ExitPrin :
              IF FlagPrin = 1 THEN
           '     Prints out the Graphic screen
                 PrinGrapScrn
              END IF
          
          
          
              'Does clean up before exiting the program
              GRAPHIC WINDOW END 'hGW
              FOR n = 1 TO UBOUND(product)
                  IF hfocusbmp(n) THEN
                      GRAPHIC ATTACH hfocusbmp(n), 0
                       GRAPHIC BITMAP END
                  END IF
                  IF hunfocusbmp(n) THEN
                      GRAPHIC ATTACH hunfocusbmp(n), 0
                      GRAPHIC BITMAP END
                  END IF
              NEXT
          
               GRAPHIC ATTACH htickbmpFS, 0
               GRAPHIC BITMAP END
               GRAPHIC ATTACH htickbmpNS, 0
               GRAPHIC BITMAP END
               GRAPHIC ATTACH htickbmpFN, 0
               GRAPHIC BITMAP END
               GRAPHIC ATTACH htickbmpNN, 0
               GRAPHIC BITMAP END
          
               IF hfont THEN
                  FONT END hfont
               END IF
          END FUNCTION
          
          
          
          
          '=====================
          ' Prints the Graphic Screen
          ' Thanks to Dave Biggs
          SUB PrinGrapScrn
             ' Do the printing
             LOCAL x,y,wNew,hNew,wImg,hImg,wCont,hCont AS LONG
          
             XPRINT ATTACH CHOOSE
          
             IF LEN(XPRINT$)=0 THEN
             '   When printer is not available
                  EXIT SUB
             END IF
             ' Landscape printout
             XPRINT SET ORIENTATION 2
          
             ' Copy and resize bitmap to XPRINT PAGE
             XPRINT STRETCH PAGE hGW, 0 , %MIX_COPYSRC, %HALFTONE
          
           ' Decorate the page
             LOCAL ncWidth!, ncHeight!
           ' Retrieve the client size (printable area) of the printer page in pixels/points
             XPRINT GET CLIENT TO ncWidth!, ncHeight!
          
            ' Retrieve the resolution (points per inch) of the attached printer
             XPRINT GET PPI TO x, y
           ' Width in inches of the printable area
             ncWidth!  = ncWidth!/x
           ' Height in inches of the printable area
             ncHeight! = ncHeight!/y
          
            ' Set the scale to inches  (if printer default paper size is American letter-size paper
            '                           in portrait mode. This is the equivalent to 8.5 x 11).
             XPRINT SCALE (0,0)-(ncWidth!,ncHeight!)
          
          
            'border box 1/2 inch in from edges
             XPRINT WIDTH 5
             XPRINT BOX (0.5, 0.5)-(ncWidth!-0.5, ncHeight!-0.5),,%BLUE
          
          
          
            'Place Title text at the center above border box
             LOCAL TitleTxt AS STRING
             TitleTxt = "Shopping List"
             XPRINT SET POS ((ncWidth!/2) - (XPRINT(TEXT.SIZE.X, TitleTxt)/2) ,0.25)
             XPRINT TitleTxt
          
          
            ' Each XPRINT must be closed otherwise will cause problem
            ' like non printing and the document is suspended in the printer
              XPRINT CLOSE
          
            ' Place some delay for printing before closing off graphics
              SLEEP 60
          END SUB
          
          
          
          
          
          '=====================
          ' Assign the Product array with the names
          ' of the available products
          SUB AsgnProduct
              DIM product(0 TO NumProd)
              ARRAY ASSIGN product() = _
             "BJ's","Eggs","Sour Cream","Lite Creamer",_
             "Milk","Orange Juice","Vegetable Oil","Vinegar","Mayoaise","Catsup", _
              "Mustard","Potatos","Soy Sauce","Bagels","Swirl Bread","Water", _
               "Diet Pepsi","Taster's Choice","Chicken Burger", _
              "Le Seur Peas", "Baked Beans","Olives","Corn","Stringbeens", _
              "Mushrooms","Paper Cups 12 oz","Paper Plates","Cling Wrap", _
              "Trash Bags","Scrubbing Bubbles","Swiffer Floor Pads","Stamps",_
              "Batteries","Quiche Appetizers","Lox","Salmon","Paper Towels", _
              "Eye Roast","Hamburger Patties","Chicken Patties","Hot Dogs",_
              "Tuna Cans","Vegetables","Paper Towels","Charmin","Puffs"
          
          END SUB

          Comment


          • #25
            Thank you Anne, can you show me how to print all the chosen items into a text file as well?

            Comment


            • #26
              Originally posted by Tim Lakinir View Post
              Thank you Anne, can you show me how to print all the chosen items into a text file as well?
              Try this.
              Code:
              FUNCTION PrintList() AS LONG
                  LOCAL ff AS LONG
                  LOCAL x AS LONG
                  ff = FREEFILE
                  OPEN "ShoppingList.txt" FOR OUTPUT AS #ff
                  FOR x = 1 TO NumProd.
                      IF Selected(x) = 1 THEN
                          PRINT #ff, Product(x)
                      END IF
                  NEXT
                  CLOSE #ff
              END FUNCTION

              Comment


              • #27
                Thank you Stuart

                Comment


                • #28
                  Hi, Tim...
                  Check any of the latter xprint statements above and copy them as I do...

                  Izzy

                  Comment


                  • #29
                    Yo, Chris...

                    Up top Borje redid my program and it runs fine, however I had a tab that allowed for the removal of items no longer wanted... That disappeared... I guess I now have to buy them...
                    I also have long since changed the 'greater than' pick sign to chr$(42), the asterisk...
                    With your program I am having a problem with the following warning...
                    GLOBAL boxen() AS rect ' array of bounding rects for products, same index as products()
                    It says that it is an "Undefined TYPE...
                    I tried to define it but couldn't get it to go... I now need your define idea...

                    Izzy


                    Comment


                    • #30
                      Originally posted by Izzy Zeitz View Post
                      ... I am having a problem with the following warning...
                      GLOBAL boxen() AS rect ' array of bounding rects for products, same index as products()
                      It says that it is an "Undefined TYPE...
                      Hi Izzy,

                      try these:

                      Code:
                      type RECT
                          nLeft   as long
                          nTop    as long
                          nRight  as long
                          nBottom as long
                      end type
                      
                      declare function GetCursorPos lib "User32.dll" alias "GetCursorPos" _
                          (lpPoint as point) as long
                      
                      declare function SetRect lib "User32.dll" alias "SetRect" (lpRect as RECT, _
                          byval X1 as long, byval Y1 as long, byval X2 as long, byval Y2 as long) _
                          as long
                      
                      declare function SetRectEmpty lib "User32.dll" alias "SetRectEmpty" _
                          (lpRect as RECT) as long
                      
                      declare function PtInRect lib "User32.dll" alias "PtInRect" (lpRect as RECT, _
                          byval pt as point) as long
                      Happy shopping!

                      Comment

                      Working...
                      X