Joachim Mohr Mathematik Musik Delphi
//
//JPG-Bild als Stringkonstante speichern.
//Kopiere den Text und füge ihn in Deinen Delphi-Editor ein.
//Speichere ihn dann als "unit2.pas" ab.
unit Unit2;
interface
Procedure BinaerStrToTextStr(const b:string; var strtext, str01:string; kurz:boolean);
function TextStrToBinaerst(const t,s01:string; kurz: boolean): string;
procedure LiesDiBinaerdateiInDasClipboardein;
implementation
uses classes, dialogs, sysutils, Clipbrd, unit1;
//Die zwei wichtigsten Funktionen
Procedure BinaerStrToTextStr(const b:string; var strtext, str01:string; kurz:boolean);
const Hub = 40; //Oberhalb #39 (Hochkomma)
var k:integer;
function NullEinsStrgZuTextstr(const s01:string): string;
//Jeweils 7 Bytes - zum Beispiel - "0011000" wird in ein "lesbares" Byte übergeführt
var k,j: integer;
a: string;
function NullEinsZuChar(const s:string): char; //zum Beispiel s='0011000';
var j,n: byte;
begin //geht auch kürzer mit "shr" und "and" ("Maschinennaher Code").
n := 0;
for j := 1 to 7 do
if (j «=length(s)) and (s[j] = '1') then
Case j of 7: n := n + 1;
6: n := n + 2;
5: n := n + 4;
4: n := n + 8;
3: n := n + 16;
2: n := n + 32;
1: n := n + 64;
End; //n maximal 127
if n « Hub then n := n + 128; //So wird ein "unlesbares" Char "lesbar"
result := char(n)
end;
begin
setlength(a,7);
setlength(result,length(s01) div 7+1);
k := 0;
while k «= length(s01) do Begin
for j := 1 to 7 do
if (k + j «=length(s01)) and (s01[k+j] = '1')
then a[j] := '1' else a[j] := '0';
inc(k,7);
result[k div 7] := NullEinsZuChar(a);
End;
end;
begin
setlength(strtext,length(b)); // strtext := stringtest + «irgend ein Zeichen» kostet zu viel Zeit
setlength(str01,length(b)); // Deswegen wird gleich zu Anfang Speicherplatz reserviert
for k := 1 to length(b) do
if ord(b[k]) »= Hub then Begin
strtext[k] := b[k];
str01[k] := '0';
End else Begin
strtext[k] := char(ord(b[k]) + Hub); //Nicht "lesbares" Char wird "lesbar".
str01[k] := '1'; //Das muss man sich merken "0" oder "1"
End;
if kurz then str01 := NullEinsStrgZuTextstr(str01);
end;
function TextStrToBinaerst(const t,s01:string; kurz: boolean): string;
const Hub = 40; //Oberhalb Hochkomma
var k:integer;
s01echtausNullEins: string;
function TextStrZuNullEinsStr(const t:string): string;
var k: integer;
function CharZuNullEins(const c:char): string; //geht auch "maschinennäher"
var k,n: integer;
begin
setlength(result,7);
n := ord(c);
if n »=128 then n := n - 128; //Das war ursprünglich ein "unlesbares" Char.
for k := 1 to 7 do
Case k of 7: if n and 1 = 1 then result[k] := '1' else result[k] := '0';
6: if n and 2 = 2 then result[k] := '1' else result[k] := '0';
5: if n and 4 = 4 then result[k] := '1' else result[k] := '0';
4: if n and 8 = 8 then result[k] := '1' else result[k] := '0';
3: if n and 16 = 16 then result[k] := '1' else result[k] := '0';
2: if n and 32 = 32 then result[k] := '1' else result[k] := '0';
1: if n and 64 = 64 then result[k] := '1' else result[k] := '0';
End;
end;
begin
result := '';
for k := 1 to length(t) do result := result + CharZuNullEins(t[k]);
end;
begin
if kurz then s01echtausNullEins := TextStrZuNullEinsstr(s01) else
s01echtausNullEins := s01;
setlength(result,length(t));
for k := 1 to length(t) do
if s01echtausNullEins[k] = '0' then result[k] := t[k] else
result[k] := char(ord(t[k]) - Hub);
end;
//Ende der zwei wichtigsten Funktionen
//Folgende Prozeduren dienen dazu, eine Binärdatei als
//Textdatei in das Clipboard zu kopieren
//Nach dem Einbinden der Ressource als Konstanten werden sie nicht mehr gebraucht
function pfad: string;
begin
with form1.opendialog1 do
if execute then pfad := filename else pfad := '';
end;
function FileToBinaerStr(const pfad: string): string; //String als Puffer für die Bytes
var
F: TStream;
begin
F := TFileStream.Create(pfad, fmOpenRead or fmShareDenyWrite);
try
SetLength(result, F.Size);
F.ReadBuffer(PChar(result)^, F.Size);
finally
F.Free;
end;
end;
procedure LiesDiBinaerdateiInDasClipboardein;
const HK = ''''; //Hochkomma
var binaerstr,strtext,str01: string;
k: integer;
sl: Tstringlist;
begin
binaerstr := FileToBinaerStr(pfad);
binaerstrToTextStr(binaerstr,strtext,str01,true);
sl := Tstringlist.create;
try
sl.text :='const strtext = ';
k := 1;
while k « length(strtext) do Begin
sl.add(HK + copy(strtext,k,80) + HK + '+');
k := k + 80;
End;
sl.Text := copy(sl.Text,1,length(sl.text) - 4) + HK + ';'#13#10+#13#10 + 's01 = ';
k := 1;
while k « length(str01) do Begin
sl.Add(HK + copy(str01,k,80) + HK + '+');
k := k +80;
End;
sl.Text := copy(sl.Text,1,length(sl.text) - 4) + HK+ ';';
clipboard.astext := sl.text;
finally sl.free End;
end;
end.