No announcement yet.

PBDLL60 how to drag and drop icons?

  • Filter
  • Time
  • Show
Clear All
new posts

  • PBDLL60 how to drag and drop icons?

    I was planning to write something like a "code generator"
    for a microprocessor based controller.

    Imagine a bunch of numbered boxes in a window that represent
    lines of "code". Then imagine a group of icons somewhere else
    that can be dragged and dropped into these code line boxes.
    These icons represent code "subroutines" like "delay", "relay
    1=on", "jump to step x", etc. Very simple and of course very
    limited, but allows a non-programmer to do simple tasks.

    I searched for "drag and drop icons" and did not find
    anything in the forums.

    Any idea how to do the drag and drop part?

    Gary Peek, Industrologic, Inc.

  • #2
    I think could be something like this (BTW, I didn't really test a code; I simply took BmpToRgn sub; reconstructed it a little and ran under Win2000)
       #Compile Exe
       #Register None
       #Dim All
       #Include ""
       %MaxRegions = 4000
       Function IconToRgn (hWnd As Long, hIcon As Long) As Long
          Dim hDC As Long, hMemDC As Long, pWidth As Long, pHeight As Long
          Dim bm As BITMAP, hMemBmp As Long, rc As RECT, bmi As BITMAPINFO, rdh As RGNDATAHEADER Ptr
          Dim i As Long, j As Long, k As Long, m As Long, t As Long, tt As Long
          hDC = GetDC(hWnd)
          hMemDC = CreateCompatibleDC (hDC)
          GetClientRect hWnd, rc
          pWidth = rc.nRight - rc.nLeft
          pHeight = rc.nBottom - rc.nTop
          bmi.bmiHeader.biSize = SizeOf(bmi.bmiHeader)
          bmi.bmiHeader.biWidth = pWidth
          bmi.bmiHeader.biHeight = pHeight
          bmi.bmiHeader.biPlanes = 1
          bmi.bmiHeader.biBitCount = 32
          bmi.bmiHeader.biCompression = %BI_RGB
          hMemBmp = CreateDIBSection(hMemDC, bmi, %DIB_RGB_COLORS, 0, 0, 0)
          GlobalLock hMemBmp
          GetObject hMemBmp, SizeOf(bm), bm
          SelectObject hMemDC, hMemBmp
          DrawIconEx hMemDC, 0, 0, hIcon, pWidth, pHeight, 0, ByVal 0, %DI_Normal
          Dim sRgnData As String, lpRect As RECT Ptr
          sRgnData = String$(SizeOf(@rdh) + SizeOf(rc) * %MaxRegions, 0)
          rdh = StrPtr(sRgnData): lpRect = SizeOf(@rdh) + rdh
          @rdh.dwSize = SizeOf(@rdh): @rdh.iType = %RDH_RECTANGLES: @rdh.rcBound = rc
          ReDim Ar(0) As Long At bm.bmBits: tt = 0
          t = Ar((pHeight - 1) * pWidth)
          For j = pHeight - 1 To 0 Step -1
             m = -1
             For i = 0 To pWidth
                If i = pWidth Then k = t Else k = Ar(tt): Incr tt
                If k <> t Then
                   If m = -1 Then m = i
                ElseIf m >= 0 Then
                   If @rdh.nCount < %MaxRegions Then
                      Incr @rdh.nCount
                      @lpRect.nLeft = m: @lpRect.nRight = i
                      @lpRect.nTop = j: @lpRect.nBottom = j + 1
                      lpRect = lpRect + SizeOf(rc)
                   End If
                   m = -1
                End If
          Function = ExtCreateRegion(ByVal 0, lpRect - rdh, ByVal rdh)
          ReleaseDC hWnd, hDC: DeleteDC hMemDC: DeleteObject hMemBmp
       End Function
       Global DlgOrigProc As Long
       CallBack Function SubClass
          Dim hIcon As Static Long, hRgn As Static Long, rc As RECT
          Select Case CbMsg
             Case %WM_ERASEBKGND
                If hIcon = 0 Then
                   hIcon = LoadIcon(ByVal 0, ByVal %IDI_QUESTION)
                   hRgn = IconToRgn(CbHndl, hIcon)
                   SetWindowRgn CbHndl, hRgn, 1
                End If
                GetClientRect CbHndl, rc
                DrawIconEx CbWparam, 0, 0, hIcon, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop, 0, ByVal 0, %DI_Normal
                Function = 1: Exit Function
             Case %WM_EXITSIZEMOVE
             Case %WM_NCHITTEST
                Function = %HTCAPTION: Exit Function
             Case %WM_DESTROY
                SetWindowLong CbHndl, %GWL_WNDPROC, DlgOrigProc
                DeleteObject hRgn: DeleteObject hIcon
                Exit Function
          End Select
          Function = CallWindowProc(DlgOrigProc, CbHndl, CbMsg, CbWparam, CbLparam)
       End Function
       Function PbMain
          Dim hDlg As Long
          Dialog New 0, "", , , 100, 100, %WS_POPUP, %WS_EX_TOPMOST Or %WS_EX_TOOLWINDOW To  hDlg
          DlgOrigProc = SetWindowLong(hDlg, %GWL_WNDPROC, CodePtr(subclass))
          Dialog Show Modal hDlg
       End Function
    E-MAIL: [email protected]


    • #3
      Semen, thank you! This goes a long way toward
      getting me started. The sample code works.

      Gary Peek, Industrologic, Inc.