FiveTech Software tech support forums

Code: Select all | Expand

function MSGToJpeg( cMSG )
   local cTitle   := ""
   local hWnd, hBmp, hBmp2, hDib, cBuf, nWait := 2
   local lRet := .f.
   local nWidth := GetSysMetrics( 0 )
   local nHeight := GetSysMetrics( 1 )
   local aClass := {}

   cTitle := msgGetTitle( cMSG )

   if nWidth > 1920
      nWidth :=  1920
   endif

   if File( cMSG )
      ShellExecute( 0, 'Open', cMSG )
      SysWait( 3 )

      do while nWait < 5 .and. Empty( hWnd :=  FindWnd( cTitle ) )
         SysWait( nWait )
         nWait    += 1
      enddo


      if ! Empty( hWnd )
         SetFocus( hWnd )
         SetForeGroundWindow( hWnd )
         SysRefresh()
         SysWait( 0.8 )
            // for a test
         EnumChildWindows( hWnd,;
            { | hWnd, nLParam | AADD( aClass,{ GetClassName( hWnd ), hWnd } ), .T. },; // .T. means continue
            0 )                                 // optional supplied value

         xbrowse( aClass )
            // for a test end

         hBmp  := WndBitmap( hWnd )

         SendMessage( hWnd, WM_CLOSE )
         hBmp2 := BmpTrim( hBmp )

         DeleteObject( hBmp )

         //    hBmp2 := CropImage( hBmp2, 150, 420, nHeight,nWidth-420 )
         hDib              := DibFromBitmap( hBmp2 )
         cBuf              := DibToStr( hDib )
         GlobalFree( hDib )

         DeleteObject( hBmp2 )

         lRet  := BmpBufToJpg( cFileSetExt( cMSG, "jpg" ), cBuf )
         cBuf  := nil


      endif
   endif

return lRet

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

function msgGetTitle( cFile )
  
   LOCAL oOutlook       := TOleAuto():New( "Outlook.Application" )
   local myOlExp        := oOutlook:ActiveExplorer
   local oMail 

        oMail := oOutlook:CreateItemFromTemplate( Alltrim(  cFile ) )

return ( oMail:Subject )

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

 

Code: Select all | Expand

static function BmpTrim( hBmp )  // Trim black sides on left and right

   local hOldBmp, hDC, hDCMem, hBmpTrim
   local nLeft := 0, nRight := 0
   local nHeight, nWidth, ny
   *----------------------------------------------------------

   nWidth   := nBmpWidth(  hBmp )
   nHeight  := nBmpHeight( hBmp )

   hDC      := GetDC( GetDeskTopWindow() )
   hDCMem   := CreateCompatibleDC( hDC )
   hOldBmp  := SelectObject( hDCMem, hBmp )

   ny       := Int( nHeight / 2 )
   do while nLeft < .4 * nWidth .and. GetPixel( hDCMem, nLeft, ny ) == 0
      nLeft++
   enddo
   nRight   := nWidth - 1
   do while nRight > .6 * nWidth .and. GetPixel( hDCMem, nRight, ny ) == 0
      nRight--
   enddo
   SelectObject( hDCMem, hOldBmp )
   DeleteDC( hDCMem )
   ReleaseDC( GetDesktopWindow(), hdc )

   hBmpTrim    := CropImage( hBmp, 0, nLeft, nHeight, nRight )

return hBmpTrim

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

Code: Select all | Expand

static function BmpBufToJpg( cJpeg, cBuf )

   local hMem, nFormat, hDib, hDib2, lRet := .f.
   local nQuality    := 0  // Default

   if LoadFreeImage() <= 32
      MsgAlert( "freeimage.dll not found" )
      return .f.
   endif

   hMem        := FI_OpenMemory( cBuf, Len( cBuf ) )
   nFormat     := FI_GetFileTypeFromMemory( hMem, 0 )
   hDib        := FI_LoadFromMemory( nFormat, hMem, 0 )
   cBuf        := nil  // to release memory
   FI_CloseMemory( hMem )
   hDib2       := FICnv24( hDib )
   FIUnload( hDib )
   lRet        := FISave( 2, hDib2, cJpeg, nQuality )
   FIUnload( hDib2 )



return lRet

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