2003-01-03 18:52

'=======================================================
' Type Objet
' Classe QCanvasEx version 1.2
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     TYPE TBITMAP
      bmType AS LONG
      bmWidth AS LONG
      bmHeight AS LONG
      bmWidthBytes AS LONG
      bmPlanes AS INTEGER
      bmBitsPixel AS INTEGER
      bmBits AS LONG
     END TYPE

' type mixmode
     CONST R2_BLACK_CAN=1
     CONST R2_NOTMERGEPEN_CAN=2
     CONST R2_MASKNOTPEN_CAN=3
     CONST R2_NOTCOPYPEN_CAN=4
     CONST R2_MASKPENNOT_CAN=5
     CONST R2_NOT_CAN=6
     CONST R2_XORPEN_CAN=7
     CONST R2_NOTMASKPEN_CAN=8
     CONST R2_MASKPEN_CAN=9
     CONST R2_NOTXORPEN_CAN=10
     CONST R2_NOP_CAN=11
     CONST R2_MERGENOTPEN_CAN=12
     CONST R2_COPYPEN_CAN=13
     CONST R2_MERGEPENNOT_CAN=14
     CONST R2_MERGEPEN_CAN=15
     CONST R2_WHITE_CAN=16

'pen styles
     CONST PS_SOLID_CAN=0
     CONST PS_DASH_CAN=1
     CONST PS_DOT_CAN=2
     CONST PS_DASHDOT_CAN=3
     CONST PS_DASHDOTDOT_CAN=4
     CONST PS_NULL_CAN=5
     CONST PS_INSIDEFRAME_CAN=6

'copy modes
     CONST BLACKNESS_CAN=&H42
     CONST DSTINVERT_CAN=&H550009
     CONST MERGECOPY_CAN=&HC000CA
     CONST MERGEPAINT_CAN=&HBB0226
     CONST NOTSRCCOPY_CAN=&H330008
     CONST NOTSRCERASE_CAN=&H1100A6
     CONST PATCOPY_CAN=&HF00021
     CONST PATINVERT_CAN=&H5A0049
     CONST PATPAINT_CAN=&HFB0A09
     CONST SRCAND_CAN=&H8800C6
     CONST SRCCOPY_CAN=&HCC0020
     CONST SRCERASE_CAN=&H440328
     CONST SRCINVERT_CAN=&H660046
     CONST SRCPAINT_CAN=&HEE0086
     CONST WHITENESS_CAN=&HFF0062

     CONST CF_BITMAP_CAN=2
     CONST DI_MASK_CAN=&H1
     CONST DI_IMAGE_CAN=&H2
     CONST DI_NORMAL_CAN=DI_MASK_CAN OR DI_IMAGE_CAN
     CONST NULL_BRUSH_CAN=5



     DECLARE FUNCTION DrawIconExCan LIB "user32" ALIAS "DrawIconEx" (hdc AS LONG,xLeft AS LONG,yTop AS LONG,hIcon AS LONG,cxWidth AS LONG,cyWidth AS LONG,istepIfAniCur AS LONG,hbrFlickerFreeDraw AS LONG,diFlags AS LONG) AS LONG
     DECLARE FUNCTION GetObjectCan LIB "gdi32" ALIAS "GetObjectA" (hObject AS LONG,nCount AS LONG, lpObject AS TBITMAP) AS LONG
     DECLARE FUNCTION DrawIconCan LIB "user32" ALIAS "DrawIcon" (hdc AS LONG,x AS LONG,y AS LONG,hIcon AS LONG) AS LONG
     DECLARE FUNCTION DeleteObjectCan LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG
     DECLARE FUNCTION CreateDCCan LIB "gdi32" ALIAS "CreateCompatibleDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION SelectObjectCan LIB "gdi32" ALIAS "SelectObject" (hdc AS LONG,hObject AS LONG) AS LONG
     DECLARE FUNCTION BitBltCan 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 DeleteDCCan LIB "gdi32" ALIAS "DeleteDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION CreateBitmapCan LIB "gdi32" ALIAS "CreateCompatibleBitmap" (hdc AS LONG,nWidth AS LONG,nHeight AS LONG) AS LONG
     DECLARE FUNCTION SetROP2Can LIB "gdi32" ALIAS "SetROP2" (hdc AS LONG,nDrawMode AS LONG) AS LONG
     DECLARE FUNCTION LineToCan LIB "gdi32" ALIAS "LineTo" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
     DECLARE FUNCTION CreatePenCan LIB "gdi32" ALIAS "CreatePen" (nPenStyle AS LONG, nWidth AS LONG, crColor AS LONG) AS LONG
     DECLARE FUNCTION MoveToExCan LIB "gdi32" ALIAS "MoveToEx" (hdc AS LONG,x AS LONG,y AS LONG, lpPoint AS LONG) AS LONG
     DECLARE FUNCTION RectangleCan LIB "gdi32" ALIAS "Rectangle" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
     DECLARE FUNCTION CreateSolidBrushCan LIB "gdi32" ALIAS "CreateSolidBrush" (crColor AS LONG) AS LONG
     DECLARE FUNCTION EllipseCan LIB "gdi32" ALIAS "Ellipse" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
     DECLARE FUNCTION GetStockObjectCan LIB "gdi32" ALIAS "GetStockObject" (nIndex AS LONG) AS LONG
     DECLARE FUNCTION ExtFloodFillCan LIB "gdi32" ALIAS "ExtFloodFill" (hdc AS LONG,x AS LONG,y AS LONG,crColor AS LONG,wFillType AS LONG) AS LONG
     DECLARE FUNCTION RoundRectCan LIB "gdi32" ALIAS "RoundRect" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG,X3 AS LONG,Y3 AS LONG) AS LONG
     DECLARE FUNCTION PatBltCan LIB "gdi32" ALIAS "PatBlt" (hdc AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,dwRop AS LONG) AS LONG
     DECLARE FUNCTION StretchBltCan LIB "gdi32" ALIAS "StretchBlt" (hdc AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,hSrcDC AS LONG,xSrc AS LONG,ySrc AS LONG,nSrcWidth AS LONG,nSrcHeight AS LONG,dwRop AS LONG) AS LONG


     TYPE QCanvasEx EXTENDS QCANVAS
