Enabling Drop on WebGadget

Just starting out? Need help? Post your questions and find answers here.
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Enabling Drop on WebGadget

Post by firace »

Does the WebGadget support dropping files from the desktop to display them? (The way IE and other browsers do)

EnableGadgetDrop doesn't seem to work for me (PB5.62, Win 10):

Code: Select all

OpenWindow(0, 0, 0, 980, 650, "TEST", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget)

WebGadget (0, 0, 0, 980, WindowHeight(0), "") 


EnableGadgetDrop(0, #PB_Drop_Files, #PB_Drag_Copy)
; EnableWindowDrop(0, #PB_Drop_Files, #PB_Drag_Copy)



Repeat 
  
  Select WaitWindowEvent()
      
      
    Case #PB_Event_GadgetDrop
        SetGadgetText(0, EventDropFiles())
      
    Case #PB_Event_CloseWindow  
      Break
      EndSelect
    ForEver
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Enabling Drop on WebGadget

Post by breeze4me »

It seems to be a bug. A file can be dropped on a web gadget in PB 5.10.
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: Enabling Drop on WebGadget

Post by firace »

breeze4me wrote:It seems to be a bug. A file can be dropped on a web gadget in PB 5.10.
Good to know, thanks.

Would anyone have a quick workaround?
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Enabling Drop on WebGadget

Post by breeze4me »

The following code works on Windows 7.

Code: Select all

Global old

Procedure WebGadgetWProc(hwnd, msg, wParam, lParam)
  Protected count, sz, *m, file$
  
  If msg = #WM_DROPFILES
    count = DragQueryFile_(wParam, -1, 0, 0)
    If count >= 1
      sz = DragQueryFile_(wParam, 0, 0, 0)
      If sz > 0
        sz + 1
        *m = AllocateMemory(sz * 4)
        If *m
          If DragQueryFile_(wParam, 0, *m, sz)
            file$ = PeekS(*m)
            
            ;open the dropped file with the web gadget.
            If file$
              SetGadgetText(0, file$)
            EndIf
          EndIf
          FreeMemory(*m)
        EndIf
      EndIf
    EndIf
    DragFinish_(wParam)
  EndIf
  
  ProcedureReturn CallWindowProc_(old, hwnd, msg, wParam, lParam)
EndProcedure

If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  hwnd = WebGadget(0, 10, 10, 580, 280, "http://www.purebasic.com")
  
  DragAcceptFiles_(hwnd, 1)
  
  old = SetWindowLongPtr_(GadgetID(0), #GWLP_WNDPROC, @WebGadgetWProc())
  
  
  Repeat
    e = WaitWindowEvent()
    
  Until e = #PB_Event_CloseWindow
  
EndIf
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Enabling Drop on WebGadget

Post by RASHAD »

Hi
Coded by : breeze4me
Modified by : RASHAD
Tested with Windows 10 x64
Drop external txt,html,pdf,bmp,jpg,gif & png and maybe more

Code: Select all

Global oldWNDPROC

Procedure WebGadgetWProc(hwnd, uMsg, wParam, lParam)
  Protected count, sz, *m, file$
 
  If uMsg = #WM_DROPFILES
    count = DragQueryFile_(wParam, -1, 0, 0)
    If count >= 1
      sz = DragQueryFile_(wParam, 0, 0, 0)
      If sz > 0
        sz + 1
        *m = AllocateMemory(sz * 4)
        If *m
          If DragQueryFile_(wParam, 0, *m, sz)
            file$ = PeekS(*m)           
            ;open the dropped file with the web gadget.
            If file$
              ext$ = LCase(GetExtensionPart(file$))
              If ext$ = "bmp" Or ext$ = "jpg" Or ext$ = "png" Or ext$ = "gif"
                Text$ = "<img src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
                SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
              Else
                SetGadgetText(0, file$)
              EndIf
            EndIf
          EndIf
          FreeMemory(*m)
        EndIf
      EndIf
    EndIf
    DragFinish_(wParam)
  EndIf
 
  ProcedureReturn CallWindowProc_(oldWNDPROC, hwnd, uMsg, wParam, lParam)
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-20)
EndProcedure

If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu |  #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  hwnd = WebGadget(0, 10, 10, 580, 280, "") 

  DragAcceptFiles_(hwnd, 1)
 
  oldWNDPROC = SetWindowLongPtr_(GadgetID(0), #GWLP_WNDPROC, @WebGadgetWProc())
 
 BindEvent(#PB_Event_SizeWindow,@sizeCB())
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
    EndSelect
       
  Until Quit = 1
 
EndIf
Egypt my love
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: Enabling Drop on WebGadget

Post by firace »

Very nice!

Thanks breeze4me, thanks Rashad.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Enabling Drop on WebGadget

Post by RASHAD »

More advanced

Code: Select all

Global oldWNDPROC,iwidth,iheight
UseTGAImageDecoder()
UseTIFFImageDecoder()

Structure ImageSizeType
   Width.l
   Height.l
EndStructure

Procedure ImageFileDimension(filename.s,*imagesize.ImageSizeType)

   #ImageMinimumSize=      24
   #ImageHeaderSize=       2048

   #ImageHeaderGIF=   $38464947;      'GIF8'
   #ImageHeaderJPG=   $E0FFD8FF;      -
   #ImageHeaderJP2=   $0C000000;      -
   #ImageHeaderPNG=   $474E5089;      '‰PNG'

   #ImageHeaderBMP=      $4D42;      'BM'
   #ImageHeaderTIF_LSB=   $4949;      'II'
   #ImageHeaderTIF_MSB=   $4D4D;      'MM'
   
   #ImageHeaderPCX=      $0A;      -
   #ImageHeaderTGA=      $01;      -
   
   Structure MemArray
      StructureUnion
         a.a[0]
         w.w[0]
         l.l[0]
      EndStructureUnion
   EndStructure

   Protected *Buffer.MemArray
   Protected *MemArray.MemArray
   Protected BytesRead.i
   Protected a.a,n.l,m

   #ImageFile=666

   *imagesize\width=#Null
   *imagesize\height=#Null
      If ReadFile(#ImageFile,FileName, #PB_File_NoBuffering)
         *Buffer=AllocateMemory(#ImageHeaderSize,#PB_Memory_NoClear)
         BytesRead=ReadData(#ImageFile,*Buffer,#ImageHeaderSize)

         If BytesRead>=#ImageMinimumSize
            Select *Buffer\l[0]&$FFFFFFFF

            Case #ImageHeaderJPG
               n=*Buffer\a[4]<< 8|*Buffer\a[5]+4
               If n>20
                  FileSeek(0,n)
                  BytesRead=ReadData(#ImageFile,*Buffer,#ImageHeaderSize)
                  n=0
               EndIf
               *MemArray=*Buffer+n
               While *MemArray-*Buffer+6<BytesRead
                  If *MemArray\a[0]=$FF
                     a=*MemArray\a[1]
                     If a=$c0 Or (a>>4=$C And a&3)
                        *imagesize\width=*MemArray\a[7]<<8|*MemArray\a[8]
                        *imagesize\height=*MemArray\a[5]<<8|*MemArray\a[6]
                        Break
                     EndIf
                  Else
                     Break
                  EndIf
                  *MemArray+*MemArray\a[2]<<8|*MemArray\a[3]+2
               Wend

            Case #ImageHeaderPNG
               *imagesize\width=*Buffer\a[18]<<8|*Buffer\a[19]
               *imagesize\height=*Buffer\a[22]<<8|*Buffer\a[23]

            Case #ImageHeaderGIF
               *imagesize\width=*Buffer\w[3]
               *imagesize\height=*Buffer\w[4]

            Case #ImageHeaderJP2
               n=*Buffer\a[14]<<8|*Buffer\a[15]+35
               If n<#ImageHeaderSize
                  *imagesize\width=*Buffer\a[n-1]<<8|*Buffer\a[n]
                  *imagesize\height=*Buffer\a[n-5]<<8|*Buffer\a[n-4]
               EndIf

            Default
               Select *Buffer\w[0]&$FFFF

               Case #ImageHeaderBMP
                  *imagesize\width=*Buffer\w[9]
                  n=*Buffer\w[11]&$FFFF
                  If n<0
                     n=-n
                  EndIf
                  *imagesize\height=n
                  
               EndSelect
            EndSelect
         EndIf
         FreeMemory(*Buffer)
         CloseFile(#ImageFile)
      EndIf
   iwidth = *imagesize\Width
   iheight = *imagesize\Height   
EndProcedure

Procedure WebGadgetWProc(hwnd, uMsg, wParam, lParam)
  Protected count, sz, *m, file$
 
  If uMsg = #WM_DROPFILES
    count = DragQueryFile_(wParam, -1, 0, 0)
    If count >= 1
      sz = DragQueryFile_(wParam, 0, 0, 0)
      If sz > 0
        sz + 1
        *m = AllocateMemory(sz * 4)
        If *m
          If DragQueryFile_(wParam, 0, *m, sz)
            file$ = PeekS(*m)           
            If file$
              ww= 100 :hh=100
              ext$ = LCase(GetExtensionPart(file$))
              Select ext$
                Case "bmp","jpg","png","gif"
                  x.ImageSizeType
                  ImageFileDimension( file$,x)
                  scale.f = 0.2
                  Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(iwidth*scale)+" Height="+Str(iheight*scale)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
                  SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
                  
                Case "emf";,"wmf"
                  Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(ww)+" Height="+Str(hh)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
                  SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
                  
                Case "tif","tiff","tga"
                  LoadImage(0,file$)
                  file$ = GetTemporaryDirectory()+GetFilePart(file$)+".bmp"
                  SaveImage(0,file$)
                  FreeImage(0)
                  x.ImageSizeType
                  ImageFileDimension( file$,x)
                  scale.f = 0.2
                  Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(iwidth*scale)+" Height="+Str(iheight*scale)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
                  SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
                  
                Default
                  SetGadgetText(0, file$)
              EndSelect
            EndIf
          EndIf
          FreeMemory(*m)
        EndIf
      EndIf
    EndIf
    DragFinish_(wParam)
  EndIf
 
  ProcedureReturn CallWindowProc_(oldWNDPROC, hwnd, uMsg, wParam, lParam)
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-20)
EndProcedure

If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu |  #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  hwnd = WebGadget(0, 10, 10, 580, 280, "") 

  DragAcceptFiles_(hwnd, 1)
 
  oldWNDPROC = SetWindowLongPtr_(GadgetID(0), #GWLP_WNDPROC, @WebGadgetWProc())
 
 BindEvent(#PB_Event_SizeWindow,@sizeCB())
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
    EndSelect
       
  Until Quit = 1
 
EndIf
Egypt my love
Post Reply