begin process at 2012 02 11 12:47:31
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Graphique

 > UNE GRANDE DÉCOUVERTE GRAPHIQUE

UNE GRANDE DÉCOUVERTE GRAPHIQUE


 Information sur la source

Note :
7 / 10 - par 3 personnes
7,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Graphique Niveau :Expert Date de création :27/02/2002 Date de mise à jour :27/02/2002 11:42:06 Vu :3 525

Auteur : Cirtasoft

Ecrire un message privé
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (12)
Ajouter un commentaire et/ou une note


 Description

Plusieurs programmeurs sur visual basic cherche a crée des effets graphique. Mes le problème et le temps de la réalisation.

J'ai retrouve la solution pour faire des effets plus vite..  

Source

  • Private Const BI_RGB = 0&
  • Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
  • Private Type BITMAPINFOHEADER '40 bytes
  • biSize As Long
  • biWidth As Long
  • biHeight As Long
  • biPlanes As Integer
  • biBitCount As Integer
  • biCompression As Long
  • biSizeImage As Long
  • biXPelsPerMeter As Long
  • biYPelsPerMeter As Long
  • biClrUsed As Long
  • biClrImportant As Long
  • End Type
  • Private Type RGBQUAD
  • rgbBlue As Byte
  • rgbGreen As Byte
  • rgbRed As Byte
  • rgbReserved As Byte
  • End Type
  • Private Type BITMAPINFO
  • bmiHeader As BITMAPINFOHEADER
  • bmiColors As RGBQUAD
  • End Type
  • Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  • Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
  • Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  • Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
  • Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  • Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  • Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  • Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  • Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  • Dim iBitmap As Long, iDC As Long
  • Public Sub CreateEff(Eff As String, OrgHdc As Long, vW As Single, vH As Single, Newhdc As Long)
  • On Error Resume Next
  • Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
  • With bi24BitInfo.bmiHeader
  • .biBitCount = 24
  • .biCompression = BI_RGB
  • .biPlanes = 1
  • .biSize = Len(bi24BitInfo.bmiHeader)
  • .biWidth = vW
  • .biHeight = vH
  • End With
  • ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 4) As Byte
  • iDC = CreateCompatibleDC(OrgHdc)
  • iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
  • SelectObject iDC, iBitmap
  • BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, OrgHdc, 0, 0, vbSrcCopy
  • GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
  • Select Case Eff
  • Case "Inverse"
  • For Cnt = LBound(bBytes) To UBound(bBytes)
  • bBytes(Cnt) = 255 - bBytes(Cnt)
  • Next Cnt
  • Case "Ombre"
  • For Cnt = LBound(bBytes) To UBound(bBytes)
  • bBytes(Cnt) = bBytes(Cnt) * 0.5
  • Next Cnt
  • Case "Cellule"
  • For Cnt = LBound(bBytes) To UBound(bBytes)
  • mutip = Tan(Abs(Cos(Abs(((Cnt * 50) / (15)))))) / 1.5
  • If Int(bBytes(Cnt) * mutip) > 255 Then
  • bBytes(Cnt) = (bBytes(Cnt))
  • Else
  • bBytes(Cnt) = Int(bBytes(Cnt) * mutip)
  • End If
  • Next Cnt
  • Case "Confus"
  • For Cnt = LBound(bBytes) To UBound(bBytes)
  • mutip = (bBytes(Cnt)) Xor 25
  • bBytes(Cnt) = mutip
  • Next Cnt
  • Case "Clear"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • mutip = bBytes(Cnt) * 0.9
  • bBytes(Cnt) = (mutip)
  • Next Cnt
  • Case "Blue"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • bBytes(Cnt + 1) = 0
  • bBytes(Cnt + 2) = 0
  • Next Cnt
  • Case "Green"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • bBytes(Cnt) = 0
  • bBytes(Cnt + 2) = 0
  • Next Cnt
  • Case "Red"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • bBytes(Cnt) = 0
  • bBytes(Cnt + 1) = 0
  • Next Cnt
  • Case "Soft"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • bBytes(Cnt) = GetMin(bBytes(Cnt) * Tan(Abs(Cos(Cnt * 2))))
  • bBytes(Cnt + 1) = GetMin(bBytes(Cnt + 1) * Tan(Abs(Cos(Cnt * 2))))
  • bBytes(Cnt + 2) = GetMin(bBytes(Cnt + 2) * Tan(Abs(Cos(Cnt * 2))))
  • Next Cnt
  • Case "Change"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • mbd = bBytes(Cnt)
  • mvd = bBytes(Cnt + 1)
  • mrd = bBytes(Cnt + 2)
  • bBytes(Cnt) = mvd
  • bBytes(Cnt + 1) = mrd
  • bBytes(Cnt + 2) = mbd
  • Next Cnt
  • Case "Noir et Blanc"
  • For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
  • mbd = bBytes(Cnt)
  • mvd = bBytes(Cnt + 1)
  • mrd = bBytes(Cnt + 2)
  • bBytes(Cnt) = mvd
  • bBytes(Cnt + 1) = mvd
  • bBytes(Cnt + 2) = mvd
  • Next Cnt
  • Case "Dark"
  • For Cnt = LBound(bBytes) To UBound(bBytes) - 3 Step 3
  • bBytes(Cnt) = bBytes(Cnt) * Cnt / UBound(bBytes)
  • bBytes(Cnt + 1) = bBytes(Cnt + 1) * Cnt / UBound(bBytes)
  • bBytes(Cnt + 2) = bBytes(Cnt + 2) * Cnt / UBound(bBytes)
  • Next Cnt
  • End Select
  • SetDIBitsToDevice Newhdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
  • DeleteDC iDC
  • DeleteObject iBitmap
  • End Sub
  • Public Function GetMin(v1)
  • GetMin = v1
  • If v1 > 255 Then
  • GetMin = 255
  • End If
  • If v1 < 0 Then
  • GetMin = 0
  • End If
  • End Function
  Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Dim iBitmap As Long, iDC As Long



