Array / matrix

unit matrix;

interface

uses
Math, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TBytesArr = array of array of byte;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
StaticText1: TStaticText;
StaticText2: TStaticText;
Button4: TButton;
Memo1: TMemo;
Button5: TButton;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);



private
{ Private declarations }
public
// procedure MxFill(AD: integer; SS:string);{ Public declarations }
end;

var
StrLen: integer;
MX: array of array of byte;
ss:string;
Strings:TStringlist;
OD:TOpenDialog;
SD:TSaveDialog;
BmpHeight, BmpWidth: integer;
Form1: TForm1;

implementation

{$R *.dfm}

function IntToBin(Value: LongWord): string;
var
i: Integer;
begin
SetLength(Result, 24);
for i := 1 to 24 do begin
if ((Value shl (i-1)) shr 23) = 0 then begin
Result[i] := '0'
end else begin
Result[i] := '1';
end;
end;
end;

function BinToInt(Value: string): Integer;
var
i, iValueSize: Integer;
begin
Result := 0;
iValueSize := Length(Value);
for i := iValueSize downto 1 do
if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i));
end;


function ArrDim(BinStr: string): integer;
//функция для определения размерности массива
begin
result:=Math.Ceil(sqrt(length(BinStr)));
end;

{function MxFill(AD: integer; SS:string): TBytesArr;
var
i,j,k:integer;
begin
Setlength(Result, AD, AD);
k:=1;
for i:=1 to AD do
begin
for j:=1 to AD do
begin
inc(k);
if k <= length(SS) then
Result[i,j]:=strtoint(SS[k])
else
begin
if (k <> length(SS)+1) or (k <> sqr(AD)) then
Result[i,j]:=0
else
Result[i,j]:=1;
end;
end;
end;
end;
}
procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
i,j:Integer;
s:string;
f:TextFile;
begin

if StaticText1.Caption <> StaticText2.Caption then
begin
if fileexists(StaticText1.Caption) then
begin
// AssignFile(f, StaticText2.Caption);
// Rewrite(f);
bmp:=TBitmap.Create;
bmp.LoadFromFile(StaticText1.Caption);
//запись параметров бмп
BmpHeight:=bmp.Height;
BmpWidth:=bmp.Width;
//глобал
for i:=0 to BmpHeight-1 do
begin
s:='';
for j:=0 to BmpWidth-1 do
s:=s+IntToBin(bmp.Canvas.Pixels[j,i]);
// Writeln(f,s);
ss:=ss+s;
end;
// CloseFile(f);
bmp.destroy;
memo1.Lines.add(inttostr(length(ss))); //контроль длины
memo1.Lines.add(inttostr(ArrDim(ss)));
end
else
StaticText2.Caption:='File do not exists'
end
else
begin
ShowMessage('The same files are setted');
StaticText2.Caption:='Select another file';
end;
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
OD:=TOpenDialog.Create(nil);
OD.Execute;
StaticText1.Caption:=OD.FileName;
OD.Destroy;
end;



procedure TForm1.Button3Click(Sender: TObject);
begin
SD:=TSaveDialog.Create(nil);
SD.Execute;
StaticText2.Caption:=SD.FileName;
SD.Destroy;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
F : file;
FileName : String;
SizeFile : Integer;
StrBuff : String;
begin
FileName := StaticText1.Caption;
AssignFile(F, FileName);
Reset(F, SizeOf(Char));
SizeFile := FileSize(F);
if SizeFile = 0 then begin
ShowMessage('File is Empty');
CloseFile(F);
Exit;
end;

SetLength(StrBuff, SizeFile);
BlockRead(F, PChar(StrBuff)^, SizeFile);
CloseFile(F);
Memo1.Lines.Add(FileName) ;
Memo1.Lines.Add('size - ' + IntToStr(length(StrBuff)));
Memo1.Lines.Add('rd nd');


Strings:=TStringlist.create;
Strings.add(StrBuff);
Strings.SaveToFile(StaticText2.Caption);
//writeln(F, StrBuff);
FileName := StaticText2.Caption;
AssignFile(F, FileName);
Memo1.Lines.Add(FileName);
Memo1.Lines.Add(IntToStr(sizefile));
Memo1.Lines.Add('wrt nd');
CloseFile(F);
// ? ?????? StrBuff ????????? ?????????? ?????
end;
procedure TForm1.Button5Click(Sender: TObject);
var
tmp:string;
i,j,k:integer;
begin
StrLen:=ArrDim(ss);
Setlength(MX, StrLen, StrLen);
k:=1;
for i:=0 to StrLen-1 do
begin
for j:=0 to StrLen-1 do
begin
if k <= length(SS) then
MX[i,j]:=strtoint(SS[k])
else
begin
if (k <> length(SS)+1) or (k <> sqr(StrLen)) then
MX[i,j]:=0
else
MX[i,j]:=1;
end;
inc(k);
end;
end;
for i:=0 to StrLen-1 do
begin
tmp:='';
for j:=0 to StrLen-1 do
tmp:=tmp+inttostr(MX[i,j]);
Memo1.Lines.Add(tmp);
end;

end;

procedure TForm1.Button6Click(Sender: TObject);
var SFBmp:TBitmap;
i,j,k,w,h:Integer;
SaveFile,s:string;
f:TextFile;
begin
OD:=TOpenDialog.Create(nil);
OD.Execute;
SaveFile:=OD.FileName;
OD.Destroy;

//сохранение файла в бмп
if StaticText1.Caption <> SaveFile then
begin
SFBmp := TBitmap.Create();
SFBmp.Width := BmpWidth;
SFBmp.Height := BmpHeight;
k:=1;
for i:=0 to StrLen-1 do
begin
for j:=0 to StrLen-1 do
begin
s := s+IntToStr(MX[i,j]);
if (k mod 24) = 0 then
begin
SFBmp.Canvas.Pixels[h,w]:=BinToInt(s);
// Memo1.Lines.Add(IntToStr(BinToInt(s)));
s:='';
inc(w);
if w = BmpWidth then
begin
w:=0;

inc(h);
// Memo1.Lines.Add(IntToStr(h))
end;
end;
inc(k);
end;
end;
end;
SFBmp.SaveToFile(StaticText2.Caption+'.bmp');
end;
// Memo1.Lines.Add(IntToStr(BinToInt('000000000000001100000000000000000000000000000110000000000001000')))
{if fileexists(StaticText1.Caption) then
begin
AssignFile(f, StaticText2.Caption);
Rewrite(f);
bmp:=TBitmap.Create;
bmp.LoadFromFile(StaticText1.Caption);
for i:=0 to bmp.Height-1 do begin
s:='';
for j:=0 to bmp.Width-1 do begin
s:=s+IntToBin(bmp.Canvas.Pixels[j,i]);
end;
Writeln(f,s);
ss:=ss+s;
end;
CloseFile(f);
bmp.destroy;
memo1.Lines.add(inttostr(length(ss))); //контроль длины
memo1.Lines.add(inttostr(ArrDim(ss)));
end
else
StaticText2.Caption:='File do not exists'
end
else }
//ShowMessage('File is the same');


end.