Announcement

Collapse
No announcement yet.

Graphic expansion via GET/SET BITSA

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

  • Graphic expansion via GET/SET BITSA

    About as fast as GRAPHIC STRETCH but with the added ability(for those that may want it) to adjust each pixel on the fly. Expands, horizontally, vertically, or both. This program only doubles those dimensions, but that could be adjusted.
    Click image for larger version

Name:	expander.gif
Views:	176
Size:	34.5 KB
ID:	807808
    Code:
    #PBFORMS Created v2.01
    '------------------------------------------------------------------------------
    ' The first line in this file is a PB/Forms metastatement.
    ' It should ALWAYS be the first line of the file. Other
    ' PB/Forms metastatements are placed at the beginning and
    ' end of "Named Blocks" of code that should be edited
    ' with PBForms only. Do not manually edit or delete these
    ' metastatements or PB/Forms will not be able to reread
    ' the file correctly.  See the PB/Forms documentation for
    ' more information.
    ' Named blocks begin like this:    #PBFORMS BEGIN ...
    ' Named blocks end like this:      #PBFORMS END ...
    ' Other PB/Forms metastatements such as:
    '     #PBFORMS DECLARATIONS
    ' are used by PB/Forms to insert additional code.
    ' Feel free to make changes anywhere else in the file.
    '------------------------------------------------------------------------------
    
    #COMPILE EXE
    #DIM ALL
    #DEBUG DISPLAY ON
    
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS Begin Includes
    #INCLUDE ONCE "WIN32API.INC"
    #PBFORMS End Includes
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS Begin Constants
    %IDD_DIALOG1       =  101
    %IDC_GRAPHIC1_32x32 = 1001
    %IDC_GRAPHIC1_64x32 = 1002
    %IDC_GRAPHIC1_32x64 = 1003
    %IDC_GRAPHIC1_64x64 = 1004
    %IDC_DOTHIS        = 1005
    %IDC_DOTHAT        = 1006
    %IDC_DOBOTH        = 1007
    %IDC_DONT          = 1008
    %IDC_A             = 1009
    %IDC_B             = 1010
    %IDC_C             = 1011
    %IDC_D             = 1012
    #PBFORMS End Constants
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS Declarations
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
      ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
      LOCAL ar, ge, be, ndx, indx, klr AS LONG
      STATIC abits, bbits, cbits, dbits, nbits, stuff AS STRING
      STATIC axz, ayz, bxz, byz, cxz, cyz, dxz, dyz AS LONG
      STATIC apxlptr, bpxlptr, cpxlptr, dpxlptr AS LONG PTR
      SELECT CASE AS LONG CB.MSG
      CASE %WM_INITDIALOG
        ' Initialization handler
        GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_32x32   'fill the 32x32 pixel graphic with colour
        FOR ndx=0 TO 31
          FOR indx=0 TO 31
            GRAPHIC SET PIXEL (indx,ndx), RGB(ar, ge, be)
            ar+=8
          NEXT indx
          ar=0
          ge+=8
          INCR be
          IF be=256 THEN be=0
        NEXT ndx
        GRAPHIC GET BITS TO abits                  'retrieve the bit string of the attached graphic
        axz=CVL(abits,1)
        ayz=CVL(abits,5)
        apxlptr=STRPTR(abits)+8
        GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_64x32
        GRAPHIC GET BITS TO bbits                  'retrieve the bit string of the attached graphic
        bxz=CVL(bbits,1)
        byz=CVL(bbits,5)
        bpxlptr=STRPTR(bbits)+8
        GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_32x64
        GRAPHIC GET BITS TO cbits                  'retrieve the bit string of the attached graphic
        cxz=CVL(cbits,1)
        cyz=CVL(cbits,5)
        cpxlptr=STRPTR(cbits)+8
        GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_64x64
        GRAPHIC GET BITS TO dbits                  'retrieve the bit string of the attached graphic
        dxz=CVL(dbits,1)
        dyz=CVL(dbits,5)
        dpxlptr=STRPTR(dbits)+8
    
      CASE %WM_NCACTIVATE
        STATIC hWndSaveFocus AS DWORD
        IF ISFALSE CB.WPARAM THEN
        ' Save control focus
        hWndSaveFocus = GetFocus()
        ELSEIF hWndSaveFocus THEN
        ' Restore control focus
        SetFocus(hWndSaveFocus)
        hWndSaveFocus = 0
        END IF
    
      CASE %WM_COMMAND
        ' Process control notifications
        SELECT CASE AS LONG CB.CTL
        CASE %IDC_GRAPHIC1_32x32
    
        CASE %IDC_GRAPHIC1_64x32
    
        CASE %IDC_GRAPHIC1_32x64
    
        CASE %IDC_GRAPHIC1_64x64
    
        CASE %IDC_DOTHIS
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            FOR ndx=1 TO axz*ayz
              [email protected]
              @bpxlptr=klr
              INCR bpxlptr
              @bpxlptr=klr
              INCR bpxlptr
              INCR apxlptr
            NEXT ndx
            GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_64x32
            GRAPHIC SET BITS bbits
            CONTROL DISABLE CB.HNDL, %IDC_DOTHIS
          END IF
    
        CASE %IDC_DOTHAT
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_32x32    'reset the pointer for the next sample
            GRAPHIC GET BITS TO abits                      '
            axz=CVL(abits,1)                               '
            ayz=CVL(abits,5)                               '
            apxlptr=STRPTR(abits)+8
            FOR ndx=1 TO axz*ayz
              [email protected]
              @cpxlptr=klr
              cpxlptr+=128
              @cpxlptr=klr
              cpxlptr-=124
              IF ndx/32=ndx\32 THEN
                cpxlptr+=128
              END IF
              INCR apxlptr
            NEXT ndx
            GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_32x64
            CONTROL DISABLE CB.HNDL, %IDC_DOTHAT
            GRAPHIC SET BITS cbits
          END IF
    
        CASE %IDC_DOBOTH
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_32x32    'reset the pointer for the next sample
            GRAPHIC GET BITS TO abits                      '
            axz=CVL(abits,1)                               '
            ayz=CVL(abits,5)                               '
            apxlptr=STRPTR(abits)+8                        '
            LOCAL ss AS STRING
            FOR ndx=1 TO axz*ayz
              [email protected]
              @dpxlptr=klr
              INCR dpxlptr
              @dpxlptr=klr
              dpxlptr+=252
              @dpxlptr=klr
              INCR dpxlptr
              @dpxlptr=klr
              IF ndx/32=ndx\32 THEN
                INCR dpxlptr
              ELSE
                dpxlptr-=252
              END IF
              INCR apxlptr
            NEXT ndx
            GRAPHIC ATTACH CB.HNDL, %IDC_GRAPHIC1_64x64
            GRAPHIC SET BITS dbits
            CONTROL DISABLE CB.HNDL, %IDC_DOBOTH
          END IF
    
        CASE %IDC_DONT
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            DIALOG END CB.HNDL
          END IF
    
        END SELECT
      END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
      LOCAL lRslt  AS LONG
    
    #PBFORMS Begin Dialog %IDD_DIALOG1->->
      LOCAL hDlg   AS DWORD
      LOCAL hFont1 AS DWORD
      LOCAL hFont2 AS DWORD
    
      DIALOG NEW PIXELS, hParent, "Graphic expander", 105, 114, 400, 400, _
      %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
      %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
      %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
      DIALOG  SET COLOR    hDlg, -1, RGB(172, 196, 196)
      CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1_32x32, "", 16, 40, 32, 32, _
      %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY
      CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1_64x32, "", 232, 40, 64, 32, _
      %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY
      GRAPHIC ATTACH hDlg, %IDC_GRAPHIC1_64x32
      CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1_32x64, "", 16, 192, 32, 64, _
      %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY
      CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1_64x64, "", 240, 192, 64, 64, _
      %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY
      CONTROL ADD BUTTON,  hDlg, %IDC_DOTHIS, "A to B", 24, 272, 75, 24
      CONTROL ADD BUTTON,  hDlg, %IDC_DOTHAT, "A to C", 24, 296, 75, 24
      CONTROL ADD BUTTON,  hDlg, %IDC_DOBOTH, "A to D", 24, 320, 75, 24
      CONTROL ADD BUTTON,  hDlg, %IDC_DONT, "Exit", 24, 344, 75, 24
      CONTROL ADD LABEL,   hDlg, %IDC_A, "A", 16, 8, 32, 32, %WS_CHILD OR _
      %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE, %WS_EX_LEFT OR _
      %WS_EX_LTRREADING
      CONTROL SET COLOR    hDlg, %IDC_A, -1, -2
      CONTROL ADD LABEL,   hDlg, %IDC_B, "B", 232, 8, 32, 32, %WS_CHILD OR _
      %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE, %WS_EX_LEFT OR _
      %WS_EX_LTRREADING
      CONTROL SET COLOR    hDlg, %IDC_B, -1, -2
      CONTROL ADD LABEL,   hDlg, %IDC_C, "C", 16, 160, 32, 32, %WS_CHILD OR _
      %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE, %WS_EX_LEFT OR _
      %WS_EX_LTRREADING
      CONTROL SET COLOR    hDlg, %IDC_C, -1, -2
      CONTROL ADD LABEL,   hDlg, %IDC_D, "D", 240, 160, 32, 32, %WS_CHILD OR _
      %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE, %WS_EX_LEFT OR _
      %WS_EX_LTRREADING
      CONTROL SET COLOR    hDlg, %IDC_D, -1, -2
    
      FONT NEW "MS Sans Serif", 10, 0, %ANSI_CHARSET TO hFont1
      FONT NEW "MS Sans Serif", 12, 1, %ANSI_CHARSET TO hFont2
    
      CONTROL SET FONT hDlg, -1, hFont1
      CONTROL SET FONT hDlg, %IDC_GRAPHIC1_32x32, hFont1
      CONTROL SET FONT hDlg, %IDC_GRAPHIC1_64x32, hFont1
      CONTROL SET FONT hDlg, %IDC_GRAPHIC1_32x64, hFont1
      CONTROL SET FONT hDlg, %IDC_GRAPHIC1_64x64, hFont1
      CONTROL SET FONT hDlg, %IDC_DOTHIS, hFont1
      CONTROL SET FONT hDlg, %IDC_DOTHAT, hFont1
      CONTROL SET FONT hDlg, %IDC_DOBOTH, hFont1
      CONTROL SET FONT hDlg, %IDC_DONT, hFont1
      CONTROL SET FONT hDlg, %IDC_A, hFont2
      CONTROL SET FONT hDlg, %IDC_B, hFont2
      CONTROL SET FONT hDlg, %IDC_C, hFont2
      CONTROL SET FONT hDlg, %IDC_D, hFont2
    #PBFORMS End Dialog
    
      DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
    #PBFORMS Begin CleanUp %IDD_DIALOG1
      FONT END hFont1
      FONT END hFont2
    #PBFORMS End CleanUp
    
      FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    Rod
    In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

  • #2
    More on this here.
    Rod
    In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

    Comment


    • #3
      Just a simplification...

      instead of this...
      IF ndx/32=ndx\32 THEN

      use this...
      IF (ndx AND 31) = 0 THEN

      Comment


      • #4
        Don't recall ever seeing that syntax but it works. So does IF (ndx MOD 32)=0. There may be others, but I like yours. I don't know which is most intuitive.
        Rod
        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

        Comment


        • #5
          Originally posted by Rodney Hicks View Post
          Don't recall ever seeing that syntax but it works. So does IF (ndx MOD 32)=0. There may be others, but I like yours. I don't know which is most intuitive.
          Once you get familiar with the IF (x AND y) = ... THEN construct, it becomes very intuitive. You'll see lots of examples of its use in code posted here.

          Frequently in the form IF (BitFlags AND %BitFlagOfInterest) = %BitFlagOfInterest THEN ... ' flag is set

          And it's much faster than the alternatives:

          '
          Code:
          #COMPILE EXE
          #DIM ALL
          %Iterations = 10000000
          
          FUNCTION PBMAIN() AS LONG
              ? fDiv & fMod & fAnd
          END FUNCTION
          
          FUNCTION fDIv() AS STRING
          LOCAL x,laccum AS LONG
          LOCAL  q AS QUAD
          TIX q
          FOR x = 1 TO %iterations
              IF x/32 = x\32 THEN INCR laccum
          NEXT
          TIX END q
          FUNCTION = "fIntDIv: Found " & STR$(lAccum) & " values out of " & STR$(%Iterations) & " in " & DEC$(q) & " tixs" & $LF
          END FUNCTION
          
          FUNCTION fMod() AS STRING
          LOCAL x,laccum AS LONG
          LOCAL  q AS QUAD
          TIX q
          FOR x = 1 TO %iterations
              IF (x MOD 32) = 0 THEN INCR laccum
          NEXT
          TIX END q
          FUNCTION = "fMod:   Found " & STR$(lAccum) & " values out of " & STR$(%Iterations) & " in " & DEC$(q) & " tixs" & $LF
          END FUNCTION
          
          FUNCTION fAnd() AS STRING
          LOCAL x,laccum AS LONG
          LOCAL  q AS QUAD
          TIX q
          FOR x = 1 TO %iterations
              IF (x AND 31) = 0 THEN INCR laccum
          NEXT
          TIX END q
          FUNCTION = "fAnd:    Found " & STR$(lAccum) & " values out of " & STR$(%Iterations) & " in " & DEC$(q) & " tixs" & $LF
          END FUNCTION
          '
          Here's my result from a typcial run

          fDiv: Found 312500 values out of 10000000 in 405579716 tixs
          fMod: Found 312500 values out of 10000000 in 99367734 tixs
          fAnd: Found 312500 values out of 10000000 in 29579994 tixs

          -
          Last edited by Stuart McLachlan; 26 May 2021, 10:03 PM.

          Comment


          • #6
            Thanks Stuart.
            I played with that a bit, filed it under 'learn something new every day'!
            Rod
            In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

            Comment


            • #7
              Originally posted by Rodney Hicks View Post
              Don't recall ever seeing that syntax but it works. So does IF (ndx MOD 32)=0. There may be others, but I like yours. I don't know which is most intuitive.
              It's good for testing if any integer is evenly divisible by 2, 4, 8, 16, 32, 64, 128, 256 and so on.
              The rule of thumb is to AND with (the power of 2) minus 1.

              If you look at any integer in binary format you can tell at a glance if it's evenly divisible by a power of 2, because the Least Significant bits will all be 0 up to the power of 2.
              That's why we test IF (x AND &B11111) = 0 ...

              Stuart demonstrated that its MUCH faster than division or MOD - but it can be a little cryptic, if you've not seen it before.

              Comment


              • #8
                Well, in spite of it being limited to the powers of 2 it is for sure a tool for the toolbox. Thanks, guys!
                Rod
                In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                Comment


                • #9

                  Using similar reasoning, I think "IF be=256 THEN be=0" would be better cast as "be = be AND 255", avoiding a conditional branch.

                  Comment


                  • #10
                    And so it does:
                    Code:
                    #COMPILE EXE
                    #DIM ALL
                    %Iterations = 10000
                    
                    
                    FUNCTION PBMAIN() AS LONG
                      LOCAL jj, kk, twin AS LONG
                      TXT.WINDOW ("AND", 10,10, 40, 70) TO twin
                      FOR jj=1 TO %Iterations
                        INCR kk
                        kk= kk AND 255
                        IF kk=1 THEN TXT.PRINT jj; kk
                      NEXT jj
                      TXT.WAITKEY$
                      TXT.END
                    END FUNCTION
                    This isn't much good for checking comparative speed since the TXT.WINDOW is rather sluggish, but it does show your idea works.

                    Thanks, Mark!
                    Rod
                    In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                    Comment


                    • #11
                      Originally posted by Rodney Hicks View Post
                      And so it does:
                      There's only about 10% difference in my testing (AND is still faster)

                      '
                      Code:
                      #COMPILE EXE
                      #DIM ALL
                      %Iterations = 1000000000
                      FUNCTION PBMAIN() AS LONG
                          ? "AND:" & STR$(fAnd())  & "   IF: " & STR$(fIf())
                      END FUNCTION
                      
                      FUNCTION fIf() AS QUAD
                      LOCAL jj,kk  AS LONG
                      LOCAL  q AS QUAD
                      TIX q
                      FOR jj = 1 TO %iterations
                          INCR kk
                          IF kk=256 THEN kk=0
                      NEXT
                      TIX END q
                      FUNCTION = q
                      END FUNCTION
                      
                      FUNCTION fAnd() AS QUAD
                      LOCAL jj,kk  AS LONG
                      LOCAL  q AS QUAD
                      TIX q
                      FOR jj = 1 TO %iterations
                          INCR kk
                          kk= kk AND 255
                      NEXT
                      TIX END q
                      FUNCTION = q
                      END FUNCTION
                      '

                      Comment


                      • #12
                        I'm getting a 40% improvement here, A typical result :
                        AND: 2532963810
                        IF: 4239594745
                        Rod
                        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                        Comment


                        • #13
                          Actually, Rod, in the context of your program, neither is necessary. The RGB function will use only the first byte of the "be" variable anyway.

                          Comment


                          • #14
                            Originally posted by Mark Bullivant View Post
                            Actually, Rod, in the context of your program, neither is necessary. The RGB function will use only the first byte of the "be" variable anyway.
                            Subtle, that!

                            Funny, I wrote the program to make myself more comfortable with pointers as they apply to the GET/SET BITS strings, expecting to be corrected for some failure or advised of some technique about pointers and here I am learning other things.

                            The benefits of these fora are boundless!!
                            Rod
                            In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                            Comment

                            Working...
                            X