home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / pcx / pcx_unit / pcx-imi.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-08-08  |  3.1 KB  |  101 lines
  1. PROGRAM ShowPCX;
  2.  
  3. USES Crt, Graph, Dos, PCXUNIT, EGAVG;
  4.  
  5. VAR
  6.  
  7.            g                  : FILE;
  8.            key                : Char;
  9.            co                 : Byte;
  10.            n2,n3              : String;
  11.            driver,Mode,so     : Integer;
  12.            Color              : ARRAY[0..640,1..4] OF Boolean;
  13.            pix,Size,re        : Word;
  14.            nx,ny,DX,dy,d2x,d2y: Integer;
  15.            x1,x2,y1,y2        : Integer;
  16.  
  17. BEGIN;
  18.  
  19.   IF RegisterBGIDriver(@EGAVGA)<0 THEN Exit;
  20.   ClrScr;
  21.   WriteLn; WriteLn; WriteLn;
  22.   WriteLn('    Unter welchen Namen soll das Bild nacher gespeichert werden ?');
  23.   Write  ('    Name:'); ReadLn(n2);
  24.   WriteLn;
  25.   WriteLn('    Wie heißt das zu ladende Paintbrush-Bild (RETURN wenn es von');
  26.   WriteLn('    einem Utility geladen werden soll)');
  27.   Write('    Name:');
  28.   ReadLn(n);
  29.  
  30.   {Bitte folgende Befehle UNBEDINGT an den erwuenschten Graphikmode}
  31.   {angleichen:                                                     }
  32.  
  33.   driver:=EGA; Mode:=EGAHi;
  34.   InitGraph(driver,Mode,'');
  35.   ClearDevice;
  36.   IF n<>'' THEN LOADPIC ELSE ReadLn;
  37.   nx:=0; ny:=0; DX:=0; dy:=0; pix:=0; d2x:=0; d2y:=0;
  38.   REPEAT;
  39.     pix:=GetPixel(nx,ny);
  40.     IF pix<>Black THEN
  41.            PutPixel(nx,ny,Black) ELSE
  42.            PutPixel(nx,ny,Yellow);
  43.     REPEAT;
  44.       key:=ReadKey;
  45.     UNTIL (key='8') OR (key='4') OR (key='6') OR (key='2') OR
  46.           (key='s') OR (key=' ') OR (Ord(key)=72) OR
  47.           (Ord(key)=75) OR (Ord(key)=77) OR (Ord(key)=80);
  48.     PutPixel(nx,ny,pix);
  49.     IF (key='8') AND (ny>5) THEN ny:=ny-5;     {Bitte die einzelnen}
  50.     IF (key='2') AND (ny<345) THEN ny:=ny+5;   {Maximalwerte an Ihre}
  51.     IF (key='4') AND (nx>5) THEN nx:=nx-5;     {Graphikkarte an-}
  52.     IF (key='6') AND (nx<635) THEN nx:=nx+5;   {gleichen}
  53.     IF (key='5') THEN nx:=640;
  54.     IF (Ord(key)=72) AND (ny>0) THEN ny:=ny-1; { s. o. }
  55.     IF (Ord(key)=75) AND (nx>0) THEN nx:=nx-1;
  56.     IF (Ord(key)=77) AND (nx<640) THEN nx:=nx+1;
  57.     IF (Ord(key)=80) AND (ny<350) THEN ny:=ny+1;
  58.     IF (key=' ') AND (d2y>0) AND (dy=0) THEN BEGIN;
  59.         IF (d2y-ny+1)<0 THEN dy:=ny-d2y-1
  60.                         ELSE dy:=d2y-ny+1;
  61.         SetColor(Yellow);
  62.         Line(nx,d2y,nx,ny);
  63.         Line(d2x,ny,d2x,d2y);
  64.         Line(d2x,ny,nx,ny);
  65.     END;
  66.     IF (key=' ') AND (d2x>0) AND (DX=0) THEN BEGIN;
  67.         IF (d2x-nx+1)<0 THEN DX:=nx-d2x-1
  68.                         ELSE DX:=d2x-nx+1;
  69.         SetColor(Yellow);
  70.         Line(d2x,ny,nx,ny);
  71.         d2y:=ny+1
  72.     END;
  73.     IF (key=' ') AND (d2x=0) THEN BEGIN;
  74.                                    d2x:=nx+1;
  75.                                    pix:=GetPixel(nx,ny);
  76.                                   END;
  77.  
  78.   UNTIL key='s';
  79.   x1:=d2x+1;
  80.   x2:=d2x+DX;
  81.   y1:=d2y+1;
  82.   y2:=d2y+dy;
  83.   Size:=ImageSize(x1,y1,x2,y2);
  84.   GetMem(p,Size);
  85.   GetImage(x1,y1,x2,y2,p^);
  86.   Assign(g,n2);
  87.   Rewrite(g,1);
  88.   BlockWrite(g,p^,Size);
  89.   Close(g);
  90.   ClearDevice;
  91.   PutImage(20,20,p^,0);
  92.   ReadLn;
  93.   CloseGraph; RestoreCrtMode;
  94.   ClrScr;
  95.   WriteLn; WriteLn;
  96.   WriteLn('x-Groesse:',x2-x1);
  97.   WriteLn('y-Groesse:',y2-y1);
  98.   WriteLn('Groesse  :',Size);
  99.   ReadLn;
  100. END.
  101.