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

Pascal/Delphi Source File | 1992-10-21 | 5.0 KB | 167 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 SVGA_Image_Maker;

{ This lets you create and edit your own bitmaps. This program        }
{ must be run from TP if you need to start modifying bitmap sizes     }
{ If editing small images the pixel size can be increased by simply   }
{ changing PixelWidth.  Image is saved to disk by dumping whole array }
{ to disk.  This makes quicker loads and saves                        }

uses SVGA, Crt;

const MaxWidth = 120;           { Width of image }
      MaxHeight = 120;          { Height of image }
      PaletteName = 'dc.pal'; { Name of pallette to use }
      ImageName = 'd.img';      { name of image }
      PixelWidth = 4;           { size of pixels }

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

var GM : GraphicMouse;
    Image : ImageType;
    XPos, YPos, Btn, TX, TY : integer;
    ActiveColor : byte;
    XCoord, YCoord : string;
    Quit : boolean;
    Ch : char;


procedure Grid;

  var i, j : integer;

  begin
    GM.Show( False );
    for i := 0 to MaxHeight do
      for j := 0 to MaxWidth do
        begin
          RectFill( j*PixelWidth, i*PixelWidth, j*PixelWidth+PixelWidth-1,
                    i*PixelWidth+PixelWidth-1, Image[i,j] );
          Plot( 500+j, 300+i, Image[i,j] )
        end;
    GM.Show( True );
  end;

procedure SaveImage;

  var  fil : File of ImageType;

  begin
    assign( fil, ImageName );
    rewrite( fil );
    write( fil, Image );
    close( fil );
  end;

procedure LoadImage;

  var  fil : File of ImageType;

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

procedure SetUp;

  var i, j : integer;

  begin
    SetMode( SVGAMED );              { Set Mode 640*480*256   }
    LoadPalette( PaletteName );      { Load desired Palette   }
    LoadFont( StandardFont );        { Load desired Font      }
    SetFontColor( 253, 0, false );   { Set Font Color and     }
    for i := 0 to 7 do               { turn on overwrite mode }
      for j := 0 to 31 do
        RectFill( 500+i*15, j*7, 500+i*15+14, j*7+7, i*32+j );
    for i := 0 to MaxWidth do
      for j := 0 to MaxHeight do
        Image[ i, j ] := 226;
    Quit := False;
    ActiveColor := 45;
    GM.Initialize;
  end;

begin
  SetUp;
  Grid;
  repeat
    GM.CheckMouse;
    GM.GetPosition( Btn, XPos, YPos );
    TX := ( XPos div PixelWidth );
    TY := ( YPos div PixelWidth );
    if (XPos < (MaxWidth+1)*PixelWidth ) AND (YPos < (MaxHeight+1)*PixelWidth) then
      begin
        str( XPos div PixelWidth, XCoord );
        str( YPos div PixelWidth, YCoord );
        OutTextXY( 525, 260, XCoord+'  ' );
        OutTextXY( 575, 260, YCoord+'  ' );
      end;
    if ( XPos > 500 ) AND ( Btn AND $01 = $01 )
        AND ( YPos < 225 ) then
      begin
        GM.Show( False );
        for TX := 0 to 7 do
          for TY := 0 to 31 do
            RectFill( 500+TX*15, TY*7, 500+TX*15+14, TY*7+7, TX*32+TY );
        TX := ((XPos-500) div 15);
        TY := (YPos div 7 );
        Rectangle( 500+TX*15, TY*7, 500+TX*15+14, TY*7+7, 255 );
        Rectangle( 500+TX*15+1, TY*7+1, 500+TX*15+13, TY*7+6, 252 );
        GM.Show( True );
        ActiveColor := TX*32 + TY;
      end;
    if ( XPos < (MaxWidth+1)*PixelWidth) AND (Btn AND $03 <> 0)
        AND (YPos < (MaxHeight+1)*PixelWidth) then
      begin
        GM.Show( False );
        Image[ TY, TX ] := ActiveColor;
        RectFill( TX * PixelWidth, TY * PixelWidth,
                  TX * PixelWidth+ PixelWidth-1,
                  TY * PixelWidth+ PixelWidth-1, ActiveColor );
        Plot( 500+TX, 300+TY, ActiveColor );
        GM.Show( True );
      end;
    if keypressed then
      begin
        Ch := ReadKey;
        case Ch of
            'q','Q' : Quit := True;
            's','S' : SaveImage;
            'l','L' : LoadImage;
        end;
      end;
    until Quit;
  ExitGraphics;
  GM.ExitSVGA;
end.