vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB4, VB5, VB629.12.03
StdPicture mit Farbverlauf erstellen

Dieser Tipp zeigt, wie man ein StdPicture-Objekt mit Farbverlauf von rechts nach links bzw. von oben nach unten per VB-Code erstellt.

Autor:   LonelySuicide666Bewertung:     [ Jetzt bewerten ]Views:  12.080 
www.vbapihelpline.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    Unser heutiger Tipp zeigt, wie man ein StdPicture-Objekt mit integriertem Farbverlauf erstellt. Der Farbverlauf kann hierbei entweder von rechts nach links oder von oben nach unten angezeigt werden. Dieses Picture-Objekt kann dann einer Form, einer PictureBox oder auch einem Image-Control! zugewiesen werden.

    Fügen Sie nachfolgenden Code in ein Modul ein:

    Option Explicit
     
    ' Benötigte API-Deklarationen
    Private Declare Function GetDC Lib "user32" ( _
      ByVal hwnd As Long) As Long
     
    Private Declare Function ReleaseDC Lib "user32" ( _
      ByVal hwnd As Long, _
      ByVal hDC As Long) As Long
     
    Private Declare Function DeleteDC Lib "gdi32" ( _
      ByVal hDC As Long) As Long
     
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
     
    Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
      ByVal hDC As Long) As Long
     
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
      ByVal hDC As Long, _
      ByVal nWidth As Long, _
      ByVal nHeight As Long) As Long
     
    Private Declare Function SelectObject Lib "gdi32" ( _
      ByVal hDC As Long, _
      ByVal hObject As Long) As Long
     
    Private Declare Function SetDIBits Lib "gdi32" ( _
      ByVal hDC As Long, _
      ByVal hBmp As Long, _
      ByVal nStartScan As Long, _
      ByVal cScanLines As Long, _
      lpvBits As Any, _
      lpbm As BITMAPINFO, _
      ByVal fuColorUse As Long) As Long
     
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
      lpPictDesc As PictDesc, _
      riid As Any, _
      ByVal fOwn As Long, _
      lplpvObj As IPicture) As Long
     
    Private Declare Function DeleteObject Lib "gdi32" ( _
      ByVal hObject As Long) As Long
     
    Private Declare Sub CopyMemory Lib "kernel32" _
      Alias "RtlMoveMemory" ( _
      pDest As Any, _
      pSrc As Any, _
      ByVal ByteLen As Long)
     
    Private Type PictDesc
      cbSizeofStruct As Long
      picType As Long
      hImage As Long
      xExt As Long
      yExt As Long
    End Type
     
    Private Type BITMAPINFOHEADER
      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
    ' Berechnet die Schrittweite für die
    ' Farbtransformationen
    Private Function CalcStepping( _
      ByVal ColorStart As Long, _
      ByVal ColorEnd As Long, _
      ByVal Steps As Long) As Double
     
      If ColorStart > ColorEnd Then
        CalcStepping = ColorStart - ColorEnd
        If CalcStepping <> 0 Then
          CalcStepping = -(CalcStepping / Steps)
        End If
      Else
        CalcStepping = ColorEnd - ColorStart
        If CalcStepping <> 0 Then
          CalcStepping = CalcStepping / Steps
        End If
      End If
    End Function
    ' Erstellt ein StdPicture mit Farbverlauf
    Public Function CreateGradientBitmap( _
      ByVal Width As Long, _
      ByVal Height As Long, _
      ByVal ColorStart As Long, _
      ByVal ColorEnd As Long, _
      ByVal LeftToRight As Boolean) As StdPicture
     
      Dim hDC As Long
      Dim TmpDC As Long
      Dim hBmp As Long
      Dim hBmpOld As Long
      Dim hDib As Long, BMI As BITMAPINFO
      Dim bmBits() As RGBQUAD
      Dim ColorS(3) As Byte
      Dim ColorE(3) As Byte
      Dim i As Long
      Dim j As Long
      Dim TmpLng As Long
      Dim IID_IPicture(3) As Long
      Dim TmpPicture As IPicture
      Dim PD As PictDesc
      Dim ColorSteps1 As Double
      Dim ColorSteps2 As Double
      Dim ColorSteps3 As Double
      Dim TmpColor1 As Double
      Dim TmpColor2 As Double
      Dim TmpColor3 As Double
     
      ' Bitmap-Device erstellen
      hDC = GetDC(GetDesktopWindow)
      TmpDC = CreateCompatibleDC(hDC)
      hBmp = CreateCompatibleBitmap(hDC, Width, Height)
      hBmpOld = SelectObject(TmpDC, hBmp)
     
      ' Initialfarben berechnen
      CopyMemory ColorS(0), ColorStart, 4
      CopyMemory ColorE(0), ColorEnd, 4
      ColorSteps1 = CalcStepping(ColorS(0), ColorE(0), Width)
      ColorSteps2 = CalcStepping(ColorS(1), ColorE(1), Width)
      ColorSteps3 = CalcStepping(ColorS(2), ColorE(2), Width)
      TmpColor1 = ColorS(0)
      TmpColor2 = ColorS(1)
      TmpColor3 = ColorS(2)
     
      ' Array erstellen und Farbwerte zuweisen
      If Not LeftToRight Then
        ReDim bmBits(Height - 1, Width - 1)
        For i = 0 To Width - 1
          TmpColor1 = TmpColor1 + ColorSteps1
          TmpColor2 = TmpColor2 + ColorSteps2
          TmpColor3 = TmpColor3 + ColorSteps3
     
          For j = 0 To Height - 1
            bmBits(j, i).rgbRed = TmpColor1
            bmBits(j, i).rgbGreen = TmpColor2
            bmBits(j, i).rgbBlue = TmpColor3
          Next j
        Next i
      Else
        ReDim bmBits(Width - 1, Height - 1)
        For i = 0 To Width - 1
          TmpColor1 = TmpColor1 + ColorSteps1
          TmpColor2 = TmpColor2 + ColorSteps2
          TmpColor3 = TmpColor3 + ColorSteps3
     
          For j = 0 To Height - 1
            bmBits(i, j).rgbRed = TmpColor1
            bmBits(i, j).rgbGreen = TmpColor2
            bmBits(i, j).rgbBlue = TmpColor3
          Next j
        Next i
      End If
     
      ' Farb-Array dem Bitmap zuweisen
      With BMI.bmiHeader
        .biSize = Len(BMI.bmiHeader)
        .biWidth = Width
        .biHeight = Height
        .biPlanes = 1
        .biBitCount = 32
        .biSizeImage = Width * Height * 4
      End With
      SetDIBits TmpDC, hBmp, 0, Height, bmBits(0, 0), BMI, 0
     
      ' Speicher aufräumen
      Call DeleteObject(hDib)
      Call SelectObject(TmpDC, hBmpOld)
      DeleteDC TmpDC
      ReleaseDC GetDesktopWindow, hDC
     
      ' StdPicture aus dem GDI Bitmap erstellen
      IID_IPicture(0) = &H7BF80980
      IID_IPicture(1) = &H101ABF32
      IID_IPicture(2) = &HAA00BB8B
      IID_IPicture(3) = &HAB0C3000
     
      With PD
        .cbSizeofStruct = Len(PD)
        .hImage = hBmp
        .picType = 1
      End With
      If OleCreatePictureIndirect(PD, IID_IPicture(0), _
        Abs(True), TmpPicture) = 0 Then
     
        Set CreateGradientBitmap = TmpPicture
      End If
    End Function

    Ein paar Anwendungsbeispiele:

    ' PictureBox mit Farbverlauf blau/weiß 
    ' von oben nach unten
    With Picture1
      Set .Picture = CreateGradientBitmap( _
        .Width / Screen.TwipsPerPixelX, _
        .Height / Screen.TwipsPerPixelY, _
        vbBlue, vbWhite, False)
    End With
    ' Image-Control mit Farbverlauf rot/weiß 
    ' von links nach rechts
    With Image1
      Set .Picture = CreateGradientBitmap( _
        .Width / Screen.TwipsPerPixelX, _
        .Height / Screen.TwipsPerPixelY, _
        vbRed, vbWhite, True)
    End With

    Dieser Tipp wurde bereits 12.080 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
    (einschl. Beispielprojekt!)

    Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
    - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
    - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
    Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel