; FBA.ASM - 32-Bit-Assembler-Code für FBA-Programm
; (c) Daniel Lichtenberger
.model tpascal
shift=15 ; Für die Fixkommaarithmetik, muß gleich groß wie in BILDMANI.PAS sein!!!
.data
.code
.386 ; nur für 386er!
public pascal GetPixel8 ; function GetPixel8(PixelOffset: longint; var DIBData):byte
; Liest ein Byte des DIBs DIBData an der Position PixelOffset
GetPixel8 proc pascal near PixelOffset:dword,DIBData:dword
uses esi,ds
lds si,DIBData ; 32-Bit-Adresse laden, für lineare Adressierung
add esi,PixelOffset
mov al,byte ptr [esi] ; Speicherinhalt dieser Adresse in al laden
ret ; An den Aufrufer zurückgeben
GetPixel8 endp
public pascal SetPixel8 ; procedure SetPixel8(PixelOffset: longint; var DIBData; color: byte)
; Schreibt ein Byte (color) an der Position PixelOffset
SetPixel8 proc pascal near PixelOffset:dword,DIBData:dword,color:byte
uses es,edi
les di,DIBData ; 32-Bit-Adresse laden, für lineare Adressierung
add edi,PixelOffset
mov al,color
mov byte ptr es:[edi],al ; Farbe schreiben
ret ; An den Aufrufer zurückgeben
SetPixel8 endp
public pascal GetPixel24 ; procedure GetPixel24(PixelOffset: longint; var DIBData; var RGBQuad: TRGBQuad)
; lädt drei Byte an der Position Pixeloffset in RGBQuad
GetPixel24 proc pascal near PixelOffset:dword,DIBData:dword,RGBQuad:dword
uses esi,ds,es,edi
lds si,DIBData
add esi,PixelOffset
les di,RGBQuad
db 67h ; Prefix 67h -> die 32-Bit-Register werden verwendet (ds:esi,es:edi,ecx)
movsw
db 67h
movsb
ret
GetPixel24 endp
public pascal SetPixel24 ; procedure SetPixel24(PixelOffset: longint; var DIBData; var RGBQuad: TRGBQuad)
; schreibt drei Bytes aus RGBQuad an der Position PixelOffset
SetPixel24 proc pascal near PixelOffset:dword,DIBData:dword,RGBQuad:dword
uses esi,ds,es,edi
les di,DIBData
add edi,PixelOffset
lds si,RGBQuad
db 67h
movsw
db 67h
movsb
ret
SetPixel24 endp
public pascal GetPixel16 ; function GetPixel16(PixelOffset:longint; var DIBData):word
; liest ein Word an der Position PixelOffset
GetPixel16 proc pascal near PixelOffset:dword,DIBData:dword
uses ds,esi
lds si,DIBData
add esi,PixelOffset
mov ax,word ptr ds:[esi]
ret
GetPixel16 endp
public pascal SetPixel16 ; procedure SetPixel16(PixelOffset:longint; var DIBData; Val: word)
; schreibt ein Word (Val) an der Position PixelOffset
SetPixel16 proc pascal near PixelOffset:dword,DIBData:dword,Val:word
uses es,edi
les di,DIBData
add edi,PixelOffset
mov ax,Val
mov word ptr es:[edi],ax
ret
SetPixel16 endp
public pascal KonvPix16_24 ; procedure KonvPix16_24(Pix16: word; var RGB);
; Wandelt eine 16-Bit-Farbe (Pix16, mit Attributbit) in eine 24-Bit-Farbe um (RGB)
KonvPix16_24 proc pascal near Pixel16:word,RGBQuad:dword
uses es,di
les di,RGBQuad
xor bx,bx
mov ax,Pixel16
and ax,32767 ; Attributbit eliminieren
mov cl,al ; rgbBlue := (Lo(Pix16) and 31) shl 3
and cl,31
shl cl,3 ; in 8-Bit-Wert umwandeln
mov byte ptr es:[di],cl ; Blauwert speichern
mov cl,ah ; rgbGreen := ((Hi(Pix16) and 3)*8 + Lo(Pix16) and 224 shr 5) shl 3
and cl,3
shl cl,3
mov dl,al
and dl,224
shr dl,5
add cl,dl
shl cl,3
mov byte ptr es:[di+1],cl
mov cl,ah ; rgbRed := ((Hi(Pix16) and 124) shr 2) shl 3
and cl,124
shr cl,2
shl cl,3
mov byte ptr es:[di+2],cl
ret
KonvPix16_24 endp
public pascal CopyRGBQuad ; procedure CopyRGBQuad(var RGBSource,RGBDest);
; kopiert vier Bytes von RGBSource nach RGBDest (beide TRGBQuad)
CopyRGBQuad proc pascal near RGBSource:dword,RGBDest:dword
uses esi,ds,es,edi
les di,RGBDest
lds si,RGBSource
movsd
ret
CopyRGBQuad endp
public pascal ColorExists ; function ColorExists(var RGB; var Pal; PalLen: integer):integer;
; überprüft, ob die Farbe RGB (TRGBQuad) in der Palette Pal mit der Länge
; PalLen (in Einträgen) bereits existiert. Gibt -1 zurück, wenn sie nicht existiert,
; und die Nummer des Eintrags, falls sie existiert
ColorExists proc pascal near RGB:dword,Pal:dword,PalLen:word
uses es,di,ds,si
lds si,RGB
lodsd
mov cx,PalLen
les di,Pal
repne scasd
jne NichtGefunden
Gefunden:
inc cx ; gefunden, Nummer des Eintrags bestimmen
mov ax,PalLen
sub ax,cx
ret
NichtGefunden:
mov ax,-1
ret
ColorExists endp
public pascal Konv8bppTo24bpp ; procedure Konv8bppTo24bpp(OldDIB:pointer; OldSize: longint;
; NewDIB,Pal: pointer)
; Konvertiert ein 8bpp-Bild in ein 24bpp-Bild
; Der Speicherplatz für NewDIB muß bereits reserviert und
; dreimal so groß wie für OldDIB sein. Pal muß auf ein Array
; von TRGBQuads zeigen. OldSize ist die Größe in Bytes von OldDIB.
Konv8bppTo24bpp proc pascal near OldDIB:dword,OldSize:dword,NewDIB:dword,Pal:dword
uses esi,ds,edi,es
les di,NewDIB
lds si,OldDIB
mov ecx,OldSize
Konv8bppTo24bppLoop:
xor eax,eax
db 67h
lodsb ; 8-Bit-Pixel laden
push ds
push esi
shl ax,2 ; Dank Windows-TRGBQuad-Format ist der Offset der Farbinformationen
lds si,Pal ; des geladenen Pixels in der Palette durch ein 2faches links-verschieben
add si,ax ; berechenbar
lodsw ; die drei Bytes aus der Palette übertragen
db 67h
stosw
lodsb
db 67h
stosb
pop esi
pop ds
dec ecx
jnz Konv8bppTo24bppLoop
ret
Konv8bppTo24bpp endp
public pascal ReplacePixel24bpp ; procedure ReplacePixel24bpp(var DIB24; DIB24Pixels: longint;
; var DIB8; var VolHist);
; ersetzt alle Pixel von DIB24 durch die Palettenindizes, die in VolHist,
; einem Volumenhistogramm, gespeichert sind: in VolHist ist zu jeder Farbe
; der nächstbeste Paletteneintrag gespeichert
ReplacePixel24bpp proc pascal near DIB24:dword,DIB24Pixels: dword,DIB8:dword,VolHist:dword
uses esi,ds,edi,es
les di,DIB8
lds si,DIB24
mov ecx,DIB24Pixels
ReplacePixel24bppLoop:
xor ax,ax
db 67h
lodsw
push ax
xor bx,bx
db 67h
lodsb ; 24bpp-Pixel laden: die ersten beiden Farbanteile kommen auf den Stack, der letzte
mov bl,al ; (also der Rotanteil) wird in bx gespeichert
shr bx,3 ; Position des Pixels im Volumenhistogramm berechnen
shl bx,10
pop ax
mov dl,al
mov al,ah
xor ah,ah
shr ax,3
shl ax,5
add bx,ax
xor ah,ah
mov al,dl
shr ax,3
add bx,ax
push si
push ds
lds si,VolHist
mov al,byte ptr [si+bx] ; Passenden Paletteneintrag aus dem Volumenhistogramm lesen
pop ds
pop si
db 67h
stosb
dec ecx
jnz ReplacePixel24bppLoop
ret
ReplacePixel24bpp endp
public pascal Helligkeit24bpp ; procedure Helligkeit24bpp(var DIB24; DIBSize: longint; NeuerWert: integer);
; verändert die Helligkeit jedes Pixels von DIB24: jede Farbkomponente wird mit
; NeuerWert multipliziert und dann durch 128 dividiert -> 128 = neutrales Element,
; wenn NeuerWert < 128: dünkler, NeuerWert > 128: heller
Helligkeit24bpp proc pascal near DIB24: dword,DIBSize: dword,NeuerWert: word
uses esi,ds
xor ax,ax
lds si,DIB24
mov ecx,DIBSize
mov bx,NeuerWert
Helligkeit24bppLoop:
db 67h
lodsb
mul bx
shr ax,7
cmp ah,0 ; ist ax größer als 255, ist also ah <> 0?
jz Weiter1
mov al,255 ; Intensität der Farbkomponente aufs Maximum setzen (also 255), damit bei Weiß
; wirklich Schluß ist
xor ah,ah ; Notwendig für den nächsten Schleifendurchlauf, damit die Multiplikation keine
; ungültigen Werte liefert
Weiter1:
dec ecx
mov byte ptr [esi-1],al
jnz Helligkeit24bppLoop
ret
Helligkeit24bpp endp
public pascal Move32 ; procedure Move32(var Source;SrcOfs:longint;var Dest;DestOfs:longint; Size:longint);
; wie Pascal-Befehl Move, arbeitet aber auch mit linearem Speicher und kennt keine
; Segmentgrenzen
Move32 proc pascal near src:dword,ofs1:dword,dest:dword,ofs2:dword,len:dword
uses ds,esi,es,edi,ecx
mov ecx,len
les di,dest
add edi,ofs2
lds si,src
add esi,ofs1
db 67h
rep movsb
ret
Move32 endp
public pascal UnpackTargaRLE24 ; procedure UnpackTargaRLE24(var Source;SrcSize:longint;var Dest);
; entpackt ein TGA-24bpp-RLE-Bild (Source, SrcSize) nach Dest (Zeiger auf ein DIB
; mit 24bpp, es muß bereits genügend Speicherplatz bereitstehen)
UnpackTargaRLE24 proc pascal near src:dword,srcSize:dword,dest:dword
uses ds,esi,es,edi
les di,dest
lds si,src
mov ebx,srcSize
UnpackTargaRLE24Loop:
xor eax,eax
xor ecx,ecx
db 67h
lodsb ; Byte aus src laden
test al,128 ; ist höchstwertiges Bit gesetzt?
jz NichtGepackt
and al,127 ; Bit gesetzt -> folgende Farbe muß wiederholt werden, das höchstwertige Bit muß aber
; gelöscht werden, um die korrekte Anzahl der Wiederholungen zu erhalten
mov cl,al
inc cl
mov dx,word ptr ds:[esi] ; zu wiederholendes 24bpp-Pixel ind dx und ch laden
mov ch,byte ptr ds:[esi+2]
FarbeSetzen24: ; Pixel cl mal schreiben
mov ax,dx
db 67h
stosw
mov al,ch
db 67h
stosb
dec cl
jnz FarbeSetzen24
add esi,3
sub ebx,4
jnz UnpackTargaRLE24Loop
jmp EndeRLE24
NichtGepackt: ; höchstwertiges Bit ist nicht gesetzt, es folgt ein "roher" Datenblock
inc al
mov cx,ax
shl cx,1 ; entspricht einer Multiplikation mit 3
add cx,ax
sub ebx,ecx
db 67h
rep movsb ; Der Aufwand, hier die zu übertragende Datenmenge in DWords und den Rest in Bytes zu
; übertragen, ist hier nicht gerechtfertigt, da höchstens 384 Bytes (128*3) übertragen
; werden und somit die notwendigen Berechnungen den (minimalen) Vorteil wieder großteils
; zunichte machen.
dec ebx
jnz UnpackTargaRLE24Loop
EndeRLE24:
ret
UnpackTargaRLE24 endp
public pascal StretchLine8bpp ; procedure StretchLine8bpp(var DIB8; var NewDIB8; SrcOffset,DstOffset: longint;
; NewW: integer; XRatio: longint);
; dehnt eine Zeile eines 8bpp-DIBs um den Faktor XRatio auf die neue Länge NewW
StretchLine8bpp proc pascal near DIB8:dword,NewDIB8:dword,SrcOffset:dword,DstOffset:dword,NewW:word,XRatio:dword
uses ds,esi,es,edi
les di,NewDIB8
lds si,DIB8
add edi,DstOffset
add esi,SrcOffset
mov cx,NewW
mov edx,XRatio
xor ebx,ebx
Stretch8Loop:
db 67h ; Pixel verschieben
movsb
add ebx,edx ; XRatio addieren (in edx)
mov eax,ebx ; Fixkommazahl auf ganzzahlige Adresse runden
shr eax,shift
add eax,SrcOffset
mov esi,eax ; neue Quelladresse zuweisen
dec cx
jnz Stretch8Loop
ret
StretchLine8bpp endp
public pascal StretchLine24bpp ; wie StretchLine8bpp, nur für ein 24bpp-DIB
StretchLine24bpp proc pascal near DIB24:dword,NewDIB24:dword,SrcOffset:dword,DstOffset:dword,NewW:word,XRatio:dword
uses ds,esi,es,edi
les di,NewDIB24
lds si,DIB24
add edi,DstOffset
add esi,SrcOffset
mov cx,NewW
mov edx,XRatio
xor ebx,ebx
Stretch24Loop:
db 67h
movsw
db 67h
movsb
add ebx,edx ; XRatio addieren (in edx)
push ebx
mov eax,ebx
shr eax,shift
imul eax,3 ; es wird mit 24-Bit-Bild gearbeitet! / eine Signed-Multiplikation ist zwar nicht
; notwendig, ansonsten müßte aber edx auch gesichert werden (wenn mit ebx multipliziert
; wird) - wenn nur mit bx multipliziert wird, ist das Ergebnis in dx:ax - was ebenfalls
; unbrauchbar ist
pop ebx
add eax,SrcOffset
mov esi,eax
dec cx
jnz Stretch24Loop
ret
StretchLine24bpp endp
end ; Ende des Codesegments und der Datei