Programmierseite - Interessante Themen
<< Zurück Alle Angaben ohne Gewähr. Benutzung auf eigenes Risiko. (C) Copyright Bernd Noetscher 1995 - 2000 eMail: webmaster@berndnoetscher.de |
||||||||||||||||||
Pascal This software may be used and distributed according to the terms of the GNU Public
License, . |
||||||||||||||||||
Ein paar kleine Programme - Sourcecode: AVI - Mini-Windowsprogramm, spielt AVI-Videos Demo - kleine Animation mit Sound Smile - kleines Labyrinthspiel, unvollständig SVGA - SVGA-Library S3 - S3-Library Soundblaster - Sound-Library U_97 - kleines UBootspiel, unvollständig U_97_Icon - der Iconeditor Ships - kleines Spiel, unvollständig 2. VGA/SVGA-Programmierung Bei der Grafikprogrammierung ist vor allem ein Gesichtspunkt sehr wichtig: die Geschwindigkeit. Alle Grafikoperationen sind sehr aufwendig und verlangen sehr viel Prozessorzeit, um die Schnelligkeit von vornherein durch so wenig Maschinenbefehle wie möglich zu erreichen, müssen die entsprechenden Programmteile deshalb in Assemblersprache implementiert werden. Die Grafikkarte Ihres PCs kennt verschiedene Bildschirmmodi, in denen die Anzahl der Pixel und Farben unterschiedlich sind. Der Standardbildschirmmodus mit einer Bildbreite von 320 Pixeln und einer Bildhöhe von 200 Pixeln (gekennzeichnet mit der Nr. 13H) war der erste mit 256 Farben. Hier entspricht jeder Pixel einem Byte im Arbeitsspeicher Ihres PCs. Dadurch ergeben sich auch die 256 Farben, denn 28 entspricht einem Byte, welches 256 verschiedene Zustände darstellen kann. Dieser Modus ist so einfach aufgebaut (jeder Pixel belegt ein Byte), daß die Programmierung enorm erleichtert wird. Zur Verständnis der späteren Programmteile ist es sehr wichtig, daß Sie den Aufbau der Bildspeicherdaten im RAM verstehen. Der Arbeitsspeicher ist in unterschiedliche Abschnitte, Segmente genannt, unterteilt. Das Segment A000H enthält die Bildspeicherdaten (diese entsprechen den Pixeln auf den Bildschirm). Man muß also nur noch die Bytes dort verändern und schon sieht man das Ergebnis auf dem Bildschirm. Das Koordinatensystem fängt links oben in der Ecke an. Dort ist der Punkt 0,0 (X,Y) angelegt. Eine bestimmte Adresse, Segmentanteil A000h und Offsetanteil 0, betrifft diesen Punkt. Wenn nun der Bytewert an dieser Position verändert wird, erscheint automatisch eine andere Farbe auf dem Bildschirm. Um nun jeden einzelnen Punkt zu erreichen, kann man die Adresse auch so formulieren: Segmentanteil ist A000h, Offsetanteil wird durch 320*Y+X berechnet. Möchten Sie z. B. dem Punkt ganz rechts unten in der Ecke eine andere Farbe geben, muß das Segmentregister mit A000h geladen und in das Offsetregister die Zahl 64000 (320*199+320) geschrieben werden. Anschließend muß der eigentliche Schreibbefehl programmiert werden und fertig ist die Farbänderung eines Punktes. Adreßbeispiele:
Das ist doch gar nicht so schwer werden Sie sagen, aber wie werden die Farben eigentlich genau festgelegt? Die Farbvergabe erfolgt durch eine Tabelle, dem Palettenregister. Dort werden 256 verschiedene Tabelleneinträge mit jeweils einem roten, grünen und blauen Farbanteil (RGB-Farben) gespeichert. Jeder Farbanteil ist ein Byte groß, was einen Wertebereich jeweils für Rot, Grün und Blau von 0 bis 255 ermöglicht. Die Bytewerte beziehen sich also auf die einzelnen Farbeinträge dieser Palette und ergeben erst zusammen die vielen bunten Farben auf dem Bildschirm. Enthält der 0. Farbeintrag (gezählt wird von 0 bis 255) einen Rotanteil von 255, einen Grünanteil von 0 und einen Blauanteil von 0, definiert dieser eine sehr helle rote Farbe. Schreiben Sie nun an der Position 0,0 den Bytewert 0, erscheint automatisch ein Pixel mit einer sehr hellen roten Farbe. Die einzelnen Bytes der Bildspeicherdaten verweisen also auf die Paletteneinträge, in denen die RGB-Farben definiert werden. Man kann natürlich die Farbregister mit beliebigen Rot-,Grün- und Blauwerten laden, so daß aus einem Farbtopf von 262.144 Farben (ergibt sich aus den RGB-Bytes=218 jeweils 26 für jeden Farbanteil), 256 Farben gleichzeitig dargestellt werden können. Gegenüber dem Vorgänger, der EGA-Karte war dies ein erheblicher Leistungssprung hinsichtlich der Programmierung und Darstellung von Grafiken. Auch deswegen verhalf die Einführung der VGA-Karte den PC-Spielen zu einem starken Höhenflug. Grafikmodus einschalten Nach Theorie kommen wir nun zur Praxis. Man muß natürlich zuerst den richtigen Grafikmodus einschalten. Erreichen kann man dies durch einen bestimmten BIOS-Aufruf. Das BIOS stellt eine unabhängige Hardware-Schnittstelle dar und wird deshalb der zweiten Möglichkeit, der direkten Hardware-Programmierung, fast immer vorgezogen. Folgender Programmteil schaltet den Grafikmodus 13H ein: MOV AH, 00H Legt die BIOS-Funktion "Bildschirmmodus einstellen" fest MOV AL, 13H Nr. des einzustellenden Grafikmodus INT 10H Einsatz des BIOS durch Ausführung des Interrupts 10H Pixel lesen/schreiben Nach der Ausführung der drei Programmzeilen sieht man erstmal gar nichts außer eine schwarzen Bildschirm, deshalb lassen wir einen Punkt an einer beliebiger Stelle auf dem Bildschirm erscheinen. Das erledigt eine kleine Prozedur: Procedure Putpixel ( x , y : Integer ; Pixelfarbe : Byte ); Assembler; asm mov ax,320 (* Bildbreite ist 320 Bytes *) imul y (* Register AX mit Y multiplizieren *) add ax,x (* X zu Register AX addieren *) mov es,segA000 (* Bildspeichersegment auswählen *) mov di,ax (* Ergebnis von AX als Offset angeben *) mov al,Pixelfarbe (* Pixelfarbe im Teilregister AL speichern *) stosb (* Pixel in den Arbeitsspeicher schreiben *) End; Beim Lesen eines Pixels sind nur ein paar Schritte mehr notwendig: Function GetPixel ( X , Y : Integer ) : Byte; assembler; asm push ds (* DS auf den Stack retten *) mov ax,320 (* Bildbreite ist 320 Bytes *) imul y (* Register AX mit Y multiplizieren *) add ax,x (* X zu Register AX addieren *) mov ds,segA000 (* Bildspeichersegment auswählen *) mov si,ax (* Ergebnis von AX als Offset angeben *) lodsb (* Pixel aus dem RAM laden *) pop ds (* geretteten Inhalt vom Stack in DS schreiben *) push ax (* Pixelfarbe als Ergebnisrückgabe retten *) end; Linie zeichnen Um eine Linie zu zeichnen muß man die logische Linie auf das Pixelraster legen. Dabei muß man sich ein rechtwinkeliges Dreieck vorstellen, welches zwei Seiten als Höhe und Breite besitzt, wobei die gegenüberliegende Seite die eigentlich zu zeichnende Linie ist. Mit Hilfe der Division in Bezug zu der Höhe und der Breite kann man nun Pixel für Pixel der Linie zeichnen. Procedure Line ( x1 , y1 , x2 , y2 : integer ; PixelFARBE : Byte ); var dx1 , dy1 , xa , ya : integer; n , maxn : word; begin asm mov ax,x2 (*dx1:=x2-x1; Breite berechnen *) sub ax,x1 mov dx1,ax mov ax,y2 (*dy1:=y2-y1; Höhe berechnen *) sub ax,y1 mov dy1,ax end; (* Breite oder Höhe größer? *) maxn:=abs(dx1); if maxn<abs(dy1) then maxn:=abs(dy1); if maxn=0 then inc(maxn); for n:=0 to maxn-1 do begin asm mov ax,dx1 (*xa:=x1+(dx1*n)div maxn;*) imul n idiv maxn add ax,x1 mov xa,ax mov ax,dy1 (*ya:=y1+(dy1*n)div maxn;*) imul n idiv maxn add ax,y1 mov ya,ax (* Folgendes verhindert zeichnen über die Ränder *) cmp xa,319 ja @verdeckt cmp xa,0 jb @verdeckt cmp ya,199 ja @verdeckt cmp ya,0 jb @verdeckt (* Offset berechnen *) mov ax,320 imul ya add ax,xa (*scroff:=ya*320+xa;*) mov es,sega000 (* Bilddatensegment auswählen *) mov di,ax (* richtigen Offset angeben *) mov al,pixelFARBE (* zu zeichnende Farbe festlegen *) stosb (* Pixel schreiben *) @verdeckt: end; end; end; Rechteck zeichnen Ähnlich funktioniert das Zeichnen eines gefüllten Rechteckes. Es wird aber nicht jeder Pixel vom Anfang bis zum Ende einer Zeile einzeln geschrieben, sondern jede Zeile komplett mit nur einem Befehl. Logischerweise erhöht sich dadurch die Ausführungsgeschwindigkeit beträchtlich. PROCEDURE Bar ( X , Y , Breite , Hoehe : Integer ; Pixelfarbe : Byte ); VAR Zeile : Integer; Laenge : Integer; BEGIN Laenge : = Breite DIV 2; (* Schreiblänge ist die Hälfte, da mit 16-bit gefüllt wird *) FOR Zeile : = Y TO Y + Hoehe DO (* von der ersten bis zur letzten Zeile wiederholen *) BEGIN ASM mov ax,320 imul Zeile add ax,x (* Offsetberechnung *) mov di,ax (* Offset laden*) mov al,Pixelfarbe (* Farbe in Unterregister AL laden *) mov ah,al (* Farbe auch ins andere 8-bit-Unterregister laden *) mov cx,laenge (* Länge der Schreibaktion festlegen *) mov es,SegA000 (* Bildspeichersegment auswählen *) rep stosw (* Zeile mit 16-bit-Schreibaktion füllen *) END; END; END; Bild/Grafik anzeigen Das Laden eines Bildes/Grafik ist Gegensatz zu dem Vorhergehendem viel komplexer. Zuerst muß das gewünschte Bild, welches sich in einer Bilddatei befindet in den Arbeitsspeicher geladen werden. Dann müssen die Informationen der Bilddatei (Größe, Breite, Höhe etc.) ausgewertet und die Farbpalette neu eingestellt werden. Danach werden nur noch die eigentlichen Bilddaten in das Segment A000H an die richtige Stelle kopiert und es erscheint das Bild. Hier wird zuerst einmal der Dateiheader einer Grafik-BMP-Datei definiert: type bmp_header_ = record signatur : word; flen : longint; dummy1 : word; dummy2 : word; offset : longint; info_size : longint; xmax : longint; ymax : longint; polanes : word; bits_per_pixel : word; compress : word; xsize : longint; hdpi : longint; vdpi : longint; cols : longint; coli : longint; end; var bmp_header : bmp_header_; (* Dateiheader *) pal_array : array[0..255,0..2]of byte; (* Palettenfarben mit Rot-, Grün- und Blauanteilen *) pal_res : array[0..255]of byte; (* muß mitgeführt werden *) helligkeit : integer; (* speichert die Helligkeit der Farben *) Nach dem Laden der Headerinformationen kann nun die neue Farbpalette eingestellt werden: procedure setpalette ( anzahl : integer ); var merker,i : integer; pl_array : array[0..255,0..2]of byte; begin merker : = helligkeit; helligkeit : = helligkeit*2; for i : = 0 to anzahl do begin pl_array[i,red] : = (pal_array[i,blue]*helligkeit div 255) shr 2; pl_array[i,green] : = (pal_array[i,green]*helligkeit div 255) shr 2; pl_array[i,blue] : = (pal_array[i,red]*helligkeit div 255) shr 2; end; port[$3C8] : = 0; for i : = 0 to anzahl do begin port[$3C9] : = pl_array[i,red]; port[$3C9] : = pl_array[i,green]; port[$3C9] : = pl_array[i,blue]; end; helligkeit : = merker; end; Folgender letzter Programmteil zeigt wie die Bilddatei geladen, die gezeigten Prozeduren genutzt und die Bilddaten kopiert werden. Function LoadBMPFile(x , y: Integer; Filename: String):Boolean; var Handle:file; Bildgroesse:longint; i,it:integer; ts2,to2,tsegmentBMP,toffsetBMP,tsegment,toffset:word; groesse2:word; breite,hoehe:integer; (* ermittelt den richtigen Pointer abhängig vom Offset *) function getptr(p:pointer;offset:longint):pointer; type long=record lo,hi:word; end; begin getptr:=ptr(long(p).hi+long(offset).hi*selectorinc,long(p).lo+long(offset).lo); end; (* lädt die eigentlichen Bilddaten in den Arbeitsspeicher *) Function loadfile:pointer; var buffer:pointer; size,offset,count:longint; begin buffer:=nil; size:=filesize(handle)-filepos(handle); buffer:=globalallocptr(gmem_moveable,size); if buffer<>nil then begin offset:=0; while offset<size do begin count:=size-offset; if count>32768 then count:=32768; blockread(handle,getptr(buffer,offset)^,count); inc(offset,count); end; end; close(handle); loadfile:=buffer; end; (* wird ganz am Schluß aufgerufen und zeigt die Grafik an *) procedure putVGAPixel(x1,y1,breite,hoehe:integer; tsegment,tsegmentBMP,toffsetBMP:word); const bildbreite=320; var c2,toffset:word; zaehler,y,x2:integer; begin (* Korrektur der Breite auf ein vielfaches von 4 *) if breite mod 4<>0 then breite:=breite+(4-(breite mod 4)); x2:=breite; (* nach dem rechten Rand abschneiden *) if 320-x1<=breite then x2:=320-x1; zaehler:=x2 div 4; for y:=y1 to y1+hoehe-1 do begin c2:=toffsetbmp+breite*(y-y1); toffset:=bildbreite*y+x1; asm push ds mov ds,tsegmentbmp (* Quelladresse-Segment *) mov si,c2 (* Quelladresse-Offset *) mov cx,zaehler mov es,tsegment (* Zieladresse-Segment *) mov di,toffset (* Zieladresse-Offset *) db 66h;rep movsw (* 32-bit-Kopieraktion *) pop ds end; end; end; (* Programm der Hauptfunktion, hier werden der Dateiheader ausgewertet und die Unterfunktionen aufgerufen *) begin assign(handle,filename); reset(handle,1); blockread(handle,bmp_header,54); if (lobyte(bmp_header.signatur)<>$42)Or(hibyte(bmp_header.signatur)<>$4D)then begin close(handle); exit; end; for it:=1 to 256 do begin blockread(handle,pal_array[it-1,0],3); blockread(handle,pal_res[it-1],1); end; filenamemerker:=filename; bildgroesse:=bmp_header.xmax*bmp_header.ymax; po:=loadfile; tsegment:=fenstersegment; tsegmentBMP:=seg(po^); toffsetBMP:=ofs(po^); setpalette(255); breite:=bmp_header.xmax; hoehe:=bmp_header.ymax; if bildgroesse<=65535 then begin putVGAPixel(x,y,breite,hoehe,segA000,tsegmentBMP,toffsetBMP); End; globalfreeptr(po); end; |
||||||||||||||||||
VGA BMP (* PROTECTED MODE *) (* Entwickelt am 03.08.96 *) (* Updates bis *) unit vga; interface procedure putpixel(x,y:integer;color:byte;tp:pointer); procedure loadinitBMPFile(nr:integer;filename:string); procedure bar(x1,y1,breite,hoehe:integer;color:byte); function loadBMPFile(x,y:integer;filename:string):boolean; procedure putvgaicon(x1,y1,breite,hoehe:integer;ziel,p:pointer); procedure diashow(x,y,delayseconds:integer;filename:string); procedure setpalettecolor(color:integer;rot,gruen,blau:byte); procedure blendingallup; procedure blendingalldown; procedure put_image(x,y,breite,hoehe:integer;p:pointer); procedure store_image(x,y,breite,hoehe:integer;p:pointer); procedure dreh_image(grad,breite,hoehe:integer;p:pointer); procedure textout(x,y:integer;text:string;forecolor,backcolor:integer;bild:pointer); procedure putvgaiconwithback(x1,y1,breite,hoehe:integer;p2,p:pointer;back:byte); var helligkeit:integer; implementation uses winapi,dos,pause,crt; const red=0; green=1; blue=2; type bmp_header_=record signatur:word; flen:longint; dummy1:word; dummy2:word; offset:longint; info_size:longint; xmax:longint; ymax:longint; polanes:word; bits_per_pixel:word; compress:word; xsize:longint; hdpi:longint; vdpi:longint; cols:longint; coli:longint; end; var handle:file; phigh,plow:word; pwert:longint; i:integer; gdimem:pointer; textp:pointer; textcode:array[1..7]of byte; reg:registers; bmp_header:bmp_header_; filenamemerker:string; pal_array:array[0..255,0..2]of byte; pal_res:array[0..255]of byte; tsegment,toffset:word; p2,p,po:pointer; fenstersegment:word; farbe:byte; x,y:integer; procedure textout(x,y:integer;text:string;forecolor,backcolor:integer;bild:pointer); const bildbreite=320; VAR x1,CharRow: Byte; FontSeg, FontOfs, ScrOfs,i,j: Word; LScrOfs: Integer; charsize,sizemerker1,sizemerker2:byte; z:byte; bildsegment,bildofs,tt,tsegment,toffset:word; p:pointer; BEGIN charsize:=8; sizemerker1:=0; sizemerker2:=0; bildsegment:=seg(bild^); bildofs:=ofs(bild^); tsegment:=seg(text); toffset:=ofs(text); for tt:=1 to length(text) do begin p:=ptr(tsegment,toffset+tt); move(p^,z,1); if x+tt*charsize<320 then begin LScrOfs := bildbreite*y+x+tt*charsize+10; sizemerker2:=0; FontSeg := Seg(textp^); (* Segmentadresse des Zeichensatzes *) FontOfs := Ofs(textp^)+CharSize*z;(* Offsetadresse der Zeichenmatrix *) FOR i := 0 TO CharSize-1 DO BEGIN CharRow := Mem[FontSeg:FontOfs]; (* Pixelreihe holen *) ScrOfs := bildofs+(LScrOfs); FOR j := 0 TO 7 DO BEGIN IF (CharRow AND $80) <> 0 THEN begin (* Falls Bit 7 gesetzt *) Mem[bildsegment:ScrOfs] := ForeColor; (* Vordergrundfarbe *) inc(sizemerker1); end ELSE if backcolor<>255 then Mem[bildsegment:ScrOfs+x1] := BackColor; (* Hintergrundfarbe *) CharRow := CharRow SHL 1; (* Pixelreihe links schieben *) inc(sizemerker1); inc(scrofs); end; if sizemerker1>sizemerker2 then sizemerker2:=sizemerker1; sizemerker1:=0; lScrOfs :=lScrOfs + bildbreite; (* Adresse der nchste Rasterzeile *) Inc(FontOfs); (* Adresse der nchsten Punktreihe *) END; end; end; end; procedure grafik_ein; begin asm mov ah,00h mov al,13h int 10h end; end; procedure putpixel(x,y:integer;color:byte;tp:pointer); var ts,tof,tofs:word; begin if x<0 then x:=0; if y<0 then y:=0; if x>319 then x:=0; if y>199 then y:=0; ts:=seg(tp^); tof:=ofs(tp^); tofs:=tof+320*y+x; asm { mov ax,y mov dx,320 mul ax add ax,x } mov bx,tofs mov cl,color mov es,ts mov es:[bx],cl end; end; procedure dreh_image(grad,breite,hoehe:integer;p:pointer); var toffset,tsegmentBMP1,toffsetBMP1, tsegmentBMP2,toffsetBMP2:word; xn,yn,yi,xi,bo,ho:integer; color:byte; xr,yr:real; begin bo:=breite div 2; ho:=hoehe div 2; tsegmentBMP1:=seg(gdimem^); toffsetBMP1:=ofs(gdimem^); tsegmentBMP2:=seg(p^); toffsetBMP2:=ofs(p^); move(p^,gdimem^,breite*hoehe); for yi:=1 to breite do begin for xi:=1 to hoehe do begin toffset:=toffsetBMP1+breite*yi+xi; asm push ds mov ds,tsegmentBMP1 mov si,toffset mov al,ds:[si] mov color,al pop ds end; xr:=(xi+bo)*cos(grad)-(yi+ho)*sin(grad); yr:=(xi+bo)*sin(grad)+(yi+ho)*cos(grad); xn:=trunc(xr); yn:=trunc(yr); if xn>=breite then xn:=breite-1; if yn>=breite then yn:=hoehe-1; if xn<0 then xn:=0; if yn<0 then yn:=0; toffset:=toffsetBMP2+breite*yn+xn; asm push ds mov ds,tsegmentBMP2 mov si,toffset mov al,color mov ds:[si],al pop ds end; end; end; end; function getptr(p:pointer;offset:longint):pointer; type long=record lo,hi:word; end; begin getptr:=ptr(long(p).hi+long(offset).hi*selectorinc,long(p).lo+long(offset).lo); end; procedure bar(x1,y1,breite,hoehe:integer;color:byte); const bildbreite=320; var tsegment,toffset:word; zaehler,y,x2:integer; regwert:byte; begin tsegment:=fenstersegment; (* Bankregister retten *) x2:=breite; if odd(x2)=true then inc(x2); zaehler:=x2 div 2; for y:=y1 to y1+hoehe-1 do begin toffset:=bildbreite*y+x1; asm mov al,color mov ah,al mov cx,zaehler mov es,tsegment (* Zieladresse-Segment *) mov di,toffset (* Zieladresse-Offset *) rep stosw end; end; end; procedure getVGAPixel(x1,y1,breite,hoehe:integer; tsegment,tsegmentBMP,toffsetBMP:word); const bildbreite=320; var c2,toffset:word; zaehler,y,x2:integer; begin (* Korrektur der Breite auf ein vielfaches von 4 *) if breite mod 4<>0 then breite:=breite+(4-(breite mod 4)); x2:=breite; (* nach dem rechten Rand abschneiden *) if 320-x1<=breite then x2:=320-x1; zaehler:=x2 div 4; for y:=y1 to y1+hoehe-1 do begin c2:=toffsetbmp+breite*(y-y1); toffset:=bildbreite*y+x1; asm push ds mov ds,tsegment (* Quelladresse-Segment *) mov si,toffset (* Quelladresse-Offset *) mov cx,zaehler mov es,tsegmentbmp (* Zieladresse-Segment *) mov di,c2 (* Zieladresse-Offset *) db 66h;rep movsw pop ds end; end; end; procedure store_image(x,y,breite,hoehe:integer;p:pointer); var tsegmentBMP,toffsetBMP:word; begin tsegmentBMP:=seg(p^); toffsetBMP:=ofs(p^); if x<0 then x:=0; if y<0 then y:=0; getVGAPixel(x,y,breite,hoehe,fenstersegment,tsegmentBMP,toffsetBMP); end; procedure putVGAPixel(x1,y1,breite,hoehe:integer; tsegment,tsegmentBMP,toffsetBMP:word); const bildbreite=320; var c2,toffset:word; zaehler,y,x2:integer; begin (* Korrektur der Breite auf ein vielfaches von 4 *) if breite mod 4<>0 then breite:=breite+(4-(breite mod 4)); x2:=breite; {(* nach dem rechten Rand abschneiden *) if 320-x1<=breite then x2:=320-x1; } zaehler:=x2 div 4; for y:=y1 to y1+hoehe-1 do begin c2:=toffsetbmp+breite*(y-y1); toffset:=bildbreite*y+x1; asm push ds mov ds,tsegmentbmp (* Quelladresse-Segment *) mov si,c2 (* Quelladresse-Offset *) mov cx,zaehler mov es,tsegment (* Zieladresse-Segment *) mov di,toffset (* Zieladresse-Offset *) db 66h;rep movsw pop ds end; end; end; procedure put_image(x,y,breite,hoehe:integer;p:pointer); var tsegmentBMP,toffsetBMP:word; begin tsegmentBMP:=seg(p^); toffsetBMP:=ofs(p^); putVGAPixel(x,y,breite,hoehe,fenstersegment,tsegmentBMP,toffsetBMP); end; procedure setpalettecolor(color:integer;rot,gruen,blau:byte); var merker:integer; pl_array:array[0..255,0..2]of byte; begin merker:=helligkeit; helligkeit:=helligkeit*2; if (rot=255)AND(gruen=255)AND(blau=255) then begin pl_array[color,red]:=(pal_array[color,blue]*helligkeit div 255) shr 2; pl_array[color,green]:=(pal_array[color,green]*helligkeit div 255) shr 2; pl_array[color,blue]:=(pal_array[color,red]*helligkeit div 255) shr 2; end else begin pl_array[color,red]:=(blau*helligkeit div 255) shr 2; pl_array[color,green]:=(gruen*helligkeit div 255) shr 2; pl_array[color,blue]:=(rot*helligkeit div 255) shr 2; end; port[$3C8]:=color; port[$3C9]:=pl_array[color,red]; port[$3C9]:=pl_array[color,green]; port[$3C9]:=pl_array[color,blue]; helligkeit:=merker; end; procedure setpalette(anzahl:integer); var merker,i:integer; pl_array:array[0..255,0..2]of byte; begin merker:=helligkeit; helligkeit:=helligkeit*2; for i:=0 to anzahl do begin pl_array[i,red]:=(pal_array[i,blue]*helligkeit div 255) shr 2; pl_array[i,green]:=(pal_array[i,green]*helligkeit div 255) shr 2; pl_array[i,blue]:=(pal_array[i,red]*helligkeit div 255) shr 2; end; port[$3C8]:=0; for i:=0 to anzahl do begin port[$3C9]:=pl_array[i,red]; port[$3C9]:=pl_array[i,green]; port[$3C9]:=pl_array[i,blue]; end; helligkeit:=merker; end; procedure loadinitBMPFile(nr:integer;filename:string); var handle:file; bildgroesse:longint; it:integer; tsegmentBMP,toffsetBMP,tsegment,toffset:word; function loadfile(nnr:integer):pointer; var buffer:pointer; size,offset,count:longint; begin buffer:=nil; size:=64000; buffer:=globalallocptr(gmem_moveable,size); seek(handle,filepos(handle)+nnr*64000); blockread(handle,buffer^,64000); close(handle); loadfile:=buffer; end; begin assign(handle,filename); reset(handle,1); blockread(handle,bmp_header,54); for it:=1 to 256 do begin blockread(handle,pal_array[it-1,0],3); blockread(handle,pal_res[it-1],1); end; filenamemerker:=filename; bildgroesse:=bmp_header.xmax*bmp_header.ymax; po:=loadfile(nr); tsegment:=fenstersegment; tsegmentBMP:=seg(po^); toffsetBMP:=ofs(po^); setpalette(255); putVGAPixel(0,0,320,200,tsegment,tsegmentBMP,toffsetBMP); globalfreeptr(po); end; function loadBMPFile(x,y:integer;filename:string):boolean; var handle:file; bildgroesse:longint; i,it:integer; ts2,to2,tsegmentBMP,toffsetBMP,tsegment,toffset:word; groesse2:word; breite,hoehe:integer; function loadfile:pointer; var buffer:pointer; size,offset,count:longint; begin buffer:=nil; size:=filesize(handle)-filepos(handle); buffer:=globalallocptr(gmem_moveable,size); if buffer<>nil then begin offset:=0; while offset<size do begin count:=size-offset; if count>32768 then count:=32768; blockread(handle,getptr(buffer,offset)^,count); inc(offset,count); end; end; close(handle); loadfile:=buffer; end; begin (* Wenn nicht aktuelles BMP-File, dann *) {if filenamemerker<>filename then } begin assign(handle,filename); reset(handle,1); blockread(handle,bmp_header,54); for it:=1 to 256 do begin blockread(handle,pal_array[it-1,0],3); blockread(handle,pal_res[it-1],1); end; filenamemerker:=filename; bildgroesse:=bmp_header.xmax*bmp_header.ymax; po:=loadfile; tsegment:=fenstersegment; tsegmentBMP:=seg(po^); toffsetBMP:=ofs(po^); setpalette(255); end; breite:=bmp_header.xmax; hoehe:=bmp_header.ymax; if bildgroesse<=65535 then begin putVGAPixel(x,y,breite,hoehe,tsegment,tsegmentBMP,toffsetBMP); end; globalfreeptr(po); end; procedure putvgaicon(x1,y1,breite,hoehe:integer;ziel,p:pointer); (* Iconfarbe 0 und 255 wird beim Zeichnen ignoriert *) label s1,s1ende; const bildbreite=320; var ztsegment,ztoffset:word; c2,toffset:word; zaehler,y,x2:integer; tsegmentBMP,toffsetBMP:word; begin if x1<0 then x1:=0; if y1<0 then y1:=0; {if x1>300 then x1:=300; if y1>190 then y1:=190; } ztsegment:=seg(ziel^); ztoffset:=ofs(ziel^); tsegmentBMP:=seg(p^); toffsetBMP:=ofs(p^); (* Korrektur der Breite auf ein vielfaches von 4 *) if breite mod 4<>0 then breite:=breite+(4-(breite mod 4)); x2:=breite; (* nach dem rechten Rand abschneiden *) if 320-x1-1<=breite then x2:=320-x1-1; zaehler:=x2; (* zu groáe hoehe abschneiden *) if y1+hoehe>200 then hoehe:=200-y1; for y:=y1 to y1+hoehe-1 do begin c2:=toffsetbmp+breite*(y-y1); toffset:=ztoffset+bildbreite*y+x1; asm push ds mov ds,tsegmentbmp (* Quelladresse-Segment *) mov si,c2 (* Quelladresse-Offset *) mov cx,zaehler mov es,ztsegment (* Zieladresse-Segment *) mov di,toffset (* Zieladresse-Offset *) s1: mov al,ds:[si] cmp al,255 je s1ende cmp al,0 je s1ende mov es:[di],al s1ende: inc si inc di loop s1 pop ds end; end; end; procedure putvgaiconwithback(x1,y1,breite,hoehe:integer;p2,p:pointer;back:byte); (* Iconfarbe 0 und 255 wird beim Zeichnen mit back berschrieben *) label s1,s1ende, lloop1; const bildbreite=320; var c2,toffset:word; zaehler,y,x2:integer; tsegment2,toffset2,tsegmentBMP,toffsetBMP:word; begin tsegmentBMP:=seg(p^); toffsetBMP:=ofs(p^); tsegment2:=seg(p2^); toffset2:=ofs(p2^); (* Korrektur der Breite auf ein vielfaches von 4 *) if breite mod 4<>0 then breite:=breite+(4-(breite mod 4)); x2:=breite; (* nach dem rechten Rand abschneiden *) if 320-x1-1<=breite then x2:=320-x1-1; zaehler:=x2; for y:=y1 to y1+hoehe-1 do begin c2:=toffsetbmp+breite*(y-y1); toffset:=toffset2+bildbreite*y+x1; asm push ds mov ds,tsegmentbmp (* Quelladresse-Segment *) mov si,c2 (* Quelladresse-Offset *) mov cx,zaehler mov es,tsegment2 (* Zieladresse-Segment *) mov di,toffset (* Zieladresse-Offset *) s1: mov al,ds:[si] cmp al,255 je s1ende cmp al,0 je s1ende movsb jmp lloop1 s1ende: mov al,back stosb inc si lloop1: loop s1 pop ds end; end; end; procedure diashow(x,y,delayseconds:integer;filename:string); var i:integer; taste:char; begin loadbmpfile(x,y,filename); for helligkeit:=1 to 100 do begin setpalette(255); warte(0); end; i:=0; repeat inc(i); warte(1); until (i>delayseconds)OR(keypressed); if keypressed then taste:=readkey; for helligkeit:=100 downto 0 do begin setpalette(255); warte(0); end; end; procedure blendingallup; var i:integer; begin for i:=0 to 25 do begin helligkeit:=i*4; setpalette(255); warte(0); end; end; procedure blendingalldown; var i:integer; begin for i:=25 downto 0 do begin helligkeit:=i*4; setpalette(255); warte(0); end; end; begin textbackground(0); clrscr; fenstersegment:=segA000; grafik_ein; helligkeit:=100; getmem(gdimem,65535); (* SCHRIFT-INIT *) getmem(textp,5000); assign(handle,'schrift.dat'); reset(handle,1); blockread(handle,textcode,7); if (textcode[1]<>byte('S'))AND (textcode[2]<>byte('C'))AND (textcode[3]<>byte('H'))AND (textcode[4]<>byte('R'))AND (textcode[5]<>byte('I'))AND (textcode[6]<>byte('F'))AND (textcode[7]<>byte('T'))then exit; blockread(handle,textp^,filesize(handle)-7); close(handle); end. |
||||||||||||||||||
Soundblaster WAV (* Update am 15.03.96 *) (* Auto-Init-Mode der SB wird benutzt *) unit sbunit3; interface uses dos,crt; function play_wavesound(name:string;baseadress,irqnumber:integer;anzeige:boolean):integer; function test_wavesound(name:string;baseadress,irqnumber:integer;anzeige:boolean):integer; (* test_wavesound : 0 = alles in Ordnung *) (* 1 = Adresse falsch *) (* 2 = IRQ falsch *) function stop_wavesound:boolean; function fertig:boolean; implementation var testen:boolean; base,int:integer; irqgemacht,angehalten:boolean; offset,segment:integer; zahl1,zahl2:byte; anzeigeaktiv:boolean; bufferz,z,i:longint; handle:file; filename:string[150]; zgr:^byte; riff:longint; filelaenge:longint; wave:longint; fmt_:longint; laenge:longint; formatart:word; kanalanzahl:word; samplefrequenz:longint; bytes_pro_sek:longint; bytes_pro_sample:word; format_specific:word; data:longint; datenlaenge:longint; fname:string[20]; handle2:file; p,p2,p3:pointer; b:byte; tr:real; xsound:longint; segadress,ofsadress:integer; Int15BSave:pointer; re:word; alt_int15:Pointer; fehlerx:boolean; timer_start : Word; lautstaerke:byte; counter:integer; procedure irq_reset; begin asm (* ICW1 *) mov al,00010001b out 20h,al out 0a0h,al (* ICW2 *) mov al,08h out 21h,al mov al,70h out 0a1h,al (* ICW3 *) mov al,00000100b out 21h,al mov al,2 out 0a1h,al (* ICW4 *) mov al,00000001b out 21h,al out 0a1h,al end; end; procedure lade; var b:integer; begin assign(handle,filename); reset(handle,1); blockread(handle,riff,4); blockread(handle,filelaenge,4); blockread(handle,wave,4); blockread(handle,fmt_,4); blockread(handle,laenge,4); blockread(handle,formatart,2); blockread(handle,kanalanzahl,2); blockread(handle,samplefrequenz,4); blockread(handle,bytes_pro_sek,4); blockread(handle,bytes_pro_sample,2); blockread(handle,format_specific,2); blockread(handle,data,4); blockread(handle,datenlaenge,4); {seek(handle,40); {writeln('Datenlaenge: ',datenlaenge); } if anzeigeaktiv=true then begin writeln('SoundBlaster-Unit (c) Bernd Ntscher 1995 '); writeln('Dateilnge : ',filelaenge,' Bytes'); writeln('- - - - - - - - - - - - - - - - - -'); { writeln('Formatart :',formatart); } writeln('Samplefrequenz : ',samplefrequenz,' Hz'); writeln('Bytes pro Sek. : ',bytes_pro_sek); {writeln('Bytes pro Sample :',bytes_pro_sample); } writeln('Bit-Tiefe : ',format_specific); writeln('Kanalanzahl : ',kanalanzahl); {writeln('Datenlnge :',datenlaenge); } writeln('- - - - - - - - - - - - - - - - - -'); b:=datenlaenge div bytes_pro_sek; writeln('Dauer : ',b,' Sekunde(n)'); end; end; function lowbyte(adresse : Word) : Byte; begin lowbyte := (adresse and 255); end; function highbyte(adresse : Word) : Byte; begin highbyte := ((adresse shr 8) and 255); end; function lowword(adress_ptr : Pointer) : Word; var adresse : LongInt; begin adresse := (Longint(Seg(adress_ptr^)) shl 4 ) + Ofs(adress_ptr^); lowword := (adresse and $0FFFF); end; function highword(adress_ptr : Pointer) : Word; var adresse : LongInt; begin adresse := (Longint(Seg(adress_ptr^)) shl 4 ) + Ofs(adress_ptr^); highword := (adresse shr 16); end; procedure fehler(meldung : String); begin { WriteLn; writeLn('Fehler: ',meldung,'!'); halt(1); } fehlerx:=true; end; function lies_dsp : Byte; var counter : Integer; ende : Boolean; begin ende := false; counter := 0; { writeln('ES GEHT LOS!!!!!!!!!!!!!!'); } while(not(ende))AND(fehlerx=false) do begin inc(counter); ende := (Port[BASE + $0E] and $080) = $080; if counter >= 100 then begin fehler('DSP kann nicht gelesen werden'); fehlerx:=true; end; end; if fehlerx=false then lies_dsp := Port[BASE + $0A]; if fehlerx=true then begin { writeln('FDSHFHFHHDFHFHHFDHDFG LESEN LESEN'); } lies_dsp:=0; end; end; procedure init_dsp; var counter : Integer; ende : Boolean; begin ende := false; counter := 0; if fehlerx=false then begin {writeln('INIT INIT INIT'); } Port[BASE + $06] := $01; delay(1); Port[BASE + $06] := $00; while(not(ende)AND(fehlerx=false)) do begin inc(counter); if fehlerx=false then ende := (lies_dsp = $0AA) else ende:=true; if (counter = 100) then begin fehler('Falsche Basisadresse oder Reset-Error'); ende:=true; end; end; end; end; procedure schreib_dsp(wert : integer); var counter2 : Integer; ende : Boolean; begin ende := false; counter2 := 0; while(not(ende)) do begin inc(counter2); ende := (Port[BASE + $0C] and $080) = $00; if counter2 = 10000 then fehler('DSP kann nicht beschrieben werden'); end; Port[BASE + $0C] := wert; end; procedure neu_int15(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP:word); interrupt; label l; var u:word; begin if testen=false then begin z:=z+i; if eof(handle)=true then goto l; if port[base+$E]=1 then delay(0); if odd(bufferz)=true then fillchar(p2^,i,128) else fillchar(p^,i,128); if odd(bufferz)=true then blockread(handle,p2^,i,re) else blockread(handle,p^,i,re); { counter:=counter+5; if counter>100 then counter:=100; if z>=filesize(handle)div 2 then counter:=counter-10; if counter<5 then counter:=1; for u:=0 to i do begin if odd(bufferz)=false then begin asm mov ax,7500h mov es,ax mov bx,u mov al,es:[bx] mov lautstaerke,al end; lautstaerke:=(counter)*lautstaerke div 100; asm mov al,lautstaerke mov es:[bx],al end; end; if odd(bufferz)=true then begin asm mov ax,8000h mov es,ax mov bx,u mov al,es:[bx] mov lautstaerke,al end; lautstaerke:=(counter)*lautstaerke div 100; asm mov al,lautstaerke mov es:[bx],al end; end; end; } inc(bufferz); end; irqgemacht:=true; l: fertig; {Port[$A]:=$20; (* Slave IRQ *) } Port[$20]:=$20; (* Master IRQ *) end; function stop_wavesound:boolean; begin fillchar(p2^,i,128); fillchar(p^,i,128); schreib_dsp($DA); if angehalten=false then SetIntVec(int,alt_int15); if angehalten=false then schreib_dsp($0D3); (* Speaker aus *) if angehalten=false then close(handle); angehalten:=true; end; function fertig:boolean; var i,b:integer; begin {fertig:=false; if eof(handle)=true then fertig:=true; } if anzeigeaktiv=true then begin textcolor(6); gotoxy(38,18); b:=z*100 div filesize(handle); if b>100 then b:=100; write(b,' %'); if b>=100 then begin stop_wavesound; angehalten:=true; end; (* Soundbar *) for i:=(b*30 div 100) to 30 do begin gotoxy(25+i,20); write('±'); end; for i:=0 to (b*30 div 100) do begin gotoxy(25+i,20); write('²'); end; end; end; function play_wavesound(name:string;baseadress,irqnumber:integer;anzeige:boolean):integer; var toffset,tsegment:word; adresse:longint; begin testen:=false; counter:=100; irq_reset; irqgemacht:=false; {base:=$220; int:=$F; } case baseadress of 210 :base:=$210; 220 :base:=$220; 230 :base:=$230; 240 :base:=$240; 250 :base:=$250; 260 :base:=$260; end; fehlerx:=false; if irqnumber=2 then int:=$72; if irqnumber=3 then int:=$b; if irqnumber=5 then int:=$d; if irqnumber=7 then int:=$f; anzeigeaktiv:=anzeige; filename:=name; z:=0; bufferz:=0; angehalten:=false; lade; i:=16000; {getmem(p,i); } {mark(p); tsegment:=seg(p^); toffset:=ofs(p^); adresse:=(longint(tsegment)shl 4)+longint(toffset); tsegment:=(adresse shr 4)+1; toffset:=0; } p:=ptr($7500,0); p2:=ptr($7500,16000); {blockread(handle,p^,200,re); } fillchar(p^,32000,128); fillchar(p2^,32000,128); {blockread(handle,p^,i,re); {zahl1:=port[$08];(* DMA-Status *) filename:=bytetos(filename,zahl1); writeln('DMA-Status: ',filename); } zahl1:=irqnumber; (* Bit setzen *) port[$21]:=port[$21]OR (1 shl zahl1); (* Interrupt sperren *) {filename:=bytetos(filename,port[$21]); writeln('Interruptstatus: ',filename); } asm cli; end; GetIntVec(int,alt_int15); tr:=256-1000000/(bytes_pro_sek*1*8 div format_specific ); timer_start := trunc(tr); (* Sample-Freq. *) SetIntVec(int,@neu_int15); zahl1:=irqnumber and $0007; (* Interrupt zulassen *) port[$21] := port[$21] and not ( 1 shl zahl1); asm sti; end; init_dsp; if fehlerx=false then begin schreib_dsp($0D1); (* Speaker an *) port[$00D]:=0;{Master clear} port[$00C]:=0;{FlipFlop lschen} port[$A]:=$5; port[$C]:=$0; port[$B]:=$59; port[$00C]:=0;{FlipFlop lschen} port[$02]:=lowbyte(lowword(p)); port[$02]:=highbyte(lowword(p)); port[$83]:=highword(p);{Seite} port[$00C]:=0;{FlipFlop lschen} port[$03]:=lowbyte(i*2); port[$03]:=highbyte(i*2); port[$A]:=$01; schreib_dsp($40); schreib_dsp(timer_start); schreib_dsp($48); schreib_dsp(lowbyte(i-1)); schreib_dsp(highbyte(i-1)); if format_specific=8 then schreib_dsp($1C); if format_specific=4 then schreib_dsp($7D); end; if (irqgemacht=true)AND(fehlerx=false) then play_wavesound:=0; if (irqgemacht=true)AND(fehlerx=true)then play_wavesound:=1; if (irqgemacht=false)AND(fehlerx=true)then play_wavesound:=1; if (irqgemacht=false)AND(fehlerx=false)then play_wavesound:=2; end; function test_wavesound(name:string;baseadress,irqnumber:integer;anzeige:boolean):integer; var toffset,tsegment:word; adresse:longint; time:integer; begin testen:=true; counter:=100; irq_reset; irqgemacht:=false; {base:=$220; int:=$F; } case baseadress of 210 :base:=$210; 220 :base:=$220; 230 :base:=$230; 240 :base:=$240; 250 :base:=$250; 260 :base:=$260; end; fehlerx:=false; if irqnumber=2 then int:=$72; if irqnumber=3 then int:=$b; if irqnumber=5 then int:=$d; if irqnumber=7 then int:=$f; anzeigeaktiv:=anzeige; filename:=name; z:=0; bufferz:=0; angehalten:=false; lade; i:=16000; {getmem(p,i); } {mark(p); tsegment:=seg(p^); toffset:=ofs(p^); adresse:=(longint(tsegment)shl 4)+longint(toffset); tsegment:=(adresse shr 4)+1; toffset:=0; } p:=ptr($7500,0); p2:=ptr($7500,16000); blockread(handle,p^,200,re); fillchar(p^,32000,128); fillchar(p2^,32000,128); {blockread(handle,p^,i,re); {zahl1:=port[$08];(* DMA-Status *) filename:=bytetos(filename,zahl1); writeln('DMA-Status: ',filename); } zahl1:=irqnumber; (* Bit setzen *) port[$21]:=port[$21]OR (1 shl zahl1); (* Interrupt sperren *) {filename:=bytetos(filename,port[$21]); writeln('Interruptstatus: ',filename); } asm cli; end; GetIntVec(int,alt_int15); tr:=256-1000000/(samplefrequenz*1); timer_start := trunc(tr); (* Sample-Freq. *) SetIntVec(int,@neu_int15); zahl1:=irqnumber and $0007; (* Interrupt zulassen *) port[$21] := port[$21] and not ( 1 shl zahl1); asm sti; end; init_dsp; if fehlerx=false then begin schreib_dsp($0D1); (* Speaker an *) port[$00D]:=0;{Master clear} port[$00C]:=0;{FlipFlop lschen} port[$A]:=$5; port[$C]:=$0; port[$B]:=$59; port[$00C]:=0;{FlipFlop lschen} port[$02]:=lowbyte(lowword(p)); port[$02]:=highbyte(lowword(p)); port[$83]:=highword(p);{Seite} port[$00C]:=0;{FlipFlop lschen} port[$03]:=lowbyte(2); port[$03]:=highbyte(2); port[$A]:=$01; schreib_dsp($40); schreib_dsp(timer_start); schreib_dsp($48); schreib_dsp(lowbyte(1)); schreib_dsp(highbyte(1)); if format_specific=8 then schreib_dsp($1C); if format_specific=4 then schreib_dsp($7D); end; time:=0; repeat inc(time); until (irqgemacht=true)OR(time>5000); if (irqgemacht=true)AND(fehlerx=false) then test_wavesound:=0; if (irqgemacht=true)AND(fehlerx=true)then test_wavesound:=1; if (irqgemacht=false)AND(fehlerx=true)then test_wavesound:=1; if (irqgemacht=false)AND(fehlerx=false)then test_wavesound:=2; end; begin testen:=false; end. |
||||||||||||||||||
<< Zurück Alle Angaben ohne Gewähr. Benutzung auf eigenes Risiko. (C) Copyright Bernd Noetscher 1995 - 2000 eMail: webmaster@berndnoetscher.de |