Public Sub CreateEff(Eff As String, OrgHdc As Long, vW As Single, vH As Single, Newhdc As Long)
On Error Resume Next
    Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
    
    
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = vW
        .biHeight = vH
    End With
    
    ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 4) As Byte
    iDC = CreateCompatibleDC(OrgHdc)
    iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    SelectObject iDC, iBitmap
    BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, OrgHdc, 0, 0, vbSrcCopy
    GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS

   Select Case Eff
    Case "Inverse"
    For Cnt = LBound(bBytes) To UBound(bBytes)
            bBytes(Cnt) = 255 - bBytes(Cnt)
    Next Cnt
    Case "Ombre"
      For Cnt = LBound(bBytes) To UBound(bBytes)
            bBytes(Cnt) = bBytes(Cnt) * 0.5
    Next Cnt
    Case "Cellule"
          For Cnt = LBound(bBytes) To UBound(bBytes)
          mutip = Tan(Abs(Cos(Abs(((Cnt * 50) / (15)))))) / 1.5
        If Int(bBytes(Cnt) * mutip) > 255 Then
        bBytes(Cnt) = (bBytes(Cnt))
        Else
            bBytes(Cnt) = Int(bBytes(Cnt) * mutip)
            End If
    Next Cnt
    Case "Confus"
          For Cnt = LBound(bBytes) To UBound(bBytes)
          mutip = (bBytes(Cnt)) Xor 25
            bBytes(Cnt) = mutip
    Next Cnt
    Case "Clear"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          mutip = bBytes(Cnt) * 0.9
            bBytes(Cnt) = (mutip)
    Next Cnt
    Case "Blue"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          bBytes(Cnt + 1) = 0
         bBytes(Cnt + 2) = 0
    Next Cnt
    Case "Green"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          bBytes(Cnt) = 0
         bBytes(Cnt + 2) = 0
    Next Cnt
    Case "Red"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          bBytes(Cnt) = 0
          bBytes(Cnt + 1) = 0
    Next Cnt
Case "Soft"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          bBytes(Cnt) = GetMin(bBytes(Cnt) * Tan(Abs(Cos(Cnt * 2))))
           bBytes(Cnt + 1) = GetMin(bBytes(Cnt + 1) * Tan(Abs(Cos(Cnt * 2))))
             bBytes(Cnt + 2) = GetMin(bBytes(Cnt + 2) * Tan(Abs(Cos(Cnt * 2))))
    Next Cnt
    Case "Change"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          mbd = bBytes(Cnt)
          mvd = bBytes(Cnt + 1)
          mrd = bBytes(Cnt + 2)
          bBytes(Cnt) = mvd
           bBytes(Cnt + 1) = mrd
             bBytes(Cnt + 2) = mbd
    Next Cnt
    Case "Noir et Blanc"
          For Cnt = LBound(bBytes) To UBound(bBytes) Step 3
          mbd = bBytes(Cnt)
          mvd = bBytes(Cnt + 1)
          mrd = bBytes(Cnt + 2)
          bBytes(Cnt) = mvd
           bBytes(Cnt + 1) = mvd
             bBytes(Cnt + 2) = mvd
    Next Cnt
    Case "Dark"
          For Cnt = LBound(bBytes) To UBound(bBytes) - 3 Step 3
              bBytes(Cnt) = bBytes(Cnt) * Cnt / UBound(bBytes)
           bBytes(Cnt + 1) = bBytes(Cnt + 1) * Cnt / UBound(bBytes)
           bBytes(Cnt + 2) = bBytes(Cnt + 2) * Cnt / UBound(bBytes)
    Next Cnt
    End Select
    SetDIBitsToDevice Newhdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    DeleteDC iDC
    DeleteObject iBitmap
End Sub




Public Function GetMin(v1)
GetMin = v1
If v1 > 255 Then
GetMin = 255
End If
If v1 < 0 Then
GetMin = 0
End If
End Function

 Conclusion

Exemple :

CreateEff "Inverse",Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture2.hdc
CreateEff "Clear",Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture2.hdc


 Sources du même auteur

