Visual Basic Forum

PokemonProgrammierer · Newbie Anmeldedatum: 23.07.2010 Beiträge: 14

Hallo,
ich habe einen Ordner idem die Vb datei drinne ist. In dem Unterordner ist auch der Ordner "Pokegranitpics". So da woauch die vb datei ist befidet sich welt.txt
In der welt.txt sind x ,y posistionen von Bilder eingetragen. Bei den bilder handelt es sich um sprites aus denen das weiß raus gemacht werden soll und gegen hintergrund (grün) ersetz werden soll. Hir mein bisheriger Code:
Form1:

Private Declare Function BitBlt Lib "gdi32.dll" ( _
ByVal hdcDest As Long, _
ByVal nXDest As Long, _
ByVal nYDest As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hdcSrc As Long, _
ByVal nXSrc As Long, _
ByVal nYSrc As Long, _
ByVal dwRop As Long) As Long

Private Const BLACKNESS = &H42
Private Const DSTINVERT = &H550009
Private Const MERGECOPY = &HC000CA
Private Const MERGEPAINT = &HBB0226
Private Const NOTSRCCOPY = &H330008
Private Const NOTSRCERASE = &H1100A6
Private Const PATCOPY = &HF00021
Private Const PATINVERT = &H5A0049
Private Const PATPAINT = &HFB0A09
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCERASE = &H440328
Private Const SRCINVERT = &H660046
Private Const SRCPAINT = &HEE0086
Private Const WHITENESS = &HFF0062

' Nur zum Testen, wird dann nicht mehr benötigt
' Kopiert den Inhalt eines Bildfeldes in ein anderes,
' wobei die Farben invertiert werden
Private Sub Command1_Click()
Dim Retval As Long

xp = 500
yp = 500
With Pic
'.Width = Bild1.Width
'.Height = Bild1.Height
Retval = BitBlt(.hDC, xp, yp, .Width, .Height, Bild1.hDC, 0, 0, SRCCOPY)
'.Width = 7000
'.Height = 7000

End With

If Retval = 0 Then
MsgBox "Ein Fehler ist aufgetreten.", vbCritical, "Fehler"
End If
End Sub

Private Sub Command2_Click()
Call ladewelt

End Sub

Private Sub Command3_Click()
Unload Me

End Sub

Private Sub Form_Load()
Me.Move 0, 0, Screen.Width - 500, Screen.Height - 1000
Pic.Height = Me.Height - 500
Pic.Width = Me.Width - 500

Timer1.Interval = 500
Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False

Call ladewelt

End Sub

Modul:

Declare Function BitBlt Lib "gdi32.dll" (ByVal _
hdcDest As Long, ByVal _
nXDest As Long, ByVal _
nYDest As Long, ByVal _
nWidth As Long, ByVal _
nHeight As Long, ByVal _
hdcSrc As Long, ByVal _
nXSrc As Long, ByVal _
nYSrc As Long, ByVal _
dwRop As Long) As Long

Global Const BLACKNESS = &H42
Global Const DSTINVERT = &H550009
Global Const MERGECOPY = &HC000CA
Global Const MERGEPAINT = &HBB0226
Global Const NOTSRCCOPY = &H330008
Global Const NOTSRCERASE = &H1100A6
Global Const PATCOPY = &HF00021
Global Const PATINVERT = &H5A0049
Global Const PATPAINT = &HFB0A09
Global Const SRCCOPY = &HCC0020
Global Const SRCAND = &H8800C6
Global Const SRCERASE = &H440328
Global Const SRCINVERT = &H660046
Global Const SRCPAINT = &HEE0086
Global Const WHITENESS = &HFF0062

Sub ladewelt()
'Welt laden und anzeigen
Open App.Path + "\Welt.txt" For Input As #1
While Not EOF(1)
Line Input #1, a$
If Trim$(a$) = "" Then GoTo finish
pos% = InStr(a$, ";")
FileName$ = Left(a$, pos% - 1)
a$ = Mid$(a$, pos% + 1)
'_
pos% = InStr(a$, ";")
Was$ = Left(a$, pos% - 1)
a$ = Mid$(a$, pos% + 1)
'_
Mehr:

pos% = InStr(a$, ";")
x$ = Left(a$, pos% - 1)
a$ = Mid$(a$, pos% + 1)
'_
pos% = InStr(a$, ";")
If pos% <> 0 Then
y$ = Left(a$, pos% - 1)
a$ = Mid$(a$, pos% + 1)
Else
y$ = a$
a$ = ""
End If
'y$ = Str$(Form1.Pic.Height - Val(y$) - 13070): '+ 700
y$ = Str$(-Val(y$) + 600) '800
x$ = Str$(Val(x$) - 0) '0

'Debug.Print y$
Call setpic(App.Path + "\Pokegranitpics\" + FileName$, Was$, x$, y$)

If Trim$(a$) <> "" Then GoTo Mehr

Wend
finish:
Close #1
End Sub

Sub setpic(FN$, W$, S$, T$)
Form1.Bild1.Picture = LoadPicture(FN$)

Dim Retval As Long
With Form1.Pic
Retval = BitBlt(.hDC, Val(S$), Val(T$), .Width, .Height, Form1.Bild1.hDC, 0, 0, SRCCOPY)
End With

If Retval = 0 Then
MsgBox "Ein Fehler ist aufgetreten.", vbCritical, "Fehler"
End If

End Sub
_________________
Nein danke, ich kaufe nichts!

christopher.g · Überflieger Anmeldedatum: 03.05.2008 Beiträge: 536

und was ist jetzt deine frage?
_________________

PokemonProgrammierer · Newbie Anmeldedatum: 23.07.2010 Beiträge: 14

Wie kann ich das weiß aus meinen sprites rausfiltern Question

_________________
Nein danke, ich kaufe nichts!

christopher.g · Überflieger Anmeldedatum: 03.05.2008 Beiträge: 536

vb-fun.de hat da fertige source codes

link1
link2
vl kannst damit was anfangen

lg

was vl noch einfacher wäre

probiere nicht bmp
sondern gif
_________________