*------------------------
* 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
|
Retour à la liste
Algérie
Fiche personnelle
Note des membres
Niveau
débutant
le 01/06/2006, 
le 03/06/2006,
News2news?