Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0427: Farbwert in RGB schneller auflösen II

VB 5/6-Tipp 0427: Farbwert in RGB schneller auflösen II

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory)

Download: Download des Beispielprojektes [2,45 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Optionsfeld-Steuerelement "Option2" auf Picture1
' Steuerelement: Optionsfeld-Steuerelement "Option1" auf Picture1
' Steuerelement: Beschriftungsfeld "Label1"


'Dank an Stefan Maag für die Idee mit der CopyMemory

Private Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal _
        ByteLen As Long)

Private Sub Form_Load()
    Dim z As Integer
    Dim Col As Long, x1 As Long, y1 As Long
    
    With Form1
        .AutoRedraw = True
        .BackColor = &HFFFFFF
        Randomize
        
        For z = 1 To 200
            Col = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
            x1 = .Width * Rnd - 300
            y1 = .Height * Rnd - 300
            Form1.Line (x1, y1)-Step(600, 600), Col, BF
        Next z
        
        .Refresh
        .AutoRedraw = False
    End With
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift _
                           As Integer, X As Single, Y As Single)
    
    Dim Col As Long
    Dim r As Byte, g As Byte, b As Byte
    Dim cRGB(0 To 3) As Byte
    
    Col = Form1.Point(X, Y)
    Me.Caption = Col
    
    If Option1.Value Then
        Call RGBsplit1(Col, r, g, b)
        Me.Caption = "R-" & r & "   G-" & g & "   B-" & b
        Label1.BackColor = RGB(r, g, b)
    Else
        Call RGBsplit2(Col, cRGB)
        Me.Caption = "R-" & cRGB(0) & "   G-" & cRGB(1) & "   B-" & cRGB(2)
        Label1.BackColor = RGB(cRGB(0), cRGB(1), cRGB(2))
    End If
End Sub

'Die herkömmliche Methode
Private Sub RGBsplit1(Col, r As Byte, g As Byte, b As Byte)
    b = (Col And 16711680) / 65536
    g = (Col And 65280) / 256
    r = Col And 255
End Sub

'Die als Exe um 10x schnellere Routine mittells CopyMemory
Private Sub RGBsplit2(Col As Long, cRGB() As Byte)
    Call CopyMemory(cRGB(0), Col, 4)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.