Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Grafik und Fonts

Colorcount (Farben zählen)

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.MitgliedEternal_Pain 23.08.2011

Kann manchmal ganz nützlich sein heraus zu finden wieviele unterschiedliche Farben ein Image besitzt

So habe ich hier zwei Beispiele geschrieben.
ColorCount ist universal für alle Grafikscreens einsetzbar
ColorCount24 für Screens bzw Images ab 24bpp, um einiges schneller
dank Inline ASM

ColorCount:

Function ColorCount (byval Image as any ptr) as UInteger
    If Image=0 Then Return 0

    Dim BufferVersion as UInteger=*cast(UInteger ptr,Image)

    If BufferVersion<>7 Then Return 0

    Dim BufferBPP     as UInteger=*cast(UInteger ptr,Image+4)
    Dim BufferSizeX   as UInteger=*cast(UInteger ptr,Image+8)
    Dim BufferSizeY   as UInteger=*cast(UInteger ptr,Image+12)

    Dim BufferPitch   as UInteger=*cast(UInteger ptr,Image+16)

    Dim ColorBitList as UByte ptr=Callocate(2097152)

    Dim CBLByte as UInteger
    Dim CBLBit  as UByte

    Dim IndexColor as UInteger
    Dim CountColor as UInteger

    Dim PAdr       as any ptr
    Dim PAdd       as Integer
    PAdr = Image+32

    For Y as UInteger=0 to BufferSizeY-1
        PAdd=0
    For X as UInteger=0 to BufferSizeX-1

        Select Case as Const BufferBPP
            Case 1
                IndexColor=*cast(Ubyte ptr,PAdr+PAdd)
            Case 2
                IndexColor=*cast(UShort ptr,PAdr+PAdd)
            Case Else
                IndexColor=(*cast(UInteger ptr,PAdr+PAdd) and &hFFFFFF)
        End Select

        CBLByte = Fix(IndexColor/8)
        CBLBit  = (IndexColor mod 8)

        If Bit(ColorBitList[CBLByte],CBLBit)=0 Then
            CountColor+=1
            ColorBitList[CBLByte]+=(1 SHL CBLBit)
        End If

        PAdd+=BufferBPP
    Next X
        PAdr+=BufferPitch
    Next Y

    Deallocate (ColorBitList)
    Return CountColor
End Function

ColorCount24:

Function ColorCount24 (byval Image as any ptr) as UInteger
    If Image=0 Then Return 0

    Dim BufferVersion as UInteger=cast(UInteger ptr,Image)[0]
    Dim BufferBPP     as UInteger=cast(UInteger ptr,Image)[1]

    If BufferBPP<4 orelse BufferVersion<>7 Then Return 0

    Dim BufferSizeX   as UInteger=cast(UInteger ptr,Image)[2]
    Dim BufferSizeY   as UInteger=cast(UInteger ptr,Image)[3]
    Dim BufferPitch   as UInteger=cast(UInteger ptr,Image)[4]

    Dim ColorBitList  as UByte ptr=Callocate(2097152)
    Dim CBLByte       as UInteger
    Dim CBLBit        as UByte
    Dim IndexColor    as UInteger
    Dim CountColor    as UInteger
    Dim PAdrBase      as any ptr
    Dim PAdd          as integer
    PAdrBase = Image+32

    For Y as UInteger=0 to BufferSizeY-1
        PAdd=0
    For X as UInteger=0 to BufferSizeX-1

        IndexColor=(cast(uinteger ptr,PAdrBase+PAdd)[0] and &hFFFFFF)

        ASM
            mov eax, [IndexColor]
            mov ebx, &h08
            mov edx, &h0
            div ebx
            mov [CBLByte],eax
            mov [CBLBit],edx
        End ASM

        If Bit(ColorBitList[CBLByte],CBLBit)=0 Then
            CountColor+=1
            ColorBitList[CBLByte]+=(1 SHL CBLBit)
        End If

        PAdd+=4
    Next X
        PAdrBase+=BufferPitch
    Next Y

    Deallocate (ColorBitList)
    Return CountColor
End Function

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 26.02.2010 von MitgliedEternal_Pain angelegt.
  • Die aktuellste Version wurde am 23.08.2011 von MitgliedEternal_Pain gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen