Home » Source Code » » PCX2COD.PAS

PCX2COD.PAS ( File view )

From:
  • By 2010-07-21
  • View(s):9
  • Download(s):0
  • Point(s): 1
			{
$DEFINE StackCheck
}
{
$DEFINE test
}

{
$IFDEF test
}
  {
$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-
}
  {
$M 16384,0,655360
}
{
$ELSE
}
  {
$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-
}
  {
$M 16384,150000,655360
}
{
$ENDIF
}

PROGRAM PCX_to_COD_and_PIC_converter;

USES Dos,Graph,crt,Eingaben,Dateien;
const
      MausMinX=0;     {
Koordinatenbereich fr Maus
}
      MausMinY=0;
      MausMaxX:INTEGER=0;
      MausMaxY:INTEGER=0;
      MausMaxX_mul2:INTEGER=0;
      MausMaxY_mul2:INTEGER=0;

      SVGA320x200x256	= 0;	(* 320x200x256 Standard VGA *)
      SVGA640x400x256	= 1;	(* 640x400x256 Svga *)
      SVGA640x480x256	= 2;	(* 640x480x256 Svga *)
      SVGA800x600x256	= 3;	(* 800x600x256 Svga *)
      SVGA1024x768x256	= 4;	(* 1024x768x256 Svga *)

CONST EventNone=0;                 {
gar nix
}
      EventError=1;                {
Fehler 
}
      EventQuit=2;                 {
Programm vielleicht beenden
}
      EventHelp=9;                 {
Hilfe
}
      EventMouseMoved=17;          {
Maus wurde bewegt
}
      EventEndProgram=41;          {
Programm tatschlich beenden
}
      EventSpeichern=100;          {
ausgewhlten Grafikbereich abspeichern
}

{
---------Menu-Felder---------
}

TYPE DrawBox=PROCEDURE;
     box=RECORD  {
Datentyp fr ein Menufeld:
}
          x1,y1,                 {
obere linke Boxecke
}
          x2,y2:WORD;            {
untere rechte Ecke 
}
          Name1,Name2:STRING[8]; {
Beschriftung 1.+2.Zeile
}
          Show :DrawBox;         {
Routine zum anzeigen des Icons
}
          Event:BYTE;            {
zurckzugebender Wert
}
          Click:BOOLEAN;         {
mu Maus geclickt werden fr Event?
}
          Paint:BOOLEAN;         {
Flag, ob Box zu zeichnen ist
}
         END;
     boxes=ARRAY[1..3] OF box;  {
alle Menufelder zusammen
}

     ButtonStringTyp=STRING[8];  {
Meldung in Clickboxen
}

PROCEDURE Dummy; FAR; BEGIN END;

CONST Menu:boxes=(

 {
gesamter Mausbereich kann auch als "Menubox" realisiert werden:
}
       (x1:MausMinX;    y1:MausMinY;
        x2:0 {
MausMaxX
};    y2:0 {
MausMaxY
};
        Name1:'';Name2:'';
        Show :Dummy;
        Event:EventMouseMoved;
        Click:FALSE;    {
kein Anclicken ntig
}
        Paint:FALSE),   {
...wird aber nicht gezeichnet
}

 {
Sentinelwert, da x1>x2!
}
       (x1:1; y1:0; x2:0; y2:0;    
        Name1:'';Name2:'';
        Show :Dummy;
        Event:EventNone;
        Click:TRUE;
        Paint:TRUE),

 {
Noch einer als Fller, x1>x2!
}
       (x1:1; y1:0; x2:0; y2:0;    
        Name1:'';Name2:'';
        Show :Dummy;
        Event:EventNone;
        Click:TRUE;
        Paint:TRUE)
      );

VAR event:BYTE;
    CRTAddress,      {
Adresse des CRT-Ports, $3B4/$3D4 fuer monochrom/Farbe
}
    StatusReg:WORD;  {
dto., fuer Statusregister, $3BA/$3DA
}
    Shift:BOOLEAN;   {
gibt wieder, ob whrend Auswertung Shift gedrckt war
}
    BestWhite,       {
Beste Nherungen der angeg. Farben
}
    BestBlack,
    BestCyan,
    BestLightGray,
    BestDarkGray:BYTE;
    MeldungX,MeldungY:INTEGER;

{
-------------------- Ziffernausgabe ------------------
}
TYPE Ziffer=ARRAY[0..6,0..7] OF BYTE;
     ToldArea=ARRAY[0..9*8,0..7] OF BYTE;
