256 Color Mode 
Author Message
 256 Color Mode

How would I implement 640x480x256 colors?

--

Thanks in advance,
Nikue Harlley
--
Veni Vidi Vici



Wed, 18 Jun 1902 08:00:00 GMT  
 256 Color Mode

Quote:

> How would I implement 640x480x256 colors?

Using a BGI driver designed for that purpose. Search the web for
a file called svga256.bgi.

You could also implement it manually by invoking VESA functions.
See the famous Interrupt List for more information.
If you do this, you will have to write PutPixel, Line, and similar
routines yourself, though.



Wed, 18 Jun 1902 08:00:00 GMT  
 256 Color Mode


:> How would I implement 640x480x256 colors?
:
:Using a BGI driver designed for that purpose. Search the web for
:a file called svga256.bgi.

 18135 May 31 1989 ftp://garbo.uwasa.fi/pc/turbopas/vga256.zip
 vga256.zip Borland's BGI driver for VGA 256 color with Turbo Pascal demo

It only is 320x480x256.

   All the best, Timo

--
Prof. Timo Salmi ftp & http://garbo.uwasa.fi/ archives 193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa

Timo's  FAQ  materials  at   http://www.uwasa.fi/~ts/http/tsfaq.html



Wed, 14 May 2003 02:16:26 GMT  
 256 Color Mode

Quote:

>How would I implement 640x480x256 colors?

The following quite long unit provides some support for 256 color modes.
First a test program which tests 640x480, 800x600 and 1024x768 modes.
It requires at least TP 5.0 though at least 6.0 is preferred.

{$s-}

uses dos,crt, VesaG;

var error:boolean;
    x,r:word;
    y:word;
var mpx,mpy:integer;
    f,i:integer;

const res:array[1..3,1..2] of word=
    ((640,480),(800,600),(1024,768));

var a1,a2:integer;

