Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Array / matrix

.pas
Скачиваний:
29
Добавлен:
07.06.2015
Размер:
7 Кб
Скачать
☆

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.
Соседние файлы в папке Array
  • #
    07.06.20152 Кб29matrix.~dfm
  • #
    07.06.20157 Кб30matrix.~pas
  • #
    07.06.201510 Кб30matrix.dcu
  • #
    07.06.201551 б29matrix.ddp
  • #
    07.06.20152 Кб29matrix.dfm
  • #
    07.06.20157 Кб29matrix.pas
  • #
    07.06.2015766 б29PRmatrix_Icon.ico
  • #
    07.06.2015392 б29PRmatrix.cfg
  • #
    07.06.20152 Кб29PRmatrix.dof
  • #
    07.06.2015190 б29PRmatrix.dpr
  • #
    07.06.20155 Кб29PRmatrix.dproj