unit CGM;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Memo1: TMemo;
BtnGo: TButton;
OpenDialog1: TOpenDialog;
Memo2: TMemo;
Label1: TLabel;
procedure BtnGoClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Function BTstBit ( Zahl : Byte; Bitnr : Integer ) : Boolean;
(* -------------------------------------------------------------------- *)
Begin
Bitnr := Bitnr
And $0007;
Btstbit := (( Zahl
Shr Bitnr )
And 1 ) = 1
End;
Function BSetBit ( Zahl : Byte; Bitnr : Integer ) : Byte;
(* -------------------------------------------------------------------- *)
Var I : Byte;
Begin
Bitnr := Bitnr
And $0007;
I := 1;
Bsetbit := Zahl
Or ( I
Shl Bitnr )
End;
Function WSetBit ( Zahl : Word; Bitnr : Integer ) : Word;
(* -------------------------------------------------------------------- *)
Var I : Byte;
Begin
Bitnr := Bitnr
And $000F;
I := 1;
Wsetbit := Zahl
Or ( I
Shl Bitnr )
End;
Function ByteToBinStr ( Zahl : Byte ) :
String;
(* -------------------------------------------------------------------- *)
Var I : Integer; W :
String[8];
Begin
W := '
00000000';
For I := 7
Downto 0
Do
If Btstbit ( Zahl,I )
Then Insert ('
1',W,8 - I );
ByteToBinStr := W
End;
Function BinStrToByte ( Str1 :
String ) : Byte;
(* -------------------------------------------------------------------- *)
Var
I,J : Integer;
K : Byte;
Begin
K := 0;
J := Length ( Str1 );
If ( J > 8 )
Then J := 8;
For I := J
Downto 1
Do
If ( Str1[i] = '
1')
Then K := Bsetbit ( K, J - I );
BinStrToByte := K
End;
Function BinStrToWord ( Str1 :
String ) : Word;
(* -------------------------------------------------------------------- *)
Var
I,J : Integer;
W : Word;
Begin
W := 0;
J := Length ( Str1 );
If ( J > 16 )
Then J := 16;
For I := J
Downto 1
Do
If ( Str1[I] = '
1')
Then W := Wsetbit ( W, J - I );
BinStrToWord := W
End;
procedure TForm1.BtnGoClick(Sender: TObject);
var
fs : TFilestream;
bHeader, ByteParam : Byte;
WordParam : Word;
boxb, boxh, posx, posy : Smallint;
count, i, j, k, paramlist, len : Integer;
bin, Byte01, Byte02, ausgabe, HClass, HID, PLLength, cgmtext, ding :
String;
begin // 1
if OpenDialog1.Execute
then { Öffnen-Dialogfeld anzeigen }
begin // 2
fs := TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
// Okay, wir lesen die Datei ein
i := 0;
// Zähler für die Grafik-Objekte in der Datei
bin := '
';
// Variable für Binärstrings
ausgabe := '
';
// Kommt ins linke Textfenster: Die Header der Grafik-Objekte
cgmtext := '
';
// Kommt ins rechte Textfenster: Der Text und (bisher leider noch nicht) seine Koordinaten
memo1.Text := '
';
// Textfenster ...
memo2.Text := '
';
// ... nullen
try // 3
repeat // so lange wiederholen, bis die Datei alle ist :-)
count:=fs.
Read(bHeader, sizeof(bheader));
Byte01 := ByteToBinStr(bHeader);
// Die ersten zwei Bytes enthalten den
count:=fs.
Read(bHeader, sizeof(bheader));
// Header. Wir wandelnb sie in einen
Byte02 := ByteToBinStr(bHeader);
// Binärstring ...
i := i + 1;
// Grafikobjekt Nr.
bin := Byte01 + Byte02;
// ... und kleben sie aneinander.
HClass := '
';
// CGM-Klasse
HID := '
';
// CGM - ID
PLLength := '
';
// Parameter-Lauflänge
// Dann gucken wir uns den Header genauer an:
For j := 1
to 16
do
begin
case j
of
1..4: HClass := HClass + bin[j];
// Die ersten vier Bit stehen für die Klasse
5..11: HID := HID + bin[j];
// Sieben Bit für die ID (meinzeit, vier hätten es auch getan)
12..16: PLLength := PLLength + bin[j];
// Der Rest geht für die Lauflänge drauf
end;
end;
HClass := IntToStr(BinStrToByte(HClass));
// Zurück zu etwas mehr lesbarem: Die CGM-Klasse ...
HID := IntToStr(BinStrToByte(HID));
// ... die ID ..
PLLength := IntToStr(BinStrToByte(PLLength));
// ... und die Lauflänge.
// Bei Klasse 4 und ID 4 haben wir Text an einer X/Y-Position, alles andere
// ist erstmal uninteressant.
if (StrToInt(HClass) = 4)
AND (StrToInt(HID) = 4)
then
begin // 4
paramlist := StrToInt(PLLength);
cgmtext := cgmtext + '
*** ' + IntToStr(i) + #13#10;
// Die laufende Nummer des Grafik-Objektes
for j := 1
to paramlist
do // So oft, wie's Parameter gibt
begin // 5
case j
of // 6
1:
begin // ???????????????????????
ding := '
';
// Noch nicht entschlüsselt!
fs.
Read(ByteParam, sizeof(ByteParam));
// Als erstes kommt die X-Koordinate mit einer
Byte01 := ByteToBinStr(ByteParam);
// Lauflänge von vier Bits, relevant sind wahrscheinlich
fs.
Read(ByteParam, sizeof(ByteParam));
// die ersten zwei.
Byte02 := ByteToBinStr(ByteParam);
bin := Byte01 + Byte02;
For k := 1
to 16
do
begin
ding := ding + bin[k];
end;
cgmtext := cgmtext + '
Xbin: ' + ding + #13#10;
cgmtext := cgmtext + '
X: ' + IntToStr(BinStrToWord(ding)) + #13#10;
fs.
Read(ByteParam, sizeof(ByteParam));
// Zwei Byte weiter in der Datei
fs.
Read(ByteParam, sizeof(ByteParam));
end;
2:
begin
fs.
Read(ByteParam, sizeof(ByteParam));
// Als nächstes die Y-Koordinate, ...
cgmtext := cgmtext + '
Y1: ' + ByteToBinStr(ByteParam) + #13#10;
// ... zu Forschungszwecken diesmal ..
fs.
Read(ByteParam, sizeof(ByteParam));
// ... in Binärdarstellung (ich habe zum
cgmtext := cgmtext + '
Y2: ' + ByteToBinStr(ByteParam) + #13#10;
// Test CGM-Dateien mit X=Y fabriziert, die
fs.
Read(ByteParam, sizeof(ByteParam));
// Binärdartsellung der Y-Koordinate entspricht
cgmtext := cgmtext + '
Y3: ' + ByteToBinStr(ByteParam) + #13#10;
// also auch dem Wert für X).
fs.
Read(ByteParam, sizeof(ByteParam));
cgmtext := cgmtext + '
Y4: ' + ByteToBinStr(ByteParam) + #13#10;
end;
3:
begin
fs.
Read(WordParam, sizeof(WordParam));
cgmtext := cgmtext + '
Fin: ' + IntToStr(WordParam) + #13#10;
// Abschlussflag. Uninteressant.
end;
4:
begin
fs.
Read(ByteParam, sizeof(ByteParam));
// Lauflänge des Textes.
len := ByteParam;
// Wird bis zum nächsten Word-Ende mit Nullen gefüllt.
cgmtext := cgmtext + '
Len: ' + IntToStr(ByteParam) + #13#10 + '
Text: ';
for k := 1
to len
do // So lange es Zeichen gibt.
begin
fs.
Read(ByteParam, sizeof(ByteParam));
if (ByteParam > 33)
and (ByteParam < 126)
then // Sicherung gegen ungültige Chars.
cgmtext := cgmtext + char(ByteParam);
end;
if len / 2 = Int(len / 2)
then // Eventuelles Füllbyte überspringen
fs.
Read(ByteParam, sizeof(ByteParam));
end;
end;
// 6
end;
// 5
cgmtext := cgmtext + #13#10 + #13#10;
// Leerzeile als Trennung zum nächsten Textobjekt
end
else begin // 4
paramlist := StrToInt(PLLength);
// Wie oben (ja, ja, schon gut :-) ), Lauflänge der Parameter
for j := 1
to paramlist
do // Was jetzt kommt ist kein Text und ...
fs.
Read(ByteParam, sizeof(ByteParam));
// ... deshalb zu überspringen.
end;
// 4
// Kumulation der CGM-Objektliste für das linke Textfenster
ausgabe := ausgabe + IntToStr(i) + #9 + '
| ' + HClass + '
| ' + HID + '
| ' + PLLength + #13#10;
Label1.Caption := IntToStr(count);
// Nicht weiter wichtig ;-)
until (count = 0);
// Ende gut ...
memo1.Text := ausgabe;
// ... Programm tut ...
memo2.Text := cgmtext;
// ... Datenflut.
finally
FreeAndNil(fs);
// Hier kommt keiner lebend raus!
end;
//3
end;
// 2
end;
// 1
end.