Announcement

Collapse
No announcement yet.

dragging a box around a GRAPHIC WINDOW

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

  • dragging a box around a GRAPHIC WINDOW

    I call the little draggable box a winlet because it's not a window - well not a Windows window, anyway. But it can have attributes of a window, like containing a menu, textbox, listbox, closeme button, etc.

    Anyway this just shows my first attempt at dragging a winlet - draggable because it contains a dragicon - around a GRAPHIC WINDOW, as ever, if you can see a way of improving it, do tell!

    Code:
    ' to show dragging a winlet on a GRAPHIC WINDOW
    ' Chris Holbrook October 2008
    '
    ' Also uses Edwin Knoppert's BINBAS to load an icon
    ' which is embedded in the executable
    '
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    '#include "COMMCTRL.INC"
    
    GLOBAL GrDialogProc AS LONG
    GLOBAL GrStaticProc AS LONG
    GLOBAL gMouseX AS LONG,gMouseY AS LONG    ' Mouse x and y
    GLOBAL gLbDOWN AS LONG,gRBDOWN AS LONG    ' Left and right mouse button
    GLOBAL gMouseMoved AS LONG               ' Detect mouse movements
    '
    ' Icon stuff - or you could load it from a resource file
    '---------------------------------------------------------------
    '//////////////////////////////////////////////////////////////////////////
    '// Icon loading
    '//////////////////////////////////////////////////////////////////////////
    
    TYPE TAGICONDIR
    
        idReserved  AS WORD '// Reserved (must be 0)
        idType      AS WORD '// Resource Type (1 For icons)
        idCount     AS WORD '// How many images?
    
    END TYPE
    
    TYPE TAGICONDIRENTRY
    
        bWidth          AS BYTE     '// Width, In Pixels, of the Image
        bHeight         AS BYTE     '// Height, In Pixels, of the Image
        bColorCount     AS BYTE     '// Number of colors In Image (0 If >=8bpp)
        bReserved       AS BYTE     '// Reserved ( must be 0)
        wPlanes         AS WORD     '// Color Planes
        wBitCount       AS WORD     '// Bits per pixel
        dwBytesInRes    AS DWORD    '// How many bytes In this resource?
        dwImageOffset   AS DWORD    '// Where In the file is this image?
    
    END TYPE
    
    '// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
    '// Returns a iconhandle.
    FUNCTION SetIconFileBits( BYVAL lpMem AS LONG ) AS LONG
    
        DIM pIconDir        AS TAGICONDIR PTR
        DIM IconDirEntry    AS TAGICONDIRENTRY PTR
    
        pIconDir = lpMem
        IF @pIconDir.idCount < 1 THEN EXIT FUNCTION
        IconDirEntry = pIconDir + LEN( @pIconDir )
    
        FUNCTION = CreateIconFromResource( _
              BYVAL pIconDir + @IconDirEntry.dwImageOffset _
            , @IconDirEntry.dwBytesInRes _
            , @pIconDir.idType _
            , &H30000& _
            )
    
    END FUNCTION
    
    
    '//////////////////////////////////////////////////////////////////////////
    MACRO mBinDataStuff
        LOCAL a AS LONG
        LOCAL t, t2 AS STRING
        FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a
        FOR a = 1 TO LEN( T ) STEP 2
            T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) )
        NEXT a
        FUNCTION = STRPTR(T2)
    END MACRO
    '-------------------------------------------------------------------------------
    FUNCTION BinBasDRAGGRIP AS DWORD
    
        mBinDataStuff
    
    DATA 0000010001001010100001000400280100001600000028000000100000002000000001
    DATA 00040000000000000000000000000000000000000000000000000000FFFF0000000000
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 0000000000000000000000000000000000000000000000000000000000011111111111
    DATA 1110011111111111111001111111111111100111111111111110011111111111111001
    DATA 1111111111111001111111111111100111111111111110011111111111111001111111
    DATA 1111111001111111111111100111111111111110011111111111111001111111111111
    DATA 100000000000000000000000007EFE00007C7E00007ABE00007EFE00006EF600005EFA
    DATA 0000000000005EFA00006EF600007EFE00007EFE00007ABE00007C7E00007EFE000000
    DATA 000000
    
    END FUNCTION
    
    '--------------------------------------------------------------------------------
    FUNCTION GrDlgProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
     FUNCTION = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
    END FUNCTION
    '--------------------------------------------------------------------------------
    FUNCTION GrProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
      LOCAL p AS pointapi
      SELECT CASE wMsg
        CASE %WM_MOUSEMOVE
            gMouseMoved = %TRUE
            gMouseX = LO(WORD,lParam)
            gMouseY = HI(WORD,lParam)         ' Current Mouse X and Y Position in the graphic window
        CASE %WM_LBUTTONDOWN
            gLBDOWN = 1
            EXIT FUNCTION                      ' Left button pressed
        CASE %WM_LBUTTONUP
            gLBDOWN = 0
            EXIT FUNCTION
        CASE %WM_RBUTTONDOWN
            gRBDOWN = 1
            EXIT FUNCTION                      ' Right button pressed
        CASE %WM_RBUTTONUP
            gRBDOWN = 0
            EXIT FUNCTION                      ' Right button pressed
      END SELECT
     FUNCTION = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
    
    END FUNCTION
    
    '----------------------------------------------------------
    SUB doboxstuff ( X AS LONG, Y AS LONG, W AS LONG, H AS LONG, OPT hicon AS LONG)
        LOCAL r, rlastbox, DragGripIconRect AS rect
        LOCAL skey AS STRING
        LOCAL movemode AS LONG
        LOCAL hDC AS LONG
        LOCAL DragSizeOriginX, DragSizeOriginY AS LONG
        LOCAL lresult AS LONG
    
    
        setrect BYVAL VARPTR(r), X, Y, W, H
        GOSUB drawbox
        DO
            SLEEP 0
            GRAPHIC INKEY$ TO skey
            IF skey = $ESC THEN EXIT SUB
            IF skey = "" THEN
                IF glbdown THEN
                    IF ptinrect ( DragGripIconRect, DragSizeOriginX, DragSizeOriginY) THEN
                        DragSizeOriginX = gMouseX
                        DragSizeOriginY = gMouseY
                    END IF
                    IF gmousemoved THEN
                        DO
                            SLEEP 50
                            ' the left mouse button has been held down
                            ' the action depends upon where cursor was when
                            ' the initial button press was made
                            offsetRect BYVAL VARPTR( r), gMouseX - DragSizeOriginX, gMouseY - DragSizeOriginY
                            GOSUB drawbox
                            DragSizeOriginX = gMouseX
                            DragSizeOriginY = gMouseY
                        LOOP UNTIL glbdown = 0
                        gmousemoved = %FALSE
                        ITERATE
                    END IF
                END IF
            END IF
        LOOP
        EXIT SUB ' never gets here
    drawbox:
    
        GRAPHIC BOX ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %WHITE, %WHITE, 0
        GRAPHIC BOX ( r.nleft,r.ntop) - (r.nright, r.nbottom), 0, %BLACK, %WHITE, 0
        ' calculate average corner size
        IF hicon THEN
            GRAPHIC GET DC TO hdc
            DragGripIconRect.nleft   = r.nleft + 10        ' position icon at offset 10, 10 inside box
            DragGripIconRect.ntop    = r.ntop  + 10
            DragGripIconRect.nright  = r.nleft + 10 + 16
            DragGripIconRect.nbottom = r.ntop  + 10 + 16
            lresult = drawiconex (hdc, r.nleft + 10, r.ntop + 10, hicon, 16, 16, 0, BYVAL 0, %di_normal)
        END IF
        GRAPHIC REDRAW
        copyrect BYVAL VARPTR(rlastbox), BYVAL VARPTR(r)
    
        RETURN
    END SUB ' never gets here either
    
    '--------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
        LOCAL hGW AS DWORD
        LOCAL hstatic AS DWORD
        LOCAL x, y, w, h, ICON_draggrip AS LONG
    
        icon_DRAGGRIP   = SetIconFileBits(BinBasDragGrip)
    
        ' Center graphic window within console window
        CONSOLE GET LOC TO x, y    ' Console pos on screen
    
        CONSOLE GET SIZE TO w, h   ' Console size
    
        x = x + (w - 200) / 2      ' Calculate center x pos
    
        y = y + (h - 200) / 2      ' Calculate center y pos
    
        GRAPHIC WINDOW "Winlet with dragicon    Chris Holbrook", x, y, 600, 600 TO hGW
    
        hStatic = GetWindow(hGW, %GW_CHILD)                       ' Retrieve static handle of graphic window
        GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, CODEPTR(GrProc)) ' Subclasses Graphic control
    
        GRAPHIC ATTACH hGW, 0
        GRAPHIC COLOR %BLACK, %WHITE
        GRAPHIC CLEAR
        doboxstuff(20, 20, 200, 200, icon_draggrip)
    
        SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
        IF icon_DRAGGRIP   THEN destroyicon(icon_DRAGGRIP)
        GRAPHIC WINDOW END
    
    
    END FUNCTION
    Last edited by Chris Holbrook; 31 Oct 2008, 04:14 PM. Reason: changed graphic window title

  • #2
    correction!

    Sorry, I got it wrong.

    The dragging was happening irrespective of whether the drag icon was clicked.

    Here is the corrected loop:

    Code:
        DO
            SLEEP 0
            GRAPHIC INKEY$ TO skey
            IF skey = $ESC THEN EXIT SUB
            IF skey = "" THEN
                IF glbdown THEN
                    IF ptinrect ( BYVAL VARPTR(DragGripIconRect), gMouseX, gMouseY) THEN
                        DragSizeOriginX = gMouseX
                        DragSizeOriginY = gMouseY
                    END IF
                    IF gmousemoved THEN
                        IF DragSizeOriginX = 0 THEN EXIT IF
                        DO
                            SLEEP 50
                            ' the left mouse button has been held down
                            ' the action depends upon where cursor was when
                            ' the initial button press was made
                            offsetRect BYVAL VARPTR( r), gMouseX - DragSizeOriginX, gMouseY - DragSizeOriginY
                            GOSUB drawbox
                            DragSizeOriginX = gMouseX
                            DragSizeOriginY = gMouseY
                        LOOP UNTIL glbdown = 0
                        gmousemoved = %FALSE
                        ITERATE
                    END IF
                ELSE ' left button is up, clear drag origin
                    DragSizeOriginX = 0
                    DragSizeOriginY = 0
                END IF
            END IF
        LOOP

    Comment


    • #3
      Now multiple draggable winlets with z-ordering

      Not showing the icon code here (too lazy), but the icon position at the top right of each winlet is more or less where the number is shown, so to move the winlet you just click on the number and drag it. If you click on a different winlet (anywhere on it) then the current winlet is deselected and the clicked one selected. If you click but not on a winlet then none is selected. If you press ESC with no winlet selected the the application terminates. If you press ESC with a winlet selected then the winlet is de-selected.

      This app doesn't do anything useful, it is just to show a way that these window-like objects could be handled on the desktop.


      Code:
      ' Winlets on a GRAPHIC WINDOW.
      '
      ' to show draggable winlets using z-order
      ' Chris Holbrook Nov 2008
      '
      ' Left-click on a winlet to select it.
      ' drag it by holding the left mouse button down over the number in the top L
      ' and dragging.
      ' to deselect, just click somewhere else, or press ESC.
      ' with no winlet selected, ESC exits the application.
      '
      #compile exe
      #dim all
      #include once "WIN32API.INC"
      
      %PBF_BOXSEL_COLOR = %yellow
      %PBF_BG_COLOR     = &HD0E0E0
      %PBF_FG_COLOR     = %black
      
      global WL() as myWinlet                   ' Winlet array
      global ghGR as dword                      ' global graphic window handle
      global gZSEQ as long                      ' sequence number for labelling winlets
                                                ' it just keeps rolling, one day it will overflow!!!!!!
      global GrDialogProc as long               ' used in subclassing the grapic control to get mouse msgs
      global GrStaticProc as long               ' used in subclassing the grapic control to get mouse msgs
      global gMouseX as long,gMouseY as long    ' Mouse x and y
      global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
      global gMouseMoved as long               ' Detect mouse movements
      '--------------------------------------------------------------------------------
      function GrDlgProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
       function = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
      end function
      '--------------------------------------------------------------------------------
      function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
        local p as pointapi
        select case wMsg
          case %wm_mousemove
              gMouseMoved = %TRUE
              gMouseX = lo(word,lParam)
              gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
          case %wm_lbuttondown
              gMouseX = lo(word,lParam)
              gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
              gLBDOWN = 1
              exit function                      ' Left button pressed
          case %wm_lbuttonup
              gLBDOWN = 0
              exit function
          case %wm_rbuttondown
              gRBDOWN = 1
              exit function                      ' Right button pressed
          case %wm_rbuttonup
              gRBDOWN = 0
              exit function                      ' Right button pressed
        end select
       function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
      
      end function
      
      sub debugprintrect ( s as string, byval rp as rect ptr)
         ? s + str$(@rp.nleft),str$(@rp.ntop),str$(@rp.nright), str$(@rp.nbottom)
      end sub
      '------------------------------------------------------------------------
      ' redraw all winlets in Z order
      sub z_draw
          local tempr, junkr as RECT
          local i, l as long
          local z() as dword
          
          
          graphic clear %PBF_BG_COLOR
      
          dim z(0 to ubound(WL)) as local dword ' 0=zpos, 1=index in WL()
      
          for i = 0 to ubound(WL)
               z(i) = mak(dword, i, WL(i).zposn)
          next
          array sort z()
          local skey as string
          for i = 0 to ubound(WL)
              WL(lo(word,z(i))).drawwinlet
          next
          graphic redraw
      end sub
      
      '-----------------------------------------------------------------------
      class myWinletClass
          ' these are PRIVATE variables shared between methods in the class
          ' exitpoint is the mouse coordinates which
          ' which the user clicked to exit the winlet - i.e. outside the current winlet
          ' LO word is X, HI word is Y
          instance exitpoint as dword
          ' Leaveform is a boolean value set e.g. by CLOSEME winlets to indicate that
          ' the form processing has finished.
          instance leaveform as long
          ' This is the initial rect for the winlet
          instance initialrect as RECT
          ' This is the current rect(after dragging and sizing, maybe)
          instance currentrect as RECT
          'If zero, no drag!
          instance draggable as long
          'if zero, no resize!
          instance sizeable as long
      
          ' type of component
          ' 0 = undefined
          ' 1 = CLOSEME
          ' 2 = edit box
          ' 3 = text box
          ' 4 = list box
          ' 5 = msgbox
          instance CompType as long
          ' handle of stored bitmap
          instance storedBMP as dword
          ' current zpos of winlet
          instance ZPOS as long
          ' default (e.g. initial) zpos of winlet to which winlet reverts when deselected
          instance DefaultZPOS as long
          ' the currently selected winlet
          instance currentwinlet as long
          ' handle for drag icon
          instance hdragicon as long
          ' handle for size icon
          instance hsizeicon as long
          ' identifying number for the winlet
          instance winletid as long
          '
          instance DragGripIconRect as RECT
          ' DC for the current GW
          instance hDC as dword
          ' testing!
          instance testarray() as long
          '---------------------------------------------------------
          ' these are PRIVATE methods
          ' update the stored copy of the winlet's bitmap
          class method updatestoredcopy ( hGR as dword, r as rect )
              local i as long
              local q as quad
              graphic bitmap new r.nright - r.nleft, r.nbottom - r.ntop to storedBMP
              graphic attach storedBMP, 0, redraw
              graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
              ' copy the area to the smaller GW
              graphic copy hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) to (0, 0)
              graphic attach hGR, 0, redraw
              graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
              graphic font "Courier New"
              me.setcurrentrect(r.nleft, r.ntop, r.nright, r.nbottom)
              graphic redraw
          end method
      
          '------------------------------------------------------------------------
          class method setCurrentRect ( X as long, Y as long, W as long, H as long)
              setrect ( byval varptr(currentRect), X, Y, W, H)
          end method
          '------------------------------------------------------------------------
          class method destroy
              graphic attach storedBMP, 0
              graphic clear %PBF_BG_COLOR
              graphic window end
              graphic attach ghGR, 0, redraw
              graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
      
          end method
          '------------------------------------------------------------------------
          class method create
              local x, y, w, h as long
              desktop get size to W, H
              X = rnd(50, W/2)
              Y = rnd(50, H/2)
              W = rnd(50, W/4)
              H = rnd(50, H/4)
              me.SetInitRect (X, Y, X + W, Y + H)
              me.SetCurrRect (X, Y, X + W, Y + H)
              winletid = gZSEQ
              zpos = gZSEQ ' record zpos
              defaultzpos = gZSEQ ' record zpos
              me.updatestoredcopy ( ghGR, CurrentRect )
              me.drawit
              incr gZSEQ
              graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
          end method
          '-----------------------------------------------------------------------
          class method SetInitRect ( X as long, Y as long, W as long, H as long)
              setrect  byval varptr(initialrect), X, Y, W, H
          end method
          '-----------------------------------------------------------------------
          class method SetCurrRect ( X as long, Y as long, W as long, H as long)
              setrect  byval varptr(CurrentRect), X, Y, W, H
          end method
          '------------------------------------------------------------------------
          class method boxrect (r as rect, byval fillcolour as long)
              graphic box ( r.nleft, r.ntop) - (r.nright, r.nbottom), 0,0,fillcolour
          end method
          '-----------------------------------------------------------------------
          class method drawit
              local tempr as rect
              local hDC as dword
      
              ' draw current rect
              graphic box (currentrect.nleft, currentrect.ntop) - (currentrect.nright, currentrect.nbottom),0,%PBF_FG_COLOR,%PBF_BG_COLOR
              ' draw highlight just inside it
              if currentwinlet then
                  copyrect byval varptr(tempr), byval varptr(currentrect)
                  inflaterect ( byval varptr(tempr), -1, -1)
                  graphic box ( tempr.nleft,tempr.ntop) - (tempr.nright, tempr.nbottom), 0, %PBF_BOXSEL_COLOR, %PBF_BG_COLOR, 0
              end if
              ' draw winlet id
              graphic set pos ( currentrect.nleft + 5, currentrect.ntop + 5 )
              graphic print str$(winletid);
              ' set new location for draggripicon
              DragGripIconRect.nleft   = CurrentRect.nleft + 2        ' position icon at offset 10, 10 inside box
              DragGripIconRect.ntop    = CurrentRect.ntop  + 2
              DragGripIconRect.nright  = CurrentRect.nleft + 2 + 16
              DragGripIconRect.nbottom = CurrentRect.ntop  + 2 + 16
              ' show icon if we have one
              if hdragicon then
                  graphic get dc to hdc
                  drawiconex (hdc, CurrentRect.nleft + 2, CurrentRect.ntop + 2, hdragicon, 16, 16, 0, byval 0, %di_normal)
              end if
          end method
          '
          'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
          interface MyWinlet
              inherit iunknown
              ' these are PUBLIC methods
              '
              method drawwinlet
                  me.drawit
              end method
      
              method exitpoint as long
                  method = exitpoint
              end method
              '------------------------------------------------------------------------
              method identity as long
                  method = winletid
              end method
      
              '------------------------------------------------------------------------
              ' the FormLoop transfers control to the winlet by calling this proc.
              ' after making it visible and selected. No need to create or draw frame.
              method warmstart
                  local skey as string
                  local dragsizeoriginX, dragsizeoriginY, dragging as long
                  local dragsizeTargetX, dragsizeTargetY as long
                  local i, lresult as long
                  local rlastbox,  junkr, tempr, redrawrect as RECT
                  local hDC as dword
                  local dragstart as double
                  local zord() as long
      
                  dim zord(0 to ubound(WL)) as local long
                  copyrect byval varptr(rlastbox), byval varptr(currentrect)
                  gosub drawbox
                  do
                      sleep 0
                      graphic inkey$ to skey
                      if skey = $esc then exit method
                      if skey = "" then
                          if glbdown then
                              if dragging = %false then
                                  ' if the click was in a drag rect, then start the drag operation
                                  if ptinrect ( byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                      dragsizeoriginX = currentrect.nleft
                                      dragsizeoriginY = currentrect.ntop
                                      dragging = %true
                                      dragstart = timer
                                  else
                                      ' if the click was outside the current winlet, exit to form loop!
                                      if ptinrect( byval varptr(currentrect), gmouseX, gmouseY) = 0 then
                                          exit method
                                      end if
                                  end if
                              end if
                              if gmousemoved then
                                  if Dragging = %false then exit if
                                  do
                                      sleep 0
                                      ' the left mouse button has been held down
                                      ' the action depends upon where cursor was when
                                      ' the initial button press was made
                                      if (gmousex = DragSizeOriginX) and (gmouseY = DragSizeOriginY) then exit loop
                                      if timer - dragstart > 0.05 then
                                          z_draw' redraw winlets in z-order
                                          gosub drawbox
                                          DragSizeOriginX = DragSizeTargetX
                                          DragSizeOriginY = DragSizeTargetY
                                          dragstart = timer
                                          graphic redraw
                                      end if
                                      DragSizeTargetX = gMouseX
                                      DragSizeTargetY = gMouseY
                                  loop until glbdown = 0
                                  gmousemoved = %FALSE
                                  iterate
                              end if
                          else ' left button is up, clear drag origin
                              if dragging then
                                  z_draw' redraw winlets in z-order
                                  me.drawit
                                  graphic redraw
                              end if
                              dragging = %false
                              DragSizeOriginX = currentrect.nleft
                              DragSizeOriginY = currentrect.ntop
      
                          end if
                      end if
                  loop
                  exit method ' never gets here
              drawbox:
                  ' calculate the rect to be redrawn from the
                  ' start pos, end pos and size of winlet being dragged
                  'if (dragsizeoriginX = dragsizetargetX) and (dragsizeoriginY = dragsizetargetY) then return
                  redrawrect = currentrect
                  offsetrect byval varptr(currentrect), DragSizeTargetX - DragSizeOriginX, DragSizeTargetY - DragSizeOriginY
                  'redraw any winlets which intersect this redraw area
                  'debugprintrect "lastbox", BYVAL VARPTR(rlastbox)
                  graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                  '
                  'debugprintrect "white ", BYVAL VARPTR(rlastbox)
                  'debugprintrect "black ", BYVAL VARPTR(currentrect)
                  graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                  me.drawit
                  ' the drag icon zone is at the top left of the winlet
                  ' irrespective of whether an icon is available
                  copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
      
                  return
              end method
              '------------------------------------------------------------------------
              method draw
                  me.drawit
              end method
      
              '------------------------------------------------------------------------
              method LeaveForm as long
                  method = leaveform
              end method
              '------------------------------------------------------------------------
              method zposn as long
                  method = zpos
              end method
              '------------------------------------------------------------------------
              method CurrentRect as dword
                  method = varptr(CurrentRect)
              end method
              '------------------------------------------------------------------------
              method unselect
                  local tempr as rect
                  ' clear the hightlighted frame
                  currentwinlet = %FALSE
                  copyrect byval varptr(tempr), byval varptr(currentrect)
                  inflaterect byval varptr(tempr), -1, -1
                  graphic box (tempr.nleft, tempr.ntop) - _
                              (tempr.nright, tempr.nbottom),0,%PBF_BG_COLOR,-2
                  graphic redraw
              end method
              '------------------------------------------------------------------------
              method makecurrent
                  graphic copy storedBMP, 0 to (CurrentRect.nleft, CurrentRect.ntop) ', %mix_MergeSrc
                  'next 3 lines attempt to draw the eye to the clicked control, are not essential
                  graphic box (CurrentRect.nleft + 1, CurrentRect.ntop + 1) - _
                              (CurrentRect.nright - 1, CurrentRect.nbottom - 1),0,%red,-2
                  graphic redraw
                  sleep 0
                  
                  zpos = gZSEQ: incr gZSEQ
                  
                  currentwinlet = %TRUE
                  me.drawit
                  graphic redraw
                  'sleep 2000
              end method
              '-------------------------------------------------------------------------
              method selected as long
                  method = currentwinlet
              end method
          end interface
          'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
      end class
      
      '-------------------------------------------------------------------------
      
      sub FormLoop ( hGW as dword, nWinlets as long)
          local i, wlx, bestz, besti as long
          local skey as string
          local r as RECT
      
          dim WL(0 to nWinlets -1) as global myWinlet
      
          for i = 0 to nWinlets -1
              WL(i) = class "MyWinLetClass"
          next
      
          wlx = nWinlets
          if wlx = 0 then
              ? "no Winlets defined! cannot proceed!"
              exit sub
          end if
          
          wlx = nwinlets -1
          z_draw
          do
              sleep 0
              graphic inkey$ to skey
              if skey = "" then ' check mouse
                  if glbdown then ' mouse clicked
                      bestz = -1
                      ' find the window with the highest Z position
                      ' which underlies the current mouse position
                      for i = 0 to nwinlets-1
                          copyrect (r, byval WL(i).CurrentRect)
                          if ptinrect ( byval varptr(r), gMouseX, gMouseY) then
                              if WL(i).zposn > bestz then
                                  bestz = WL(i).zposn
                                  besti = i
                              end if
                          end if
                      next
                      if bestz = -1 then iterate ' clicked outside any winlet
                      WL(besti).makecurrent
                      wlx = besti
                      WL(wlx).warmstart ' transfer control to the winlet
                      WL(wlx).unselect ' unselect whichever is currently selected
                  end if
              end if
              select case skey
                  case $esc
                      exit loop
              end select
          loop
      
      end sub
       '----------------------------------------------------------------
      function pbmain () as long
          local w, h as long
          local hstatic as dword
      
          desktop get size to W, H
          graphic window "Winlets on a GRAPHIC WINDOW (select, drag, z-ordering)                                 Chris Holbrook Nov 2008", 0,0, W, H to ghGR
          hStatic = GetWindow(ghGR, %GW_CHILD)                       ' Retrieve static handle of graphic window
          GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
          FormLoop  ghGR, 10
          SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
          graphic window end
      
      end function

      Comment


      • #4
        select, drag, size, z-order, icons

        I put the icons back, drag icon in the top left, size in the bottom right.

        Code:
        ' Winlets on a GRAPHIC WINDOW.
        '
        ' to show selectable, draggable, sizeable winlets using z-order
        ' Chris Holbrook Nov 2008
        '
        ' Left-click on a winlet to select it.
        ' drag it by holding the left mouse button down over the icon in the top L
        ' and dragging.
        ' Resize using the icon in the bottom right.
        '
        ' to deselect, just move the cursor off the winlet or click somewhere else, or press ESC.
        ' with no winlet is selected, ESC exits the application.
        '
        #compile exe
        #dim all
        #include once "WIN32API.INC"
        
        %PBF_BOXSEL_COLOR = %yellow
        %PBF_BG_COLOR     = &HD0E0E0
        %PBF_FG_COLOR     = %black
        %PBFMINWINLETSIZE = 45
        
        %PBFDragging = 1
        %PBFSizing   = 2
        
        global WL() as myWinlet                   ' Winlet array
        global ghGR as dword                      ' global graphic window handle
        global gZSEQ as long                      ' sequence number for labelling winlets
                                                  ' it just keeps rolling, one day it will overflow!!!!!!
        global GrDialogProc as long               ' used in subclassing the grapic control to get mouse msgs
        global GrStaticProc as long               ' used in subclassing the grapic control to get mouse msgs
        global gMouseX as long,gMouseY as long    ' Mouse x and y
        global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
        global gMouseMoved as long                ' Detect mouse movements
        global gIcon_Draggrip as long              ' draggrip icon handle
        global gIcon_Sizegrip as long              ' sizegrip icon handle
        '
        ' Icon stuff - or you could load it from a resource file
        '---------------------------------------------------------------
        '//////////////////////////////////////////////////////////////////////////
        '// Icon loading
        '//////////////////////////////////////////////////////////////////////////
        
        type TAGICONDIR
        
            idReserved  as word '// Reserved (must be 0)
            idType      as word '// Resource Type (1 For icons)
            idCount     as word '// How many images?
        
        end type
        
        type TAGICONDIRENTRY
        
            bWidth          as byte     '// Width, In Pixels, of the Image
            bHeight         as byte     '// Height, In Pixels, of the Image
            bColorCount     as byte     '// Number of colors In Image (0 If >=8bpp)
            bReserved       as byte     '// Reserved ( must be 0)
            wPlanes         as word     '// Color Planes
            wBitCount       as word     '// Bits per pixel
            dwBytesInRes    as dword    '// How many bytes In this resource?
            dwImageOffset   as dword    '// Where In the file is this image?
        
        end type
        
        '// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
        '// Returns a iconhandle.
        function SetIconFileBits( byval lpMem as long ) as long
        
            dim pIconDir        as TAGICONDIR ptr
            dim IconDirEntry    as TAGICONDIRENTRY ptr
        
            pIconDir = lpMem
            if @pIconDir.idCount < 1 then exit function
            IconDirEntry = pIconDir + len( @pIconDir )
        
            function = CreateIconFromResource( _
                  byval pIconDir + @IconDirEntry.dwImageOffset _
                , @IconDirEntry.dwBytesInRes _
                , @pIconDir.idType _
                , &H30000& _
                )
        
        end function
        
        
        '//////////////////////////////////////////////////////////////////////////
        macro mBinDataStuff
            local a as long
            local t, t2 as string
            for a = 1 to datacount: T = T & read$( a ): next a
            for a = 1 to len( T ) step 2
                T2 = T2 & chr$( val( "&H" & mid$( T, a , 2 ) ) )
            next a
            function = strptr(T2)
        end macro
        '-------------------------------------------------------------------------------
        function BinBasDRAGGRIP as dword
        
            mBinDataStuff
        data 0000010001001010000001000800680500001600000028000000100000002000000001
        data 0008000000000000000000000000000000000000000000000000000000000080808000
        data C4C4C40080808000C4C4C4000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000002020202020202010101010000000000020202
        data 0202020202020101000000000002020202020202020102010000000000020202020202
        data 0201020201000000000002020202020201020202020000000000020202020201020202
        data 0202000000000002020202010202020202020000000000020202010202020202020200
        data 0000000002020102020202020202020000000000020102020202020202020200000000
        data 0001020202020202020202020000000000000000000000000000000000000000000000
        data 000000000000000000000000FFFF0000FFFF0000FFFF0000C0070000C0070000C00700
        data 00C0070000C0070000C0070000C0070000C0070000C0070000C0070000C0070000FFFF
        data 0000FFFF0000
        
        
        end function
        '-------------------------------------------------------------------------------
        function BinBasSIZEGRIP as dword
        
            mBinDataStuff
        data 0000010001001010000001000800680500001600000028000000100000002000000001
        data 0008000000000000000000000000000000000000000000000000000000000080808000
        data FFFFFF0000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000101020001010200010102000000
        data 0000010100000101000001010000000000000000000000000000000000000000000000
        data 0000000101020001010200000000000000000001010000010100000000000000000000
        data 0000000000000000000000000000000000000000010100000000000000000000000000
        data 0001010000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 0000000000000000000000000000000000000000000000000000000000000000000000
        data 000000000000000000000000FFFF0000F1110000F3330000FFFF0000FF110000FF3300
        data 00FFFF0000FFF30000FFF30000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
        data 0000FFFF0000
        
        end function
        '--------------------------------------------------------------------------------
        function GrDlgProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
         function = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
        end function
        '--------------------------------------------------------------------------------
        function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
          local p as pointapi
          select case wMsg
            case %wm_mousemove
                gMouseMoved = %TRUE
                gMouseX = lo(word,lParam)
                gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
            case %wm_lbuttondown
                gMouseX = lo(word,lParam)
                gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                gLBDOWN = 1
                exit function                      ' Left button pressed
            case %wm_lbuttonup
                gLBDOWN = 0
                exit function
            case %wm_rbuttondown
                gRBDOWN = 1
                exit function                      ' Right button pressed
            case %wm_rbuttonup
                gRBDOWN = 0
                exit function                      ' Right button pressed
          end select
         function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
        
        end function
        
        sub debugprintrect ( s as string, byval rp as rect ptr)
           ? s + str$(@rp.nleft),str$(@rp.ntop),str$(@rp.nright), str$(@rp.nbottom)
        end sub
        '------------------------------------------------------------------------
        ' redraw all winlets in Z order
        sub z_draw
            local tempr, junkr as RECT
            local i, l as long
            local z() as dword
        
        
            graphic clear %PBF_BG_COLOR
        
            dim z(0 to ubound(WL)) as local dword ' 0=zpos, 1=index in WL()
        
            for i = 0 to ubound(WL)
                 z(i) = mak(dword, i, WL(i).zposn)
            next
            array sort z()
            local skey as string
            for i = 0 to ubound(WL)
                WL(lo(word,z(i))).drawwinlet
            next
            graphic redraw
        end sub
        
        '-----------------------------------------------------------------------
        class myWinletClass
            ' these are PRIVATE variables shared between methods in the class
            ' exitpoint is the mouse coordinates which
            ' which the user clicked to exit the winlet - i.e. outside the current winlet
            ' LO word is X, HI word is Y
            instance exitpoint as dword
            ' Leaveform is a boolean value set e.g. by CLOSEME winlets to indicate that
            ' the form processing has finished.
            instance leaveform as long
            ' This is the initial rect for the winlet
            instance initialrect as RECT
            ' This is the current rect(after PBFDragging and PBFSizing, maybe)
            instance currentrect as RECT
            'If zero, no drag!
            instance draggable as long
            'if zero, no resize!
            instance sizeable as long
            ' the rect of the drag grip icon
            instance DragGripIconRect as RECT
            ' the rect of the size grip icon
            instance SizeGripIconRect as RECT
        
            ' type of component
            ' 0 = undefined
            ' 1 = CLOSEME
            ' 2 = edit box
            ' 3 = text box
            ' 4 = list box
            ' 5 = msgbox
            instance CompType as long
            ' handle of stored bitmap
            instance storedBMP as dword
            ' current zpos of winlet
            instance ZPOS as long
            ' default (e.g. initial) zpos of winlet to which winlet reverts when deselected
            instance DefaultZPOS as long
            ' the currently selected winlet
            instance currentwinlet as long
            ' handle for drag icon
            instance hdragicon as long
            ' handle for size icon
            instance hsizeicon as long
            ' identifying number for the winlet
            instance winletid as long
            ' DC for the current GW
            instance hDC as dword
            ' testing!
            instance testarray() as long
            '---------------------------------------------------------
            ' these are PRIVATE methods
            ' update the stored copy of the winlet's bitmap
            class method updatestoredcopy ( hGR as dword, r as rect )
                local i as long
                local q as quad
                graphic bitmap new r.nright - r.nleft, r.nbottom - r.ntop to storedBMP
                graphic attach storedBMP, 0, redraw
                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                ' copy the area to the smaller GW
                graphic copy hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) to (0, 0)
                graphic attach hGR, 0, redraw
                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                graphic font "Courier New"
                me.setcurrentrect(r.nleft, r.ntop, r.nright, r.nbottom)
                graphic redraw
            end method
        
            '------------------------------------------------------------------------
            class method setCurrentRect ( X as long, Y as long, W as long, H as long)
                setrect ( byval varptr(currentRect), X, Y, W, H)
            end method
            '------------------------------------------------------------------------
            class method destroy
                graphic attach storedBMP, 0
                graphic clear %PBF_BG_COLOR
                graphic window end
                graphic attach ghGR, 0, redraw
                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
        
            end method
            '------------------------------------------------------------------------
            class method create
                local x, y, w, h as long
                
                hdragicon = gIcon_DRAGGRIP
                hsizeicon = gIcon_SIZEGRIP
                desktop get size to W, H
                X = rnd(50, W/2)
                Y = rnd(50, H/2)
                W = rnd(50, W/4)
                H = rnd(50, H/4)
                me.SetInitRect (X, Y, X + W, Y + H)
                me.SetCurrRect (X, Y, X + W, Y + H)
                winletid = gZSEQ
                zpos = gZSEQ ' record zpos
                defaultzpos = gZSEQ ' record zpos
                me.updatestoredcopy ( ghGR, CurrentRect )
                me.drawit
                incr gZSEQ
                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                
            end method
            '-----------------------------------------------------------------------
            class method SetInitRect ( X as long, Y as long, W as long, H as long)
                setrect  byval varptr(initialrect), X, Y, W, H
            end method
            '-----------------------------------------------------------------------
            class method SetCurrRect ( X as long, Y as long, W as long, H as long)
                setrect  byval varptr(CurrentRect), X, Y, W, H
            end method
            '------------------------------------------------------------------------
            class method boxrect (r as rect, byval fillcolour as long)
                graphic box ( r.nleft, r.ntop) - (r.nright, r.nbottom), 0,0,fillcolour
            end method
            '-----------------------------------------------------------------------
            class method drawit
                local tempr as rect
                local hDC as dword
        
                ' draw current rect
                graphic box (currentrect.nleft, currentrect.ntop) - (currentrect.nright, currentrect.nbottom),0,%PBF_FG_COLOR,%PBF_BG_COLOR
                ' draw highlight just inside it
                if currentwinlet then
                    copyrect byval varptr(tempr), byval varptr(currentrect)
                    inflaterect ( byval varptr(tempr), -1, -1)
                    graphic box ( tempr.nleft,tempr.ntop) - (tempr.nright, tempr.nbottom), 0, %PBF_BOXSEL_COLOR, %PBF_BG_COLOR, 0
                end if
                ' draw winlet id
                graphic set pos ( currentrect.nleft + 20, currentrect.ntop + 20 )
                graphic print str$(winletid);
                ' set new location for draggripicon
                DragGripIconRect.nleft   = CurrentRect.nleft + 2        ' position icon at offset 2, 2 (topleft)
                DragGripIconRect.ntop    = CurrentRect.ntop  + 2
                DragGripIconRect.nright  = CurrentRect.nleft + 2 + 16
                DragGripIconRect.nbottom = CurrentRect.ntop  + 2 + 16
                ' show icon if we have one
                if hdragicon then
                    graphic get dc to hdc
                    drawiconex (hdc, DragGripIconRect.nleft, DragGripIconRect.ntop, hdragicon, 16, 16, 0, byval 0, %di_normal)
                end if
                SizeGripIconRect.nleft   = CurrentRect.nright -2 -16        ' position icon at offset -2. -2 from bottom right
                SizeGripIconRect.ntop    = CurrentRect.nbottom - 5 -16
                SizeGripIconRect.nright  = CurrentRect.nright - 2
                SizeGripIconRect.nbottom = CurrentRect.nbottom -2
                ' show icon if we have one
                if hSizeicon then
                    graphic get dc to hdc
                    drawiconex (hdc, SizeGripIconRect.nleft, SizeGripIconRect.ntop + 2, hSizeicon, 16, 16, 0, byval 0, %di_normal)
                end if
            end method
            '
            'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
            interface MyWinlet
                inherit iunknown
                ' these are PUBLIC methods
                '
                method drawwinlet
                    me.drawit
                end method
        
                method exitpoint as long
                    method = exitpoint
                end method
                '------------------------------------------------------------------------
                method identity as long
                    method = winletid
                end method
        
                '------------------------------------------------------------------------
                ' the FormLoop transfers control to the winlet by calling this proc.
                ' after making it visible and selected. No need to create or draw frame.
                method warmstart
                    local skey as string
                    local DragSizeMode as long ' mode indicator see %PBFDragging and %PBFSizing
                    local dragsizeoriginX, dragsizeoriginY as long
                    local dragsizeTargetX, dragsizeTargetY as long
                    local i, lresult as long
                    local rlastbox,  junkr, tempr as RECT
                    local hDC as dword
                    local dragsizestart as double
                    local zord() as long
        
                    dim zord(0 to ubound(WL)) as local long
                    copyrect byval varptr(rlastbox), byval varptr(currentrect)
                    gosub drawdrag
                    do
                        sleep 0
                        graphic inkey$ to skey
                        if skey = $esc then exit method
                        if len(skey) then iterate ' an unused key has been pressed
                        if glbdown then
                            select case DragSizeMode
                                ' if the click was in a drag rect, then start the drag operation
                                case 0
                                    if ptinrect ( byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                        dragsizeoriginX = currentrect.nleft
                                        dragsizeoriginY = currentrect.ntop
                                        DragSizeMode = %PBFDragging 'PBFDragging = %true
                                        dragsizestart = timer
                                        exit select
                                    end if
                                    if ptinrect ( byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                        dragsizeoriginX = currentrect.nright
                                        dragsizeoriginY = currentrect.nbottom
                                        DragSizeMode = %PBFSizing
                                        dragsizestart = timer
                                        exit select
                                    end if
                                    ' if the click was outside the current winlet, exit to the Formloop!
                                    if ptinrect( byval varptr(currentrect), gmouseX, gmouseY) = 0 then
                                        exit method
                                    end if
                            end select
                            if gmousemoved then
                                if DragsizeMode  <> 0 then
                                    do
                                        sleep 0
                                        ' the left mouse button has been held down
                                        ' the action depends upon where cursor was when
                                        ' the initial button press was made
                                        if (gmousex = DragSizeOriginX) and (gmouseY = DragSizeOriginY) then exit loop
                                        if timer - dragsizestart > 0.05 then
                                            z_draw' redraw winlets in z-order
                                            select case dragsizemode
                                                case %PBFdragging
                                                    gosub drawdrag
                                                case %PBFsizing
                                                    gosub drawsize
                                            end select
                                            DragSizeOriginX = DragSizeTargetX
                                            DragSizeOriginY = DragSizeTargetY
                                            dragsizestart = timer
                                            graphic redraw
                                        end if
                                        DragSizeTargetX = gMouseX
                                        DragSizeTargetY = gMouseY
                                    loop until glbdown = 0
                                end if
                            end if
                            gmousemoved = %FALSE
                            iterate
                        else ' left button is up, clear dragsize origin
                            if DragSizeMode <> 0 then 'PBFDragging then
                                z_draw' redraw winlets in z-order
                                me.drawit
                                graphic redraw
                            end if
                            DragSizeMode = 0 'PBFDragging = %false
                            DragSizeOriginX = currentrect.nleft
                            DragSizeOriginY = currentrect.ntop
        
                        end if
                    loop
                    exit method ' never gets here
                drawdrag:
                    ' calculate the rect to be redrawn from the
                    ' start pos, end pos and size of winlet being dragged
                    offsetrect byval varptr(currentrect), DragSizeTargetX - DragSizeOriginX, DragSizeTargetY - DragSizeOriginY
                    graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                    '
                    graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                    me.drawit
                    ' the drag icon zone is at the top left of the winlet
                    ' irrespective of whether an icon is available
                    copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
        
                    return
        drawsize:
                    ' calculate the rect to be redrawn from the
                    ' start pos, end pos and size of winlet being dragged
                    if dragsizetargetX > currentrect.nleft + %PBFMINWINLETSIZE then
                        currentrect.nright  = DragsizetargetX
                    end if
                    if dragsizetargetY > currentrect.ntop + %PBFMINWINLETSIZE then
                        currentrect.nbottom     = DragSizeTargetY
                    end if
                    graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                    graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                    me.drawit
                    ' the draw icon zone is at the top left of the winlet
                    ' irrespective of whether an icon is available
                    copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
        return
                end method
                '------------------------------------------------------------------------
                method draw
                    me.drawit
                end method
        
                '------------------------------------------------------------------------
                method LeaveForm as long
                    method = leaveform
                end method
                '------------------------------------------------------------------------
                method zposn as long
                    method = zpos
                end method
                '------------------------------------------------------------------------
                method CurrentRect as dword
                    method = varptr(CurrentRect)
                end method
                '------------------------------------------------------------------------
                method unselect
                    local tempr as rect
                    ' clear the hightlighted frame
                    currentwinlet = %FALSE
                    copyrect byval varptr(tempr), byval varptr(currentrect)
                    inflaterect byval varptr(tempr), -1, -1
                    graphic box (tempr.nleft, tempr.ntop) - _
                                (tempr.nright, tempr.nbottom),0,%PBF_BG_COLOR,-2
                    graphic redraw
                end method
                '------------------------------------------------------------------------
                method makecurrent
                    graphic copy storedBMP, 0 to (CurrentRect.nleft, CurrentRect.ntop) ', %mix_MergeSrc
                    'next 3 lines attempt to draw the eye to the clicked control, are not essential
                    graphic box (CurrentRect.nleft + 1, CurrentRect.ntop + 1) - _
                                (CurrentRect.nright - 1, CurrentRect.nbottom - 1),0,%red,-2
                    graphic redraw
                    sleep 0
        
                    zpos = gZSEQ: incr gZSEQ
        
                    currentwinlet = %TRUE
                    me.drawit
                    graphic redraw
                    'sleep 2000
                end method
                '-------------------------------------------------------------------------
                method selected as long
                    method = currentwinlet
                end method
            end interface
            'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
        end class
        
        '-------------------------------------------------------------------------
        
        sub FormLoop ( hGW as dword, nWinlets as long)
            local i, wlx, bestz, besti as long
            local skey as string
            local r as RECT
        
            dim WL(0 to nWinlets -1) as global myWinlet
        
            for i = 0 to nWinlets -1
                WL(i) = class "MyWinLetClass"
            next
        
            wlx = nWinlets
            if wlx = 0 then
                ? "no Winlets defined! cannot proceed!"
                exit sub
            end if
        
            wlx = nwinlets -1
            z_draw
            do
                sleep 0
                graphic inkey$ to skey
                if skey = "" then ' check mouse
                    if glbdown then ' mouse clicked
                        bestz = -1
                        ' find the window with the highest Z position
                        ' which underlies the current mouse position
                        for i = 0 to nwinlets-1
                            copyrect (r, byval WL(i).CurrentRect)
                            if ptinrect ( byval varptr(r), gMouseX, gMouseY) then
                                if WL(i).zposn > bestz then
                                    bestz = WL(i).zposn
                                    besti = i
                                end if
                            end if
                        next
                        if bestz = -1 then iterate ' clicked outside any winlet
                        WL(besti).makecurrent
                        wlx = besti
                        WL(wlx).warmstart ' transfer control to the winlet
                        WL(wlx).unselect ' unselect whichever is currently selected
                    end if
                end if
                select case skey
                    case $esc
                        exit loop
                end select
            loop
        
        end sub
         '----------------------------------------------------------------
        function pbmain () as long
            local w, h as long
            local hstatic as dword
        
            gIcon_DRAGGRIP   = SetIconFileBits(BinBasDragGrip)
            gIcon_SIZEGRIP   = SetIconFileBits(BinBasSIZEGrip)
        
            desktop get size to W, H
            graphic window "Winlets on a GRAPHIC WINDOW (select, drag, size, z-ordering, icons)                                 Chris Holbrook Nov 2008", 0,0, W, H to ghGR
            hStatic = GetWindow(ghGR, %GW_CHILD)                       ' Retrieve static handle of graphic window
            GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
            FormLoop  ghGR, 10
            SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
            graphic window end
            if gIcon_DRAGGRIP then DestroyIcon ( gIcon_draggrip)
            if gIcon_SIZEGRIP then DestroyIcon ( gIcon_sizegrip)
        end function

        Comment


        • #5
          Just got my PBCC 5.0 yesterday.

          I like the name and year in the title bar.

          When I click on the drag icon the winlet shifts down and to the right, and I assume that this is so the mouse pointer coordinates can be used.
          I also assume that the same reason applies to the size icon making the rectangle smaller.
          Could you not move the mouse pointer rather than move or resize the rectangle? This would mean that if one wanted to resize in one dimension only it would be simpler(for the user). I do like the corner icon concept but it might require the coordinates for the four corners to be listed, depending on where you're going with this.
          Rod
          In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

          Comment


          • #6
            Originally posted by Rodney Hicks View Post
            Just got my PBCC 5.0 yesterday.
            Congratulations!

            Originally posted by Rodney Hicks View Post
            When I click on the drag icon the winlet shifts down and to the right... same ... applies to the size icon...
            Fixed this by ignoring cursor movements within the respective icon RECTs. Will include in next post of code.

            Originally posted by Rodney Hicks View Post
            Could you not move the mouse pointer rather than move or resize the rectangle?
            yes, but I think that comes under "feature enrichment", which comes under "tomorrow"!

            Comment


            • #7
              which comes under "tomorrow"!
              This I understand.
              Rod
              In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

              Comment


              • #8
                Looks ok.

                1)
                Not sure what you mean with: "Fixed this by ignoring cursor movements within the respective icon RECTs"
                Imo you must maintain the mousepointer's offset from left-top all the time.

                2)
                Annoying background redraw when you go from an active 'control' to another which resides under another.
                Seems it's background color is done at the wrong moment ( i guess: Graphic Box ? ).
                Backcolor must be set during WM_ERASEBKGND.
                (This could also be related by not using a memorydc and bitblt()?)
                I never used the graphic commands.

                3)
                Just clicking the resize has a similar issue as #1, it results in resizing right away.

                --

                Why not drag on any part of the 'control'?
                hellobasic

                Comment


                • #9
                  To show #1's mouse behaviour see:

                  www.hellobasic.com/trials/uvdtest.zip

                  (May crash, work in progess)
                  hellobasic

                  Comment


                  • #10
                    more code including Dumbpic control

                    Rod, Edwin:

                    The fix for the "jump" when clicking the drag or size icons is included. Edwin, although the initial offset is always from the topleft or the winlet, I ignore any mouse movement within the icons themslves, so the threshold for drag or size is a WM_MOUSEMOVE outside the icon.

                    The reason I don't allow drag to be triggered by clicking anywhere is that this would not be appropriate for every type of control, as some of them will respond to clicks in other ways.

                    I've also included a DUMBPIC control which just shows a static image. The associated BMP file is declared in the create function. This is the one which I have complained about speed elsewhere (actually I am amazed theat it works several times per second!). If you want to try it you will have to change the path, see code.

                    Code:
                    ' Winlets on a GRAPHIC WINDOW.
                    '
                    ' to show draggable, sizeable winlets using z-order
                    ' Chris Holbrook Nov 2008
                    '
                    ' Left-click on a winlet to select it.
                    ' drag it by holding the left mouse button down over the number in the top L
                    ' and PBFDragging.
                    ' to deselect, just click somewhere else, or press ESC.
                    ' with no winlet selected, ESC exits the application.
                    '
                    ' changes
                    ' 12-Nov-2008 fixed initial jump in drag & size operations reported by Rod Hicks
                    ' 12-Nov-2008 added winlet dimensions display
                    ' 12-Nov-2008 added very basic DUMPIC control - too slow!
                    ' 12-NOV-2008 got rid of background redraw from MakeCurrent proc reported by Edwin Knoppert
                    '
                    #compile exe
                    #dim all
                    %CCWIN = 1 ' allows us to use COMMCTRL.INC
                    
                    #include once "WIN32API.INC"
                    #include once "COMMCTRL.INC"
                    #include once "COMDLG32.INC"
                    #include once "winletsbbico.inc"
                    
                    %PBF_BOXSEL_COLOR = %yellow
                    %PBF_BG_COLOR     = &HD0E0E0
                    %PBF_FG_COLOR     = %black
                    %PBFMINWINLETSIZE = 45
                    %PBFDUMBPIC = 6
                    
                    %PBFDragging = 1
                    %PBFSizing   = 2
                    
                    global WL() as myWinlet                   ' Winlet array
                    global ghGR as dword                      ' global graphic window handle
                    global gZSEQ as long                      ' sequence number for labelling winlets
                                                              ' it just keeps rolling, one day it will overflow!!!!!!
                    global GrDialogProc as long               ' used in subclassing the grapic control to get mouse msgs
                    global GrStaticProc as long               ' used in subclassing the grapic control to get mouse msgs
                    global gMouseX as long,gMouseY as long    ' Mouse x and y
                    global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
                    global gMouseMoved as long                ' Detect mouse movements
                    global gIcon_Draggrip as long              ' draggrip icon handle
                    global gIcon_Sizegrip as long              ' sizegrip icon handle
                    '-------------------------------------------------------------------------------------------------------
                    ' Computes location and size to stretch a bitmap preserving its aspect.
                    '
                    sub skIconise (byval xPic as long, byval yPic as long,            _ picture dimensions
                                   byval xCell as long, byval yCell as long,          _ FRAME dimensions
                                   byref xOfs as long, byref yOfs as long,            _ calc'd offset in frame
                                   byref xSize as long, byref ySize as long) export   ' thumbnail dimensions
                      local scale as single
                    
                        if xPIC& then scale! = xCell& / xPic&
                        if scale! > 1 then scale! = 1
                        xSize& = xPic& * scale!: ySize& = yPic& * scale!
                      ' In case Height > 150 compute new scale factor
                        if ySize& > yCell& then
                           if yPic& then scale! = yCell& / yPic&
                           xSize& = xPic& * scale!: ySize& = yPic& * scale!
                        end if
                        xOfs& = (xCell& - xSize&) \ 2
                        yOfs& = (yCell& - ySize&) \ 2
                    end sub
                    '---------------------------------------------------------------------
                    ' get a jpg filename
                    function getpic (hD as long) as string
                        local buf, spath, sfile as string
                        local dwstyle as dword
                        local hFile as long
                    
                        '------------------------ get JPG file
                        dwStyle = %ofn_explorer or %ofn_filemustexist or %ofn_hidereadonly
                        Buf   = "Picture files (*.JPG)|*.JPG|"
                        'IF gddlpath <> "" THEN spath = gddlpath
                        if OpenFileDialog (hD, "Locate JPG file ", sfile, spath, buf, "JPG", dwstyle) = 0 then
                           exit function
                        end if
                        function = sfile
                    end function
                    
                    '--------------------------------------------------------------------------------
                    function GrDlgProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                     function = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
                    end function
                    '--------------------------------------------------------------------------------
                    function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                      local p as pointapi
                      select case wMsg
                        case %wm_mousemove
                            gMouseMoved = %TRUE
                            gMouseX = lo(word,lParam)
                            gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                            exit function
                        case %wm_lbuttondown
                            gMouseX = lo(word,lParam)
                            gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                            gLBDOWN = 1
                            exit function                      ' Left button pressed
                        case %wm_lbuttonup
                            gLBDOWN = 0
                            exit function
                        case %wm_rbuttondown
                            gRBDOWN = 1
                            exit function                      ' Right button pressed
                        case %wm_rbuttonup
                            gRBDOWN = 0
                            exit function                      ' Right button pressed
                    
                      end select
                     function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
                    
                    end function
                    
                    sub debugprintrect ( s as string, byval rp as rect ptr)
                       ? s + str$(@rp.nleft),str$(@rp.ntop),str$(@rp.nright), str$(@rp.nbottom)
                    end sub
                    '------------------------------------------------------------------------
                    ' redraw all winlets in Z order
                    sub z_draw
                        local tempr, junkr as RECT
                        local i, l as long
                        local z() as dword
                    
                    
                        graphic clear %PBF_BG_COLOR
                    
                        dim z(0 to ubound(WL)) as local dword ' 0=zpos, 1=index in WL()
                    
                        for i = 0 to ubound(WL)
                             z(i) = mak(dword, i, WL(i).zposn)
                        next
                        array sort z()
                        local skey as string
                        for i = 0 to ubound(WL)
                            WL(lo(word,z(i))).drawwinlet
                        next
                        graphic redraw
                    end sub
                    
                    '-----------------------------------------------------------------------
                    class myWinletClass
                        ' these are PRIVATE variables shared between methods in the class
                        ' exitpoint is the mouse coordinates which
                        ' which the user clicked to exit the winlet - i.e. outside the current winlet
                        ' LO word is X, HI word is Y
                        instance exitpoint as dword
                        ' Leaveform is a boolean value set e.g. by CLOSEME winlets to indicate that
                        ' the form processing has finished.
                        instance leaveform as long
                        ' This is the initial rect for the winlet
                        instance initialrect as RECT
                        ' This is the current rect(after PBFDragging and PBFSizing, maybe)
                        instance currentrect as RECT
                        'If zero, no drag!
                        instance draggable as long
                        'if zero, no resize!
                        instance sizeable as long
                        ' the rect of the drag grip icon
                        instance DragGripIconRect as RECT
                        ' the rect of the size grip icon
                        instance SizeGripIconRect as RECT
                        ' initial grab offset - subsequent cursorposns are offset by the same amount to
                        ' avoid initial "jump" in click or drag operations
                        instance InitGrabOffsetX as long
                        instance InitGrabOffsetY as long
                    
                        ' type of component
                        ' 0 = undefined
                        ' 1 = CLOSEME
                        ' 2 = edit box
                        ' 3 = text box
                        ' 4 = list box
                        ' 5 = msgbox
                        ' 6 = dumbpic
                        instance CompType as long
                        ' handle of stored bitmap
                        instance storedBMP as dword
                        ' default pic path
                        instance picpath as string
                        ' image for picture
                        instance hImage as dword
                        ' BMP for picture
                        instance hPicBMP as dword
                        ' current zpos of winlet
                        instance ZPOS as long
                        ' default (e.g. initial) zpos of winlet to which winlet reverts when deselected
                        instance DefaultZPOS as long
                        ' the currently selected winlet
                        instance currentwinlet as long
                        ' handle for drag icon
                        instance hdragicon as long
                        ' handle for size icon
                        instance hsizeicon as long
                        ' identifying number for the winlet
                        instance winletid as long
                        ' DC for the current GW
                        instance hDC as dword
                        ' testing!
                        instance testarray() as long
                        '---------------------------------------------------------
                        ' these are PRIVATE methods
                        ' update the stored copy of the winlet's bitmap
                        class method updatestoredcopy ( hGR as dword, r as rect )
                            local i as long
                            local q as quad
                            graphic bitmap new r.nright - r.nleft, r.nbottom - r.ntop to storedBMP
                            graphic attach storedBMP, 0, redraw
                            graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                            ' copy the area to the smaller GW
                            graphic copy hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) to (0, 0)
                            graphic attach hGR, 0, redraw
                            graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                            graphic font "Courier New"
                            me.setcurrentrect(r.nleft, r.ntop, r.nright, r.nbottom)
                            graphic redraw
                        end method
                    
                        '------------------------------------------------------------------------
                        class method setCurrentRect ( X as long, Y as long, W as long, H as long)
                            setrect ( byval varptr(currentRect), X, Y, W, H)
                        end method
                        '------------------------------------------------------------------------
                        class method destroy
                            graphic attach storedBMP, 0
                            graphic clear %PBF_BG_COLOR
                            graphic window end
                            graphic attach ghGR, 0, redraw
                            graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                    
                        end method
                        '------------------------------------------------------------------------
                        class method create
                            local x, y, w, h as long
                    
                            hdragicon = gIcon_DRAGGRIP
                            hsizeicon = gIcon_SIZEGRIP
                            desktop get size to W, H
                            X = rnd(50, W/2)
                            Y = rnd(50, H/2)
                            W = rnd(50, W/4)
                            H = rnd(50, H/4)
                            me.SetInitRect (X, Y, X + W, Y + H)
                            me.SetCurrRect (X, Y, X + W, Y + H)
                            winletid = gZSEQ
                            if winletid mod 2 = 0  then
                                picpath = "c:\chris\image\pulled.bmp"    ' <------ YOU NEED TO CHANGE THIS!!!!
                                comptype = %PBFDUMBPIC
                            else
                                picpath = ""
                                comptype = 0
                            end if
                            zpos = gZSEQ ' record zpos
                            defaultzpos = gZSEQ ' record zpos
                            me.updatestoredcopy ( ghGR, CurrentRect )
                            me.drawit
                            incr gZSEQ
                            graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                    
                        end method
                        '-----------------------------------------------------------------------
                        class method winletsetpos ( x as long, Y as long)
                            graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                        end method
                        '-----------------------------------------------------------------------
                        class method showpic
                            beep
                            graphic render PicPath, (currentrect.nleft,currentrect.ntop)-(currentrect.nright, currentrect.nbottom)
                        end method
                        '-----------------------------------------------------------------------
                        class method winletprintat ( x as long, Y as long, s as string)
                            local pX, pY as long
                            local sX, sY as single
                            
                            graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                            graphic get pos to pX, pY
                            graphic text size s to sX, sY
                            if pX + sX > currentrect.nright then exit method
                            graphic print s;
                        end method
                        '-----------------------------------------------------------------------
                        class method SetInitRect ( X as long, Y as long, W as long, H as long)
                            setrect  byval varptr(initialrect), X, Y, W, H
                        end method
                        '-----------------------------------------------------------------------
                        class method SetCurrRect ( X as long, Y as long, W as long, H as long)
                            setrect  byval varptr(CurrentRect), X, Y, W, H
                        end method
                        '------------------------------------------------------------------------
                        class method boxrect (r as rect, byval fillcolour as long)
                            graphic box ( r.nleft, r.ntop) - (r.nright, r.nbottom), 0,0,fillcolour
                        end method
                        '-----------------------------------------------------------------------
                        class method drawit
                            local tempr as rect
                            local hDC as dword
                            local chX, chY as long ' for charcter size
                    
                            ' draw current rect
                            graphic box (currentrect.nleft, currentrect.ntop) - (currentrect.nright, currentrect.nbottom),0,%PBF_FG_COLOR,%PBF_BG_COLOR
                            ' draw highlight just inside it
                            if currentwinlet then
                                copyrect byval varptr(tempr), byval varptr(currentrect)
                                inflaterect ( byval varptr(tempr), -1, -1)
                                graphic box ( tempr.nleft,tempr.ntop) - (tempr.nright, tempr.nbottom), 0, %PBF_BOXSEL_COLOR, %PBF_BG_COLOR, 0
                            end if
                            ' if winlet is a dumb pic, display the pic
                            if comptype = %PBFDUMBPIC then
                                me.showpic
                            end if
                            ' draw winlet id
                            me.WinletPrintAt ( 20, 5, format$(winletId))
                            graphic chr size to ChX, ChY
                            me.WinletPrintAt ( 2, 5 + ChY, _
                                            format$(currentrect.ntop) + "," + format$(currentrect.nleft) + " - " + _
                                            format$(currentrect.nright - currentrect.nleft) + "," + _
                                            format$(currentrect.nbottom - currentrect.ntop))
                            
                            
                            ' set new location for draggripicon
                            DragGripIconRect.nleft   = CurrentRect.nleft + 2        ' position icon at offset 2, 2 (topleft)
                            DragGripIconRect.ntop    = CurrentRect.ntop  + 2
                            DragGripIconRect.nright  = CurrentRect.nleft + 2 + 16
                            DragGripIconRect.nbottom = CurrentRect.ntop  + 2 + 16
                            ' show icon if we have one
                            if hdragicon then
                                graphic get dc to hdc
                                drawiconex (hdc, DragGripIconRect.nleft, DragGripIconRect.ntop, hdragicon, 16, 16, 0, byval 0, %di_normal)
                            end if
                            SizeGripIconRect.nleft   = CurrentRect.nright -2 -16        ' position icon at offset -2. -2 from bottom right
                            SizeGripIconRect.ntop    = CurrentRect.nbottom - 5 -16
                            SizeGripIconRect.nright  = CurrentRect.nright - 2
                            SizeGripIconRect.nbottom = CurrentRect.nbottom -2
                            ' show icon if we have one
                            if hSizeicon then
                                graphic get dc to hdc
                                drawiconex (hdc, SizeGripIconRect.nleft, SizeGripIconRect.ntop + 2, hSizeicon, 16, 16, 0, byval 0, %di_normal)
                            end if
                        end method
                        '
                        'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                        interface MyWinlet
                            inherit iunknown
                            ' these are PUBLIC methods
                            '
                            method drawwinlet
                                me.drawit
                            end method
                    
                            method exitpoint as long
                                method = exitpoint
                            end method
                            '------------------------------------------------------------------------
                            method identity as long
                                method = winletid
                            end method
                    
                            '------------------------------------------------------------------------
                            ' the FormLoop transfers control to the winlet by calling this proc.
                            ' after making it visible and selected. No need to create or draw frame.
                            method warmstart
                                local skey as string
                                local DragSizeMode as long ' mode indicator see %PBFDragging and %PBFSizing
                                local dragsizeoriginX, dragsizeoriginY as long
                                local dragsizeTargetX, dragsizeTargetY as long
                                local i, lresult as long
                                local rlastbox,  junkr, tempr as RECT
                                local hDC as dword
                                local dragsizestart as double
                                local zord() as long
                    
                                dim zord(0 to ubound(WL)) as local long
                                copyrect byval varptr(rlastbox), byval varptr(currentrect)
                                gosub drawdrag
                                do
                                    sleep 0
                                    graphic inkey$ to skey
                                    if skey = $esc then exit method
                                    if len(skey) then iterate ' an unused key has been pressed
                                    if glbdown then
                                        select case DragSizeMode
                                            ' if the click was in a drag rect, then start the drag operation
                                            case 0
                                                if ptinrect ( byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                    dragsizeoriginX = currentrect.nleft
                                                    dragsizeoriginY = currentrect.ntop
                                                    dragsizetargetX = currentrect.nleft
                                                    dragsizetargetY = currentrect.ntop
                                                    DragSizeMode = %PBFDragging 'PBFDragging = %true
                                                    exit select
                                                end if
                                                if ptinrect ( byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                    dragsizeoriginX = currentrect.nright
                                                    dragsizeoriginY = currentrect.nbottom
                                                    dragsizeTargetX = currentrect.nright
                                                    dragsizeTargetY = currentrect.nbottom
                                                    DragSizeMode = %PBFSizing
                                                    exit select
                                                end if
                                                ' start the timer
                                                ' dragsizestart = timer
                                                ' if the click was outside the current winlet, exit to the Formloop!
                                                if ptinrect( byval varptr(currentrect), gmouseX, gmouseY) = 0 then
                                                    exit method
                                                end if
                                        end select
                                        if gmousemoved then
                                            if DragsizeMode  <> 0 then
                                                do
                                                    sleep 0
                                                    ' the left mouse button has been held down
                                                    ' the action depends upon where cursor was when
                                                    ' the initial button press was made
                                                    if (gmousex = DragSizeOriginX) and (gmouseY = DragSizeOriginY) then exit loop
                                                    select case dragsizemode
                                                        case %PBFdragging
                                                            if ptinrect(byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                                iterate ' dragged within drag icon rect - ignore!
                                                            end if
                                                        case %PBFsizing
                                                            if ptinrect(byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                                iterate ' dragged within size icon rect - ignore!
                                                            end if
                                                    end select
                                                    'if timer - dragsizestart > 0.01 then
                                                        z_draw' redraw winlets in z-order
                                                        select case dragsizemode
                                                            case %PBFdragging
                                                                gosub drawdrag
                                                            case %PBFsizing
                                                                gosub drawsize
                                                        end select
                                                        DragSizeOriginX = DragSizeTargetX
                                                        DragSizeOriginY = DragSizeTargetY
                                                        dragsizestart = timer
                                                        graphic redraw
                                                    'end if
                                                    DragSizeTargetX = gMouseX
                                                    DragSizeTargetY = gMouseY
                                                loop until glbdown = 0
                                            end if
                                        end if
                                        gmousemoved = %FALSE
                                        iterate
                                    else ' left button is up, clear dragsize origin
                                        if DragSizeMode <> 0 then
                                            z_draw' redraw winlets in z-order
                                            me.drawit
                                            graphic redraw
                                            DragSizeMode = 0
                                        end if
                                    end if
                                loop
                                exit method ' never gets here
                    drawdrag:
                                ' calculate the rect to be redrawn from the
                                ' start pos, end pos and size of winlet being dragged
                                offsetrect byval varptr(currentrect), DragSizeTargetX - DragSizeOriginX, DragSizeTargetY - DragSizeOriginY
                                graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                '
                                graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                me.drawit
                                ' the drag icon zone is at the top left of the winlet
                                ' irrespective of whether an icon is available
                                copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                    
                                return
                    drawsize:
                                ' calculate the rect to be redrawn from the
                                ' start pos, end pos and size of winlet being dragged
                                if dragsizetargetX > currentrect.nleft + %PBFMINWINLETSIZE then
                                    currentrect.nright  = DragsizetargetX
                                end if
                                if dragsizetargetY > currentrect.ntop + %PBFMINWINLETSIZE then
                                    currentrect.nbottom     = DragSizeTargetY
                                end if
                                graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                me.drawit
                                ' the draw icon zone is at the top left of the winlet
                                ' irrespective of whether an icon is available
                                copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                    return
                            end method
                            '------------------------------------------------------------------------
                            method draw
                                me.drawit
                            end method
                    
                            '------------------------------------------------------------------------
                            method LeaveForm as long
                                method = leaveform
                            end method
                            '------------------------------------------------------------------------
                            method zposn as long
                                method = zpos
                            end method
                            '------------------------------------------------------------------------
                            method CurrentRect as dword
                                method = varptr(CurrentRect)
                            end method
                            '------------------------------------------------------------------------
                            method unselect
                                local tempr as rect
                                ' clear the hightlighted frame
                                currentwinlet = %FALSE
                                copyrect byval varptr(tempr), byval varptr(currentrect)
                                inflaterect byval varptr(tempr), -1, -1
                                graphic box (tempr.nleft, tempr.ntop) - _
                                            (tempr.nright, tempr.nbottom),0,%PBF_BG_COLOR,-2
                                graphic redraw
                            end method
                            '------------------------------------------------------------------------
                            method makecurrent
                                graphic copy storedBMP, 0 to (CurrentRect.nleft, CurrentRect.ntop) ', %mix_MergeSrc
                                zpos = gZSEQ: incr gZSEQ
                    
                                currentwinlet = %TRUE
                                me.drawit
                                graphic redraw
                                'sleep 2000
                            end method
                            '-------------------------------------------------------------------------
                            method selected as long
                                method = currentwinlet
                            end method
                        end interface
                        'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                    end class
                    
                    '-------------------------------------------------------------------------
                    
                    sub FormLoop ( hGW as dword, nWinlets as long)
                        local i, wlx, bestz, besti as long
                        local skey as string
                        local r as RECT
                    
                        dim WL(0 to nWinlets -1) as global myWinlet
                    
                        for i = 0 to nWinlets -1
                            WL(i) = class "MyWinLetClass"
                        next
                    
                        wlx = nWinlets
                        if wlx = 0 then
                            ? "no Winlets defined! cannot proceed!"
                            exit sub
                        end if
                    
                        wlx = nwinlets -1
                        z_draw
                        do
                            sleep 0
                            graphic inkey$ to skey
                            if skey = "" then ' check mouse
                                if glbdown then ' mouse clicked
                                    bestz = -1
                                    ' find the window with the highest Z position
                                    ' which underlies the current mouse position
                                    for i = 0 to nwinlets-1
                                        copyrect (r, byval WL(i).CurrentRect)
                                        if ptinrect ( byval varptr(r), gMouseX, gMouseY) then
                                            if WL(i).zposn > bestz then
                                                bestz = WL(i).zposn
                                                besti = i
                                            end if
                                        end if
                                    next
                                    if bestz = -1 then iterate ' clicked outside any winlet
                                    WL(besti).makecurrent
                                    wlx = besti
                                    WL(wlx).warmstart ' transfer control to the winlet
                                    WL(wlx).unselect ' unselect whichever is currently selected
                                end if
                            end if
                            select case skey
                                case $esc
                                    exit loop
                            end select
                        loop
                    
                    end sub
                     '----------------------------------------------------------------
                    function pbmain () as long
                        local w, h as long
                        local hstatic as dword
                        gIcon_DRAGGRIP   = SetIconFileBits(BinBasDragGrip)
                        gIcon_SIZEGRIP   = SetIconFileBits(BinBasSIZEGrip)
                    
                        desktop get size to W, H
                        graphic window "Winlets on a GRAPHIC WINDOW (dumbpic, select, drag, size, z-ordering, icons)                                 Chris Holbrook Nov 2008", 0,0, W, H to ghGR
                        hStatic = GetWindow(ghGR, %GW_CHILD)                       ' Retrieve static handle of graphic window
                        GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
                        FormLoop  ghGR, 10
                        SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
                        graphic window end
                        if gIcon_DRAGGRIP then DestroyIcon ( gIcon_draggrip)
                        if gIcon_SIZEGRIP then DestroyIcon ( gIcon_sizegrip)
                    end function
                    Last edited by Chris Holbrook; 12 Nov 2008, 07:01 AM.

                    Comment


                    • #11
                      Forgot to mention, when closed via the box, the exe keeps running.
                      Severe processing time as well.
                      Last edited by Edwin Knoppert; 12 Nov 2008, 08:20 AM.
                      hellobasic

                      Comment


                      • #12
                        GRAPHIC STRETCH causing mental turmoil

                        In this version a BMP image path (defined in %PBF_PICPATH at the top of the program) is used to define a default picture for some of the winlets. During winlet object creation, the bitmap is loaded and its handle stored in the winlet as an instance variable. When the winlet is displayed, the image is transferred to the winlet rect using GRAPHIC STRETCH - see MyWinletClass.showpic. This will enable the image to be redrawn to fit the winlet when it is moved or resized.

                        That's the theory anyway. It almost works! Clearly I have yet to master this aspect of graphic programming... Help will be appreciated.

                        Code:
                        ' Winlets on a GRAPHIC WINDOW.
                        '
                        ' to show draggable, sizeable winlets using z-order
                        ' Chris Holbrook Nov 2008
                        '
                        ' Left-click on a winlet to select it.
                        ' drag it by holding the left mouse button down over the number in the top L
                        ' and PBFDragging.
                        ' to deselect, just click somewhere else, or press ESC.
                        ' with no winlet selected, ESC exits the application.
                        '
                        ' changes
                        ' 12-Nov-2008 fixed initial jump in drag & size operations reported by Rod Hicks
                        ' 12-Nov-2008 added winlet dimensions display
                        ' 12-Nov-2008 added very basic DUMPIC control - too slow!
                        ' 12-NOV-2008 got rid of background redraw from MakeCurrent proc reported by Edwin Knoppert
                        ' 13-NOV-2008 replaced SLEEP 0 statements with SLEEP 1 to reduce CPU from 98% to 0% reported by Edwin Knoppert
                        ' 13-NOV-2008 added DUMBPIC margin
                        #compile exe
                        #dim all
                        %CCWIN = 1 ' allows us to use COMMCTRL.INC
                        
                        #include once "WIN32API.INC"
                        #include once "COMMCTRL.INC"
                        #include once "COMDLG32.INC"
                        #include once "winletsbbico.inc"
                        
                        %PBF_BOXSEL_COLOR = %yellow
                        %PBF_BG_COLOR     = &HD0E0E0
                        %PBF_FG_COLOR     = %black
                        %PBFMINWINLETSIZE = 45
                        %PBFDUMBPIC = 6
                        %PBF_DUMBPICMARGIN = 3
                        $PBF_PICPATH = "c:\chris\image\good.bmp"    ' <------ YOU NEED TO CHANGE THIS!!!!
                        %PBFDragging = 1
                        %PBFSizing   = 2
                        
                        global WL() as myWinlet                   ' Winlet array
                        global ghGR as dword                      ' global graphic window handle
                        global gZSEQ as long                      ' sequence number for labelling winlets
                                                                  ' it just keeps rolling, one day it will overflow!!!!!!
                        global GrDialogProc as long               ' used in subclassing the grapic control to get mouse msgs
                        global GrStaticProc as long               ' used in subclassing the grapic control to get mouse msgs
                        global gMouseX as long,gMouseY as long    ' Mouse x and y
                        global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
                        global gMouseMoved as long                ' Detect mouse movements
                        global gIcon_Draggrip as long              ' draggrip icon handle
                        global gIcon_Sizegrip as long              ' sizegrip icon handle
                        '-------------------------------------------------------------------------------------------------------
                        ' Computes location and size to stretch a bitmap preserving its aspect.
                        '
                        sub skIconise (byval xPic as long, byval yPic as long,            _ picture dimensions
                                       byval xCell as long, byval yCell as long,          _ FRAME dimensions
                                       byref xOfs as long, byref yOfs as long,            _ calc'd offset in frame
                                       byref xSize as long, byref ySize as long) export   ' thumbnail dimensions
                          local scale as single
                        
                            if xPIC& then scale! = xCell& / xPic&
                            if scale! > 1 then scale! = 1
                            xSize& = xPic& * scale!: ySize& = yPic& * scale!
                          ' In case Height > 150 compute new scale factor
                            if ySize& > yCell& then
                               if yPic& then scale! = yCell& / yPic&
                               xSize& = xPic& * scale!: ySize& = yPic& * scale!
                            end if
                            xOfs& = (xCell& - xSize&) \ 2
                            yOfs& = (yCell& - ySize&) \ 2
                        end sub
                        '---------------------------------------------------------------------
                        ' get a jpg filename
                        function getpic (hD as long) as string
                            local buf, spath, sfile as string
                            local dwstyle as dword
                            local hFile as long
                        
                            '------------------------ get JPG file
                            dwStyle = %ofn_explorer or %ofn_filemustexist or %ofn_hidereadonly
                            Buf   = "Picture files (*.JPG)|*.JPG|"
                            'IF gddlpath <> "" THEN spath = gddlpath
                            if OpenFileDialog (hD, "Locate JPG file ", sfile, spath, buf, "JPG", dwstyle) = 0 then
                               exit function
                            end if
                            function = sfile
                        end function
                        
                        '--------------------------------------------------------------------------------
                        function GrDlgProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                         function = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
                        end function
                        '--------------------------------------------------------------------------------
                        function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                          local p as pointapi
                          select case wMsg
                            case %wm_mousemove
                                gMouseMoved = %TRUE
                                gMouseX = lo(word,lParam)
                                gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                                exit function
                            case %wm_lbuttondown
                                gMouseX = lo(word,lParam)
                                gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                                gLBDOWN = 1
                                exit function                      ' Left button pressed
                            case %wm_lbuttonup
                                gLBDOWN = 0
                                exit function
                            case %wm_rbuttondown
                                gRBDOWN = 1
                                exit function                      ' Right button pressed
                            case %wm_rbuttonup
                                gRBDOWN = 0
                                exit function                      ' Right button pressed
                        
                          end select
                         function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
                        
                        end function
                        
                        sub debugprintrect ( s as string, byval rp as rect ptr)
                           ? s + str$(@rp.nleft),str$(@rp.ntop),str$(@rp.nright), str$(@rp.nbottom)
                        end sub
                        '------------------------------------------------------------------------
                        ' redraw all winlets in Z order
                        sub z_draw
                            local tempr, junkr as RECT
                            local i, l as long
                            local z() as dword
                        
                        
                            graphic clear %PBF_BG_COLOR
                        
                            dim z(0 to ubound(WL)) as local dword ' 0=zpos, 1=index in WL()
                        
                            for i = 0 to ubound(WL)
                                 z(i) = mak(dword, i, WL(i).zposn)
                            next
                            array sort z()
                            local skey as string
                            for i = 0 to ubound(WL)
                                WL(lo(word,z(i))).drawwinlet
                            next
                            graphic redraw
                        end sub
                            '-----------------------------------------------------------------------
                        sub debugshowpic ( byval r as RECT ptr, hPicbmp as dword, PicWidth as single, PicHeight as single)
                        '        local w, x, y, z as single
                        '
                        '        w = currentrect.nleft : x = currentrect.ntop
                        '        y = currentrect.nright: z = currentrect.nbottom
                                graphic stretch hPicBMP, 0, (0,0)-(PicWidth, PicHeight) to _
                                                (@r.nleft + %PBF_DUMBPICMARGIN,@r.ntop + %PBF_DUMBPICMARGIN)-_
                                                (@r.nright - %PBF_DUMBPICMARGIN, @r.nbottom - %PBF_DUMBPICMARGIN),_
                                                %mix_copysrc, %HALFTONE
                                graphic set pos (@r.nright, @r.nbottom)
                                graphic print "HELLO"
                                'sleep 1000
                        
                            end sub
                        
                        '-----------------------------------------------------------------------
                        class myWinletClass
                            ' these are PRIVATE variables shared between methods in the class
                            ' exitpoint is the mouse coordinates which
                            ' which the user clicked to exit the winlet - i.e. outside the current winlet
                            ' LO word is X, HI word is Y
                            instance exitpoint as dword
                            ' Leaveform is a boolean value set e.g. by CLOSEME winlets to indicate that
                            ' the form processing has finished.
                            instance leaveform as long
                            ' This is the initial rect for the winlet
                            instance initialrect as RECT
                            ' This is the current rect(after PBFDragging and PBFSizing, maybe)
                            instance currentrect as RECT
                            'If zero, no drag!
                            instance draggable as long
                            'if zero, no resize!
                            instance sizeable as long
                            ' the rect of the drag grip icon
                            instance DragGripIconRect as RECT
                            ' the rect of the size grip icon
                            instance SizeGripIconRect as RECT
                            ' initial grab offset - subsequent cursorposns are offset by the same amount to
                            ' avoid initial "jump" in click or drag operations
                            instance InitGrabOffsetX as long
                            instance InitGrabOffsetY as long
                        
                            ' type of component
                            ' 0 = undefined
                            ' 1 = CLOSEME
                            ' 2 = edit box
                            ' 3 = text box
                            ' 4 = list box
                            ' 5 = msgbox
                            ' 6 = dumbpic
                            instance CompType as long
                            ' handle of stored bitmap
                            instance storedBMP as dword
                            ' default pic path
                            instance picpath as string
                            ' image for picture
                            instance hImage as dword
                            ' BMP for picture
                            instance hPicBMP as dword
                            ' width & height of bitmap
                            instance PicWidth as single
                            instance PicHeight as single
                            ' current zpos of winlet
                            instance ZPOS as long
                            ' default (e.g. initial) zpos of winlet to which winlet reverts when deselected
                            instance DefaultZPOS as long
                            ' the currently selected winlet
                            instance currentwinlet as long
                            ' handle for drag icon
                            instance hdragicon as long
                            ' handle for size icon
                            instance hsizeicon as long
                            ' identifying number for the winlet
                            instance winletid as long
                            ' DC for the current GW
                            instance hDC as dword
                            ' testing!
                            instance testarray() as long
                            '---------------------------------------------------------
                            ' these are PRIVATE methods
                            ' update the stored copy of the winlet's bitmap
                            class method updatestoredcopy ( hGR as dword, r as rect )
                                local i as long
                                local q as quad
                                graphic bitmap new r.nright - r.nleft, r.nbottom - r.ntop to storedBMP
                                graphic attach storedBMP, 0, redraw
                                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                                ' copy the area to the smaller GW
                                graphic copy hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) to (0, 0)
                                graphic attach hGR, 0, redraw
                                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                                graphic font "Courier New"
                                me.setcurrentrect(r.nleft, r.ntop, r.nright, r.nbottom)
                                graphic redraw
                            end method
                        
                            '------------------------------------------------------------------------
                            class method setCurrentRect ( X as long, Y as long, W as long, H as long)
                                setrect ( byval varptr(currentRect), X, Y, W, H)
                            end method
                            '------------------------------------------------------------------------
                            class method destroy
                                graphic attach storedBMP, 0
                                graphic clear %PBF_BG_COLOR
                                graphic window end
                                graphic attach ghGR, 0, redraw
                                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                        
                            end method
                            '------------------------------------------------------------------------
                            class method create
                                local l, x, y, w, h, nfile as long
                        
                        
                                hdragicon = gIcon_DRAGGRIP
                                hsizeicon = gIcon_SIZEGRIP
                                desktop get size to W, H
                                X = rnd(50, W/2)
                                Y = rnd(50, H/2)
                                W = rnd(50, W/4)
                                H = rnd(50, H/4)
                                me.SetInitRect (X, Y, X + W, Y + H)
                                me.SetCurrRect (X, Y, X + W, Y + H)
                                winletid = gZSEQ
                                if winletid mod 2 = 0  then
                                    picpath = $PBF_PICPATH
                                    comptype = %PBFDUMBPIC
                                    nFile = freefile
                                    open picpath for binary as nFile
                                    get #nFile, 19, l: PicWidth = l
                                    get #nFile, 23, l : PicHeight = l
                                    close nFile
                                    graphic bitmap load picpath, W, H to hPicbmp
                                else
                                    picpath = ""
                                    comptype = 0
                                end if
                                zpos = gZSEQ ' record zpos
                                defaultzpos = gZSEQ ' record zpos
                                me.updatestoredcopy ( ghGR, CurrentRect )
                                me.drawit
                                incr gZSEQ
                                graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                        
                            end method
                            '-----------------------------------------------------------------------
                            class method winletsetpos ( x as long, Y as long)
                                graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                            end method
                            '-----------------------------------------------------------------------
                            class method showpic
                                graphic stretch hPicBMP, 0, (0,0)-(PicWidth, PicHeight) to _
                                                (currentrect.nleft + %PBF_DUMBPICMARGIN,currentrect.ntop + %PBF_DUMBPICMARGIN)-_
                                                (currentrect.nright, currentrect.nbottom), _
                                                %mix_copysrc, %HALFTONE
                        '                        (currentrect.nright - %PBF_DUMBPICMARGIN, currentrect.nbottom - %PBF_DUMBPICMARGIN),_
                                graphic set pos (currentrect.nright, currentrect.nbottom)
                                graphic print "W, H pic" + str$(picwidth) + str$(picheight) + " rectBR" + _
                                              str$(currentrect.nright) + str$(currentrect.nbottom)
                        
                            end method
                            '-----------------------------------------------------------------------
                            class method winletprintat ( x as long, Y as long, s as string)
                                local pX, pY as long
                                local sX, sY as single
                        
                                graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                                graphic get pos to pX, pY
                                graphic text size s to sX, sY
                                if pX + sX > currentrect.nright then exit method
                                graphic print s;
                            end method
                            '-----------------------------------------------------------------------
                            class method SetInitRect ( X as long, Y as long, W as long, H as long)
                                setrect  byval varptr(initialrect), X, Y, W, H
                            end method
                            '-----------------------------------------------------------------------
                            class method SetCurrRect ( X as long, Y as long, W as long, H as long)
                                setrect  byval varptr(CurrentRect), X, Y, W, H
                            end method
                            '------------------------------------------------------------------------
                            class method boxrect (r as rect, byval fillcolour as long)
                                graphic box ( r.nleft, r.ntop) - (r.nright, r.nbottom), 0,0,fillcolour
                            end method
                            '-----------------------------------------------------------------------
                            class method drawit
                                local tempr as rect
                                local hDC as dword
                                local chX, chY as long ' for charcter size
                        
                                ' draw current rect
                                graphic box (currentrect.nleft, currentrect.ntop) - (currentrect.nright, currentrect.nbottom),0,%PBF_FG_COLOR,%PBF_BG_COLOR
                                ' draw highlight just inside it
                                if currentwinlet then
                                    copyrect byval varptr(tempr), byval varptr(currentrect)
                                    inflaterect ( byval varptr(tempr), -1, -1)
                                    graphic box ( tempr.nleft,tempr.ntop) - (tempr.nright, tempr.nbottom), 0, %PBF_BOXSEL_COLOR, %PBF_BG_COLOR, 0
                                end if
                                ' if winlet is a dumb pic, display the pic
                                if comptype = %PBFDUMBPIC then
                                    me.showpic 'debugshowpic(byval varptr(currentrect), hPicbmp, PicWidth, PicHeight)
                                end if
                                ' draw winlet id
                                me.WinletPrintAt ( 20, 5, format$(winletId))
                                graphic chr size to ChX, ChY
                        
                        '        graphic color %PBF_FG_COLOR, -2'%PBF_BG_COLOR
                        '        me.WinletPrintAt ( 2, 5 + ChY, _
                        '                        format$(currentrect.ntop) + "," + format$(currentrect.nleft) + " - " + _
                        '                        format$(currentrect.nright) + "," + _
                        '                        format$(currentrect.nbottom))
                        '        graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                        
                        
                                ' set new location for draggripicon
                                DragGripIconRect.nleft   = CurrentRect.nleft + 2        ' position icon at offset 2, 2 (topleft)
                                DragGripIconRect.ntop    = CurrentRect.ntop  + 2
                                DragGripIconRect.nright  = CurrentRect.nleft + 2 + 16
                                DragGripIconRect.nbottom = CurrentRect.ntop  + 2 + 16
                                ' show icon if we have one
                                if hdragicon then
                                    graphic get dc to hdc
                                    drawiconex (hdc, DragGripIconRect.nleft, DragGripIconRect.ntop, hdragicon, 16, 16, 0, byval 0, %di_normal)
                                end if
                                SizeGripIconRect.nleft   = CurrentRect.nright -2 -16        ' position icon at offset -2. -2 from bottom right
                                SizeGripIconRect.ntop    = CurrentRect.nbottom - 5 -16
                                SizeGripIconRect.nright  = CurrentRect.nright - 2
                                SizeGripIconRect.nbottom = CurrentRect.nbottom -2
                                ' show icon if we have one
                                if hSizeicon then
                                    graphic get dc to hdc
                                    drawiconex (hdc, SizeGripIconRect.nleft, SizeGripIconRect.ntop + 2, hSizeicon, 16, 16, 0, byval 0, %di_normal)
                                end if
                            end method
                            '
                            'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                            interface MyWinlet
                                inherit iunknown
                                ' these are PUBLIC methods
                                '
                                method drawwinlet
                                    me.drawit
                                end method
                        
                                method exitpoint as long
                                    method = exitpoint
                                end method
                                '------------------------------------------------------------------------
                                method identity as long
                                    method = winletid
                                end method
                        
                                '------------------------------------------------------------------------
                                ' the FormLoop transfers control to the winlet by calling this proc.
                                ' after making it visible and selected. No need to create or draw frame.
                                method warmstart
                                    local skey as string
                                    local DragSizeMode as long ' mode indicator see %PBFDragging and %PBFSizing
                                    local dragsizeoriginX, dragsizeoriginY as long
                                    local dragsizeTargetX, dragsizeTargetY as long
                                    local i, lresult as long
                                    local rlastbox,  junkr, tempr as RECT
                                    local hDC as dword
                                    local dragsizestart as double
                                    local zord() as long
                        
                                    dim zord(0 to ubound(WL)) as local long
                                    copyrect byval varptr(rlastbox), byval varptr(currentrect)
                                    gosub drawdrag
                                    do
                                        sleep 2
                                        graphic inkey$ to skey
                                        if skey = $esc then exit method
                                        if len(skey) then iterate ' an unused key has been pressed
                                        if glbdown then
                                            select case DragSizeMode
                                                ' if the click was in a drag rect, then start the drag operation
                                                case 0
                                                    if ptinrect ( byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                        dragsizeoriginX = currentrect.nleft
                                                        dragsizeoriginY = currentrect.ntop
                                                        dragsizetargetX = currentrect.nleft
                                                        dragsizetargetY = currentrect.ntop
                                                        DragSizeMode = %PBFDragging 'PBFDragging = %true
                                                        exit select
                                                    end if
                                                    if ptinrect ( byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                        dragsizeoriginX = currentrect.nright
                                                        dragsizeoriginY = currentrect.nbottom
                                                        dragsizeTargetX = currentrect.nright
                                                        dragsizeTargetY = currentrect.nbottom
                                                        DragSizeMode = %PBFSizing
                                                        exit select
                                                    end if
                                                    ' start the timer
                                                    ' dragsizestart = timer
                                                    ' if the click was outside the current winlet, exit to the Formloop!
                                                    if ptinrect( byval varptr(currentrect), gmouseX, gmouseY) = 0 then
                                                        exit method
                                                    end if
                                            end select
                                            if gmousemoved then
                                                if DragsizeMode  <> 0 then
                                                    do
                                                        'sleep 0
                                                        ' the left mouse button has been held down
                                                        ' the action depends upon where cursor was when
                                                        ' the initial button press was made
                                                        if (gmousex = DragSizeOriginX) and (gmouseY = DragSizeOriginY) then exit loop
                                                        select case dragsizemode
                                                            case %PBFdragging
                                                                if ptinrect(byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                                    iterate ' dragged within drag icon rect - ignore!
                                                                end if
                                                            case %PBFsizing
                                                                if ptinrect(byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                                    iterate ' dragged within size icon rect - ignore!
                                                                end if
                                                        end select
                                                        'if timer - dragsizestart > 0.01 then
                                                            z_draw' redraw winlets in z-order
                                                            select case dragsizemode
                                                                case %PBFdragging
                                                                    gosub drawdrag
                                                                case %PBFsizing
                                                                    gosub drawsize
                                                            end select
                                                            DragSizeOriginX = DragSizeTargetX
                                                            DragSizeOriginY = DragSizeTargetY
                                                            dragsizestart = timer
                                                            graphic redraw
                                                        'end if
                                                        DragSizeTargetX = gMouseX
                                                        DragSizeTargetY = gMouseY
                                                    loop until glbdown = 0
                                                end if
                                            end if
                                            gmousemoved = %FALSE
                                            iterate
                                        else ' left button is up, clear dragsize origin
                                            if DragSizeMode <> 0 then
                                                z_draw' redraw winlets in z-order
                                                me.drawit
                                                graphic redraw
                                                DragSizeMode = 0
                                            end if
                                        end if
                                    loop
                                    exit method ' never gets here
                        drawdrag:
                                    ' calculate the rect to be redrawn from the
                                    ' start pos, end pos and size of winlet being dragged
                                    offsetrect byval varptr(currentrect), DragSizeTargetX - DragSizeOriginX, DragSizeTargetY - DragSizeOriginY
                                    graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                    '
                                    graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                    me.drawit
                                    ' the drag icon zone is at the top left of the winlet
                                    ' irrespective of whether an icon is available
                                    copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                        
                                    return
                        drawsize:
                                    ' calculate the rect to be redrawn from the
                                    ' start pos, end pos and size of winlet being dragged
                                    if dragsizetargetX > currentrect.nleft + %PBFMINWINLETSIZE then
                                        currentrect.nright  = DragsizetargetX
                                    end if
                                    if dragsizetargetY > currentrect.ntop + %PBFMINWINLETSIZE then
                                        currentrect.nbottom     = DragSizeTargetY
                                    end if
                                    graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                    graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                    me.drawit
                                    ' the draw icon zone is at the top left of the winlet
                                    ' irrespective of whether an icon is available
                                    copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                        return
                                end method
                                '------------------------------------------------------------------------
                                method draw
                                    me.drawit
                                end method
                        
                                '------------------------------------------------------------------------
                                method LeaveForm as long
                                    method = leaveform
                                end method
                                '------------------------------------------------------------------------
                                method zposn as long
                                    method = zpos
                                end method
                                '------------------------------------------------------------------------
                                method CurrentRect as dword
                                    method = varptr(CurrentRect)
                                end method
                                '------------------------------------------------------------------------
                                method unselect
                                    local tempr as rect
                                    ' clear the hightlighted frame
                                    currentwinlet = %FALSE
                                    copyrect byval varptr(tempr), byval varptr(currentrect)
                                    inflaterect byval varptr(tempr), -1, -1
                                    graphic box (tempr.nleft, tempr.ntop) - _
                                                (tempr.nright, tempr.nbottom),0,%PBF_BG_COLOR,-2
                                    graphic redraw
                                end method
                                '------------------------------------------------------------------------
                                method makecurrent
                                    graphic copy storedBMP, 0 to (CurrentRect.nleft, CurrentRect.ntop) ', %mix_MergeSrc
                                    zpos = gZSEQ: incr gZSEQ
                        
                                    currentwinlet = %TRUE
                                    me.drawit
                                    graphic redraw
                                    'sleep 2000
                                end method
                                '-------------------------------------------------------------------------
                                method selected as long
                                    method = currentwinlet
                                end method
                            end interface
                            'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                        end class
                        
                        '-------------------------------------------------------------------------
                        
                        sub FormLoop ( hGW as dword, nWinlets as long)
                            local i, wlx, bestz, besti as long
                            local skey as string
                            local r as RECT
                        
                            dim WL(0 to nWinlets -1) as global myWinlet
                        
                            for i = 0 to nWinlets -1
                                WL(i) = class "MyWinLetClass"
                            next
                        
                            wlx = nWinlets
                            if wlx = 0 then
                                ? "no Winlets defined! cannot proceed!"
                                exit sub
                            end if
                        
                            wlx = nwinlets -1
                            z_draw
                            do
                                sleep 1
                                graphic inkey$ to skey
                                if skey = "" then ' check mouse
                                    if glbdown then ' mouse clicked
                                        bestz = -1
                                        ' find the window with the highest Z position
                                        ' which underlies the current mouse position
                                        for i = 0 to nwinlets-1
                                            copyrect (r, byval WL(i).CurrentRect)
                                            if ptinrect ( byval varptr(r), gMouseX, gMouseY) then
                                                if WL(i).zposn > bestz then
                                                    bestz = WL(i).zposn
                                                    besti = i
                                                end if
                                            end if
                                        next
                                        if bestz = -1 then iterate ' clicked outside any winlet
                                        WL(besti).makecurrent
                                        wlx = besti
                                        WL(wlx).warmstart ' transfer control to the winlet
                                        WL(wlx).unselect ' unselect whichever is currently selected
                                    end if
                                end if
                                select case skey
                                    case $esc
                                        exit loop
                                end select
                            loop
                        
                        end sub
                         '----------------------------------------------------------------
                        function pbmain () as long
                            local w, h as long
                            local hstatic as dword
                            gIcon_DRAGGRIP   = SetIconFileBits(BinBasDragGrip)
                            gIcon_SIZEGRIP   = SetIconFileBits(BinBasSIZEGrip)
                        
                            desktop get size to W, H
                            graphic window "Winlets on a GRAPHIC WINDOW (dumbpic, select, drag, size, z-ordering, icons)                                 Chris Holbrook Nov 2008", 0,0, W, H to ghGR
                            hStatic = GetWindow(ghGR, %GW_CHILD)                       ' Retrieve static handle of graphic window
                            GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
                            FormLoop  ghGR, 10
                            SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
                            graphic window end
                            if gIcon_DRAGGRIP then DestroyIcon ( gIcon_draggrip)
                            if gIcon_SIZEGRIP then DestroyIcon ( gIcon_sizegrip)
                        end function

                        Comment


                        • #13
                          now with STRETCHED images working

                          OK I found it - a silly mistake on my part. The code below now puts a STRETCHED version of the bitmap into even-numbered winlets and they can be sized and dragged just like the others.

                          Code:
                          ' Winlets on a GRAPHIC WINDOW.
                          '
                          ' to show draggable, sizeable winlets using z-order
                          ' Chris Holbrook Nov 2008
                          '
                          ' Left-click on a winlet to select it.
                          ' drag it by holding the left mouse button down over the number in the top L
                          ' and PBFDragging.
                          ' to deselect, just click somewhere else, or press ESC.
                          ' with no winlet selected, ESC exits the application.
                          '
                          ' changes
                          ' 12-Nov-2008 fixed initial jump in drag & size operations reported by Rod Hicks
                          ' 12-Nov-2008 added winlet dimensions display
                          ' 12-Nov-2008 added very basic DUMPIC control - too slow!
                          ' 12-NOV-2008 got rid of background redraw from MakeCurrent proc reported by Edwin Knoppert
                          ' 13-NOV-2008 replaced SLEEP 0 statements with SLEEP 1 to reduce CPU from 98% to 0% reported by Edwin Knoppert
                          ' 13-NOV-2008 added DUMBPIC margin
                          #compile exe
                          #dim all
                          %CCWIN = 1 ' allows us to use COMMCTRL.INC
                          
                          #include once "WIN32API.INC"
                          #include once "COMMCTRL.INC"
                          #include once "COMDLG32.INC"
                          #include once "winletsbbico.inc"
                          
                          %PBF_BOXSEL_COLOR = %yellow
                          %PBF_BG_COLOR     = &HD0E0E0
                          %PBF_FG_COLOR     = %black
                          %PBFMINWINLETSIZE = 45
                          %PBFDUMBPIC = 6
                          %PBF_DUMBPICMARGIN = 3
                          $PBF_PICPATH = "c:\chris\image\good.bmp"    ' <------ YOU NEED TO CHANGE THIS!!!!
                          %PBFDragging = 1
                          %PBFSizing   = 2
                          
                          global WL() as myWinlet                   ' Winlet array
                          global ghGR as dword                      ' global graphic window handle
                          global gZSEQ as long                      ' sequence number for labelling winlets
                                                                    ' it just keeps rolling, one day it will overflow!!!!!!
                          global GrDialogProc as long               ' used in subclassing the grapic control to get mouse msgs
                          global GrStaticProc as long               ' used in subclassing the grapic control to get mouse msgs
                          global gMouseX as long,gMouseY as long    ' Mouse x and y
                          global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
                          global gMouseMoved as long                ' Detect mouse movements
                          global gIcon_Draggrip as long              ' draggrip icon handle
                          global gIcon_Sizegrip as long              ' sizegrip icon handle
                          '-------------------------------------------------------------------------------------------------------
                          ' Computes location and size to stretch a bitmap preserving its aspect.
                          '
                          sub skIconise (byval xPic as long, byval yPic as long,            _ picture dimensions
                                         byval xCell as long, byval yCell as long,          _ FRAME dimensions
                                         byref xOfs as long, byref yOfs as long,            _ calc'd offset in frame
                                         byref xSize as long, byref ySize as long) export   ' thumbnail dimensions
                            local scale as single
                          
                              if xPIC& then scale! = xCell& / xPic&
                              if scale! > 1 then scale! = 1
                              xSize& = xPic& * scale!: ySize& = yPic& * scale!
                            ' In case Height > 150 compute new scale factor
                              if ySize& > yCell& then
                                 if yPic& then scale! = yCell& / yPic&
                                 xSize& = xPic& * scale!: ySize& = yPic& * scale!
                              end if
                              xOfs& = (xCell& - xSize&) \ 2
                              yOfs& = (yCell& - ySize&) \ 2
                          end sub
                          '---------------------------------------------------------------------
                          ' get a jpg filename
                          function getpic (hD as long) as string
                              local buf, spath, sfile as string
                              local dwstyle as dword
                              local hFile as long
                          
                              '------------------------ get JPG file
                              dwStyle = %ofn_explorer or %ofn_filemustexist or %ofn_hidereadonly
                              Buf   = "Picture files (*.JPG)|*.JPG|"
                              'IF gddlpath <> "" THEN spath = gddlpath
                              if OpenFileDialog (hD, "Locate JPG file ", sfile, spath, buf, "JPG", dwstyle) = 0 then
                                 exit function
                              end if
                              function = sfile
                          end function
                          
                          '--------------------------------------------------------------------------------
                          function GrDlgProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                           function = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
                          end function
                          '--------------------------------------------------------------------------------
                          function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
                            local p as pointapi
                            select case wMsg
                              case %wm_mousemove
                                  gMouseMoved = %TRUE
                                  gMouseX = lo(word,lParam)
                                  gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                                  exit function
                              case %wm_lbuttondown
                                  gMouseX = lo(word,lParam)
                                  gMouseY = hi(word,lParam)         ' Current Mouse X and Y Position in the graphic window
                                  gLBDOWN = 1
                                  exit function                      ' Left button pressed
                              case %wm_lbuttonup
                                  gLBDOWN = 0
                                  exit function
                              case %wm_rbuttondown
                                  gRBDOWN = 1
                                  exit function                      ' Right button pressed
                              case %wm_rbuttonup
                                  gRBDOWN = 0
                                  exit function                      ' Right button pressed
                          
                            end select
                           function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
                          
                          end function
                          
                          sub debugprintrect ( s as string, byval rp as rect ptr)
                             ? s + str$(@rp.nleft),str$(@rp.ntop),str$(@rp.nright), str$(@rp.nbottom)
                          end sub
                          '------------------------------------------------------------------------
                          ' redraw all winlets in Z order
                          sub z_draw
                              local tempr, junkr as RECT
                              local i, l as long
                              local z() as dword
                          
                          
                              graphic clear %PBF_BG_COLOR
                          
                              dim z(0 to ubound(WL)) as local dword ' 0=zpos, 1=index in WL()
                          
                              for i = 0 to ubound(WL)
                                   z(i) = mak(dword, i, WL(i).zposn)
                              next
                              array sort z()
                              local skey as string
                              for i = 0 to ubound(WL)
                                  WL(lo(word,z(i))).drawwinlet
                              next
                              graphic redraw
                          end sub
                          
                          '-----------------------------------------------------------------------
                          class myWinletClass
                              ' these are PRIVATE variables shared between methods in the class
                              ' exitpoint is the mouse coordinates which
                              ' which the user clicked to exit the winlet - i.e. outside the current winlet
                              ' LO word is X, HI word is Y
                              instance exitpoint as dword
                              ' Leaveform is a boolean value set e.g. by CLOSEME winlets to indicate that
                              ' the form processing has finished.
                              instance leaveform as long
                              ' This is the initial rect for the winlet
                              instance initialrect as RECT
                              ' This is the current rect(after PBFDragging and PBFSizing, maybe)
                              instance currentrect as RECT
                              'If zero, no drag!
                              instance draggable as long
                              'if zero, no resize!
                              instance sizeable as long
                              ' the rect of the drag grip icon
                              instance DragGripIconRect as RECT
                              ' the rect of the size grip icon
                              instance SizeGripIconRect as RECT
                              ' initial grab offset - subsequent cursorposns are offset by the same amount to
                              ' avoid initial "jump" in click or drag operations
                              instance InitGrabOffsetX as long
                              instance InitGrabOffsetY as long
                          
                              ' type of component
                              ' 0 = undefined
                              ' 1 = CLOSEME
                              ' 2 = edit box
                              ' 3 = text box
                              ' 4 = list box
                              ' 5 = msgbox
                              ' 6 = dumbpic
                              instance CompType as long
                              ' handle of stored bitmap
                              instance storedBMP as dword
                              ' default pic path
                              instance picpath as string
                              ' image for picture
                              instance hImage as dword
                              ' BMP for picture
                              instance hPicBMP as dword
                              ' width & height of bitmap
                              instance PicWidth as single
                              instance PicHeight as single
                              ' current zpos of winlet
                              instance ZPOS as long
                              ' default (e.g. initial) zpos of winlet to which winlet reverts when deselected
                              instance DefaultZPOS as long
                              ' the currently selected winlet
                              instance currentwinlet as long
                              ' handle for drag icon
                              instance hdragicon as long
                              ' handle for size icon
                              instance hsizeicon as long
                              ' identifying number for the winlet
                              instance winletid as long
                              ' DC for the current GW
                              instance hDC as dword
                              ' testing!
                              instance testarray() as long
                              '---------------------------------------------------------
                              ' these are PRIVATE methods
                              ' update the stored copy of the winlet's bitmap
                              class method updatestoredcopy ( hGR as dword, r as rect )
                                  local i as long
                                  local q as quad
                                  graphic bitmap new r.nright - r.nleft, r.nbottom - r.ntop to storedBMP
                                  graphic attach storedBMP, 0, redraw
                                  graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                                  ' copy the area to the smaller GW
                                  graphic copy hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) to (0, 0)
                                  graphic attach hGR, 0, redraw
                                  graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                                  graphic font "Courier New"
                                  me.setcurrentrect(r.nleft, r.ntop, r.nright, r.nbottom)
                                  graphic redraw
                              end method
                          
                              '------------------------------------------------------------------------
                              class method setCurrentRect ( X as long, Y as long, W as long, H as long)
                                  setrect ( byval varptr(currentRect), X, Y, W, H)
                              end method
                              '------------------------------------------------------------------------
                              class method destroy
                                  graphic attach storedBMP, 0
                                  graphic clear %PBF_BG_COLOR
                                  graphic window end
                                  graphic attach ghGR, 0, redraw
                                  graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                          
                              end method
                              '------------------------------------------------------------------------
                              class method create
                                  local l, x, y, w, h, nfile as long
                          
                          
                                  hdragicon = gIcon_DRAGGRIP
                                  hsizeicon = gIcon_SIZEGRIP
                                  desktop get size to W, H
                                  X = rnd(50, W/2)
                                  Y = rnd(50, H/2)
                                  W = rnd(50, W/4)
                                  H = rnd(50, H/4)
                                  me.SetInitRect (X, Y, X + W, Y + H)
                                  me.SetCurrRect (X, Y, X + W, Y + H)
                                  winletid = gZSEQ
                                  if winletid mod 2 = 0  then
                                      picpath = $PBF_PICPATH
                                      comptype = %PBFDUMBPIC
                                      nFile = freefile
                                      open picpath for binary as nFile
                                      get #nFile, 19, l: PicWidth = l
                                      get #nFile, 23, l : PicHeight = l
                                      close nFile
                                      graphic bitmap load picpath, PicWidth, PicHeight to hPicbmp
                                  else
                                      picpath = ""
                                      comptype = 0
                                  end if
                                  zpos = gZSEQ ' record zpos
                                  defaultzpos = gZSEQ ' record zpos
                                  me.updatestoredcopy ( ghGR, CurrentRect )
                                  me.drawit
                                  incr gZSEQ
                                  graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                          
                              end method
                              '-----------------------------------------------------------------------
                              class method winletsetpos ( x as long, Y as long)
                                  graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                              end method
                              '-----------------------------------------------------------------------
                              class method showpic
                                  graphic stretch hPicBMP, 0, (0,0)-(PicWidth, PicHeight) to _
                                                  (currentrect.nleft  + %PBF_DUMBPICMARGIN, currentrect.ntop    + %PBF_DUMBPICMARGIN)-_
                                                  (currentrect.nright - %PBF_DUMBPICMARGIN, currentrect.nbottom - %PBF_DUMBPICMARGIN)
                              end method
                              '-----------------------------------------------------------------------
                              class method winletprintat ( x as long, Y as long, s as string)
                                  local pX, pY as long
                                  local sX, sY as single
                          
                                  graphic set pos ( currentrect.nleft + X, currentrect.ntop + Y )
                                  graphic get pos to pX, pY
                                  graphic text size s to sX, sY
                                  if pX + sX > currentrect.nright then exit method
                                  graphic print s;
                              end method
                              '-----------------------------------------------------------------------
                              class method SetInitRect ( X as long, Y as long, W as long, H as long)
                                  setrect  byval varptr(initialrect), X, Y, W, H
                              end method
                              '-----------------------------------------------------------------------
                              class method SetCurrRect ( X as long, Y as long, W as long, H as long)
                                  setrect  byval varptr(CurrentRect), X, Y, W, H
                              end method
                              '------------------------------------------------------------------------
                              class method boxrect (r as rect, byval fillcolour as long)
                                  graphic box ( r.nleft, r.ntop) - (r.nright, r.nbottom), 0,0,fillcolour
                              end method
                              '-----------------------------------------------------------------------
                              class method drawit
                                  local tempr as rect
                                  local hDC as dword
                                  local chX, chY as long ' for charcter size
                          
                                  ' draw current rect
                                  graphic box (currentrect.nleft, currentrect.ntop) - (currentrect.nright, currentrect.nbottom),0,%PBF_FG_COLOR,%PBF_BG_COLOR
                                  ' draw highlight just inside it
                                  if currentwinlet then
                                      copyrect byval varptr(tempr), byval varptr(currentrect)
                                      inflaterect ( byval varptr(tempr), -1, -1)
                                      graphic box ( tempr.nleft,tempr.ntop) - (tempr.nright, tempr.nbottom), 0, %PBF_BOXSEL_COLOR, %PBF_BG_COLOR, 0
                                  end if
                                  ' if winlet is a dumb pic, display the pic
                                  if comptype = %PBFDUMBPIC then
                                      me.showpic 'debugshowpic(byval varptr(currentrect), hPicbmp, PicWidth, PicHeight)
                                  end if
                                  ' draw winlet id
                                  me.WinletPrintAt ( 20, 5, format$(winletId))
                                  graphic chr size to ChX, ChY
                          
                          '        graphic color %PBF_FG_COLOR, -2'%PBF_BG_COLOR
                          '        me.WinletPrintAt ( 2, 5 + ChY, _
                          '                        format$(currentrect.ntop) + "," + format$(currentrect.nleft) + " - " + _
                          '                        format$(currentrect.nright) + "," + _
                          '                        format$(currentrect.nbottom))
                          '        graphic color %PBF_FG_COLOR, %PBF_BG_COLOR
                          
                          
                                  ' set new location for draggripicon
                                  DragGripIconRect.nleft   = CurrentRect.nleft + 2        ' position icon at offset 2, 2 (topleft)
                                  DragGripIconRect.ntop    = CurrentRect.ntop  + 2
                                  DragGripIconRect.nright  = CurrentRect.nleft + 2 + 16
                                  DragGripIconRect.nbottom = CurrentRect.ntop  + 2 + 16
                                  ' show icon if we have one
                                  if hdragicon then
                                      graphic get dc to hdc
                                      drawiconex (hdc, DragGripIconRect.nleft, DragGripIconRect.ntop, hdragicon, 16, 16, 0, byval 0, %di_normal)
                                  end if
                                  SizeGripIconRect.nleft   = CurrentRect.nright -2 -16        ' position icon at offset -2. -2 from bottom right
                                  SizeGripIconRect.ntop    = CurrentRect.nbottom - 5 -16
                                  SizeGripIconRect.nright  = CurrentRect.nright - 2
                                  SizeGripIconRect.nbottom = CurrentRect.nbottom -2
                                  ' show icon if we have one
                                  if hSizeicon then
                                      graphic get dc to hdc
                                      drawiconex (hdc, SizeGripIconRect.nleft, SizeGripIconRect.ntop + 2, hSizeicon, 16, 16, 0, byval 0, %di_normal)
                                  end if
                              end method
                              '
                              'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                              interface MyWinlet
                                  inherit iunknown
                                  ' these are PUBLIC methods
                                  '
                                  method drawwinlet
                                      me.drawit
                                  end method
                          
                                  method exitpoint as long
                                      method = exitpoint
                                  end method
                                  '------------------------------------------------------------------------
                                  method identity as long
                                      method = winletid
                                  end method
                          
                                  '------------------------------------------------------------------------
                                  ' the FormLoop transfers control to the winlet by calling this proc.
                                  ' after making it visible and selected. No need to create or draw frame.
                                  method warmstart
                                      local skey as string
                                      local DragSizeMode as long ' mode indicator see %PBFDragging and %PBFSizing
                                      local dragsizeoriginX, dragsizeoriginY as long
                                      local dragsizeTargetX, dragsizeTargetY as long
                                      local i, lresult as long
                                      local rlastbox,  junkr, tempr as RECT
                                      local hDC as dword
                                      local dragsizestart as double
                                      local zord() as long
                          
                                      dim zord(0 to ubound(WL)) as local long
                                      copyrect byval varptr(rlastbox), byval varptr(currentrect)
                                      gosub drawdrag
                                      do
                                          sleep 2
                                          graphic inkey$ to skey
                                          if skey = $esc then exit method
                                          if len(skey) then iterate ' an unused key has been pressed
                                          if glbdown then
                                              select case DragSizeMode
                                                  ' if the click was in a drag rect, then start the drag operation
                                                  case 0
                                                      if ptinrect ( byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                          dragsizeoriginX = currentrect.nleft
                                                          dragsizeoriginY = currentrect.ntop
                                                          dragsizetargetX = currentrect.nleft
                                                          dragsizetargetY = currentrect.ntop
                                                          DragSizeMode = %PBFDragging 'PBFDragging = %true
                                                          exit select
                                                      end if
                                                      if ptinrect ( byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                          dragsizeoriginX = currentrect.nright
                                                          dragsizeoriginY = currentrect.nbottom
                                                          dragsizeTargetX = currentrect.nright
                                                          dragsizeTargetY = currentrect.nbottom
                                                          DragSizeMode = %PBFSizing
                                                          exit select
                                                      end if
                                                      ' start the timer
                                                      ' dragsizestart = timer
                                                      ' if the click was outside the current winlet, exit to the Formloop!
                                                      if ptinrect( byval varptr(currentrect), gmouseX, gmouseY) = 0 then
                                                          exit method
                                                      end if
                                              end select
                                              if gmousemoved then
                                                  if DragsizeMode  <> 0 then
                                                      do
                                                          'sleep 0
                                                          ' the left mouse button has been held down
                                                          ' the action depends upon where cursor was when
                                                          ' the initial button press was made
                                                          if (gmousex = DragSizeOriginX) and (gmouseY = DragSizeOriginY) then exit loop
                                                          select case dragsizemode
                                                              case %PBFdragging
                                                                  if ptinrect(byval varptr(DragGripIconRect), gMouseX, gMouseY) then
                                                                      iterate ' dragged within drag icon rect - ignore!
                                                                  end if
                                                              case %PBFsizing
                                                                  if ptinrect(byval varptr(SizeGripIconRect), gMouseX, gMouseY) then
                                                                      iterate ' dragged within size icon rect - ignore!
                                                                  end if
                                                          end select
                                                          'if timer - dragsizestart > 0.01 then
                                                              z_draw' redraw winlets in z-order
                                                              select case dragsizemode
                                                                  case %PBFdragging
                                                                      gosub drawdrag
                                                                  case %PBFsizing
                                                                      gosub drawsize
                                                              end select
                                                              DragSizeOriginX = DragSizeTargetX
                                                              DragSizeOriginY = DragSizeTargetY
                                                              dragsizestart = timer
                                                              graphic redraw
                                                          'end if
                                                          DragSizeTargetX = gMouseX
                                                          DragSizeTargetY = gMouseY
                                                      loop until glbdown = 0
                                                  end if
                                              end if
                                              gmousemoved = %FALSE
                                              iterate
                                          else ' left button is up, clear dragsize origin
                                              if DragSizeMode <> 0 then
                                                  z_draw' redraw winlets in z-order
                                                  me.drawit
                                                  graphic redraw
                                                  DragSizeMode = 0
                                              end if
                                          end if
                                      loop
                                      exit method ' never gets here
                          drawdrag:
                                      ' calculate the rect to be redrawn from the
                                      ' start pos, end pos and size of winlet being dragged
                                      offsetrect byval varptr(currentrect), DragSizeTargetX - DragSizeOriginX, DragSizeTargetY - DragSizeOriginY
                                      graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                      '
                                      graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                      me.drawit
                                      ' the drag icon zone is at the top left of the winlet
                                      ' irrespective of whether an icon is available
                                      copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                          
                                      return
                          drawsize:
                                      ' calculate the rect to be redrawn from the
                                      ' start pos, end pos and size of winlet being dragged
                                      if dragsizetargetX > currentrect.nleft + %PBFMINWINLETSIZE then
                                          currentrect.nright  = DragsizetargetX
                                      end if
                                      if dragsizetargetY > currentrect.ntop + %PBFMINWINLETSIZE then
                                          currentrect.nbottom     = DragSizeTargetY
                                      end if
                                      graphic box ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %PBF_BG_COLOR, %PBF_BG_COLOR, 0
                                      graphic box ( CurrentRect.nleft,CurrentRect.ntop) - (CurrentRect.nright, CurrentRect.nbottom), 0, %PBF_FG_COLOR, %PBF_BG_COLOR, 0
                                      me.drawit
                                      ' the draw icon zone is at the top left of the winlet
                                      ' irrespective of whether an icon is available
                                      copyrect byval varptr(rlastbox), byval varptr(CurrentRect)
                          return
                                  end method
                                  '------------------------------------------------------------------------
                                  method draw
                                      me.drawit
                                  end method
                          
                                  '------------------------------------------------------------------------
                                  method LeaveForm as long
                                      method = leaveform
                                  end method
                                  '------------------------------------------------------------------------
                                  method zposn as long
                                      method = zpos
                                  end method
                                  '------------------------------------------------------------------------
                                  method CurrentRect as dword
                                      method = varptr(CurrentRect)
                                  end method
                                  '------------------------------------------------------------------------
                                  method unselect
                                      local tempr as rect
                                      ' clear the hightlighted frame
                                      currentwinlet = %FALSE
                                      copyrect byval varptr(tempr), byval varptr(currentrect)
                                      inflaterect byval varptr(tempr), -1, -1
                                      graphic box (tempr.nleft, tempr.ntop) - _
                                                  (tempr.nright, tempr.nbottom),0,%PBF_BG_COLOR,-2
                                      graphic redraw
                                  end method
                                  '------------------------------------------------------------------------
                                  method makecurrent
                                      graphic copy storedBMP, 0 to (CurrentRect.nleft, CurrentRect.ntop) ', %mix_MergeSrc
                                      zpos = gZSEQ: incr gZSEQ
                          
                                      currentwinlet = %TRUE
                                      me.drawit
                                      graphic redraw
                                      'sleep 2000
                                  end method
                                  '-------------------------------------------------------------------------
                                  method selected as long
                                      method = currentwinlet
                                  end method
                              end interface
                              'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
                          end class
                          
                          '-------------------------------------------------------------------------
                          
                          sub FormLoop ( hGW as dword, nWinlets as long)
                              local i, wlx, bestz, besti as long
                              local skey as string
                              local r as RECT
                          
                              dim WL(0 to nWinlets -1) as global myWinlet
                          
                              for i = 0 to nWinlets -1
                                  WL(i) = class "MyWinLetClass"
                              next
                          
                              wlx = nWinlets
                              if wlx = 0 then
                                  ? "no Winlets defined! cannot proceed!"
                                  exit sub
                              end if
                          
                              wlx = nwinlets -1
                              z_draw
                              do
                                  sleep 1
                                  graphic inkey$ to skey
                                  if skey = "" then ' check mouse
                                      if glbdown then ' mouse clicked
                                          bestz = -1
                                          ' find the window with the highest Z position
                                          ' which underlies the current mouse position
                                          for i = 0 to nwinlets-1
                                              copyrect (r, byval WL(i).CurrentRect)
                                              if ptinrect ( byval varptr(r), gMouseX, gMouseY) then
                                                  if WL(i).zposn > bestz then
                                                      bestz = WL(i).zposn
                                                      besti = i
                                                  end if
                                              end if
                                          next
                                          if bestz = -1 then iterate ' clicked outside any winlet
                                          WL(besti).makecurrent
                                          wlx = besti
                                          WL(wlx).warmstart ' transfer control to the winlet
                                          WL(wlx).unselect ' unselect whichever is currently selected
                                      end if
                                  end if
                                  select case skey
                                      case $esc
                                          exit loop
                                  end select
                              loop
                          
                          end sub
                           '----------------------------------------------------------------
                          function pbmain () as long
                              local w, h as long
                              local hstatic as dword
                              gIcon_DRAGGRIP   = SetIconFileBits(BinBasDragGrip)
                              gIcon_SIZEGRIP   = SetIconFileBits(BinBasSIZEGrip)
                          
                              desktop get size to W, H
                              graphic window "Winlets on a GRAPHIC WINDOW (dumbpic, select, drag, size, z-ordering, icons)                                 Chris Holbrook Nov 2008", 0,0, W, H to ghGR
                              hStatic = GetWindow(ghGR, %GW_CHILD)                       ' Retrieve static handle of graphic window
                              GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
                              FormLoop  ghGR, 10
                              SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
                              graphic window end
                              if gIcon_DRAGGRIP then DestroyIcon ( gIcon_draggrip)
                              if gIcon_SIZEGRIP then DestroyIcon ( gIcon_sizegrip)
                          end function

                          Comment


                          • #14
                            Chris,

                            I tried to help in testing, but I'm missing "winletsbbico.inc". Is it posted elsewhere?

                            Comment


                            • #15
                              John, sorry, I forgot that I had put that code into an include file, it is appended.

                              The image quality is not good compared with GDIPlus. I'm going to see if I can use that instead. Got to get this text editor winlet working first, though.

                              Code:
                              ' winletsBBICO.inc
                              '
                              ' Icon stuff - or you could load it from a resource file
                              '---------------------------------------------------------------
                              '//////////////////////////////////////////////////////////////////////////
                              '// Icon loading
                              '//////////////////////////////////////////////////////////////////////////
                              
                              type TAGICONDIR
                              
                                  idReserved  as word '// Reserved (must be 0)
                                  idType      as word '// Resource Type (1 For icons)
                                  idCount     as word '// How many images?
                              
                              end type
                              
                              type TAGICONDIRENTRY
                              
                                  bWidth          as byte     '// Width, In Pixels, of the Image
                                  bHeight         as byte     '// Height, In Pixels, of the Image
                                  bColorCount     as byte     '// Number of colors In Image (0 If >=8bpp)
                                  bReserved       as byte     '// Reserved ( must be 0)
                                  wPlanes         as word     '// Color Planes
                                  wBitCount       as word     '// Bits per pixel
                                  dwBytesInRes    as dword    '// How many bytes In this resource?
                                  dwImageOffset   as dword    '// Where In the file is this image?
                              
                              end type
                              
                              '// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
                              '// Returns a iconhandle.
                              function SetIconFileBits( byval lpMem as long ) as long
                              
                                  dim pIconDir        as TAGICONDIR ptr
                                  dim IconDirEntry    as TAGICONDIRENTRY ptr
                              
                                  pIconDir = lpMem
                                  if @pIconDir.idCount < 1 then exit function
                                  IconDirEntry = pIconDir + len( @pIconDir )
                              
                                  function = CreateIconFromResource( _
                                        byval pIconDir + @IconDirEntry.dwImageOffset _
                                      , @IconDirEntry.dwBytesInRes _
                                      , @pIconDir.idType _
                                      , &H30000& _
                                      )
                              
                              end function
                              
                              
                              '//////////////////////////////////////////////////////////////////////////
                              macro mBinDataStuff
                                  local a as long
                                  local t, t2 as string
                                  for a = 1 to datacount: T = T & read$( a ): next a
                                  for a = 1 to len( T ) step 2
                                      T2 = T2 & chr$( val( "&H" & mid$( T, a , 2 ) ) )
                                  next a
                                  function = strptr(T2)
                              end macro
                              '-------------------------------------------------------------------------------
                              function BinBasDRAGGRIP as dword
                              
                                  mBinDataStuff
                              data 0000010001001010000001000800680500001600000028000000100000002000000001
                              data 0008000000000000000000000000000000000000000000000000000000000084828400
                              data FFFFFF0080808000C4C4C4000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000002020200000000000000000000000000010101010000000000000000
                              data 0000000000020101000000000000000000000000020100010000000000000000000000
                              data 0201000001000000000000000000000201000000000000000000000000000201000000
                              data 0000000000000000000002010000000000000000000000000002010000000000000000
                              data 0000000000020100000000000000000000000000020100000000000000000000000000
                              data 0001000000000000000000000000000000000000000000000000000000000000000000
                              data 000000000000000000000000FFFF0000FFFF0000FF8F0000FF870000FFC70000FF9700
                              data 00FF370000FE7F0000FCFF0000F9FF0000F3FF0000E7FF0000CFFF0000DFFF0000FFFF
                              data 0000FFFF0000
                              
                              end function
                              '-------------------------------------------------------------------------------
                              function BinBasSIZEGRIP as dword
                              
                                  mBinDataStuff
                              data 0000010001001010000001000800680500001600000028000000100000002000000001
                              data 0008000000000000000000000000000000000000000000000000000000000080808000
                              data FFFFFF0000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000101020001010200010102000000
                              data 0000010100000101000001010000000000000000000000000000000000000000000000
                              data 0000000101020001010200000000000000000001010000010100000000000000000000
                              data 0000000000000000000000000000000000000000010100000000000000000000000000
                              data 0001010000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 0000000000000000000000000000000000000000000000000000000000000000000000
                              data 000000000000000000000000FFFF0000F1110000F3330000FFFF0000FF110000FF3300
                              data 00FFFF0000FFF30000FFF30000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
                              data 0000FFFF0000
                              
                              end function

                              Comment


                              • #16
                                Chris,

                                I took a quick look through your code -- you are WAY more advanced in the modern stuff than I am! I'm not sure how much help I can be at this time. But I'm willing to test what I can.

                                OK, compiles and runs. I tried it with 3 .BMP files (one at a time).
                                First BMP is 1M bytes, the second is 600K bytes, and the third is only 400 bytes.

                                The first two were visible, the third didn't display.

                                All winlets were moveable. Movement was slow and a bit uneven.

                                A mouseclick on the upper-right control menu's red X button closed the winlets and the graphic window, but the console window remained open, and its process had to be killed via extra, external methods.

                                Let me know if this is of any help...

                                Comment


                                • #17
                                  Just running the code you supplied with no alterations.
                                  I resized a couple of the winlets.(made bigger, then smaller)
                                  When clicking on the resized winlet to select it, the area now no longer within the winlet that was previously in the winlet prior to resizing smaller turns white. This white disappears when the winlet is moved. Notice it on winlet 7. Didn't do it on any others this run. I noticed it on two winlets first run, but I was checking other features and didn't take notes, but winlet 7 was one of them in that instance as well. I did not try analyzing your code to see the cause of this effect.

                                  Nice that the winlets do not move or resize until you move the mouse.
                                  You might want to develop a nudge method for 'pixel at a time' adjustment in some future iteration.
                                  Rod
                                  In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                                  Comment


                                  • #18
                                    John and Rod, thanks for giving it a spin. I appreciate the feedback.

                                    To be honest, I had not thought through the small BMP. Most of the images which I have used in th past have been photography, which results in a different problem -image quality. There is a minimum size for a winlet - ISTR it is 100 x 100 px and I'm not sure about how tiny BMPs work out, I will take a look.

                                    Dragging winlets is a bit notchy. I'm not sure how to improve it, my guess is that I have still not balanced the SLEEP (timeslice surrender) to minimise CPU with the number of redraws to make the movement look smooth. Maybe I need to draw evertyhing direct, which may speed up dragging but slow down "development".

                                    The shutdown problem is an own goal, I wanted to put a title on the GW and the red box comes with it. In future the title will be a static winlet and shutdown will be via a CLOSEME winlet.

                                    I have fixed the background colour problem reported by Rod.

                                    The next version includes the fixes mentioned above plus a TEXTEDITOR winlet, but I'm having a bit of trouble with GRAPHIC REDRAW at the moment.

                                    Comment


                                    • #19
                                      some more functionality

                                      code withdrawn
                                      Last edited by Chris Holbrook; 27 Nov 2008, 01:41 AM.

                                      Comment


                                      • #20
                                        Code:
                                        PowerBASIC Console Compiler
                                        PB/CC   Version 5.00 
                                        Copyright (c) 1998-2008 PowerBasic Inc.
                                        Venice, Florida USA
                                        All Rights Reserved
                                        
                                        Error 526 in C:\PBCC50\Programs\winletsch20081126.bas(733:043):  Period not allowed
                                        Line 733:             IF CtlType = %PBFCLOSEME THEN me.showcloseme(l)
                                        ==============================
                                        Compile failed at 7:48:07 PM on 26/11/2008
                                        What I got when I tried running the program.
                                        Code:
                                        $PBF_PICPATH = "c:\chris\image\good.bmp"    ' <------ YOU NEED TO CHANGE THIS!!!!
                                        While I'm posting, are there any more lines of this nature?
                                        Rod
                                        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

                                        Comment

                                        Working...
                                        X