مود يل سحري للرسم Private Enum GpStatus Gp_Ok = 0 Gp_GenericError = 1 Gp_InvalidParameter = 2 Gp_OutOfMemory = 3 Gp_ObjectBusy = 4 Gp_InsufficientBuffer = 5 Gp_NotImplemented = 6 Gp_Win32Error = 7 Gp_WrongState = 8 Gp_Aborted = 9 Gp_FileNotFound = 10 Gp_ValueOverflow = 11 Gp_AccessDenied = 12 Gp_UnknownImageFormat = 13 Gp_FontFamilyNotFound = 14 Gp_FontStyleNotFound = 15 Gp_NotTrueTypeFont = 16 Gp_UnsupportedGdiplusVersion = 17 Gp_GdiplusNotInitialized = 18 Gp_PropertyNotFound = 19 Gp_PropertyNotSupported = 20 End Enum Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Enum GpColorMatrixFlags ColorMatrixFlagsDefault = 0 ColorMatrixFlagsSkipGrays = 1 ColorMatrixFlagsAltGray = 2 End Enum Private Enum GpColorAdjustType ColorAdjustTypeDefault = 0 ColorAdjustTypeBitmap = 1 ColorAdjustTypeBrush = 2 ColorAdjustTypePen = 3 ColorAdjustTypeText = 4 ColorAdjustTypeCount = 5 ColorAdjustTypeAny = 6 End Enum Private Enum GpUnit UnitWorld = 0 UnitDisplay = 1 UnitPixel = 2 UnitPoint = 3 UnitInch = 4 UnitDocument = 5 UnitMillimeter = 6 End Enum Private Enum GpMatrixOrder MatrixOrderPrepend = 0 MatrixOrderAppend = 1 End Enum Private Type GpColorMatrix m(4, 4) As Single End Type Private Enum GpCoordinateSpace CoordinateSpaceWorld = 0 CoordinateSpacePage = 1 CoordinateSpaceDevice = 2 End Enum Private Type GpPointF x As Single y As Single End Type Public Enum GpWrapMode WrapModeTile = &H0 WrapModeTileFlipX = &H1 WrapModeTileFlipY = &H2 WrapModeTileFlipXY = &H3 WrapModeClamp = &H4 End Enum '# APIs GDI+ Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As String, ByRef bitmap As Long) As GpStatus Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus Private Declare Function GdipCreateSolidFill Lib "GdiPlus.dll" (ByVal mColor As Long, ByRef mBrush As Long) As GpStatus Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, ByRef hbmReturn As Long, Optional ByVal background As Long = 0) As GpStatus Private Declare Function GdipCreateTexture Lib "gdiplus" (ByVal image As Long, ByVal WrapMode As GpWrapMode, ByRef texture As Long) As GpStatus Private Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal brush As Long) As GpStatus Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus Private Declare Function GdipDisposeImageAttributes Lib "gdiplus" (ByVal imageattr As Long) As GpStatus Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As GpUnit, ByVal imageAttributes As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As GpStatus Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus Private Declare Function GdipCreateImageAttributes Lib "gdiplus" (ByRef imageattr As Long) As GpStatus Private Declare Function GdipFillRectangleI Lib "gdiplus" (ByVal graphics As Long, ByVal brush As Long, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long) As GpStatus Private Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal image As Long, ByRef width As Single, ByRef height As Single) As GpStatus Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, ByRef image As Long) As GpStatus Private Declare Function GdipRotateWorldTransform Lib "GdiPlus.dll" (ByVal graphics As Long, ByVal angle As Single, ByVal order As GpMatrixOrder) As GpStatus Private Declare Function GdipSetImageAttributesColorMatrix Lib "gdiplus" (ByVal imageattr As Long, ByVal adjustType As GpColorAdjustType, ByVal enableFlag As Boolean, ByRef colorMatrix As GpColorMatrix, ByRef grayMatrix As GpColorMatrix, ByVal flags As GpColorMatrixFlags) As GpStatus Private Declare Function GdipTransformPoints Lib "gdiplus" (ByVal graphics As Long, ByVal destSpace As GpCoordinateSpace, ByVal srcSpace As GpCoordinateSpace, ByRef points As GpPointF, ByVal count As Long) As GpStatus Private Declare Function GdipTranslateWorldTransform Lib "GdiPlus.dll" (ByVal graphics As Long, ByVal dx As Single, ByVal dy As Single, ByVal order As GpMatrixOrder) As GpStatus Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long) '# APIs Windows Private Const HWND_DESKTOP As Long = 0 Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Type IID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare Sub IIDFromString Lib "ole32.dll" (ByVal lpsz As String, ByRef lpiid As IID) Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As IID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long '# Permet de dessiner une image issue d'un fichier, en la redimensionnant si nc0065ssaire, et en appliquant un % de translucidit 0050ublic Sub DrawImage(ByRef vsFilePath As String, ByVal vnTargetDC As Long, ByVal vnX As Long, ByVal vnY As Long, Optional ByVal vnWidth, Optional ByVal vnHeight, Optional ByVal vnTransparency As Single = 1, Optional vnAngle As Single = 0) Dim hTargetGraphics As Long Dim hImage As Long Dim hImageAttr As Long Dim nWidth As Single Dim nheight As Single Dim lpColorMatrix As GpColorMatrix Dim lpSI As GdiplusStartupInput Dim hGdipToken As Long Dim lpOrg As GpPointF '# On allume GDI+ '# Il vaudrait mieux ne le faire qu'une fois pour toutes, au db0075t, mais ainsi, la fonction est directement ru0074ilisable... '# Si on n'active/ds0061ctive pas GDI+ comme il faut, quand il faut, vous allez faire crasher votre VB. lpSI.GdiplusVersion = 1 GdiplusStartup hGdipToken, lpSI '# On cre0020un objet de type Graphic, issu de notre hDc If GdipCreateFromHDC(vnTargetDC, hTargetGraphics) = Gp_Ok Then '# Chargement de l'image (PNG/JPG/TIF/GIF/BMP...) '# Toutes les chaines sont a passer en Unicode '# On contrebalance la transformation que VB effectue lors des appels API... If GdipLoadImageFromFile(W(vsFilePath), hImage) = Gp_Ok Then '# On cre0020des attributs d'image. '# C'est uniquement nc0065ssaire ici pour dessiner l'image en smi transparence GdipCreateImageAttributes hImageAttr With lpColorMatrix .m(0, 0) = 1 .m(1, 1) = 1 .m(2, 2) = 1 .m(3, 3) = vnTransparency .m(4, 4) = 1 End With '# On renseigne nos attributs (hImageAttr) GdipSetImageAttributesColorMatrix hImageAttr, ColorAdjustTypeBitmap, True, lpColorMatrix, lpColorMatrix, ColorMatrixFlagsSkipGrays '# On rc0075pr0065 les dimensions de l'image... If GdipGetImageDimension(hImage, nWidth, nheight) = Gp_Ok Then '# Si on ne passe pas de dimension (largeur ou hauteur), '# On n'effectue pas de redimensionnement : on garde les dimensions de l'image If IsMissing(vnWidth) Then vnWidth = nWidth End If If IsMissing(vnHeight) Then vnHeight = nheight End If lpOrg.x = vnX lpOrg.y = vnY '# On traduit les coordonne0073 en coordonne0073 du monde : oriente0020 0076nAngle degrs000a If vnAngle <> 0# Then GdipRotateWorldTransform hTargetGraphics, vnAngle, MatrixOrderPrepend GdipTransformPoints hTargetGraphics, CoordinateSpaceWorld, CoordinateSpaceDevice, lpOrg, 1 End If '# On dessine enfin notre image. '# On aurait pu utiliser GdipDrawImage, ou GdipDrawImageRect, mais elles ne permettent '# pas de prendre en compte les attributs (ici la transparence) GdipDrawImageRectRectI hTargetGraphics, hImage, lpOrg.x + vnWidth * -0.5, lpOrg.y + vnHeight * -0.5, vnWidth, vnHeight, 0, 0, nWidth, nheight, UnitPixel, hImageAttr End If '# On dt0072uit nos attributs d'image GdipDisposeImageAttributes hImageAttr '# On libr0065 l'image GdipDisposeImage hImage End If '# On dt0072uit notre objet Graphic GdipDeleteGraphics hTargetGraphics End If GdiplusShutdown hGdipToken End Sub Public Sub FillRect(ByRef vsFilePath As String, ByVal vnTargetDC As Long, ByVal vnX As Long, ByVal vnY As Long, ByVal vnWidth As Long, ByVal vnHeight As Long, Optional veWrapMode As GpWrapMode = WrapModeTile) Dim hTargetGraphics As Long Dim hImage As Long Dim hBrush As Long Dim hImageAttr As Long Dim nWidth As Single Dim nheight As Single Dim lpColorMatrix As GpColorMatrix Dim lpSI As GdiplusStartupInput Dim hGdipToken As Long Dim lpOrg As GpPointF lpSI.GdiplusVersion = 1 GdiplusStartup hGdipToken, lpSI If GdipCreateFromHDC(vnTargetDC, hTargetGraphics) = Gp_Ok Then If GdipLoadImageFromFile(W(vsFilePath), hImage) = Gp_Ok Then GdipCreateTexture hImage, veWrapMode, hBrush GdipFillRectangleI hTargetGraphics, hBrush, vnX, vnY, vnWidth, vnHeight GdipDeleteBrush hBrush GdipDisposeImage hImage End If GdipDeleteGraphics hTargetGraphics End If GdiplusShutdown hGdipToken End Sub '# Permet de charger un fichier, et de rc0075prr un objet image directement exploitable sous VB6 Public Function GetPicture(ByRef vsFilePath As String) As IPicture Dim hTargetGraphics As Long Dim hBitmap As Long Dim nWidth As Single Dim nheight As Single Dim lpSI As GdiplusStartupInput Dim hGdipToken As Long Dim lpPic As PicBmp Dim lpIID_IDispatch As IID IIDFromString "{00020400-0000-0000-C000-000000000046}", lpIID_IDispatch lpSI.GdiplusVersion = 1 GdiplusStartup hGdipToken, lpSI If GdipCreateBitmapFromFile(W(vsFilePath), hBitmap) = Gp_Ok Then '# Nous nous preparons a cre0072 une image With lpPic GdipCreateHBITMAPFromBitmap hBitmap, .hBmp GdipDisposeImage hBitmap .Size = Len(lpPic) .Type = vbPicTypeBitmap End With '# Nous avons rc0075per 0075n HBITMAP, que nous transformons maintenant, en IPicture OleCreatePictureIndirect lpPic, lpIID_IDispatch, 1, GetPicture End If GdiplusShutdown hGdipToken End Function '# Permet de convertir une chan0065 en Unicode Private Function W(ByRef vsA As String) As String W = StrConv(vsA, vbUnicode) End Function </div></td> </tr> </table> </td> <td></td> </tr> <tr> <td class="cont_bar_middle" colspan="4" height="9"></td> </tr> </table> </td> </tr> </table> </td> <td width="182" align="left" valign="top" class="edit_bg_rightbox"> <table width="100%" border="0" cellspacing="0" cellpadding="0"> <tr> <td background="//theme.webme.com/designs/butterfly/images//headline_bg.gif" height="35" class="edit_rechts_headline"> <table width="182" border="0" cellspacing="0" cellpadding="0"> <tr> <td class="edit_headline_bar_right_left" width="9"></td> <td class="headline_bar_right" width="5"><img src="//theme.webme.com/designs/butterfly/images_rot/head.gif" width="5" height="21"></td> <td class="headline_bar_right_right" width="4"></td> <td width="155" class="headline6"><strong>عدد الزوار</strong></td> <td class="edit_headline6_right" width="9"> </td> </tr> </table> </td> </tr> <tr> <td height="35" align="left" valign="top" bgcolor="#4B595B" class="edit_right_box"> <table width="182" border="0" cellspacing="0" cellpadding="0"> <tr> <td class="edit_rechts_headline2_left" width="9"></td> <td width="164" height="5" background="//theme.webme.com/designs/butterfly/images_rot/head.gif" class="edit_rechts_headline2"></td> <td class="edit_rechts_headline2_right" width="9"></td> </tr> <tr> <td class="rb_bar_left" width="9"> </td> <td width="164" height="60" bgcolor="#FFFFFF" class="edit_right_box2" style="padding-left:5px;"> </td> <td class="rb_bar_right" width="9"> </td> </tr> <tr> <td class="rb_bar_bottom" colspan="3" height="9"></td> </tr> </table> </td> </tr> </table> <center><font color="white" style="font-size: 11px; font-family: Tahoma, Arial, Helvetica, sans-serif">Aujourduit 11356 visiteurs (16791 hits) </font><center> </td> </tr> </table> </td> </tr> </table> <a id="selfpromotionOverlay" href="https://www.ma-page.fr/?c=4000&utm_source=selfpromotion&utm_campaign=overlay&utm_medium=footer" target="_blank" rel="nofollow"> Ce site web a été créé gratuitement avec <b>Ma-page.fr</b>. Tu veux aussi ton propre site web ? <div class="btn btn-1">S'inscrire gratuitement</div> </a> <style> body { padding-top: 124px; } #forFixedElement { top: 124px; } @media (min-width: 365px) { body { padding-top: 103px; } #forFixedElement { top: 103px; } } @media (min-width: 513px) { body { padding-top: 82px; } #forFixedElement { top: 82px; } } @media (min-width: 936px) { body { padding-top: 61px; } #forFixedElement { top: 61px; } } /* General button style */ #selfpromotionOverlay .btn { border: none; font-size: inherit; color: inherit; background: none; cursor: pointer; padding: 6px 15px; display: inline-block; text-transform: uppercase; letter-spacing: 1px; font-weight: 700; outline: none; position: relative; -webkit-transition: all 0.3s; -moz-transition: all 0.3s; transition: all 0.3s; margin: 0px; } /* Button 1 */ #selfpromotionOverlay .btn-1, #selfpromotionOverlay .btn-1:visited { background: rgb(0, 85, 204); color: #fff; } #selfpromotionOverlay .btn-1:hover { background: #2980b9; } #selfpromotionOverlay .btn-1:active { background: #2980b9; top: 2px; } #selfpromotionOverlay { font: 400 12px/1.8 "Open Sans", Verdana, sans-serif; text-align: center; opacity: 1; transition: opacity 1s ease; position: fixed; overflow: hidden; box-sizing: border-box; font-size: 14px; text-decoration: none; line-height: 1.5em; flex-wrap: nowrap; z-index: 5000; padding: 14px; width: 100%; left: 0; right: 0; top: 0; color: rgb(35,35,35); background-color: rgb(246,246,246); border-bottom: 1px solid #5a5a5a; } #selfpromotionOverlay:hover { background: white; text-decoration: none; } </style></body> </html>