C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/TRCBGI11/BGIDEMO.002

Text File | 1993-01-06 | 6KB | 197 lines

(* Color demonstration routines for BGIDemo *)
(* you should include this code in your version of BGIDemo.PAS and call
   the 4 procedures succesively after ColorPlay. *)

procedure ColorPlane0;
const
  XBars = 16;
  YBars = 16;
var
  I, J     : word;
  X, Y     : word;
  Color    : word;
  ViewInfo : ViewPortType;
  Width    : word;
  Height   : word;
  OldPal   : PaletteType;
begin
 if MaxColor=255 then begin
  MainWindow('256 color demonstration');
  StatusLine('Esc aborts or press a key');
  GetViewSettings(ViewInfo);
  with ViewInfo do
  begin
    Width := (x2-x1) div XBars;
    Height := (y2-y1) div YBars;
  end;
  X := 0; Y := 0;
  Color := 0;
  for J := 1 to YBars do
  begin
    for I := 1 to XBars do
    begin
      SetFillStyle(SolidFill, Color);
      Bar(X, Y, X+Width, Y+Height);
      Inc(X, Width+1);
      Inc(Color);
      Color := Color mod (MaxColor+1);
    end;
    X := 0;
    Inc(Y, Height+1);
  end;
  waittogo;
 end;
end;

procedure ColorPlane1;
const
  Esc = #27;
var MaxColVal:LongInt;
    ViewPort : ViewPortType;
    Stepx,stepy:integer;
    x,y,xs,ys,yl,xl:integer;
    M2,color:LongInt;
    Ch : char;
    h1,h2,m1,mi2,s1,s2,hd1,hd2:word;
begin
  if MaxColor>255 then begin
    MainWindow('Colorplane green/red');
    StatusLine('Esc aborts or press a key');
    if MaxColor<32768 then MaxColVal:=32 else MaxColVal:=256;
    M2:=MaxColVal*MaxColVal;
    GetViewSettings(ViewPort);
    Gettime(h1,m1,s1,hd1);
    with ViewPort do begin
      stepx:=((x2-x1) div (MaxColVal+1))+1;
      stepy:=((y2-y1) div (MaxColVal+1))+1;
      for y:=0 to MaxColVal-1 do begin
        for ys:=0 to StepY-1 do begin
          yl:=y*StepY+ys;
          for x:=0 to MaxColVal-1 do begin
            if MaxColVal=32 then
              Color:=LongInt(x)*MaxColVal+LongInt(y)*M2
            else
              Color:=LongInt(x)*MaxColVal+LongInt(y);
            xl:=x*StepX;
            for xs:=0 to StepX-1 do begin
              PutPixel(xl+xs,yl,color);
              if keypressed then begin
                Ch := ReadKey;
                if ch = #0 then ch := readkey;      { trap function keys }
                if Ch = Esc then
                  Halt(0)                           { terminate program }
                else begin
                  ClearDevice;            { clear screen, go on with demo }
                  exit;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
    Gettime(h2,mi2,s2,hd2);
    waittogo;
  end;
end;

procedure ColorPlane2;
const
  Esc = #27;
var MaxColVal:LongInt;
    ViewPort : ViewPortType;
    Stepx,stepy:integer;
    x,y,xs,ys,yl,xl:integer;
    color:LongInt;
    Ch : char;
    M2:LongInt;
begin
  if MaxColor>255 then begin
    MainWindow('Colorplane green/blue');
    StatusLine('Esc aborts or press a key');
    if MaxColor<32768 then MaxColVal:=32 else MaxColVal:=256;
    M2:=MaxColVal*MaxColVal;
    GetViewSettings(ViewPort);
    with ViewPort do begin
      stepx:=((x2-x1) div (MaxColVal+1))+1;
      stepy:=((y2-y1) div (MaxColVal+1))+1;
      for y:=0 to MaxColVal-1 do begin
        for ys:=0 to StepY-1 do begin
          yl:=y*StepY+ys;
          for x:=0 to MaxColVal-1 do begin
            if MaxColVal=32 then
              Color:=LongInt(x)*MaxColVal+LongInt(y)
            else
              Color:=LongInt(x)*MaxColVal+LongInt(y)*M2;
            xl:=x*StepX;
            for xs:=0 to StepX-1 do begin
              PutPixel(xl+xs,yl,color);
              if keypressed then begin
                Ch := ReadKey;
                if ch = #0 then ch := readkey;      { trap function keys }
                if Ch = Esc then
                  Halt(0)                           { terminate program }
                else begin
                  ClearDevice;            { clear screen, go on with demo }
                  exit;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
    waittogo;
  end;
end;

procedure ColorPlane3;
const
  Esc = #27;
var MaxColVal:LongInt;
    ViewPort : ViewPortType;
    Stepx,stepy:integer;
    x,y,xs,ys,yl,xl:integer;
    color:LongInt;
    Ch : char;
    M2:LongInt;
begin
  if MaxColor>255 then begin
    MainWindow('Colorplane blue/red');
    StatusLine('Esc aborts or press a key');
    if MaxColor<32768 then MaxColVal:=32 else MaxColVal:=256;
    M2:=MaxColVal*MaxColVal;
    GetViewSettings(ViewPort);
    with ViewPort do begin
      stepx:=((x2-x1) div (MaxColVal+1))+1;
      stepy:=((y2-y1) div (MaxColVal+1))+1;
      for y:=0 to MaxColVal-1 do begin
        for ys:=0 to StepY-1 do begin
          yl:=y*StepY+ys;
          for x:=0 to MaxColVal-1 do begin
            if MaxColVal=32 then
              Color:=LongInt(y)*M2+LongInt(x)
            else
              Color:=LongInt(x)*M2+LongInt(y);
            xl:=x*StepX;
            for xs:=0 to StepX-1 do begin
              PutPixel(xl+xs,yl,color);
              if keypressed then begin
                Ch := ReadKey;
                if ch = #0 then ch := readkey;      { trap function keys }
                if Ch = Esc then
                  Halt(0)                           { terminate program }
                else begin
                  ClearDevice;            { clear screen, go on with demo }
                  exit;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
    waittogo;
  end;
end;