Announcement

Collapse
No announcement yet.

dragging a box around a GRAPHIC WINDOW

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

  • Chris Holbrook
    replied
    Originally posted by Rodney Hicks View Post
    While I'm posting, are there any more lines of this nature?
    Sorry Rod, forgot I was using a beta V. of the compiler. I will re-post the code when I can synchronise with the proper version.

    Leave a comment:


  • Rodney Hicks
    replied
    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?

    Leave a comment:


  • Chris Holbrook
    replied
    some more functionality

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

    Leave a comment:


  • Chris Holbrook
    replied
    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.

    Leave a comment:


  • Rodney Hicks
    replied
    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.

    Leave a comment:


  • John Montenigro
    replied
    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...

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • John Montenigro
    replied
    Chris,

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

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Edwin Knoppert
    replied
    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.

    Leave a comment:


  • Chris Holbrook
    replied
    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.

    Leave a comment:


  • Edwin Knoppert
    replied
    To show #1's mouse behaviour see:

    www.hellobasic.com/trials/uvdtest.zip

    (May crash, work in progess)

    Leave a comment:


  • Edwin Knoppert
    replied
    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'?

    Leave a comment:


  • Rodney Hicks
    replied
    which comes under "tomorrow"!
    This I understand.

    Leave a comment:


  • Chris Holbrook
    replied
    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"!

    Leave a comment:


  • Rodney Hicks
    replied
    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.

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:


  • Chris Holbrook
    replied
    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

    Leave a comment:

Working...
X