Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/dc/dc.pas

Pascal/Delphi Source File | 1992-10-21 | 4.9 KB | 163 lines

{
  Copyright 1992 by Digital Crime.

  All rights reserved.

  Permission to use, copy, modify, and distribute this software and its
  documentation for any purpose and without fee is hereby granted,
  provided that the above copyright notice appear in all copies and that
  both that copyright notice and this permission notice appear in
  supporting documentation, and that the name of the Digital Crime
  not be used in advertising or publicity pertaining to distribution
  of the software without specific, written  prior permission.

  DIGITAL CRIME DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
  SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  AND FITNESS, IN NO EVENT SHALL DIGITAL CRIME BE LIABLE FOR ANY SPECIAL,
  INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
  NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
  WITH THE USE OR PERFORMANCE OF THIS  SOFTWARE.

  [e-mail]   Chandi.
  [e-mail]   Ed.

}
{$R-}

program Digital_Crime;

{ Simple demo of using bitmaps made using SVGAMAP }
{ and some pallette scrolling                     }

uses SVGA, Crt;

const MaxWidth = 120;
      MaxHeight = 120;

type ImageType = array[ 0..MaxWidth, 0..MaxHeight ] of byte;

var D, C, T : ImageType;
    i, j, Col, Top, Top2  : integer;
    Hue : RGB;
    TempCol : PaletteRegister;

procedure LoadImage( ImageName: string; var Image: ImageType );

  var fil : File of ImageType;

  begin
    assign( fil, ImageName );
    reset( fil );
    read( fil, Image );
    close( fil );
  end;

procedure PutImage( Image : ImageType; x, y : integer );

  var i, y1, y2, x1, x2 : integer;
      Segment, Color : byte;

  procedure PutPix( Color : byte; xx, yy : integer );

    begin
        asm
          mov ax, Bytes_per_Line
          mov bx, yy
          mul bx
          add ax, xx
          mov di, ax
          mov ax, 0a000h
          mov es, ax
          mov al, Color
          mov es:[di], al
        end;
    end;

  begin
    x1 := x; x2 := x + 119;
    y1 := y; y2 := y + 119;
    repeat
      if (y1 = 102) OR (y1 = 204) OR (y1 = 307) OR (y1 = 409) then
        begin
          repeat
            if (y1 = 102) AND (x1 < 256) then Segment := 0
             else if ((y1 = 102) AND (x1 > 255)) OR
                     ((y1 = 204) AND (x1 < 512)) then Segment := 1
             else if ((y1 = 204) AND (x1 > 511)) OR
                     ((y1 = 307) AND (x1 < 128)) then  Segment := 2
             else if ((y1 = 307) AND (x1 > 127)) OR
                     ((y1 = 409) AND (x1 < 384)) then Segment := 3
               else Segment := 4;
            LoadWriteBank( Segment );
            if Image[y1-y,x1-x] <> 0 then
              PutPix( Image[ y1-y, x1-x ], x1, y1 );
            x1 := x1 + 1;
          until  x1 > x2
        end
      else
        begin
          if y1 < 102 then Segment := 0
            else if y1 < 204 then Segment := 1
              else if y1 < 307 then Segment := 2
                else if y1 < 409 then Segment := 3
                  else Segment := 4;
          LoadWriteBank( Segment );
          repeat
            if Image[y1-y,x1-x] <> 0 then
              PutPix( Image[ y1-y, x1-x ], x1, y1 );
            x1 := x1 + 1;
          until x1 > x2;
        end;
      x1 := x;
      y1 := y1 + 1;
    until y1 > y2;
  end;

begin
  SetMode( SVGAMED );
  LoadPalette( 'DC.PAL' );
  LoadImage( 'D.Img', D );
  LoadImage( 'C.Img', C );
  for j := 0 to 639 do
    begin
      Col := round( j * 0.19844 );
      Line( 320, 240, j, 0, Col );
      Line( 320, 240, j, 479, Col );
    end;
  for j := 0 to 479 do
    begin
      Col := round( j * 0.2645833 );
      Line( 320, 240, 0, j, Col );
      Line( 320, 240, 639, j, Col );
    end;
  TempCol := Color;                    { Color is a public pallette array }
  for i := 0 to 63 do                  { that keeps track of the colors   }
    begin                              { stored in each pallette          }
      for j := 0 to 255 do
        begin
          if 0 < Color[j].Red then Color[j].Red := Color[j].Red - 1;
          if 0 < Color[j].Grn then Color[j].Grn := Color[j].Grn - 1;
          if 0 < Color[j].Blu then Color[j].Blu := Color[j].Blu - 1;
        end;
     SetPalette( Color );
    end;
  PutImage( D, 180, 180 );
  PutImage( C, 340, 180 );
  for i := 0 to 63 do
    begin
      for j := 0 to 255 do
        begin
          if TempCol[j].Red > Color[j].Red then
            Color[j].Red := Color[j].Red + 1;
          if TempCol[j].Grn > Color[j].Grn then
            Color[j].Grn := Color[j].Grn + 1;
          if TempCol[j].Blu > Color[j].Blu then
            Color[j].Blu := Color[j].Blu + 1;
        end;
     SetPalette( Color );
    end;
  repeat  until keypressed;
  ExitGraphics;
end.