drag & drop box

drag & drop box

Postby Otto » Sat Jun 01, 2013 7:21 pm

Hello Antonio,
could you please help me with this drag & drop box.
I inherited xTRich. The program is working so far that I can drag: files from the explorer, emails and links from the addressbar of the internet explorer. The problem is that I can’t get it working in one dropbox for all the cases.
Would you be so kind to help me.
Thanks in advance
Otto

//from IE we need .and. .not. nMsg = 1094
if nMsg > 1000 .and. .not. nMsg = 1094
//from explorer this works
// if nMsg > 1000
return 0
endif


Code: Select all  Expand view

#INCLUDE "FIVEWIN.CH"
REQUEST DBFCDX
REQUEST DBFFPT

function Main(cKdnr)
   local oDlg, oRich
   local hRichDLL  := LoadLibrary( "riched20.dll" )
   local cTitle    := ""
    local nTop      := VAL(GetPvProfString( "XFANG", "TOP", "1",  ".\INI\WINHOTEL.INI" ))
    local nLeft     := VAL(GetPvProfString( "XFANG", "LEFT","1",  ".\INI\WINHOTEL.INI" ))
    local cAufruf   := ""
    local cName     := ""
  //----------------------------------------------------------------------------//

      DEFINE DIALOG oDlg NAME "DROP"   TITLE cTitle PIXEL    TRANSPARENT
     
        if oDlg:nHorzRes() - nLeft < 200
            nLeft := 1
        endif
       
        if oDlg:nVertRes()-nTop < 200
            nTop := 1
        endif

      oRich = xTRich():Redefine( 100, { || "" }, oDlg )
     
      oRich:cKdNr := cKdNr
 
      oRich:bMButtonDown  := {|nRow, nCol, nFlags| iif( oRich:cCargo = "DRAGANDDROP", cAufruf := "DRAGANDDROP",;
        iif( oRich:cCargo = "Von", cAufruf := "Outlook", ( cAufruf := "Homepage", cName := oRich:cCargo ) ) ),;
      oRich:end(), oDlg:hide(),;
      dropread( cKdnr, cName ,cAufruf ), oDlg:show(),;
      oDlg:CoorsUpdate() ,;
      WritePProString( "XFANG", "TOP",  str(odlg:ntop),  ".\INI\WINHOTEL.INI" ),;
        WritePProString( "XFANG", "LEFT", str(odlg:nLEFT)".\INI\WINHOTEL.INI" ),;
      oDlg:end()}
           
           
      oDlg:bDropFiles := {|nRow,nCol,aFiles| PaintTheName( nRow, nCol, aFiles, cKdnr ), oDlg:show(),;
      oDlg:CoorsUpdate() ,;
      WritePProString( "XFANG", "TOP",  str(odlg:ntop),  ".\INI\WINHOTEL.INI" ),;
        WritePProString( "XFANG", "LEFT", str(odlg:nLEFT),  ".\INI\WINHOTEL.INI" ),;
        oDlg:end() }
        DragAcceptFiles( oRich:hWnd, .t. )
        oRich:bDropFiles = oDlg:bDropFiles

      ACTIVATE DIALOG oDlg   ON PAINT SETWINDOWPOS( oDlg:hWnd, -1, 0, ntop, 0, 0, 3 ) ;
         ON INIT (oDlg:Move(nTop, nLeft, 320, 280 ),;
         DragAcceptFiles( oDlg:hWnd, .t. )  )


      FreeLibrary( hRichDLL )


return nil
//----------------------------------------------------------------------------//
   