TEXTBOX NUMERIQUE AVEC DES API
Source avec Zip CRÉATION DES METAFILE IMAGE SUR VB (DEMO+COM+SOURCE DE DLL E...
Source avec Zip Source avec une capture SHELLLISTVIEW LE CONTOL ACTIVEX
Source avec Zip Source avec une capture MY PROJECT APPLICATION (GESTION DES PROJETS VB) AVEC STYLE W...
Source avec Zip Source avec une capture CIRTASOFT IMAGO 2002 (IL Y A QUE LE CODE-SOURCE)

 Sources de la même categorie

Source avec une capture GRAPH PHP COURBE DE CHARGE par s.defaye
Source avec Zip Source avec une capture BOULE DE CRISTAL par BLUEBIBUBBLE
VB6 - DÉPLACEMENT D'UN CONTRÔLE SUR UN SEGMENT DE DROITE DÉL... par ucfoutu
Source avec Zip Source .NET (Dotnet) APPLICATION DE DESSIN par fsafsafsaf
Source avec Zip Source avec une capture Source .NET (Dotnet) MERGEIMAGES par Le Pivert

Commentaires et avis

Commentaire de DragonHeart le 27/02/2002 10:36:22

Est il est ou le zip?

Commentaire de celiphane le 27/02/2002 12:58:55

mais enfin, pourquoi tu continue à prétendre que ce code est de toi ?
"J'ai trouvé la solution"
pffff..., on se doute bien que ce bordel de déclaration, tu l'as pas inventé tout seul... pis tjrs ces comments en anglais, décidément ça trahi...

Commentaire de Pekinio le 27/02/2002 16:24:51

hey mec, ca trahi qu'dalle, même moi j'utilise un language hybride, mélangeant francais anglais et langue perso pour mes commentaires ou même variables, et tout le reste aussi d'ailleurs...

Commentaire de NicoVB le 27/02/2002 19:37:32

Je suis d'accord avec Pekinio, ça ne prouve rien.
De plus, il ne dit pas ke ce code vient de lui : il dit bien : "J'ai retrouve la solution pour faire des effets plus vite.."... Retrouvé... ça veut dire k'il vient de lui ça ? explike moi celiphane t trop sur la défensive....

Commentaire de Skywalker13 le 27/02/2002 19:39:22

lol... celiphane...
je vois pas pourquoi tu es perturbé par les déclaration.. c'est à la portée de tout le monde étant donné que c'est de l'API ;-)
Et le code est très simple.. vu que l'API est à l'honneur..
Je dirais que c'est bien de telle programme vu que sa donne un exemple de l'utilisation de telles fonctions extrêmement utilent..

Commentaire de FunkySteps le 27/02/2002 23:13:38

Même moi j'utilise les noms de mes variables en anglais et mes commentaires sont en français, alors continue ton bon bouleau Cirtasoft. En passant tu passeras voir ma source aussi héhé :)

Commentaire de celiphane le 28/02/2002 01:07:30

messieurs, tout d'abord bonjour !
je vois que vous défendez dument ce code !
Et bien soit, sachez que j'ai conversé avec l'auteur même de celui-ci par ce site, et...    IL N'EST PAS FRANCAIS ! tout est clair ! c'est donc bien par lui que ce code a été pondu, même que je me suis excusé auprès de cette personne, NA ! ;o)
En revanche, Skywalker13, quel génie tu dois être en API... respects... bien que je sache que tout les APIs sont "easily" dispo on the web, ba je pensais pas qu'un type aurais pu en combiner autant pour faire un prog pareille !
Comme quoi, on en a TOUJOURS à apprendre, à comprendre, et à critiquer... c'est la belle moralité de ce site !
une fois de plus, pardon à tous !

(sinon, moi aussi j'utilise des langages méga hybride en perso, mais qd je partage, je traduis ! lol)

Commentaire de celiphane le 28/02/2002 01:10:17

ha oui un dernier comments : putain c dingue comment avec la moindre connerie on se fait descendre sur cette communauté ! mine de rien, c mieux comme ça, car n'en déplaise à certain, ça refout tout le monde dans le bon chemin !

tchao à tous VBistes, @+

Commentaire de Mémère le 28/02/2002 15:00:55 administrateur CS

perso on ne m'a jamais remis dans le prétendus "bon chemin" et je ne crois personne ici en être capable. bon j'ai du taff à plush

Commentaire de celiphane le 01/03/2002 17:44:45

beu...
g po dit qu'c'était une prouesse Mémère, je disais ça pour moi, pour m'excuser et montrer ma sincérité...
t po un peu râleur toi aussi ? :)

Commentaire de DARKSIDIOUS le 19/03/2004 13:30:38 administrateur CS

Source très intéressante qui permet de comprendre comment fonction la fonction GetDIBits qui est bien pratique pour la retouche d'image ! Elle ne vaut absolument pas le 1 !

Donc je mets 10 pour remonter cette note ridicule !

DarK Sidious

Commentaire de demiebruce le 24/10/2005 17:48:09

Ya ocune explication...

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,437 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales