home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TILECON.ZIP / TILECON.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-03-10  |  5.0 KB  |  173 lines
  1. Program TILECON;
  2.  
  3. (* Convertiert Mahjong-Tiles in Windows-Icons und umgekehrt *)
  4. (* Aufruf ohne Parameter                                    *)
  5. (*  Es erscheinen  Abfragen der Konvertierungsrichtung und  *)
  6. (*  der Dateinamen.                                         *)
  7. (*  Fehlermeldungen sollten nicht auftreten.                *)
  8. (* Sprache: Turbo Pascal 6.0                                *)
  9. (* Autor  : W. Ahls                                         *)
  10. (* Das Programm ist frei benutzbar.                         *)
  11.  
  12.  uses dos,crt;
  13.  
  14.  const
  15.   version = '1.0';
  16.   IconHeader : array[1..126] of Byte =
  17.            (0,0,1,0,   1,0,$20,$20,   $10,0,0,0,   0,0,$e8,2,
  18.                0,0,$16,0, 0,0,$28,0,     0,0,$20,0,   0,0,$40,0,
  19.         0,0,1,0,   4,0,0,0,       0,0,$80,2,   0,0,0,0,
  20.         0,0,0,0,   0,0,0,0,       0,0,0,0,     0,0,0,0,
  21.         0,0,0,0,   $80,0,0,$80,   0,0,0,$80,   $80,0,$80,0,
  22.         0,0,$80,0, $80,0,$80,$80, 0,0,$80,80,  $80,0,$c0,$c0,
  23.         $c0,0,0,0, $ff,0,0,$ff,   $ff,0,0,$ff, $ff,0,$ff,0,
  24.         0,0,$ff,0, $ff,0,$ff,$ff, 0,0,$ff,$ff, $ff,0);
  25.    (* Der Anhang an ein Icon besteht aus 128 Leerbytes *)
  26.  
  27.  
  28.  var
  29.   TileArray : array[1..40] of array[1..20] of Byte;
  30.   Icon : record
  31.           case Boolean of
  32.            true  : (Buffer : array[1..766] of Byte);     (* Komplett *)
  33.            false : (Prefix : array[1..126] of Byte;
  34.                     Data   : array[1..32] of array[1..16] of Byte;
  35.                     Suffix : array[1..128] of Byte);
  36.           end;
  37.   n : Word;
  38.   z, s : byte;
  39.   f : File;
  40.   rc : Integer;
  41.   result : Word;
  42.   Aufgabe : Char;
  43.   IDatei : String;
  44.   ODatei : String;
  45.  
  46.  Function ConvertFarbe(Farbe : Byte) : Byte;
  47.   var
  48.    HNibble, LNibble : Byte;
  49.   begin
  50.    HNibble := Farbe shr 4;
  51.    LNibble := Farbe and $f;
  52.    case HNibble of
  53.      1 : HNibble := 4;
  54.      3 : HNibble := 6;
  55.      4 : HNibble := 1;
  56.      6 : HNibble := 3;
  57.      7 : HNibble := 8;
  58.      8 : HNibble := 7;
  59.      9 : HNibble := 12;
  60.     11 : HNibble := 14;
  61.     12 : HNibble := 9;
  62.     14 : HNibble := 11;
  63.    end;
  64.    case LNibble of
  65.      1 : LNibble := 4;
  66.      3 : LNibble := 6;
  67.      4 : LNibble := 1;
  68.      6 : LNibble := 3;
  69.      7 : LNibble := 8;
  70.      8 : LNibble := 7;
  71.      9 : LNibble := 12;
  72.     11 : LNibble := 14;
  73.     12 : LNibble := 9;
  74.     14 : LNibble := 11;
  75.    end;
  76.    ConvertFarbe := (HNibble shl 4) + LNibble;
  77.   end;
  78.  
  79.  Begin
  80.   WriteLn('TILE-ICON Converter ',Version);
  81.   WriteLn;
  82.   (* --- Eingabe der Aufgabe und der Dateinamen --- *)
  83.   WriteLN(' ICON -> TILE = 1 ');
  84.   WriteLn(' TILE -> ICON = 2  (Nur einzelne TILEs.)');
  85.   WriteLn;
  86.   Write('Gewünschte Konvertierung = ');
  87.   repeat
  88.    Aufgabe := readKey;
  89.    if Aufgabe = #0 then Aufgabe := readkey;
  90.    if Aufgabe = #27 then Halt;
  91.   until (Aufgabe = '1') or (Aufgabe = '2');
  92.   WriteLn(Aufgabe);
  93.   if Aufgabe = '1'
  94.    then Write('ICON-Datei (z.B.: TEST.ICO) : ')
  95.    else Write('TILE-Datei (z.B.: TEST.TIL) : ');
  96.   ReadLn(IDatei);
  97.   if Aufgabe = '1'
  98.    then Write('TILE-Datei (z.B.: TEST.TIL) : ')
  99.    else Write('ICON-Datei (z.B.: TEST.ICO) : ');
  100.   ReadLn(ODatei);
  101.   (* --- Zu konvertierende Datei lesen --- *)
  102.   Assign(f,IDatei);
  103.   {$I-} Reset(f,1); {$I+}
  104.   if IOResult <> 0 then
  105.    begin
  106.     Writeln('Fehler beim öffnen von ',IDatei,' !');
  107.     Halt;
  108.    end;
  109.   {$F-}
  110.   if Aufgabe = '1'
  111.    then Blockread(f,Icon.Buffer,sizeOf(Icon.Buffer),result)
  112.    else Blockread(f,TileArray,SizeOf(TileArray),result);
  113.   {$F+}
  114.   rc := IOResult;
  115.   if rc <> 0 then
  116.    begin
  117.     WriteLn('DOS-Fehler ',rc,' beim lesen von ',IDatei,' !');
  118.     Halt;
  119.    end;
  120.   if Aufgabe = '1'
  121.    then begin
  122.     if result <> SizeOf(Icon.Buffer) then
  123.      begin
  124.       WriteLn('Fehler beim lesen von ',IDatei,' !');
  125.       Halt;
  126.      end;
  127.    end else begin
  128.     if result <> SizeOf(TileArray) then
  129.      begin
  130.       WriteLn('Fehler beim lesen von ',IDatei,' !');
  131.       Halt;
  132.      end;
  133.    end;
  134.   {$F-} close(f); {$F+}
  135.   rc := IOResult; (* vergiß es *)
  136.   (* --- Daten übertragen und Farben umsetzen --- *)
  137.   if Aufgabe = '1' then
  138.    begin          (* ICON -> TILE *)
  139.     (* Lösche TileArray *)
  140.     FillChar(TileArray,sizeof(Tilearray),#0);
  141.     (* Bild übertragen *)
  142.     for z := 1 to 32 do
  143.      for s := 1 to 16 do
  144.       TileArray[z+2][s+3] := ConvertFarbe(Icon.Data[33-z][s]);
  145.    end else begin (* TILE -> ICON *)
  146.     (* Löschen des Puffers *)
  147.     FillChar(ICON.Buffer,SizeOf(Icon.Buffer),#0);
  148.     (* Füllen des Puffers *)
  149.     move(IconHeader,Icon.Prefix,SizeOf(Icon.Prefix));
  150.     (* Bild übertragen *)
  151.     for z := 1 to 32 do
  152.      for s := 1 to 16 do
  153.       Icon.Data[33-z][s] := ConvertFarbe(TileArray[z+2][s+3]);
  154.     (* Der Suffix bleibt leer *)
  155.    end;
  156.   (* --- Ergebnis speichern --- *)
  157.   Assign(f,ODatei);
  158.   {$I-} ReWrite(f,1); {$I+}
  159.   if IOResult <> 0 then
  160.    begin
  161.     Writeln('Fehler beim öffnen von ',ODatei,' !');
  162.     Halt;
  163.    end;
  164.   {$F-}
  165.   if Aufgabe = '1'
  166.    then BlockWrite(f,TileArray,SizeOf(TileArray),result)
  167.    else BlockWrite(f,Icon.Buffer,sizeOf(Icon.Buffer),result);
  168.   {$F+}
  169.   rc := IOResult; (* vergiß es *)
  170.   {$F-} close(f); {$F+}
  171.   rc := IOResult; (* vergiß es *)
  172.  End.
  173.