Exploring Bos Taurus

[srvet_claudio]

Hi All

esgici wrote:
Another trial to explore Bos Taurus : Image Converter

Added :
- Save As PDF
- Print
- Image file validity check

Hi Friend,
wow, very nice !!!

I did small improvements in your project.
I hope is useful.
Best regards,
Claudio.

Code: Select all

#include "hmg.ch"
#include "hfcl.ch"

#define BTExp_FILEFORMAT_PDF   0xFF


PROCEDURE Main()

   SET CENT ON
   SET DATE GERM
   
   hImage        := 0
   hImageDisplay := 0
   cImgFilName   := ''

   DEFINE WINDOW frmBTExp_IC;
      AT 0,0;
      WIDTH  700;
      HEIGHT 600;
      TITLE "Exploring Bos Taurus for HMG  -- Image Converter";
      ICON "BT_Icon" ;
      ON INIT BTExp_OpenImgFile() ; 
      ON RELEASE BT_BitmapRelease ( hImage ) ;
      ON MAXIMIZE BTExp_SetImageAdjust() ;
      ON SIZE BTExp_SetImageAdjust() ;
      MAIN
      
      ON KEY ESCAPE         ACTION ThisWindow.Release
      
      DEFINE MAIN MENU 
      
         DEFINE POPUP '&File'
         
            ITEM "&Open"            NAME mit_RFile      ACTION BTExp_OpenImgFile()
               
            DEFINE POPUP  '&Save As ...'  NAME mitSaveAs
               ITEM "&BMP"          NAME mit_WFBMP_0   ACTION SaveAs ( BT_FILEFORMAT_BMP )
               ITEM "&JPG"          NAME mit_WFJPG_1   ACTION SaveAs ( BT_FILEFORMAT_JPG )
               ITEM "&GIF"          NAME mit_WFGIF_2   ACTION SaveAs ( BT_FILEFORMAT_GIF )
               ITEM "&TIF"          NAME mit_WFTIF_3   ACTION SaveAs ( BT_FILEFORMAT_TIF )
               ITEM "&PNG"          NAME mit_WFPNG_4   ACTION SaveAs ( BT_FILEFORMAT_TIF )
               ITEM "&PDF"          NAME mit_WFPDF_5   ACTION SaveAs ( BTExp_FILEFORMAT_PDF )
            END POPUP // File
            
            ITEM "&Print"           NAME mit_Print     ACTION Pict2Prn()            
            
            ITEM "&Close"           NAME mit_Close     ACTION BTExp_CloseImgFile()
            SEPARATOR
            
            ITEM "E&xit"  ACTION ThisWindow.Release
       
         END POPUP // File

         POPUP '?'                    
            ITEM 'About &BT'  ACTION MsgInfo( BT_InfoName() + Space(3) + ;
                                              BT_InfoVersion() + CRLF + ;
                                              BT_InfoAuthor () + CRLF + ;
                                              "E-MAIL:   srvet@adinet.com.uy" + CRLF + ;
                                              "BLOG:     http://srvet.blogspot.com", "BT Info" )
            ITEM '&Author'  ACTION MsgInfo( "AUTHOR:   B. Esgici "+ CRLF + ;
                                            "E-MAIL:   esgici@gmail.com" + CRLF + ;
                                            "BLOG:     http://vivaclipper.wordpress.com", "Author Info" )
                                           
         END POPUP // Info
         
         @  0, 0 IMAGE imgTestImage PICTURE NIL ACTION NIL
         
      END MENU // MAIN

      DEFINE STATUSBAR FONT 'Verdana' SIZE 8
          STATUSITEM ""
          STATUSITEM ""
          DATE WIDTH 80
          CLOCK WIDTH 90
      END STATUSBAR
      
   END WINDOW // frmBTExp_IC

   
   frmBTExp_IC.mitSaveAs.Enabled := .F.
   frmBTExp_IC.mit_Print.Enabled := .F.
   frmBTExp_IC.mit_Close.Enabled := .F.

   CENTER WINDOW   frmBTExp_IC
   ACTIVATE WINDOW frmBTExp_IC
   
RETURN // BTExplore.Main()


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE BTExp_CloseImgFile()                 // Close an Image file

   IF hImage <> 0
      frmBTExp_IC.mitSaveAs.Enabled := .F.
      frmBTExp_IC.mit_Print.Enabled := .F.
      frmBTExp_IC.mit_Close.Enabled := .F.
      frmBTExp_IC.StatusBar.Item( 1 ) := ''
      frmBTExp_IC.StatusBar.Item( 2 ) := ''

      BT_BitmapRelease ( hImage )
