home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
t
/
tilecon.zip
/
TILECON.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-07-03
|
5KB
|
173 lines
Program TILECON;
(* Convertiert Mahjong-Tiles in Windows-Icons und umgekehrt *)
(* Aufruf ohne Parameter *)
(* Es erscheinen Abfragen der Konvertierungsrichtung und *)
(* der Dateinamen. *)
(* Fehlermeldungen sollten nicht auftreten. *)
(* Sprache: Turbo Pascal 6.0 *)
(* Autor : W. Ahls *)
(* Das Programm ist frei benutzbar. *)
uses dos,crt;
const
version = '1.0';
IconHeader : array[1..126] of Byte =
(0,0,1,0, 1,0,$20,$20, $10,0,0,0, 0,0,$e8,2,
0,0,$16,0, 0,0,$28,0, 0,0,$20,0, 0,0,$40,0,
0,0,1,0, 4,0,0,0, 0,0,$80,2, 0,0,0,0,
0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,
0,0,0,0, $80,0,0,$80, 0,0,0,$80, $80,0,$80,0,
0,0,$80,0, $80,0,$80,$80, 0,0,$80,80, $80,0,$c0,$c0,
$c0,0,0,0, $ff,0,0,$ff, $ff,0,0,$ff, $ff,0,$ff,0,
0,0,$ff,0, $ff,0,$ff,$ff, 0,0,$ff,$ff, $ff,0);
(* Der Anhang an ein Icon besteht aus 128 Leerbytes *)
var
TileArray : array[1..40] of array[1..20] of Byte;
Icon : record
case Boolean of
true : (Buffer : array[1..766] of Byte); (* Komplett *)
false : (Prefix : array[1..126] of Byte;
Data : array[1..32] of array[1..16] of Byte;
Suffix : array[1..128] of Byte);
end;
n : Word;
z, s : byte;
f : File;
rc : Integer;
result : Word;
Aufgabe : Char;
IDatei : String;
ODatei : String;
Function ConvertFarbe(Farbe : Byte) : Byte;
var
HNibble, LNibble : Byte;
begin
HNibble := Farbe shr 4;
LNibble := Farbe and $f;
case HNibble of
1 : HNibble := 4;
3 : HNibble := 6;
4 : HNibble := 1;
6 : HNibble := 3;
7 : HNibble := 8;
8 : HNibble := 7;
9 : HNibble := 12;
11 : HNibble := 14;
12 : HNibble := 9;
14 : HNibble := 11;
end;
case LNibble of
1 : LNibble := 4;
3 : LNibble := 6;
4 : LNibble := 1;
6 : LNibble := 3;
7 : LNibble := 8;
8 : LNibble := 7;
9 : LNibble := 12;
11 : LNibble := 14;
12 : LNibble := 9;
14 : LNibble := 11;
end;
ConvertFarbe := (HNibble shl 4) + LNibble;
end;
Begin
WriteLn('TILE-ICON Converter ',Version);
WriteLn;
(* --- Eingabe der Aufgabe und der Dateinamen --- *)
WriteLN(' ICON -> TILE = 1 ');
WriteLn(' TILE -> ICON = 2 (Nur einzelne TILEs.)');
WriteLn;
Write('Gewünschte Konvertierung = ');
repeat
Aufgabe := readKey;
if Aufgabe = #0 then Aufgabe := readkey;
if Aufgabe = #27 then Halt;
until (Aufgabe = '1') or (Aufgabe = '2');
WriteLn(Aufgabe);
if Aufgabe = '1'
then Write('ICON-Datei (z.B.: TEST.ICO) : ')
else Write('TILE-Datei (z.B.: TEST.TIL) : ');
ReadLn(IDatei);
if Aufgabe = '1'
then Write('TILE-Datei (z.B.: TEST.TIL) : ')
else Write('ICON-Datei (z.B.: TEST.ICO) : ');
ReadLn(ODatei);
(* --- Zu konvertierende Datei lesen --- *)
Assign(f,IDatei);
{$I-} Reset(f,1); {$I+}
if IOResult <> 0 then
begin
Writeln('Fehler beim öffnen von ',IDatei,' !');
Halt;
end;
{$F-}
if Aufgabe = '1'
then Blockread(f,Icon.Buffer,sizeOf(Icon.Buffer),result)
else Blockread(f,TileArray,SizeOf(TileArray),result);
{$F+}
rc := IOResult;
if rc <> 0 then
begin
WriteLn('DOS-Fehler ',rc,' beim lesen von ',IDatei,' !');
Halt;
end;
if Aufgabe = '1'
then begin
if result <> SizeOf(Icon.Buffer) then
begin
WriteLn('Fehler beim lesen von ',IDatei,' !');
Halt;
end;
end else begin
if result <> SizeOf(TileArray) then
begin
WriteLn('Fehler beim lesen von ',IDatei,' !');
Halt;
end;
end;
{$F-} close(f); {$F+}
rc := IOResult; (* vergiß es *)
(* --- Daten übertragen und Farben umsetzen --- *)
if Aufgabe = '1' then
begin (* ICON -> TILE *)
(* Lösche TileArray *)
FillChar(TileArray,sizeof(Tilearray),#0);
(* Bild übertragen *)
for z := 1 to 32 do
for s := 1 to 16 do
TileArray[z+2][s+3] := ConvertFarbe(Icon.Data[33-z][s]);
end else begin (* TILE -> ICON *)
(* Löschen des Puffers *)
FillChar(ICON.Buffer,SizeOf(Icon.Buffer),#0);
(* Füllen des Puffers *)
move(IconHeader,Icon.Prefix,SizeOf(Icon.Prefix));
(* Bild übertragen *)
for z := 1 to 32 do
for s := 1 to 16 do
Icon.Data[33-z][s] := ConvertFarbe(TileArray[z+2][s+3]);
(* Der Suffix bleibt leer *)
end;
(* --- Ergebnis speichern --- *)
Assign(f,ODatei);
{$I-} ReWrite(f,1); {$I+}
if IOResult <> 0 then
begin
Writeln('Fehler beim öffnen von ',ODatei,' !');
Halt;
end;
{$F-}
if Aufgabe = '1'
then BlockWrite(f,TileArray,SizeOf(TileArray),result)
else BlockWrite(f,Icon.Buffer,sizeOf(Icon.Buffer),result);
{$F+}
rc := IOResult; (* vergiß es *)
{$F-} close(f); {$F+}
rc := IOResult; (* vergiß es *)
End.