ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

charger une image bmp avec api   



L'auteur

lotfi072003
Algérie Algérie
Membre Simple
# 0000000489
enregistré le 20/07/2005

http://www.oasis-gestion.com
abdelatif belguidoum
Fiche personnelle


Note des membres
pas de note

Contributions > 05 - API et appels systèmes

charger une image bmp avec api
# 0000000322
ajouté le 23/05/2006 22:55:57 et modifié le 24/05/2006
consulté 9466 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0
VFP 5.0

Description

Bonsoir à tous les foxeux
Cette procedure affiche un BMP à l'aide des API

Code source :
*------------------------
* cette proc sert a afficher une image bmp a l'ecran
* en ralantissant l'affichage des pixel d'image vs aurez une
* annimation cool
* et je l'utlise ds mes logicielle comme entree
************************
***********defenir des constantes pour utlisation
#DEFINE LR_LOADFROMFILE  16        && set pour l'image bmp seulement l'autre chercher 32 et plus
#DEFINE AC_SRC_OVER 0              && pour faire sortir l'image a l'ecran
#DEFINE IMAGE_BITMAP 0             && sert pour le variable d'image
#DEFINE BITMAP_STRU_SIZE 24        && sert pour la taille du bmp

DO declare        && charger le api necessaires



LOCAL lcBitmap
**********faite une image bmp ici avec le chemin
**lcBitmap = "c:\gestion\bmp\SplachLotfi.bmp"
**lcBitmap = "c:\EmloiduTemps\bmp\SplachLotfi.bmp"
*cette image vous pouvez la changer avec votre probre bmp
_screen.visible=.F.        && masquer l'ecran
For i= 1 to 100 step 1
     = LoadAndShowBitmap(lcBitmap, LR_LOADFROMFILE, 200,150)
  ********mettre une pause de 0.5 s pour voire l'animation de l'affichage
Endfor
_screen.visible=.T.         && afficher l'ecran

clear dlls          && fermer la boutique et c'est fini la fête





PROCEDURE LoadAndShowBitmap(lcBitmap, lnLoadOptions, lnX,lnY)
    LOCAL hBitmap
    hBitmap = LoadImage(0, lcBitmap, IMAGE_BITMAP,;
        0,0, lnLoadOptions)

    IF hBitmap <> 0
        = ShowBitmap(hBitmap, lnX,lnY)
        = DeleteObject(hBitmap)
    ELSE
        = MESSAGEBOX(lcBitmap + Chr(13) + Chr(13) +;
            "ce n'est pas une fichier bmp.",;
            32, " impossible de charger le fichier")
    ENDIF

PROCEDURE ShowBitmap(hBitmap, lnX, lnY)
******* intialiser les variables locales pour charger le bmp

    LOCAL hWindow, hDC, hMemDC, lnWidth, lnHeight


    STORE 0 TO lnWidth, lnHeight
    = GetBitmapSize(hBitmap, @lnWidth, @lnHeight)    && definir la taille du bmp

    hWindow = GetActiveWindow()                      && definir le handle d'affichage
    hDC = GetWindowDC(hWindow)

    hMemDC = CreateCompatibleDC(hDC)
    = SelectObject(hMemDC, hBitmap)

    LOCAL lnAlphaBlend, lnResult,;
        lnBlendOp, lnBlendFlags, lnSrcConstAlpha, lnAlphaFormat

    lnBlendOp = AC_SRC_OVER    && toutjour
    lnBlendFlags = 0           && toutjour
    lnSrcConstAlpha = 48       && intensity
    lnAlphaFormat = 0          && afficher AC_SRC_ALPHA sur non-blanc background

    * assember la strecture de la fonction  BLENDFUNCTION
    lnAlphaBlend = lnBlendOp +;
        BitLShift(lnBlendFlags, 8) +;
        BitLShift(lnSrcConstAlpha, 16) +;
        BitLShift(lnAlphaFormat, 24)

        *** transmettre a le resulta

    lnResult = AlphaBlend(hDC, lnX,lnY, lnWidth,lnHeight,;
        hMemDC, 0,0, lnWidth,lnHeight,;
        lnAlphaBlend)
************verfier le resultat

    IF lnResult = 0
                ? "Error:", GetLastError()
    ENDIF

    = DeleteDC(hMemDC)              && ecraser le memo utliser
    = ReleaseDC(hWindow, hDc)       && le handle
RETURN .T.

FUNCTION GetBitmapSize(hBitmap, lnWidth, lnHeight)
    LOCAL lcBuffer
    lcBuffer = Repli(Chr(0), BITMAP_STRU_SIZE)

    IF GetObjectA(hBitmap, BITMAP_STRU_SIZE, @lcBuffer) <> 0
        lnWidth  = buf2dword(SUBSTR(lcBuffer, 5,4))
        lnHeight = buf2dword(SUBSTR(lcBuffer, 9,4))
       ENDIF

FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)

PROCEDURE declare
    DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
    DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER GetWindowDC IN user32 INTEGER hWindow
    DECLARE INTEGER ReleaseDC IN user32 INTEGER hWindow, INTEGER dc
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObject

    DECLARE INTEGER LoadImage IN user32;
        INTEGER hinst, STRING lpszName, INTEGER uType,;
        INTEGER cxDesired, INTEGER cyDesired, INTEGER fuLoad

    DECLARE INTEGER GetObject IN gdi32 AS GetObjectA;
        INTEGER hgdiobj, INTEGER cbBuffer, STRING @lpvObject

    DECLARE INTEGER AlphaBlend IN Msimg32;
        INTEGER hDestDC, INTEGER x, INTEGER y,;
        INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
        INTEGER xSrc, INTEGER ySrc, INTEGER nWidthSrc,;
        INTEGER nHeightSrc, INTEGER blendFunction

    DECLARE INTEGER GetLastError IN kernel32
Commentaires
le 29/05/2006, Mike Gagnon a écrit :
News2news?
le 01/06/2006, FoxInCloud (Th. Nivelet) a écrit :
Bonjour Lofti
Pour information, as-tu regardé si la classe GDI+ permettrait la même chose ?

le 03/06/2006, lotfi072003 a écrit :
merci abaquelinside
je ne sais pas mais je vai essayer
merci de votre comantaire


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3