//    BT_BitmapRelease ( hImageDisplay )   // is not necessary because hImageDisplay is associated to the @...IMAGE control

      BT_HMGSetImage( "frmBTExp_IC", "imgTestImage", 0 )    // Sets a specified bitmap into an Image Control of HMG (@...IMAGE) and automatically
                                                            // releases the handle of the bitmap previously associated to the Image Control
      hImage        := 0
      hImageDisplay := 0
      cImgFilName   := ''
   ENDIF
RETURN


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE BTExp_SetImageAdjust()
LOCAL New_Width , New_Height

   IF hImage <> 0
      New_Width  := min ( BT_ClientAreaWidth  ( "frmBTExp_IC" ) , BT_BitmapWidth (hImage) )
      New_Height := min ( BT_ClientAreaHeight ( "frmBTExp_IC" ) , BT_BitmapHeight(hImage) )

//    BT_BitmapRelease ( hImageDisplay )   // is not necessary because hImageDisplay is associated to the @...IMAGE control
      hImageDisplay := BT_BitmapCopyAndResize( hImage, New_Width, New_Height, BT_SCALE )

      BT_HMGSetImage( "frmBTExp_IC", "imgTestImage", hImageDisplay )   // Sets a specified bitmap into an Image Control of HMG (@...IMAGE) and automatically
                                                                       // releases the handle of the bitmap previously associated to the Image Control
   ENDIF
RETURN


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE BTExp_OpenImgFile()                 // Open an Image file


   cImgFilName := Getfile( { {'All images','*.png; *.jpg; *.bmp; *.tif; *.gif'},;    // acFilter
                             {'PNG Files', '*.png'},;
                             {'JPG Files', '*.jpg'},;
                             {'BMP Files', '*.bmp'},;
                             {'TIF Files', '*.tif'},;
                             {'GIF Files', '*.gif'} },;                          
                              'Open Image' ) 

   IF ! EMPTY( cImgFilName ) .OR. FILE( cImgFilName )  

      hImage := BT_BitmapLoadFile( cImgFilName )

      IF hImage <> 0

         BTExp_SetImageAdjust()

         frmBTExp_IC.StatusBar.Item( 1 ) := cImgFilName
         frmBTExp_IC.StatusBar.Item( 2 ) := HB_NTOS( BT_BitmapWidth(hImage) ) +' x '+ HB_NTOS( BT_BitmapHeight(hImage) ) +" pixels"
         frmBTExp_IC.mitSaveAs.Enabled := .T.
         frmBTExp_IC.mit_Print.Enabled := .T.
         frmBTExp_IC.mit_Close.Enabled := .T.
      ELSE
         MsgStop( "Couldn't open " + cImgFilName + " file as a image !"+CRLF+CRLF+;
                  "Not Image File OR unsupported file format ! ", "OPEN ERROR !" )
      ENDIF
      
   ENDIF ! EMPTY( cBMFileName )
   
RETURN // BTExp_OpenImgFile()


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE SaveAs ( nNewImageType )

   LOCAL cNewImageType,;
         cTargetFileNam,;
         lContinue := .T.
         
   LOCAL nImgOrjWidth,;     
         nImgOrjHeight,;
         nAspectRatio,;
         nImgPDFWidth,;
         nImgPDFHeight,;
         lSelPDF         
   
   IF ! EMPTY( cImgFilName ) .AND. hImage # 0

      cNewImageType  := HB_USUBSTR( This.Name, 7, 3 )
      cTargetFileNam := HB_ULEFT( cImgFilName, HMG_LEN( cImgFilName )- 3 ) + cNewImageType

      IF FILE( cTargetFileNam )
          
         lContinue := MsgYesNo( cTargetFileNam + " file exist;" + CRLF + CRLF +;
                                         "OVERWRITE ?", "Confirm Overwrite" )
      ENDIF
      
      IF lContinue                             
         
         IF nNewImageType <> BTExp_FILEFORMAT_PDF
         
            IF BT_BitmapSaveFile( hImage, cTargetFileNam, nNewImageType )
               MsgInfo( "Image saved as " + cNewImageType + " in:" + CRLF + cTargetFileNam )
            ELSE
               MsgInfo( "Saving as " + cNewImageType + " is UNSUCCESSFUL !", "ERROR !")
            ENDIF         
            
         ELSE  // Target is PDF
         
            Pict2PDF( cTargetFileNam )
            
         ENDIF
         
      ENDIF lContinue                             
      
   ENDIF   
   
