Posted By: Jovo (Jovo) on 'CZprogram' Title: Odpovedi Date: Tue Mar 11 18:02:17 1997 Ahoj, VGA Paleta : No jestli nevis co je to retrace, tak si sezen pcgpe (zkus pres parkera hledat PCGPE10.ZIP, nebo si prolez simtel) tam najdes Asphyxia VGA traineers a tam to vsechno je, jinak Procedure WaitRetrace; Assembler; {Thanx goes to PCGPE} Asm push dx {aby to nerozhazelo registry pri CALLech} push ax mov dx,3DAh @@1: in al,dx and al,08h jnz @@1 @@2: in al,dx and al,08h jz @@2 pop ax pop dx @@WaitNot: End; Operace s VGA Paletou : unit palette; { Co to je : ---------- - Unita pro Vetsinu paletovych operaci nad paletou VGA - Vsechny casove kriticke operace jsou v ASM - povedlo se mi to , teda az na maly hacek u FadeTo, mozna ho nekdy odstranim Co to dela : ------------ - meni, cte, zapisuje paletu VGA a dela to taky ruzne efekty (linearizace palety, fadind) Vyrobil : --------- - Vyhotoveno : prubezne od ledna 96 az do ted - xhovor00@dcse.fee.vutbr.cz , jinak Jovo - s pouzitim PCGPE a dalsi vetese ('stuff') } interface const maxcol = 255; {max pocet barev} MaxPalCol = 63; {maximalni velikost R/G/B slozky} MinPalCol = 0; {minimalni velikost R/G/B slozky} StartPal = 1; {OD ktere bary se bude zapisovat paleta} EndPal = 255; {DO ktere bary se bude zapisovat paleta} type tRGB = array [1..3] of byte; TPaleta = array [0..maxcol] of tRGB; var RGBBlack,RGBRed,RGBGreen,RGBBlue,RGBWhite, RGBYellow,RGBCyan,RGBMangenta:tRGB; {cerna,cervena,modra,bila,zluta,Cyan a Mangenta RGB barva, no proste vsechny kombinace 00,00,00 x 63,63,63} OldSystemPalette : Tpaleta; {uschovana puvodni paleta, lze ji obnovit volanim SetOldPal} {---------------------------} {Operace nad paletou.} {Pozn.: je-li v hlavicce DEL - je to DELAY - zpozdeni nejakych kroku} procedure SetOldPal; {nastavi puvodni paletu (paleta pri spusteni unity GR13h} function GetMax(var pal:Tpaleta):byte; {vrati max velikost ze vsech slozek RGB} procedure ReadPal (var pal : Tpaleta); procedure WritePal (var pal : Tpaleta); {cteni a zapis palety} procedure ReadCol(ColNum:byte;var RGB:tRgb); procedure WriteCol(ColNum:byte;var RGB:tRgb); {precteni a zapis jedine barvy (jeji cislo je ColNum)} procedure DecPal(var Pal:Tpaleta); {snizi vsechny hodnoty v palete o 1. Zadna ze slosek RGB nepodtece to 0} procedure IncPal(Var Pal1,Pal2:Tpaleta); {provede 'fadeing' z prvni palety do druhe. Nevsima si overscanu.} procedure FadeOut(del:word); {FADE TO BLACK - blba hra , ale tohle je dobry efekt} procedure FadeTo(var pal2:Tpaleta;del:word); {Prechazi ze stavajici palety na barvy palety PAL2} procedure CycleDown(var pal:Tpaleta); procedure Cycleup(var pal:Tpaleta); {Protoci paletu dolu nebo nahoru. Obe operace zachovaji Overscan} procedure LinearPal(Rs,Re,Gs,Ge,Bs,Be:byte; Var Pal:Tpaleta); {vyrobi linearni paletu. Xs - pocatecni Xe - koncova sytost barvy pro R,G,B} Procedure LinearPalWhite( Var Pal:Tpaleta); {vyrobi bilou linearni paletu} Procedure LinearPalBlack( Var Pal:Tpaleta); {vyrobi cernou linearni paletu :) } Procedure LinearPalRed( Var Pal:Tpaleta); {vyrobi cervenou linearni paletu} Procedure LinearPalGreen( Var Pal:Tpaleta); {vyrobi zelenou linearni paletu} Procedure LinearPalBlue( Var Pal:Tpaleta); {vyrobi modrou linearni paletu} Procedure LinearPalYellow( Var Pal:Tpaleta); {vyrobi zlutou linearni paletu} Procedure LinearPalCyan( Var Pal:Tpaleta); {vyrobi svetle modrou linearni paletu} Procedure LinearPalMangenta( Var Pal:Tpaleta); {vyrobi fialovou linearni paletu} Procedure FillPal(var Pal:Tpaleta;var RGB:tRGB); {vyplni paletu o STARTPAL do ENDPAL barvou definovanou v RGB} implementation uses crt;{huh , to jen kvuli pouziti DELAY(word);} Procedure WaitRetrace; Assembler; {Thanx goes to PCGPE} Asm push dx {aby to nerozhazelo registry pri CALLech} push ax mov dx,3DAh @@1: in al,dx and al,08h jnz @@1 @@2: in al,dx and al,08h jz @@2 pop ax pop dx @@WaitNot: End; Procedure WriteCol(ColNum:byte;var RGB:tRgb); { This sets the Red, Green and Blue values of a certain color } assembler; asm mov bx,ds mov dx,3c8h mov al,[colNum] out dx,al inc dx lds si,RGB mov cx,3 rep outsb mov ds,bx end; procedure WriteColOld2(ColNum:byte;var RGB:tRgb); {predpoklada, ze byla provedena funkce SchovejPaletuVGA} begin Port[$3c8] := ColNum; Port[$3c9] := RGB[1]; Port[$3c9] := RGB[2]; Port[$3c9] := RGB[3]; end; Procedure ReadCol(ColNum:byte;var RGB:tRgb); { This sets the Red, Green and Blue values of a certain color } assembler; asm mov dx,3c7h mov al,[colNum] out dx,al inc dx inc dx les di,RGB mov cx,3 rep insb end; procedure ReadColOld2(ColNum:byte;var RGB:tRgb); begin Port[$3c7] := ColNum; RGB[1] := Port[$3c9]; RGB[2] := Port[$3c9]; RGB[3] := Port[$3c9]; end; procedure WritePal (var Pal : Tpaleta); assembler; asm mov bx,ds {pekna nahrada pushnuti, ne<} mov dx,3c8h mov ax,StartPal out dx,al inc dx lds si,Pal add si,3*StartPal mov cx,3*(EndPal-StartPal+1) call WaitRetrace rep outsb mov ds,bx end; procedure WritePalOld2 (var pal : Tpaleta); var i:integer; begin; waitretrace; for i:=StartPal to EndPal div 2 do WriteCol(i,pal[i]); waitretrace; for i:=EndPal div 2+1 to EndPal do WriteCol(i,pal[i]); end; procedure ReadPal (var Pal : Tpaleta); assembler; asm mov dx,3c8h mov ax,StartPal out dx,al inc dx les di,Pal add di,3*StartPal mov cx,3*(EndPal-StartPal+1) call WaitRetrace rep insb end; procedure ReadPalOld2 (var pal : Tpaleta); var i:integer; begin; for i:=StartPal to EndPal do ReadCol(i,pal[i]); end; procedure LinearPal(Rs,Re,Gs,Ge,Bs,Be:byte; Var Pal:Tpaleta); var i:integer; begin; for i:=0 to maxcol do begin; pal[i,1]:= Trunc ( i * (Re - Rs) / MaxCol + Rs) ; pal[i,2]:= Trunc ( i * (Ge - Gs) / MaxCol + Gs) ; pal[i,3]:= Trunc ( i * (Be - Bs) / MaxCol + Bs) ; end; end; {!!} Procedure LinearPalWhite( Var Pal:Tpaleta); begin; LinearPal(0,MaxPalCol,0,MaxPalCol,0,MaxPalCol,pal); end; Procedure LinearPalBlack( Var Pal:Tpaleta); begin; LinearPal(0,0,0,0,0,0,pal); end; Procedure LinearPalRed( Var Pal:Tpaleta); begin; LinearPal(0,MaxPalCol,0,0,0,0,pal); end; Procedure LinearPalGreen( Var Pal:Tpaleta); begin; LinearPal(0,0,0,MaxPalCol,0,0,pal); end; Procedure LinearPalBlue( Var Pal:Tpaleta); begin; LinearPal(0,0,0,0,0,MaxPalCol,pal); end; Procedure LinearPalYellow( Var Pal:Tpaleta); begin; LinearPal(0,63,0,63,0,0,Pal); end; Procedure LinearPalCyan( Var Pal:Tpaleta); begin; LinearPal(0,0,0,63,0,63,Pal); end; Procedure LinearPalMangenta( Var Pal:Tpaleta); begin; LinearPal(0,63,0,0,0,63,Pal); end; Procedure FillPal(var Pal:Tpaleta;var RGB:tRGB); var i:integer; begin; for i:=StartPal to EndPal do pal[i]:=RGB; end; procedure SetOldPal; begin; WritePal(OldSystemPalette); end; function GetMax(var pal:Tpaleta):byte; {zjisti maximalni velikost vsech barevnych slozek} assembler; asm push ds lds si,pal xor bx,bx xor cx,cx @@dalsi: cmp bx,maxcol je @@konec inc cx cmp cx,(maxcol+1)*3 je @@konec lodsb cmp bl,al jae @@dalsi mov bl,al jmp @@dalsi @@konec: xor ax,ax mov al,bl pop ds end; procedure CycleDown(var pal:Tpaleta); {shodi paletu o jednu barvu dolu. Zachovava Overscan(barva[0])} assembler; var ovRGB,RGB:tRGB; asm mov bx,ds {push ds} cld lds si,pal {les di,ovRGB{uschovani overscanu} mov ax,seg ovRGB mov es,ax mov di,offset ovRGB mov cx,3 rep movsb {les di,rgb{uschovani prvni barvy} mov ax,seg RGB mov es,ax mov di,offset RGB mov cx,3 rep movsb les di,pal add di,3 mov cx,(maxcol-1)*3 rep movsb {lds si,RGB{zapis posledni barvy} mov ax,seg RGB mov ds,ax mov si,offset RGB mov cx,3 rep movsb les di,pal {lds si,ovRGB{zapis puvodniho overscanu} mov ax,seg ovRGB mov ds,ax mov si,offset ovRGB mov cx,3 rep movsb mov ds,bx{pop ds} end; procedure CycleUp(var pal:Tpaleta); {prida o jednu barvu nahoru. Zachovava Overscan(barva[0])} assembler; var ovRGB,RGB:tRGB; asm mov bx,ds{push ds} cld lds si,pal {les di,ovRGB{uschovani overscanu} mov ax,seg ovRGB mov es,ax mov di,offset ovRGB mov cx,3 rep movsb {les di,rgb{uschovani posledni barvy} lds si,pal add si,(256-1)*3 mov ax,seg RGB mov es,ax mov di,offset RGB mov cx,3 rep movsb les di,pal lds si,pal add si,(256-1)*3 add di,(256)*3 mov cx,255*3 std {ufffff, nez jsem na to prisel} rep movsb cld les di,pal {lds si,ovRGB{zapis puvodniho overscanu} mov ax,seg ovRGB mov ds,ax mov si,offset ovRGB mov cx,3 rep movsb les di,pal add di,3 {lds si,RGB{zapis prvni barvy} mov ax,seg RGB mov ds,ax mov si,offset RGB mov cx,3 rep movsb mov ds,bx{pop ds} end; procedure DecPal(var Pal:Tpaleta); {snizi vsechny hodnoty v palete o 1. Nepodtece to 0} {tak tady me Jusoft poblil , eeeeh , pobil :)} assembler; asm mov bx,ds{push ds} mov cx,256*3 les di,pal lds si,pal @@zmensuj: mov di,si lodsb cmp al,0 je @@OK {hruza , co ?} dec al stosb @@OK: loop @@zmensuj mov ds,bx{pop ds} (* {Jusoft wrote: Zkusim to trosku jinac} {jo a obcas to havaruje :) } push ds mov cx,256*3 mov di,OFFSET pal @@zmensuj: cmp Byte Ptr [di],0 je @@Ok dec Byte Ptr [di] @@Ok: inc di loop @@zmensuj pop ds *) end; procedure FadeOut(del:word); { :-) } var pal:Tpaleta; max,i:byte; begin; ReadPal(pal); max:=GetMax(pal); for i:=0 to max do begin; DecPal(pal); WritePal(pal); delay(del); end; end; procedure IncPal(Var Pal1,Pal2:Tpaleta); {provede 'fadeing' z prvni palety do druhe. Nevsima si overscanu.} var j,k:byte; begin; for j:=1 to 255 do for k:=1 to 3 do if pal1[j,k]<pal2[j,k] then inc(pal1[j,k]) else if pal1[j,k]>pal2[j,k] then dec(pal1[j,k]); end; procedure FadeTo(var pal2:Tpaleta;del:word); {provede fading z puvodni palety do druhe. Stavajici paleta bude znicena (prepsana pal2) :) } var i,j,k:byte; pal1:Tpaleta; begin; ReadPal(pal1); for i:=0 to GetMax(pal2) do begin; IncPal(pal1,pal2); WritePal(pal1); delay(del); end; writepal(pal2); end; begin; RGBBlack [1] := MinPalCol; RGBBlack[2] := MinPalCol; RGBBlack[3] := MinPalCol; RGBWhite [1] := maxPalCol; RGBWhite[2] := maxPalCol; RGBWhite[3] := maxPalCol; RGBRed [1] := maxPalCol; RGBRed [2] := MinPalCol; RGBRed [3] := MinPalCol; RGBGreen [1] := MinPalCol; RGBGreen[2] := maxPalCol; RGBGreen[3] := MinPalCol; RGBBlue [1] := MinPalCol; RGBBlue [2] := MinPalCol; RGBBlue [3] := maxPalCol; RGBYellow [1] := maxPalCol; RGBWhite[2] := maxPalCol; RGBWhite[3] := minPalCol; RGBCyan [1] := minPalCol; RGBWhite[2] := maxPalCol; RGBWhite[3] := maxPalCol; RGBMangenta [1] := maxPalCol; RGBWhite[2] := minPalCol; RGBWhite[3] := maxPalCol; ReadPal(OldSystemPalette); writeln('pouzita UNITa : ''PALETTE'''); end. Hele nemlatte me : tenhle kod docela funguje a vo co jde ? :) ODPOVED 2 : fonty v protectu pod BP 7.0 ? Proc ne, ale ja mam dojem, ze (zatim mi stacil zakladni bitmapak 8x8) chyba bude nejspis v .BGIcku. Hm, nemohl bys rict, kde ti to krachne ? Jovo. PS: Sorry za takovou dylku, ale taky jsem byl zacatecnik (a ted ses teda co, bracho ? :) a podobne posty mi dooooost pomohly. Kdyby to nekdo chtel trosku povysvetlovat, rad odpovim, ale nejlepe na : xhovor00@stud.fee.vutbr.cz OK ?