PRIVATE:
      info AS TBITMAP
      hpen AS LONG
      hbrush AS LONG
      oldpen AS LONG
      oldbrush AS LONG

PUBLIC:
      MixMode AS LONG
      PenStyle AS LONG
      PenSize AS INTEGER


  '========================================
  ' méthode dessin d'icones
  '========================================
      SUB DrawIco(left AS INTEGER,top AS INTEGER,width AS INTEGER,height AS INTEGER,handle AS LONG)
       DrawIconExCan(QCanvasEx.handle,left,top,handle,width,height,0,0,DI_NORMAL_CAN)
      END SUB

  '================================================
  ' méthode copie le contenu dans le 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=CreateDCCan(QCanvasEx.handle)
       hBitmap=CreateBitmapCan(QCanvasEx.handle,width,height)
       hOldBitmap=SelectObjectCan(hDC,hBitmap)
       BitBltCan(hDC,0,0,width,height,QCanvasEx.handle,rect.left,rect.top,SRCCOPY_CAN)
       clipboard.OPEN
       clipboard.clear
       clipboard.SetAsHandle(CF_BITMAP_CAN,hBitmap)
       clipboard.CLOSE
       SelectObjectCan(hDC,hOldBitmap)
       DeleteDCCan(hDC)
       DeleteObjectCan(hBitmap)
      END SUB

  '=============================================
  ' méthode colle une image du le presse papier
  '=============================================
      SUB PasteFromClipboard(x AS SHORT,y AS SHORT)
       DIM hDC AS INTEGER
       DIM hBitmap AS INTEGER
       DIM hOldBitmap AS INTEGER

       IF clipboard.hasformat(CF_BITMAP_CAN) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_CAN)
        clipboard.CLOSE
        GetObjectCan(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
        hDC=CreateDCCan(QCanvasEx.handle)
        hOldBitmap=SelectObjectCan(hDC,hBitmap)
        BitBltCan(QCanvasEx.handle,x,y,QCanvasEx.info.bmwidth,QCanvasEx.info.bmheight,hDC,0,0,SRCCOPY_CAN)
        SelectObjectCan(hDC,hOldBitmap)
        DeleteDCCan(hDC)
       END IF
      END SUB

  '===============================================
  ' méthode info largeur image du presse papier
  '===============================================
      FUNCTION GetWidthClipboard AS INTEGER
       DIM hBitmap AS INTEGER

       IF clipboard.hasformat(CF_BITMAP_CAN) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_CAN)
        clipboard.CLOSE
        GetObjectCan(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
        result=QCanvasEx.info.bmwidth
       END IF
      END FUNCTION

  '===============================================
  ' méthode info hauteur image du presse papier
  '===============================================
      FUNCTION GetHeightClipboard AS INTEGER
       DIM hBitmap AS INTEGER

       IF clipboard.hasformat(CF_BITMAP_CAN) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_CAN)
        clipboard.CLOSE
        GetObjectCan(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
        result=QCanvasEx.info.bmheight
       END IF
      END FUNCTION

  '===============================================
  ' méthode info image presente dans presse papier
  '===============================================
      FUNCTION CanPaste AS boolean
       result=clipboard.hasformat(CF_BITMAP_CAN)
      END FUNCTION

  '========================================
  ' méthode trace un cercle vide
  '========================================
      SUB circle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
       QCanvasEx.hbrush=GetStockObjectCan(NULL_BRUSH_CAN)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       EllipseCan(QCanvasEx.handle,x1,y1,x2,y2)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
      END SUB

  '========================================
  ' méthode trace un cercle plein
  '========================================
      SUB circleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.hbrush=CreateSolidBrushCan(fill)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       EllipseCan(QCanvasEx.handle,x1,y1,x2,y2)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
       DeleteObjectCan(QCanvasEx.hbrush)
      END SUB

  '========================================
  ' méthode trace un rectangle vide
  '========================================
      SUB rectangle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
       QCanvasEx.hbrush=GetStockObjectCan(NULL_BRUSH_CAN)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       RectangleCan(QCanvasEx.handle,x1,y1,x2,y2)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
      END SUB

  '==================================================
  ' méthode trace un rectangle vide au coins arrondi
  '==================================================
      SUB RoundRect(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG)
       QCanvasEx.hbrush=GetStockObjectCan(NULL_BRUSH_CAN)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       RoundRectCan(QCanvasEx.handle,x1,y1,x2,y2,x3,y3)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
      END SUB

  '==================================================
  ' méthode trace un rectangle plein au coins arrondi
  '==================================================
      SUB RoundRectFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG,fill AS LONG)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.hbrush=CreateSolidBrushCan(fill)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       RoundRectCan(QCanvasEx.handle,x1,y1,x2,y2,x3,y3)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
       DeleteObjectCan(QCanvasEx.hbrush)
      END SUB

  '==================================================
  ' méthode trace un rectangle plein
  '==================================================
      SUB rectangleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.hbrush=CreateSolidBrushCan(fill)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       RectangleCan(QCanvasEx.handle,x1,y1,x2,y2)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hpen)
       DeleteObjectCan(QCanvasEx.hbrush)
      END SUB

  '==================================================
  ' méthode trace une ligne
  '==================================================
      SUB line(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
       QCanvasEx.hpen=CreatePenCan(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
       QCanvasEx.oldpen=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hpen)
       SetROP2Can(QCanvasEx.handle,QCanvasEx.mixmode)
       MoveToExCan(QCanvasEx.handle,x1,y1,0)
       LineToCan(QCanvasEx.handle,x2,y2)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldpen)
       DeleteObjectCan(QCanvasEx.hpen)
      END SUB

  '==================================================
  ' méthode rempli une surface
  '==================================================
      SUB FillSurface(x AS INTEGER,y AS INTEGER,c AS LONG)
       QCanvasEx.hbrush=CreateSolidBrushCan(c)
       QCanvasEx.oldbrush=SelectObjectCan(QCanvasEx.handle,QCanvasEx.hbrush)
       ExtFloodFillCan(QCanvasEx.handle,x,y,QCanvasEx.pixel(x,y),1)
       SelectObjectCan(QCanvasEx.handle,QCanvasEx.oldbrush)
       DeleteObjectCan(QCanvasEx.hbrush)
      END SUB

  '==================================================
  ' méthode inverse les couleurs
  '==================================================
      SUB InvertColor(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
       PatBltCan(QCanvasEx.handle,x,y,Width,Height,DSTINVERT_CAN)
      END SUB

  '==================================================
  ' méthode effectue un miroir en x
  '==================================================
      SUB mirror(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
       StretchBltCan(QCanvasEx.handle,x+width,y,-Width,Height,QCanvasEx.handle,x,y,Width,Height,SRCCOPY_CAN)
      END SUB

  '==================================================
  ' méthode effectue un miroir en y
  '==================================================
      SUB flip(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
       StretchBltCan(QCanvasEx.handle,x,y+height,Width,-Height,QCanvasEx.handle,x,y,Width,Height,SRCCOPY_CAN)
      END SUB

      CONSTRUCTOR
       MixMode=R2_COPYPEN_CAN
       PenStyle=PS_SOLID_CAN
       PenSize=1
      END CONSTRUCTOR
     END TYPE

2003-01-03 18:52