Begin
  randomize;

  for r:=1 to 3 do begin
      SetSVGA(res[r,1],res[r,2],error);
    if error then runerror(254);
    mpx:=hres div 2;
    mpy:=vres div 2;

    for f:=1 to 1000 do
      circle(mpx,mpy,random(mpy),random(255));

    for f:=0 to 3 do begin
      case f of 0: setfont(8,16);
                1: Setfont(9,16);
                2: Setfont(8,14);
                3: setfont(8,8);
                {4: SetSpecialfont(8,11,8);\

           End;

       for i:=0 to Vres div csize div 2-1 do begin
          DrawString2(180*(f mod 3),(mpy*(f div 3))+csize*i,'Hello world! ??????',random(256),random(256));
       End;
       DrawStringRot(160,f*100,'Hello World!',random(6)+9);
    End;

    readkey;
  End;

  textmode(co80);

End.

-------------------------------------

{$r-}
{$s-}

Unit VesaG;

interface

{$ifdef ver60} {$define asm} {$endif}
{$ifdef ver70} {$define asm} {$endif}

uses dos{$ifdef dpmi},winapi,intprot{$endif};

Function ModeOK(x,y:word):boolean;

Procedure SetSVGA(x,y:word; var error:boolean);
Procedure SetSVGAn(n:word; var error:boolean);
Procedure InitDisp; { call if any other than SetSVG initalizes, or
                     when something else has manipulated the screen }

Procedure PutPixel(x,y:word; col:byte);
Procedure PutPixel2(x,y:word; col1,col2:byte);
Procedure CopyPixels(x,y:word; n:word; Var Pixels);
Procedure PutPixels(x,y:word; col:byte; n:word);
Procedure PutPixelsL(x,y:word; col:byte; n:longint);

Procedure Line(X1,Y1,X2,Y2:integer; color:byte);

Procedure Rectangle(X1,Y1,X2,Y2:integer; color:byte);
Procedure Solid(X1,Y1,X2,Y2:integer; color:byte);

{$ifdef ver70}
Procedure DrawString(x,y:integer; const st:string; col:byte);
Procedure DrawString2(x,y:integer; const st:string; col,bckcol:byte);
Procedure DrawStringRot(x,y:integer; const st:string; col:byte);
Procedure DrawStringW(x,y:integer; const st:string; xmul,ymul,col:byte);
{$else}
Procedure DrawString(x,y:integer; st:string; col,font:byte);
Procedure DrawString2(x,y:integer; st:string; col,bckcol:byte);
Procedure DrawString(x,y:integer; st:string; col,font:byte);
{$endif}
Procedure SetFont(w,h:byte);
Procedure SetUserFont(w,h:byte;p:pointer);
Procedure SetSpecialFont(w,h,num:byte);

Procedure Circle(xcen,ycen,r:integer;color:byte);
Procedure Fill(x,y:integer; col:byte);
Procedure Wipe(x,y:integer; col:byte);

Const FillError:boolean=False;

Procedure Cls;

{ available fonts: 8,16, 9,16, 8,14 and 8,8. Default 8,16 }

{Const Font8x8=$22;
      Font8x9c}

{Warning, the three last do not check for the end of screen, }

Function GetPixel(x,y:word):byte;

Var SetWindow:Procedure(x:word);     { variable so it can be changed }
    Curbank:word;

Function Wmul(x,y:word):longint;
  inline(
          $5B/              {POP     BX}
          $58/              {POP     AX}
          $F7/$E3           {MUL     BX}
         );

var Hres,Vres:word;

const csize:byte=16;
      cwidth:byte=8;

Var MinSP:word;

Implementation

{$ifndef ver70}
const SegA000:word=$A000;
{$endif}

Type ModeInfoBuff=record
                    ModeAttributes:Word; {bit 0 supported }
                    WindowAAttrib: byte;   {bit 0: exists, bit 1 readable, b2 writable }
                    WindowBAttrib: byte;   {bit 0: exists, bit 1 readable, b2 writable }
                    WindowGranularity:word;
                    WindoSize:word;
                    WindowAstartSeg:word;
                    WindowBStartSeg:word;
                    PositFunc:Pointer;
                    BytesPerline:word;
                    Filler:array[1..256-18] of byte;
                  End;

{$ifdef msdos}
var SetBankRoutine:pointer;
{$endif}

type words=record lo,hi:word; end;

Function ModeNro(Hres,Vres:word):word;
Begin
  ModeNro:=0;
  Case Hres of
    640: if Vres=400 then ModeNro:=$100
         else if Vres=480 then ModeNro:=$101;
    800: if Vres=600  then ModeNro:=$103;
   1024: if Vres=768  then ModeNro:=$105;
   1280: if Vres=1024 then ModeNro:=$107;
  End;

End;

Procedure GetVesaModeInfo(Mode:word; var buff:ModeinfoBuff; var Error:boolean);
var rg:registers;
Begin
  rg.ax:=$4f01;
  rg.cx:=mode;
  rg.es:=seg(buff);
  rg.di:=ofs(buff);
  fillchar(buff,sizeof(buff),0);
  {$ifdef dpmi}
  SetBuffer(rg.es,rg.di,sizeof(buff));
  {$endif}
  Intr($10,rg);
  Error:=rg.ax<>$4f;
End;

Function ModeOK(x,y:word):boolean;
var buff:ModeinfoBuff;
    error:boolean;
    mode:word;
Begin
  ModeOK:=false;
  mode:=ModeNro(x,y);
  if mode=0 then Error:=true
            else GetVesaModeInfo(mode,buff,error);
  If error then exit;
  Error:=(buff.windowgranularity<>64) or
         (buff.windowAAttrib and 5<>5) or
         (buff.windowAStartSeg<>$A000);
  ModeOK:=not error;
End;

{$f+}

{$ifdef asm}

Procedure SetwindowVESA(WindAddr:word); assembler;
          asm
          mov bh,0
          mov dx,WindAddr
          Mov bl,0
          mov curbank,dx;
          {$ifdef dpmi}
          mov ax,4f05h
          int 10h
          {$else}
          Call SetBankRoutine
          {$endif}
          End;
{$else}
Procedure SetwindowVESA(WindAddr:word);
var rg:registers;
Begin
  fillchar(rg,sizeof(rg),0);
  rg.ax:=$4f05;
  rg.bx:=0;
  rg.dx:=WindAddr;
  Intr($10,rg);
  Curbank:=WinDAddr;
End;
{$endif}
{$f-}

{$ifdef asm}
Procedure PutPixel(x,y:word; col:byte); assembler;
          asm
          mov bx,x
          cmp bx,Hres

          mov ax,y
          cmp ax,Vres

          mul Hres
          add ax,bx
          adc dx,0
          cmp dx,curbank

          push ax
          push dx
          call SetWindow
          pop ax

          mov es,SegA000
          mov al,col

          end;

{$else}

Procedure PutPixel(x,y:word; col:byte);
var addr:longint;
begin
  if (x>=Hres) or (y>=Vres) then exit;
  addr:=wmul(Hres,y)+x;
  if words(addr).hi<>curbank then begin
     SetWindow(words(addr).hi);
  End;
  Mem[SegA000:words(addr).lo]:=col;
End;
{$endif}

Function GetPixel(x,y:word):byte;
var addr:longint;
type words=record lo,hi:word; end;
begin
  if (x>=Hres) or (y>=Vres) then begin getpixel:=0; exit; end;
  addr:=wmul(Hres,y)+x;
  if words(addr).hi<>curbank then begin
     SetWindow(words(addr).hi);
  End;
  GetPixel:=Mem[SegA000:words(addr).lo];
End;

Procedure PutPixel2(x,y:word; col1,col2:byte);
var addr:longint;
type words=record lo,hi:word; end;
begin
  if odd(x) then Begin
     PutPixel(x,y,col1);
     PutPixel(x+1,y,col2);
     exit;
  End;
  if (x>=Hres) or (y>=Vres) then exit;
  addr:=wmul(Hres,y)+x;
  if words(addr).hi<>curbank then begin
     SetWindow(words(addr).hi);
  End;
  Memw[SegA000:words(addr).lo]:=col1+256*col2;
End;

Procedure SetVesaMode(mode:word;var error:boolean);
var rg:dos.registers;
Begin
  rg.ax:=$4f02;
  rg.bx:=mode;
  dos.Intr($10,rg);
  Error:=rg.ax<>$4f;
  curbank:=65535;
  SetWindow:=SetWindowVESA;
End;

Procedure SetSVGA(x,y:word; var error:boolean);
var mode:word;
    minfo:modeinfobuff;

Begin
  mode:=modenro(x,y);
  if mode=0 then error:=true
     else begin
            GetVesaModeInfo(mode,minfo,error);
            If error then  Exit;
            Error:=(minfo.windowgranularity<>64) or
                   (minfo.windowAAttrib and 5<>5) or
                   (minfo.windowAStartSeg<>$A000);
            if error then exit;
            SetVesamode(mode,error);
            Hres:=x;
            Vres:=y;
            {$ifdef msdos}
            SetBankRoutine:=minfo.PositFunc;
            {$endif}
            CurBank:=65535;
            initdisp;
          End;

End;

Procedure SetSVGAn(n:word; var error:boolean);
Begin
  case n of
    0: SetSVGA(640,400,error);
    1: SetSVGA(640,480,error);
    2: SetSVGA(800,600,error);
    3: SetSVGA(1024,768,error);
    4: SetSVGA(1280,1024,error);
    else error:=true;
  End;
End;

Procedure InitDisp;
Begin
  curbank:=65535;  { force bank setting on next pixel }
end;

{$ifdef asm}
Procedure move(var src,dest; size: word);  assembler;
            asm
            cld
            push ds
            mov cx,size
            or cx,cx

            mov bx,cx
            les di,dest
            lds si,src

            mov ax,di
            and ax,1
            mov cx,ax
            rep movsb                   { word align DI }

            sub bx,ax
            mov cx,bx                   { Adjust the size }
            shr cx,1

            rep movsw

            mov cx,bx
            and cx,1
            rep movsb

            end;

Procedure Fillchar(var dest; size: word; chr:byte);  assembler;

            asm
            cld
            mov cx,size
            or cx,cx

            mov al,chr
            mov ah,al

            mov bx,cx
            les di,dest

            mov si,di
            and si,1
            mov cx,si
            rep stosb                   { word align DI }

            sub bx,si
            mov cx,bx                   { Adjust the size }
            shr cx,1

            rep stosw

            mov cx,bx
            and cx,1
            rep stosb

            end;

{$endif}

Procedure CopyPixels(x,y:word; n:word; Var Pixels);
var addr:longint;
    p:pointer;
    segleft:word;

type words=record lo,hi:word; end;

Begin
  if (x>=Hres) or (y>=Vres) then exit;
  addr:=wmul(Hres,y)+x;
  p:=ptr(SegA000,words(addr).lo);

  if
...

read more »



Wed, 14 May 2003 04:46:14 GMT  
 
 [ 4 post ] 

 Relevant Pages 

1. Mouse in 256 color mode PROBLEM

2. 256 color mode - HELP!!!

3. HELP: Showing Mouse in SVGA 256 colors mode

4. HELP: Showing Mouse in SVGA 256 colors mode

5. info on 640x480 256 color mode??

6. info on 640x480 256 color mode??

7. Vesa unit for all 256 and 65K color modes (protected,real mode)

8. HELP! GRAPHIC MOUSE IN 256 COLOR MODE!

9. Mouse "Jumps" by 8 Pixels in 256 Color Mode (at Any Resolution).

10. 256 color text mode

11. Colorscreen mode 256 colors

12. 256 colors - VGA - mode?

 

 
Powered by phpBB® Forum Software