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
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
#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
//----------------------------------------------------------------------------//// 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
//----------------------------------------------------------------------------//