RETURN // SaveAs()


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE Pict2PDF( ;
                    cTargetFileNam )             

   LOCAL cTmpFName := TEMPFILE(, "png")
   
   nImgOrjWidth  := BT_BitmapWidth( hImage )            
   nImgOrjHeight := BT_BitmapHeight( hImage )
   
   nImgPDFWidth  := MIN( nImgOrjWidth / 2.54, 170 )
   
   IF nImgPDFWidth # nImgOrjWidth            
      nImgPDFHeight := nImgOrjHeight / ( nImgOrjWidth / nImgPDFWidth )
   ELSE
      nImgPDFHeight :=  nImgOrjHeight
   ENDIF   
   
   BT_BitmapSaveFile( hImage, cTmpFName, 4 )
   
   SELECT HPDFDOC ( cTargetFileNam ) TO lSelPDF // papersize HPDF_PAPER_A4
   
   IF lSelPDF
      START HPDFDOC
   
         START HPDFPAGE
            @ 20,  20 HPDFPRINT IMAGE cTmpFName WIDTH nImgPDFWidth  HEIGHT nImgPDFHeight
         END HPDFPAGE   
      
      END HPDFDOC

      IF FILE( cTargetFileNam )            
         MsgInfo( "PDF Builded as " + cTargetFileNam ) 
      ELSE
         MsgStop( "PDF Building Unsuccessful :(" + CRLF + CRLF + ;
                  "May be UNICODE incompatibilty isssue;" + CRLF + ;
                  "Please check your folder for file names.", ;                                                     
                  "Unexpected ERROR !" ) 
      ENDIF FILE( cTargetFileNam )                           
      
   ELSE   
      MsgStop( "SELECT PDFDOC is unsuccessful :(", "ERROR !" )         
   ENDIF lSelPDF
   
   FILEDELETE( cTmpFName )
            
RETURN // Pict2PDF()            


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

PROCEDURE Pict2Prn()                      // ( previously loaded ) Picture -> Print

   LOCAL lSelPrntr
   
   SELECT PRINTER DIALOG TO lSelPrntr PREVIEW
   
   IF lSelPrntr
      START PRINTDOC 
         START PRINTPAGE
               @ 20, 20 PRINT IMAGE cImgFilName;
                        WIDTH  170 ;
                        HEIGHT 170 
         END PRINTPAGE
      END PRINTDOC 
      MsgInfo('Print Picture Finished')
   ELSE   
      MsgBox( "Printing Picture is unsuccessful :(" )
   ENDIF lSelPrntr
   
RETURN // Pict2Prn()

[esgici]

Hola dear Dr.

I did small improvements in your project.

No doubt, you are a real hidalgo

Thank you very much to your interest and highly valuable improvements

I'm honored

All improvements and simplifications are suitable and very good

Especially usage of file-format constants and BTExp_SetImageAdjust()

By the way, I have a little wish :

I had really struggled to found a way for checking validity of image file;
and you had discarded my valuable IsImgFile() function

This is becuse my ignorence about return value of BT_BitmapLoadFile() function; I didn't know what is a "handle", what values are correct and what value(s) indicate the error ?

Now, I know from

Code: Select all

  IF hImage <> 0 

line, that zero return value indicate the error, and negative values are legal

So, my humble wish is : it will be very useful, if included "Return value" explanation for each BT_xxx function in the documentation.

And, if we have a BT function like BT_IsValidImgFile( <cImgFileName> ), it will be useful to know file validity before loaded it.

I hope is useful.

Not useful, wonderful

Separate thank to your addition in '?' menu ;

But please instead of "Author", "Author of sample" may be better.

Thanks again for your attention and help

Viva HMG, viva Dr. Soto

[srvet_claudio]

All improvements and simplifications are suitable and very good

Thanks Friend.

So, my humble wish is : it will be very useful, if included "Return value" explanation for each BT_xxx function in the documentation.

And, if we have a BT function like BT_IsValidImgFile( <cImgFileName> ), it will be useful to know file validity before loaded it.

Yes you are right.
I will include in the next release of BT.

[esgici]

Thanks amigo

Viva HMG, viva Dr. Soto

[bpd2000]

Nice improvement by Dr. Claudio

Dear Esgici
It will be nice to add Crop picture, batch conversion and batch printing, batch resize

[Rathinagiri]

I think this will become a wonderful image utility.

[srvet_claudio]

I had forgotten this thread.

Code: Select all

FUNCTION BT_BitmapIsValidFileImage( cFilName )
LOCAL lRet := .F.
   hBitmap := BT_BitmapLoadFile( cFilName )
   IF hBitmap <> 0
      BT_BitmapRelease ( hBitmap )
      lRet := .T.
   ENDIF
RETURN lRet