CONST Ziffern:ARRAY['0'..'9'] OF Ziffer=
(
((0,1,1,1,1,1,0,0),
 (1,1,0,0,0,1,1,0),
 (1,1,0,0,1,1,1,0),
 (1,1,0,1,1,1,1,0),
 (1,1,1,1,0,1,1,0),
 (1,1,1,0,0,1,1,0),
 (0,1,1,1,1,1,0,0)),

((0,0,1,1,0,0,0,0),
 (0,1,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0),
 (1,1,1,1,1,1,0,0)),

((0,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (0,0,0,0,1,1,0,0),
 (0,0,1,1,1,0,0,0),
 (0,1,1,0,0,0,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,1,1,1,1,0,0)),

((0,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (0,0,0,0,1,1,0,0),
 (0,0,1,1,1,0,0,0),
 (0,0,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,0,0,0)),

((0,0,0,1,1,1,0,0),
 (0,0,1,1,1,1,0,0),
 (0,1,1,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,1,1,1,1,1,0),
 (0,0,0,0,1,1,0,0),
 (0,0,0,1,1,1,1,0)),

((1,1,1,1,1,1,0,0),
 (1,1,0,0,0,0,0,0),
 (1,1,1,1,1,0,0,0),
 (0,0,0,0,1,1,0,0),
 (0,0,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,0,0,0)),

((0,0,1,1,1,0,0,0),
 (0,1,1,0,0,0,0,0),
 (1,1,0,0,0,0,0,0),
 (1,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,0,0,0)),

((1,1,1,1,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,0,0,0,1,1,0,0),
 (0,0,0,1,1,0,0,0),
 (0,0,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0),
 (0,0,1,1,0,0,0,0)),

((0,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,0,0,0)),

((0,1,1,1,1,0,0,0),
 (1,1,0,0,1,1,0,0),
 (1,1,0,0,1,1,0,0),
 (0,1,1,1,1,1,0,0),
 (0,0,0,0,1,1,0,0),
 (0,0,0,1,1,0,0,0),
 (0,1,1,1,0,0,0,0))
);

FUNCTION min(a,b:INTEGER):INTEGER;
BEGIN
 IF a<=b THEN min:=a ELSE min:=b
END;

FUNCTION max(a,b:INTEGER):INTEGER;
BEGIN
 IF a>=b THEN max:=a ELSE max:=b
END;

FUNCTION min3(a,b,c:INTEGER):INTEGER;
BEGIN
 min3:=min(a,min(b,c))
END;

FUNCTION max3(a,b,c:INTEGER):INTEGER;
BEGIN
 max3:=max(a,max(b,c))
END;

PROCEDURE PrintXY(x,y,a,b:INTEGER; VAR oldP:ToldArea);
VAR n,i,j:INTEGER;
    s:STRING[8];
BEGIN
 FOR i:=Max(0,x) TO Min(x+9*8-1,GetMaxX) DO
  FOR j:=Max(0,y) TO Min(y+7,GetMaxY) DO
   oldP[i-x,j-y]:=GetPixel(i,j);

 Str(a,s);
 FOR n:=1 TO Length(s) DO
  FOR j:=0 TO 6 DO
   BEGIN
    FOR i:=0 TO 7 DO
     IF (Ziffern[s[n]][j,i]=1)
       THEN PutPixel(x+i +Pred(n) SHL 3,y+j,BestWhite)
   END;

 INC(x,Length(s) SHL 3 +4);
 Str(b,s);
 FOR n:=1 TO Length(s) DO
  FOR j:=0 TO 6 DO
   BEGIN
    FOR i:=0 TO 7 DO
     IF (Ziffern[s[n]][j,i]=1)
       THEN PutPixel(x+i +Pred(n) SHL 3,y+j,BestWhite)
   END;
END;

{
----------Maus-Routinen----------
}
CONST MouseMoved=1;
      LeftButtonPressed=2;
      LeftButtonReleased=4;
      RightButtonPressed=8;
      RightButtonReleased=16;
      SuppressMouse:BOOLEAN=FALSE;
VAR   Aufrufmaske,Maustasten:WORD;
      MausX,MausY,MausXalt,MausYalt:INTEGER;
      mouseX2,mouseY2:INTEGER; {
interne Mauskoordinaten
}
      oldMouse:RECORD
                BoxLeft,BoxRight,BoxTop,BoxBottom :ARRAY[0..1023] OF BYTE;
                {
Speicher fr Windowbox
}
                oldX,oldY:WORD;   {
alte Mauskoordinaten
}
                breite,hoehe:WORD;  {
des Fensters
}
                oldP:ToldArea;
               END;
      MouseUpdate:BOOLEAN;
      LeftButton,RightButton:BOOLEAN;
      regs:REGISTERS;


FUNCTION MouseEvent(VAR menu):BYTE;
{
 in: MausX,MausY = aktuelle Mausposition
}
{
     LeftButton, RightButton = TRUE, wenn Mausbutton gedrckt
}
{
     Shift = TRUE, falls Shifttaste whrend des Mausclicks gedrckt  
}
{
             worden ist
}
{
     menu = Array vom Typ "boxes", das die Menuboxkoordinaten enthlt
}
{
     EventNone = Rckgabewert, falls Maus in keinem der Felder steht 
}
{
out: Der Index desjenigen "menu"-Eintrages, in dem die Maus steht;   
}
{
     sollte dies keiner sein, so wird "EventNone"=0 zurckgegeben    
}
{
rem: Das Ende der Menueintrge mu durch einen Eintrag mit x1>x2 an- 
}
{
     gegeben werden!
}
VAR i:BYTE;
    a:boxes ABSOLUTE menu;
BEGIN
 i:=1;
 WHILE (a[i].x1<=a[i].x2) DO
  BEGIN
   WITH a[i] DO
   IF (x1<=MausX) AND (MausX<=x2) AND (y1<=MausY) AND (MausY<=y2)
      AND ( (NOT click) OR (LeftButton OR RightButton) )
    THEN BEGIN
          MouseEvent:=Event;
          exit
         END
    ELSE INC(i)
   END;
 MouseEvent:=EventNone;
END;

PROCEDURE DrawMaus;
{
 in: MausX,MausY = Koordinaten fr Mauscursor
}
{
     MausXalt,MausYalt = Koord. des vorherigen Aufrufs
}
{
     oldMouse.Box* = Platz fr Grafikausschnitt unter Mauscursor
}
{
out: oldMouse.* = gerettete Grafikdaten
}
{
rem: Der Speicherplatz MouseMem^ mu bereits reserviert worden sein  
}
{
     Obwohl die Routine "Cursor" nicht verndert, wird als VAR-Para- 
}
{
     meter bergeben, da dann nur ein Zeiger bergeben wird!
}
VAR i,oldX2,oldY2:WORD;
    diff:INTEGER;
BEGIN
 WITH oldMouse DO
  BEGIN
   oldx:=MausX;  oldY:=MausY;
   diff:=GetMaxX-(MausX+breite-1);
   IF diff<0 THEN inc(breite,diff);
   diff:=GetMaxY-(MausY+hoehe-1);
   IF diff<0 THEN inc(hoehe,diff);
   IF breite<1 THEN breite:=1;
   IF hoehe<1 THEN hoehe:=1;
   PrintXY(oldX+1,oldY+1,breite,hoehe,oldP);

   oldx2:=MausX+breite-1; oldY2:=MausY+hoehe-1;
   FOR i:=oldX TO oldX2 DO
    BEGIN
     BoxTop[i]:=GetPixel(i,oldY);
     BoxBottom[i]:=GetPixel(i,oldY2);
     IF Odd(i)
      THEN BEGIN
            PutPixel(i,oldY,BestWhite);
            PutPixel(i,oldY2,BestWhite)
           END
      ELSE BEGIN
            PutPixel(i,oldY,BestBlack);
            PutPixel(i,oldY2,BestBlack)
           END
    END;
   FOR i:=oldY+1 TO oldY2-1 DO
    BEGIN
     BoxLeft[i]:=GetPixel(oldX,i);
     BoxRight[i]:=GetPixel(oldX2,i);
     IF Odd(i)
      THEN BEGIN
            PutPixel(oldX,i,BestWhite);
            PutPixel(oldX2,i,BestWhite)
           END
      ELSE BEGIN
            PutPixel(oldX,i,BestBlack);
            PutPixel(oldX2,i,BestBlack)
           END
    END;

  END;
END;

PROCEDURE UnDrawMaus;
{
 in: oldMouse.* = zu restaurierende Grafikdaten
}
VAR i,j,oldX2,oldY2:WORD;
BEGIN
 WITH oldMouse DO
  BEGIN
   oldX2:=oldX+breite-1; oldY2:=oldY+hoehe-1;
   FOR i:=oldX TO oldX2 DO
    BEGIN
     PutPixel(i,oldY,BoxTop[i]);
     PutPixel(i,oldY2,BoxBottom[i])
    END;
   FOR i:=oldY+1 TO oldY2-1 DO
    BEGIN
     PutPixel(oldX,i,BoxLeft[i]);
     PutPixel(oldX2,i,BoxRight[i])
    END;
   FOR i:=Max(0,oldX+1) TO Min(oldX+1+9*8-1,GetMaxX) DO
    FOR j:=Max(0,oldY+1) TO Min(oldY+1+7,GetMaxY) DO
     PutPixel(i,j,oldP[i-(oldX+1),j-(oldY+1)]);
  END;
END;

FUNCTION MouseInstalled : Boolean;
{
 in: - 
}
{
out: TRUE|FALSE fr: Maus gefunden/nicht gefunden
}
VAR INT33h:POINTER;
BEGIN
 GetIntVec($33,INT33h);
 IF (BYTE(INT33h^)=$CF) OR (LONGINT(INT33h)=0)
  THEN MouseInstalled:=FALSE  {
nur IRET oder Nullpointer
}
  ELSE BEGIN {
INT33h fhrt nicht ins Nirwana, trau dich!
}
        WRITELN(10);
     (* regs.ax := 0;   {
Ja hallo, gibt's hier ne Maus im System?
}
        Intr($33,regs);
        MouseInstalled:=(regs.ax=$FFFF); *)
        ASM
          PUSHF
          CLI
          PUSH BX
          PUSH CX
  
...
...
(Not finished, please download and read the complete file)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
ANIVGA.DOC220.35 kB07-11-93|18:45
ANIVGA.ENG320.98 kB07-11-93|18:45
ANIVGA.PAS318.61 kB07-11-93|18:45
ANIVGA.TUT12.66 kB07-11-93|18:45
BFFFFFFF.PAS2.02 kB07-11-93|18:45
CHANGES.TXT4.76 kB07-11-93|18:45
COMPRESS.PAS38.98 kB07-11-93|18:45
DATEIEN.PAS45.08 kB07-11-93|18:45
DUMP_SPR.PAS10.05 kB07-11-93|18:45
EINGABEN.PAS8.68 kB07-11-93|18:45
EXAMPL12.PAS3.77 kB07-11-93|18:45
EXAMPLE1.PAS1.58 kB07-11-93|18:45
EXAMPLE2.PAS1.89 kB07-11-93|18:45
EXAMPLE3.PAS3.24 kB07-11-93|18:45
EXAMPLE4.PAS1.64 kB07-11-93|18:45
EXAMPLE5.PAS2.92 kB07-11-93|18:45
EXAMPLE6.PAS3.98 kB07-11-93|18:45
EXAMPLE7.PAS3.03 kB07-11-93|18:45
EXAMPLE8.PAS2.82 kB07-11-93|18:45
EXAMPLE9.PAS1.38 kB07-11-93|18:45
FAQ.TXT11.99 kB07-11-93|18:45
07.00 B
2_HEBREW.FNT3.51 kB11-03-92|10:38
30.FNT3.26 kB11-03-92|10:39
33Q.FNT3.01 kB11-03-92|10:39
36.FNT2.76 kB11-03-92|10:39
44.FNT2.26 kB11-03-92|10:39
8X10.FNT2.51 kB11-03-92|10:38
8X11SNSF.FNT2.76 kB11-03-92|10:38
8X14.FNT3.51 kB11-03-92|10:38
ALPS.FNT3.51 kB11-03-92|10:37
ALPS10.FNT2.51 kB11-03-92|10:37
ALPS11.FNT2.76 kB11-03-92|10:37
ALPS6.FNT1.51 kB11-03-92|10:37
ALPS7.FNT1.76 kB11-03-92|10:37
ALPS8.FNT2.01 kB11-03-92|10:37
ANTIQUE.FNT3.51 kB11-03-92|10:38
APLS9.FNT2.26 kB11-03-92|10:37
B814.FNT3.51 kB11-03-92|10:39
BIGSERIF.FNT3.51 kB11-03-92|10:38
BLCKSNSF.FNT2.51 kB11-03-92|10:38
BLOCK.FNT3.51 kB11-03-92|10:38
BOLD.FNT3.51 kB11-03-92|10:38
BROADWAY.FNT3.51 kB11-03-92|10:38
CNTDOWN.FNT3.51 kB11-03-92|10:37
COMPUTER.FNT3.51 kB11-03-92|10:38
COURIER.FNT3.51 kB11-03-92|10:38
CYRILLIC.FNT3.51 kB11-03-92|10:38
DEFAULT.FNT1.51 kB11-03-92|10:39
FIRE.FNT52.26 kB11-03-92|18:45
FIRE.PAL768.00 B11-03-92|18:45
FRANKFRT.FNT3.51 kB11-03-92|10:37
FRESNO.FNT3.51 kB11-03-92|10:38
FUTURE.FNT3.51 kB11-03-92|10:38
GAELIC.FNT3.51 kB11-03-92|10:37
GEORGIAN.FNT3.51 kB11-03-92|10:37
GREEK.FNT3.51 kB11-03-92|10:38
HOLLOW.FNT3.51 kB11-03-92|10:38
HUGE.FNT4.01 kB11-03-92|10:39
HYLAS.FNT3.51 kB11-03-92|10:38
ITALIC.FNT3.51 kB11-03-92|10:37
ITALICS.FNT3.51 kB11-03-92|10:37
ITT.FNT3.51 kB11-03-92|10:38
LCD.FNT3.51 kB11-03-92|10:38
MEDIEVAL.FNT3.51 kB11-03-92|10:38
MODERNFO.FNT4.01 kB11-03-92|10:39
OCR.FNT3.51 kB11-03-92|10:37
OLDENG.FNT3.51 kB11-03-92|10:37
ROMAN.FNT3.51 kB11-03-92|10:39
SANSERIF.FNT3.51 kB11-03-92|10:39
SCRIBBLE.FNT4.01 kB11-03-92|10:39
SCRIPT.FNT3.51 kB11-03-92|10:37
SCRIPT2.FNT3.51 kB11-03-92|10:39
SENAPL.FNT3.51 kB11-03-92|10:37
SIDE.FNT2.51 kB11-03-92|10:37
SIMILITE.FNT3.51 kB11-03-92|10:39
SMALCAPS.FNT3.51 kB11-03-92|10:39
STRETCH.FNT3.51 kB11-03-92|10:39
SUPER.FNT2.01 kB11-03-92|10:39
THAI.FNT3.51 kB11-03-92|10:39
THIN.FNT3.51 kB11-03-92|10:39
THIN8X8.FNT2.01 kB11-03-92|10:39
_BROADWA.FNT8.01 kB11-02-92|12:06
_OCR.FNT3.51 kB11-03-92|10:39
GRAB.EXE14.53 kB07-11-93|18:45
GRAB.PAS45.71 kB07-11-93|18:45
07.00 B
AEGYPTEN.COD1.30 kB06-12-92|21:42
BLACK.COD434.00 B06-12-92|21:54
FLOWER.COD3.26 kB03-20-92|14:04
FRACTAL.PAL768.00 B07-03-93|16:12
FRACTAL1.PIC62.50 kB07-03-93|16:12
FRACTAL2.PIC62.50 kB07-03-93|16:13
FRACTAL3.PIC62.50 kB07-03-93|16:13
FRACTAL4.PIC62.50 kB07-03-93|16:14
HANTEL.LIB4.77 kB11-10-91|15:20
MARMOR.COD8.80 kB06-13-92|18:38
RANDOM.PAL768.00 B07-17-92|19:31
TILE2.COD1.30 kB10-20-91|13:57
WHATSNEW.LIB1.72 kB06-12-93|20:09
07.00 B
APPLE.COD290.00 B10-02-92|05:34
ESP.COD4.55 kB10-05-92|15:06
GAME.EXE43.13 kB07-04-93|12:21
GAME.PAS12.00 kB07-04-93|13:46
LINE.COD1.02 kB09-25-92|18:55
MUSIC.PAS20.14 kB09-24-92|16:52
MUSIC.TPU4.89 kB07-04-93|12:21
QUEST.LIB4.53 kB10-05-92|15:51
README.TXT549.00 B07-04-93|13:47
SMALLNUM.LIB13.00 kB09-27-92|16:24
SPOOK.LIB3.57 kB10-02-92|07:36
STANDARD.PAL768.00 B09-25-92|18:53
MAKE.BAT165.00 B07-11-93|18:45
MAKES.PAS218.08 kB07-11-93|18:45
PCX2COD.DOC852.00 B07-11-93|18:45
PCX2COD.PAS77.98 kB07-11-93|18:45
README.1ST2.87 kB07-11-93|18:45
README.2ND4.12 kB07-11-93|18:45
SHOWPIC.PAS995.00 B07-11-93|18:45
SVGA256.BGI6.19 kB07-11-93|18:45
UNCHAIN.ASM11.60 kB07-11-93|18:45
UNCHAIN.EXE1.20 kB07-11-93|18:45
UNLIB.PAS5.86 kB07-11-93|18:45
WHATSNEW.EXE37.36 kB07-11-93|18:45
WHATSNEW.PAS9.10 kB07-11-93|18:45
...
Sponsored links

PCX2COD.PAS (678.56 kB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D