function dropread( cKdnr, cName, cAufruf )
   local oDlg
    LOCAL oOutlook      
   local myOlExp      
   local oMail
   local oGet
   local nDocNr          := 0
   local cKategorie      := cAufruf + space(50)
   local cStichwort      := space(50)
   local oK              := .f.
   local dDatum          := date()
   local dNachfassen     := date() + 14
   local cScanner        := GetPvProfString( "SCANNER","MODELL","N",".\INI\WINHOTEL.INI" )
   local ziel            := ""
   local cWHArchiv       := ""
   local cGastOrdner     := ""
   local oDatei
   local cEmailDMSdbf    := ""
   local I               := 0
   local cNotiz          := "cNotiz"
   local oInhalt
   local cDatei              := ""
   local cEmail              := ""
   *--------------------------------------------------------------------------
   
    TRY
    oOutlook := TOleAuto():New( "Outlook.Application" )
    CATCH
    Msginfo( "Outlook nicht installiert" )
    quit
    END
   
    // msginfo( oMail:body )
    // msginfo( oMail:subject )

    IF cAufruf = "Outlook"
        
        myOlExp        := oOutlook:ActiveExplorer
        
        if lIsDir(cFilePath( GetModuleFileName( GetInstance( ) ) )+"tmpEMail" ) = .F.
        lMKDir( cFilePath( GetModuleFileName( GetInstance( ) ) )+"tmpEMail"  )
    endif
     
      SYSREFRESH()
     
      oMail  := myOlExp:Selection:Item(1)
        cDatei := cFilePath( GetModuleFileName( GetInstance( ) ) )+"tmpEMail\drop" + ".msg"

        oMail:SaveAs  ( cDatei  )
   
    cEmailDMSdbf := oMail:subject
    
        //  msginfo( oMail:subject)
        cNotiz       := left( ALLTRIM( oMail:body ), 1000 )
      cStichwort   := oMail:subject + space(50)
   
   elseIF cAufruf = "Homepage"
    cDatei := cName
   
   else
        cDatei := cName
 msginfo( procname() + " cDatei := cName  " + str(procline()) + "   " + str( 1 ) )
   endif
   
    TRY
        cEmail := oMail:SenderEmailAddress
    CATCH
        cEmail := "no Email #"
    END
   
    //msginfo( oMail:SenderEmailAddress )
   
    //msginfo( oMail:CC )
   

   if lIsDir( cWHArchiv ) = .F.
      lMKDir( cWHArchiv )
   endif

   DEFINE DIALOG oDlg RESOURCE "SCANNER"

   REDEFINE SAY   oDatei               ID 111   OF oDlg
   REDEFINE GET   ckategorie           ID 101   of oDlg
   REDEFINE GET   cStichwort           ID 102   of oDlg
   REDEFINE GET   dDatum               ID 105   of oDlg
   REDEFINE GET   dNachfassen          ID 106   of oDlg
   REDEFINE GET   oGet VAR  cNotiz     ID 8002  of oDlg MEMO


   REDEFINE BUTTON ID 103 OF oDlg  ACTION (oDlg:END())
   REDEFINE BUTTON ID 104 OF oDlg  ACTION (OK:=.T.,oDlg:END())

   ACTIVATE DIALOG oDlg ON INIT oDatei:SetText( cDatei ) ;
      ON PAINT SETWINDOWPOS( oDlg:hWnd, -1, 0, 0, 0, 0, 3 ) ;
      CENTERED

   IF ok = .t.

//      dmsdbf->docnummer   := nDocNr
//      dmsdbf->Kategorie   := ckategorie
//      dmsdbf->Stichwort   := cStichwort
//      dmsdbf->gast_kdnr   := cKdNr
//      dmsdbf->NOTIZ       := cNotiz
//      dmsdbf->NUMMER      := recno()
     
      endif

       
 
return nil
//----------------------------------------------------------------------------//

INIT PROCEDURE PrgInit

   SET CENTURY ON
   SET EPOCH TO YEAR(DATE())-98

   SET DELETED ON
   SET EXCLUSIVE OFF

   REQUEST HB_Lang_DE
   REQUEST HB_CODEPAGE_DEWIN

   HB_LangSelect("DE")
   HB_SetCodePage("DEWIN")

   SET DATE TO GERMAN

   SetHandleCount(205)
   rddsetdefault( "DBFCDX" )
   SetGetColorFocus()


   EXTERN DESCEND

   SetBalloon( .T. )

RETURN
//----------------------------------------------------------------------------//

