unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, Math, Spin, ComCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit1: TEdit;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ProgressBar1: TProgressBar;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure setbit(X,Y,Bit: Longint; B: Boolean);
function getbit(X,Y,Bit: Longint): Boolean;
end;
TBitposition =
record
X,Y: longint;
Bit: Integer;
end;
TParameter =
record
P: Integer;
H,Shift,GesP,W: Longint;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.setbit(X,Y,Bit: Longint; B: Boolean);
begin
Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=
(Image1.Picture.Bitmap.Canvas.Pixels[X,Y]
and ($FFFFFFFF
xor (1
shl Bit)))
or
(Byte(B)
shl Bit);
end;
function TForm1.getbit(X,Y,Bit: Longint): Boolean;
begin
result:=odd(Image1.Picture.Bitmap.Canvas.Pixels[X,Y]
shr Bit);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Edit1.Width:= Form1.CLientwidth - Edit1.Left;
Progressbar1.Width:= Form1.CLientwidth - Progressbar1.Left;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Openpicturedialog1.execute
then
Image1.Picture.Loadfromfile(Openpicturedialog1.Filename);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if Savepicturedialog1.execute
then
Image1.Picture.Savetofile(Savepicturedialog1.Filename);
end;
function generiereParameter(W,GesP: Longint; Pass:
String): TParameter;
var J: Integer;
begin
Result.H:=GesP
div W;
Result.P:=0;
For J:=1
to length(Pass)
do
Result.P:=((Result.P
shl (J
mod 32))
or (Result.P
shr (32-(J
mod 32))))
xor ord(Pass[J]);
// (P um J Bits nach links mit Carry) xor Pass[J]
Result.Shift:=0;
For J:=1
to length(Pass)
do
Result.Shift:=(Result.Shift * ord(Pass[J])*J)
mod GesP;
// (1 runter + 2 nach rechts)*ord(Passwortbuchstabe)
Result.GesP:=GesP;
Result.W:=W;
end;
function mixPixelNumber(I: Longint; Params: TParameter): Integer;
var J,X,Y,Z1,Z2: Integer;
begin
I:=(I + Params.Shift)
mod Params.GesP;
// (1 runter + 2 nach rechts)*ord(Passwortbuchstabe)
X:=I
mod Params.W;
Y:=I
div Params.W;
Y:=(Y+2*X)
mod Params.H;
Z1:=Params.W;
Z2:=Params.W;
while (Z1>0)
and (Z2>X)
do
begin
For J:=2
to Z2-1
do
if Z2
mod J = 0
then
begin
X:=((X
div J + 1)
mod (Z2
div J))*J + ((X + Params.P)
mod J);
dec(Z1);
end;
dec(Z2);
end;
Z1:=Params.H;
Z2:=Params.H;
while (Z1>0)
and (Z2>Y)
do
begin
For J:=2
to Z2-1
do
if Z2
mod J = 0
then
begin
Y:=((Y
div J + 3)
mod (Z2
div J))*J + ((Y + 2*Params.P)
mod J);
dec(Z1);
end;
dec(Z2);
end;
Result:=X + Params.W*Y;
end;
function rtp(I,GesB: longint; Params: TParameter): TBitposition;
var bpp,bpp3: integer;
begin
if I<32
then
begin
Result.Bit:=8*(I
mod 3);
I:=mixPixelNumber(I
div 3,Params);
Result.X:=I
mod Params.W;
Result.Y:=I
div Params.W;
end
else
begin
bpp:=ceil((GesB-32)/(Params.GesP-11));
bpp3:=ceil(bpp/3);
I:=I-32;
Result.Bit:=((I
mod bpp)
mod bpp3 + 8*((I
mod bpp)
div bpp3));
I:=(I
div bpp) + 11;
I:=mixPixelNumber(I,Params);
Result.X:=I
mod Params.W;
Result.Y:=I
div Params.W;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var F:
File;
Datalen,W: longint;
S:
String;
I,J: longint;
Buff:
array of Byte;
B: Byte;
Pixelpos: TBitposition;
Params: TParameter;
begin
if Opendialog1.Execute
then
begin
W:=Image1.Picture.Bitmap.Width;
S:=Opendialog1.Filename;
assignfile(F,S);
S:=extractfilename(S);
reset(F,1);
Datalen:=filesize(F)+length(S)+5;
setlength(Buff,Datalen);
Blockread(F,Buff[length(S)+5],filesize(F));
Buff[4]:=length(S);
move(S[1],Buff[5],length(S));
Buff[3]:=(Datalen
shr 24)
and $FF;
Buff[2]:=(Datalen
shr 16)
and $FF;
Buff[1]:=(Datalen
shr 8)
and $FF;
Buff[0]:=Datalen
and $FF;
closefile(F);
Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
Progressbar1.Min:=0;
Progressbar1.Max:=Datalen-1;
Progressbar1.Position:=0;
Progressbar1.Step:=1;
For I:=0
to Datalen-1
do
begin
B:=Buff[I];
For J:=0
to 7
do
begin
Pixelpos:=rtp(8*I + J,Datalen*8,Params);
setbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit,odd(B));
B:=B
shr 1;
end;
Progressbar1.Stepit;
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var F:
File;
S,T:
String;
I,J,W,
Datalen: longint;
Buff:
array of Byte;
Pixelpos: TBitposition;
Params: TParameter;
begin
if Savedialog1.Execute
then
begin
W:=Image1.Picture.Bitmap.Width;
Datalen:=0;
Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
For I:=0
to 31
do
begin
Pixelpos:=rtp(I,0,Params);
Datalen:=Datalen
or (byte(getbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit))
shl I);
end;
Setlength(Buff,Datalen);
Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
Progressbar1.Min:=0;
Progressbar1.Max:=Datalen-1;
Progressbar1.Position:=0;
Progressbar1.Step:=1;
For I:=0
to Datalen-1
do
begin
Buff[I]:=0;
For J:=0
to 7
do
begin
Pixelpos:=rtp(I*8 + J,Datalen*8,Params);
Buff[I]:=Buff[I]
or (byte(getbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit))
shl J);
end;
Progressbar1.Stepit;
end;
setlength(T,Buff[4]);
Move(Buff[5],T[1],length(T));
S:=extractfilepath(Savedialog1.Filename)+T;
if fileexists(S)
then
begin
Messagedlg('
Die Datei ''
'+S+'
''
existiert bereits - Vorganng abgebrochen!',mterror,[mbOK],0);
exit;
end;
assignfile(F,S);
rewrite(F,1);
Blockwrite(F,Buff[5+length(T)],Datalen - 5 - length(T));
closefile(F);
end;
end;
end.
Sprachen und Entwicklungsumgebungen
Zitat
Baum-Darstellung
