Guidance
指路人
g.yi.org
software / rapidq / Examples / QObject / Object / QBitmapEx.inc

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'=======================================================
' Type Objet
' Classe QBitmapEx Version 1.4
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

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

'pen styles
     CONST PS_SOLID_BMP=0
     CONST PS_DASH_BMP=1
     CONST PS_DOT_BMP=2
     CONST PS_DASHDOT_BMP=3
     CONST PS_DASHDOTDOT_BMP=4
     CONST PS_NULL_BMP=5
     CONST PS_INSIDEFRAME_BMP=6

'copy modes
     CONST BLACKNESS_BMP=&H42
     CONST DSTINVERT_BMP=&H550009
     CONST MERGECOPY_BMP=&HC000CA
     CONST MERGEPAINT_BMP=&HBB0226
     CONST NOTSRCCOPY_BMP=&H330008
     CONST NOTSRCERASE_BMP=&H1100A6
     CONST PATCOPY_BMP=&HF00021
     CONST PATINVERT_BMP=&H5A0049
     CONST PATPAINT_BMP=&HFB0A09
     CONST SRCAND_BMP=&H8800C6
     CONST SRCCOPY_BMP=&HCC0020
     CONST SRCERASE_BMP=&H440328
     CONST SRCINVERT_BMP=&H660046
     CONST SRCPAINT_BMP=&HEE0086
     CONST WHITENESS_BMP=&HFF0062

     CONST NULL_BRUSH_BMP=5
     CONST CF_BITMAP_BMP=2
     CONST DI_MASK_BMP=&H1
     CONST DI_IMAGE_BMP=&H2
     CONST DI_NORMAL_BMP=DI_MASK_BMP OR DI_IMAGE_BMP
     CONST OBJ_BITMAP_BMP=7

     DECLARE FUNCTION DrawIconExBmp 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 CreateDCBmp LIB "gdi32" ALIAS "CreateCompatibleDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION SelectObjectBmp LIB "gdi32" ALIAS "SelectObject" (hdc AS LONG,hObject AS LONG) AS LONG
     DECLARE FUNCTION BitBltBmp 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 DeleteDCBmp LIB "gdi32" ALIAS "DeleteDC" (hdc AS LONG) AS LONG
     DECLARE FUNCTION GetObjectBmp LIB "gdi32" ALIAS "GetObjectA" (hObject AS LONG,nCount AS LONG, lpObject AS TBITMAP_BMP) AS LONG
     DECLARE FUNCTION GetStockObjectBmp LIB "gdi32" ALIAS "GetStockObject" (nIndex AS LONG) AS LONG
     DECLARE FUNCTION LineToBmp LIB "gdi32" ALIAS "LineTo" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
     DECLARE FUNCTION CreatePenBmp LIB "gdi32" ALIAS "CreatePen" (nPenStyle AS LONG, nWidth AS LONG, crColor AS LONG) AS LONG
     DECLARE FUNCTION MoveToExBmp LIB "gdi32" ALIAS "MoveToEx" (hdc AS LONG,x AS LONG,y AS LONG, lpPoint AS LONG) AS LONG
     DECLARE FUNCTION RectangleBmp LIB "gdi32" ALIAS "Rectangle" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
     DECLARE FUNCTION CreateSolidBrushBmp LIB "gdi32" ALIAS "CreateSolidBrush" (crColor AS LONG) AS LONG
     DECLARE FUNCTION ElipseBmp LIB "gdi32" ALIAS "Ellipse" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
     DECLARE FUNCTION ExtFloodFillBmp LIB "gdi32" ALIAS "ExtFloodFill" (hdc AS LONG,x AS LONG,y AS LONG,crColor AS LONG,wFillType AS LONG) AS LONG
     DECLARE FUNCTION RoundRectBmp 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 PatBltBmp 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 StretchBltBmp 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
     DECLARE FUNCTION DeleteObjectBmp LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG
     DECLARE FUNCTION GetCurrentObjectBmp LIB "gdi32" ALIAS "GetCurrentObject" (hdc AS LONG,uObjectType AS LONG) AS LONG
     DECLARE FUNCTION Load_JPGBmp LIB "NViewLib.dll" ALIAS "Load_JPG" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION Load_GIFBmp LIB "NViewLib.dll" ALIAS "Load_GIF" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION LoadBmp LIB "NVIEWLIB" ALIAS "NViewLibLoad" (FileName AS STRING,Progress AS INTEGER) AS LONG
     DECLARE FUNCTION SetLanguageBmp LIB "NVIEWLIB" ALIAS "NViewLibSetLanguage" (Language AS STRING) AS INTEGER
     DECLARE FUNCTION GetWidthBmp LIB "NVIEWLIB" ALIAS "GetWidth" () AS INTEGER
     DECLARE FUNCTION GetHeightBmp LIB "NVIEWLIB" ALIAS "GetHeight" () AS INTEGER
     DECLARE FUNCTION SaveAsJPGBmp LIB "NViewLib.dll" ALIAS "NViewLibSaveAsJPG" (Quality AS INTEGER,FileName AS STRING) AS INTEGER


     TYPE QBitmapEx EXTENDS QBITMAP
PRIVATE:
      info AS TBITMAP_BMP
      hpen AS LONG
      hbrush AS LONG
      oldpen AS LONG
      oldbrush AS LONG
