» »

[VB] prebiranje barve pixla iz .tga slike

[VB] prebiranje barve pixla iz .tga slike

kivi113 ::

živjo

situacija je naslednja. z visual basic programom bi rad odprl sliko v .tga formatu in iz nje prebral vrednosti RGB iz .tga formata slik iz določenih pixlov na tga sliki. zadeva verjetno ni precej komplicirana, nekako pa nimam idej, kje in kako začeti. z VB nimam ravno veliko izkušenj, vendar dovolj, da bi lahko spacal tako zadevico, če bi le zvedel kak začeti :\

hvala za pomoč :)

Thomas ::

Maš po kakšnih 48 (ali 44?) byteih headerja RGB ali BGR byte. Po 3. Lahhko pa tudi po 4, tedaj je RGBA. Ali pa BGRA ali nekaj takega. Poeksperimentiraj malko. A pomeni Alfa kanal. Tam ni barva, ampak prozornost.

EDIT: RGB->BGR.
Man muss immer generalisieren - Carl Jacobi

Zgodovina sprememb…

  • spremenil: Thomas ()

darkolord ::

Hoj, tale modul prebere TGA fajl in zloopa skozi vse piksle, ostane ti samo da pogruntaš, kje se začne slika (mislim da spodaj levo - nisem siguren). Headerja pa je 16 bajtov ;)

Option Explicit

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80

Private Type rgbalpha
    Red As Byte
    alpha As Byte
    blue As Byte
    green As Byte
End Type

Private Type TGA
    idlength As Byte
    colourmaptype As Byte
    datatypecode As Byte
    colourmaporigin As Integer
    colourmaplength As Integer
    colourmapdepth As Byte
    x_origin As Byte
    y_origin As Byte
    Width As Integer
    Height As Integer
    bitsperpixel As Byte
    imagedescriptor As Byte
    
End Type

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Dim TGAHeader As TGA
Dim bmapbytes() As rgbalpha


Public Function LoadTGAFile(filename As String) As Long
    Dim filehandle As Long
    Dim outputfilehandle As Long
    Dim successvar As Long
    Dim bytesread As Long

    filehandle = CreateFile(filename, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    successvar = ReadFile(filehandle, TGAHeader, Len(TGAHeader), bytesread, ByVal 0&)

    If TGAHeader.datatypecode <> 2 Then
        successvar = CloseHandle(filehandle)
        LoadTGAFile = 0
        Exit Function
    Else
        Dim temprgb As rgbalpha
        ReDim bmapbytes(CLng(TGAHeader.Height) * CLng(TGAHeader.Width)) As rgbalpha
        successvar = ReadFile(filehandle, bmapbytes(0), UBound(bmapbytes) * 4, bytesread, ByVal 0&)
        Dim tempDC As Long
        Dim i As Long
        If bytesread / 4 = UBound(bmapbytes) Then
            For i = 0 To UBound(bmapbytes)

                    With temprgb
                        .Red = bmapbytes(i).Red
                        .green = bmapbytes(i).green
                        .blue = bmapbytes(i).blue
                        .alpha = bmapbytes(i).alpha
                    End With
                    With bmapbytes(i)
                        .Red = (CLng(temprgb.blue) * CLng(temprgb.alpha)) \ 255   ' blue
                        .green = temprgb.alpha    ' alpha
                        .blue = (CLng(temprgb.Red) * CLng(temprgb.alpha)) \ 255    ' red
                        .alpha = (CLng(temprgb.green) * CLng(temprgb.alpha)) \ 255  ' green
                    End With
            Next i
        Else
            LoadTGAFile = 0
        End If
        successvar = CloseHandle(filehandle)
        successvar = CloseHandle(outputfilehandle)
    End If

End Function

kivi113 ::

hvala darkolord

modul ima sicer nekaj banalnih napak

(.Red = (CLng(temprgb.blue) * CLng(temprgb.alpha)) \ 255 ' blue

.green = temprgb.alpha ' alpha

.blue = (CLng(temprgb.Red) * CLng(temprgb.alpha)) \ 255 ' red

.alpha = (CLng(temprgb.green) * CLng(temprgb.alpha)) \ 255 ' green)


kjer so zamešane barve, ampak po korekciji zadeva deluje tako kot sem hotel.

najlepša hvala :)

darkolord ::

Res je, nekaj sem bajte menjaval, pa sem očitno pozabil nazaj popravit... no, važno da ti dela :D


Vredno ogleda ...

TemaSporočilaOglediZadnje sporočilo
TemaSporočilaOglediZadnje sporočilo
»

[C#] Prosim pomagajte! Potrebujem program, ki bi pobiral podatke iz ene strani

Oddelek: Programiranje
212699 (2309) David1994
»

Vb6

Oddelek: Programiranje
101311 (1174) StratOS
»

API+VB

Oddelek: Programiranje
262067 (1771) webblod
»

Odpiranje dat.exe v VB

Oddelek: Programiranje
122957 (2750) webblod
»

Visual basic Progress bar

Oddelek: Programiranje
51546 (1479) Lunik

Več podobnih tem