function PaintTheName( nRow, nCol, aFiles,cKdnr )
   local cAufruf := "Dokumentimport"
   local cName, cResult := ""
   local n := 1


   while ! Empty( cName := StrToken( aFiles[ 1 ], n++, "\" ) )
      if "
~" $ cName
         cName = SFN2LFN( cResult + cName )
      endif
      cResult += cName + "
\"

   end

   cResult = SubStr( cResult, 1, Len( cResult ) - 1 )
    cName := aFiles[ 1 ]
msginfo( procname() + "
 c N a m e " + str(procline()) + "   " + cName )
    dropread( cKdnr, cName, cAufruf )

return nil
//----------------------------------------------------------------------------//






Code: Select all  Expand view


// Win32 RichEdit Control support

#include "FiveWin.ch"
#include "Constant.ch"
#include "WColors.ch"
#include "RichEdit.ch"

#ifdef __XPP__
   #define Super ::TControl
   #define New   _New
#endif

#define CTRL_CLASS        "RichEdit20A"

#define MK_MBUTTON         16

#define WM_SETREDRAW       11
#define WM_ERASEBKGND      20
#define WM_SETFONT         48
#define WM_MBUTTONDOWN    519
#define WM_MBUTTONDBLCLK  521
#define WM_MOUSEWHEEL     522
#define WM_CUT            768
#define WM_COPY           769
#define WM_PASTE          770
#define WM_CLEAR          771
#define WM_NCHITTEST      132  // 0x84
#define FNT_HEIGHT         17
#define FW_BOLD           700

//----------------------------------------------------------------------------//

CLASS xTRich FROM TRichEdit

   DATA   cCargo, cKdNr
   
    METHOD HandleEvent( nMsg, nWParam, nLParam )
   
    METHOD MButtonDown( nRow, nCol, nFlags )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS xTRich
    local  nRow, nCol, nFlags
    local ctext:="demo"

 logfile("log23.log", {  nMsg } )  
   

if nMsg = 2053
    ::lHighlight := .t.
endif



//from IE we need .and. .not. nMsg = 1094
if nMsg >  1000 .and. .not. nMsg = 1094
 
  //from explorer this works
 //   if nMsg >  1000
       return 0
    endif  
 
     do case
       
        case nMsg == WM_NCHITTEST
           //::ReDo()
         //     cText := ::GetText()
       
            if ::cCargo = GetWindowText( ::hWnd ) .or. len( ALLTRIM( GetWindowText( ::hWnd ) ) ) = 0
   
   
            logfile("log1.log", { "-", nMsg } )        
               
                if ::lHighlight = .t.
               
           
                    ::cCargo := "DRAGANDDROP"
           
                    ::MButtonDown( nRow, nCol, nFlags )
                   
                endif
       
            else  
            ::cCargo := GetWindowText( ::hWnd )
                ::MButtonDown( nRow, nCol, nFlags )
               
            endif              
     
      case nMsg == FM_HIGHLIGHT
         return ::HighLightLine()

      case nMsg == FM_HIGHLIGHTALL
         return ::HighlightAllText()


      case nMsg == WM_KEYDOWN
         if ::lReadOnly
            if ( nWParam == Asc( "E" ) .or. nWParam == Asc( "L" ) .or. ;
                 nWParam == Asc( "J" ) .or. nWParam == Asc( "R" ) ) .and. ;
               GetKeyState( VK_CONTROL )

               return 0
            endif
         endif

         return ::KeyDown( nWParam, nLParam )

      otherwise
         if( nMsg == WM_MOUSEWHEEL .or. nMsg == WM_MBUTTONDOWN .or. ;
             nMsg == WM_MBUTTONDBLCLK )

            if GetKeyState( VK_CONTROL )
               return 0
            endif
         else
            Super:HandleEvent( nMsg, nWParam, nLParam )
         endif
   endcase

return nil

//----------------------------------------------------------------------------//

METHOD MButtonDown( nRow, nCol, nKeyFlags ) CLASS xTRich


Super:MButtonDown( nRow, nCol, nKeyFlags )
 
 
 
   ::PostMsg( FM_CHANGE )


return nil


//----------------------------------------------------------------------------//


 
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm

Re: drag & drop box

Postby Antonio Linares » Mon Jun 03, 2013 10:57 am

Otto,

I have not tested your code yet, but I see a missing line that must be in FWH inherited classes from TWindow:

CLASSDATA lRegistered AS LOGICAL

Please check if that line makes any change in the problem you described, thanks
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: drag & drop box

Postby Otto » Mon Jun 03, 2013 11:46 am

Hello Antonio,
I tested but it does not make any difference.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm

Re: drag & drop box

Postby Antonio Linares » Mon Jun 03, 2013 1:59 pm

Otto,

Please provide me the RC for your example, thanks :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: drag & drop box

Postby Otto » Mon Jun 03, 2013 5:25 pm

Hello Antonio,
thank you for helping me.
Best regards,
Otto


http://www.atzwanger-software.com/fw/xfang.zip
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm

Re: drag & drop box

Postby Antonio Linares » Mon Jun 03, 2013 6:17 pm

Otto,

You should not inherit from TRichEdit as it seems as that control is not properly accepting it. I mean: we can not always interfere in the behavior of a standard control.

I modified your example to use a estandard TRichEdit and properly accepted everything :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42092
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: drag & drop box

Postby Otto » Mon Jun 03, 2013 7:23 pm

Hello Antonio,
I am so glad. I tried several days to get it running.
Thank you very much.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm

Re: drag & drop box

Postby Otto » Tue Jun 04, 2013 12:39 pm

Hello Antonio,
I tried your Suggestion.
I inserted a button like this:
REDEFINE BUTTONBMP ID 4002 OF oDlg ;
ACTION msginfo( oRich:gettext() )

When I drop files from Explorer oRich:gettext() is empty.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm

Re: drag & drop box

Postby Otto » Sat Jun 08, 2013 10:50 pm

Hello Antonio,
is there any news on this subject.
Thanks in advance
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6332
Joined: Fri Oct 07, 2005 7:07 pm


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 106 guests