PUBLIC:
      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)
       DrawIconExBmp(QBitmapEx.handle,left,top,handle,width,height,0,0,DI_NORMAL_BMP)
      END SUB

  '================================================
  ' méthode copie le contenu dans le presse papier
  '================================================
      SUB CopyToClipboard
       DIM hBitmap AS INTEGER
       DIM bitmap AS QBITMAP

       bitmap.bmp=this.bmp
       bitmap.pixelformat=0
       hBitmap=GetCurrentObjectBmp(bitmap.handle,OBJ_BITMAP_BMP)
       clipboard.OPEN
       clipboard.clear
       clipboard.SetAsHandle(CF_BITMAP_BMP,hBitmap)
       clipboard.CLOSE
      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_BMP) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_BMP)
        clipboard.CLOSE
        GetObjectBmp(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
        hDC=CreateDCBmp(QBitmapEx.handle)
        hOldBitmap=SelectObjectBmp(hDC,hBitmap)
        BitBltBmp(QBitmapEx.handle,x,y,QBitmapEx.info.bmwidth,QBitmapEx.info.bmheight,hDC,0,0,SRCCOPY_BMP)
        SelectObjectBmp(hDC,hOldBitmap)
        DeleteDCBmp(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_BMP) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_BMP)
        clipboard.CLOSE
        GetObjectBmp(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
        result=QBitmapEx.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_BMP) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP_BMP)
        clipboard.CLOSE
        GetObjectBmp(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
        result=QBitmapEx.info.bmheight
       END IF
      END FUNCTION

  '===============================================
  ' méthode info image presente dans presse papier
  '===============================================
      FUNCTION CanPaste AS boolean
       result=clipboard.hasformat(CF_BITMAP_BMP)
      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)
       QBitmapEx.hbrush=GetStockObjectBmp(NULL_BRUSH_BMP)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       ElipseBmp(QBitmapEx.handle,x1,y1,x2,y2)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.hbrush=CreateSolidBrushBmp(fill)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       ElipseBmp(QBitmapEx.handle,x1,y1,x2,y2)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.hpen)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hbrush=GetStockObjectBmp(NULL_BRUSH_BMP)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       RectangleBmp(QBitmapEx.handle,x1,y1,x2,y2)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hbrush=GetStockObjectBmp(NULL_BRUSH_BMP)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       RoundRectBmp(QBitmapEx.handle,x1,y1,x2,y2,x3,y3)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.hbrush=CreateSolidBrushBmp(fill)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       RoundRectBmp(QBitmapEx.handle,x1,y1,x2,y2,x3,y3)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.hpen)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.hbrush=CreateSolidBrushBmp(fill)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       RectangleBmp(QBitmapEx.handle,x1,y1,x2,y2)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.hpen)
       DeleteObjectBmp(QBitmapEx.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)
       QBitmapEx.hpen=CreatePenBmp(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
       QBitmapEx.oldpen=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hpen)
       MoveToExBmp(QBitmapEx.handle,x1,y1,0)
       LineToBmp(QBitmapEx.handle,x2,y2)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldpen)
       DeleteObjectBmp(QBitmapEx.hpen)
      END SUB

  '==================================================
  ' méthode rempli une surface
  '==================================================
      SUB FillSurface(x AS INTEGER,y AS INTEGER,c AS LONG)
       QBitmapEx.hbrush=CreateSolidBrushBmp(c)
       QBitmapEx.oldbrush=SelectObjectBmp(QBitmapEx.handle,QBitmapEx.hbrush)
       ExtFloodFillBmp(QBitmapEx.handle,x,y,QBitmapEx.pixel(x,y),1)
       SelectObjectBmp(QBitmapEx.handle,QBitmapEx.oldbrush)
       DeleteObjectBmp(QBitmapEx.hbrush)
      END SUB

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

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

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

  '==================================================
  ' méthode charge les formats dll
  '==================================================
      SUB LoadOtherImage(FileName AS STRING,Progress AS boolean,Language AS STRING)
       DIM hDC AS INTEGER
       DIM hBitmap AS LONG
       DIM hOldBitmap AS INTEGER

       SetLanguageBmp(language)
       hBitmap=LoadBmp(FileName,Progress)
       IF hBitmap<>0 THEN
        this.pixelformat=6
        this.width=GetWidthBmp()
        this.height=GetHeightBmp()
        hDC=CreateDCBmp(QBitmapEx.handle)
        hOldBitmap=SelectObjectBmp(hDC,hBitmap)
        BitBltBmp(QBitmapEx.handle,0,0,this.width,this.height,hDC,0,0,SRCCOPY_BMP)
        SelectObjectBmp(hDC,hOldBitmap)
        DeleteDCBmp(hDC)
        DeleteObjectBmp(hBitmap)
       END IF
      END SUB

  '==================================================
  ' méthode sauve le bitmap au format Jpg
  '==================================================
      SUB SaveAsJpg(FileName AS STRING,Quality AS INTEGER)
       DIM hBitmap AS INTEGER
       DIM path AS STRING
       DIM File AS STRING
       DIM bitmap AS QBITMAP

       IF FileName<>"" THEN
        path=LEFT$(FileName,RINSTR(FileName,"\"))
        IF DIREXISTS(path) THEN
         File=path+"temp.bmp"
         bitmap.pixelformat=5
         bitmap.width=this.width
         bitmap.height=this.height
         bitmap.draw(0,0,this.bmp)
         bitmap.pixelformat=6
         bitmap.SaveToFile(File)
         hBitmap=LoadBmp(File,false)
         SaveAsJPGBmp(Quality,FileName)
         DeleteObjectBmp(hBitmap)
         KILL File
        END IF
       END IF
      END SUB

      CONSTRUCTOR
       PenStyle=PS_SOLID_BMP
       PenSize=1
      END CONSTRUCTOR
     END TYPE
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Sat 2023-2-4  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-12-31 10:29:44