PBDLL60 how to drag and drop icons?

[Gary Peek]

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?


------------------

[Semen Matusovski]

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 "win32api.inc"

   %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
         Next
      Next
      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
            Beep
         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]

[Gary Peek]

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

------------------