2003-12-31 11:21

'=======================================================
' Type Objet
' Classe QImageEx version 1.1
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     CONST SRCCOPY_IMG=&HCC0020
     CONST CF_BITMAP_IMG=2

     DECLARE FUNCTION DeleteObjectImg LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG
     DECLARE FUNCTION CreateDCImg LIB "gdi32" ALIAS "CreateCompatibleDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION SelectObjectImg LIB "gdi32" ALIAS "SelectObject" (hdc AS LONG,hObject AS LONG) AS LONG
     DECLARE FUNCTION BitBltImg LIB "gdi32" ALIAS "BitBlt" (hDestDC AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,hSrcDC AS LONG,xSrc AS LONG,ySrc AS LONG,dwRop AS LONG) AS LONG
     DECLARE FUNCTION DeleteDCImg LIB "gdi32" ALIAS "DeleteDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION CreateBitmapImg LIB "gdi32" ALIAS "CreateCompatibleBitmap" (hdc AS LONG,nWidth AS LONG,nHeight AS LONG) AS LONG
     DECLARE FUNCTION LoadImageImg LIB "user32" ALIAS "LoadImageA" (hInst AS LONG,lpsz AS STRING,dwImageType AS LONG,dwDesiredWidth AS LONG,dwDesiredHeight AS LONG,dwFlags AS LONG) AS LONG
     DECLARE FUNCTION Load_JPGImg LIB "NViewLib.dll" ALIAS "Load_JPG" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION Load_GIFImg LIB "NViewLib.dll" ALIAS "Load_GIF" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION LoadImg LIB "NVIEWLIB" ALIAS "NViewLibLoad" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION SetLanguageImg LIB "NVIEWLIB" ALIAS "NViewLibSetLanguage" (Language AS STRING) AS INTEGER
     DECLARE FUNCTION GetWidthImg LIB "NVIEWLIB" ALIAS "GetWidth" () AS INTEGER
     DECLARE FUNCTION GetHeightImg LIB "NVIEWLIB" ALIAS "GetHeight" () AS INTEGER
     DECLARE FUNCTION SaveAsJPGImg LIB "NViewLib.dll" ALIAS "NViewLibSaveAsJPG" (Quality AS INTEGER,FileName AS STRING) AS INTEGER


     TYPE QImageEx EXTENDS QIMAGE
PRIVATE:
      bitmap AS QBITMAP

PUBLIC:
  '===================================================
  ' Méthode copie image dans presse papier
  '===================================================
      SUB CopyToClipboard(rect AS QRECT)
       DIM hDC AS INTEGER
       DIM hBitmap AS INTEGER
       DIM hOldBitmap AS INTEGER
       DIM width AS INTEGER
       DIM height AS INTEGER

       width=rect.right-rect.left
       height=rect.bottom-rect.top
       hDC=CreateDCImg(This.handle)
       hBitmap=CreateBitmapImg(This.handle,width,height)
       hOldBitmap=SelectObjectImg(hDC,hBitmap)
       BitBltImg(hDC,0,0,width,height,This.handle,rect.left,rect.top,SRCCOPY_IMG)
       clipboard.OPEN
       clipboard.clear
       clipboard.SetAsHandle(CF_BITMAP_IMG,hBitmap)
       clipboard.CLOSE
       SelectObjectImg(hDC,hOldBitmap)
       DeleteDCImg(hDC)
       DeleteObjectImg(hBitmap)
      END SUB

  '===================================================
  ' Méthode colle image du presse papier
  '===================================================
      SUB PasteFromClipboard
       IF clipboard.hasformat(CF_BITMAP_IMG) THEN
        clipboard.OPEN
        This.handle=clipboard.GetAsHandle(CF_BITMAP_IMG)
        clipboard.CLOSE
       END IF
      END SUB

  '===================================================
  ' Méthode charge et affiche un fichier bitmap
  '===================================================
      SUB LoadFromFile(FileName AS STRING,width AS SHORT,height AS SHORT,real AS boolean)
       IF real THEN
        This.bitmap.bmp=FileName
        This.handle=LoadImageImg(Application.hInstance,fileName,0,This.bitmap.width,This.bitmap.height,&H10)
       ELSE
        This.handle=LoadImageImg(Application.hInstance,fileName,0,width,height,&H10)
       END IF
      END SUB

  '===================================================
  ' Méthode info image présente dans presse papier
  '===================================================
      FUNCTION CanPaste AS boolean
       result=clipboard.hasformat(CF_BITMAP_IMG)
      END SUB

  '==================================================
  ' méthode charge les formats dll
  '==================================================
      SUB LoadOtherImage(FileName AS STRING,Progress AS boolean,Language AS STRING)
       IF FileName<>"" AND FILEEXISTS(FileName) THEN
        SetLanguageImg(language)
        this.handle=LoadImg(FileName,Progress)
        this.width=GetWidthImg
        this.height=GetHeightImg
       END IF
      END SUB
     END TYPE

2003-12-31 11:21