Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.06.2011, 19:15   #11
Less1
Новичок
Джуниор
 
Регистрация: 26.06.2011
Сообщений: 7
По умолчанию

Код:
unit unit3;

interface

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

type
  TForm3 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;

                         
var
  Form3: TForm3;

implementation
uses unit1;
{$R *.dfm}
const
  Nm = 100; Otv = 50;
  cod = 471;

var 
  a: array [1..Nm,1..Otv] of string;
  b: array [1..Nm] of integer;
  f: array[1..Otv] of integer;
  n: integer;

procedure TForm3.FormActivate(Sender: TObject);
var i: integer;
begin
  n := 1;
  f[1] := 0;
  stringgrid1.RowCount := 10;
  for i := 2 to 10 do
 begin
    StringGrid1.Cells[0, i] := IntToStr(i - 1);
  end;
end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  form3.hide;
  form1.show;
end;

procedure TForm3.Button1Click(Sender: TObject);
var i, j: integer;
begin
for i:=2 to 10 do
begin
if stringgrid1.cells[1,i] <> '' then
f[n] := f[n]+1;
end;
for i := 1 to f[n]+1 do
begin
a[n,i] := stringgrid1.cells[1,i];
stringgrid1.cells[1,i] := '';
b[n] := strtoint(LabeledEdit1.text)
end;
n := n + 1;
end;


function Decrypt(const s:string; cod: integer): string;
var i: integer;
begin
 Result:='';
 for i:=1 to Length(s) do
  begin
   Result:=Result+Char(Byte(s[i]) xor (cod shr 8));
   cod:=(Byte(s[i])+cod)*62142+11719;
  end;
end;


procedure TForm3.Button2Click(Sender: TObject);
var ffile: textfile; i,j: integer; s,s1: string;
begin
  AssignFile(ffile, 'file.txt');
  Rewrite(ffile);
 for i:= 1 to n-1 do
 for j:= 1 to f[i]+1 do
    begin
    s:=Decrypt(a[i,j], cod);
    Writeln(ffile, s);
    if j = f[i]+1 then begin
     s1:=Decrypt(inttostr(b[i]), cod);
      s1:=s1+'&';
      writeln(ffile, s1) end;
    end;
  closefile(ffile);
  close;
  
end;

end.
а вот так легче?))
Less1 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ColorBox - убрать лишнее MyLastHit Общие вопросы Delphi 1 08.12.2010 08:49
Убрать лишнее Айдар Общие вопросы C/C++ 1 17.09.2010 01:08
убрать лишнее из программы dragun4ik Помощь студентам 2 30.01.2010 17:33
Убрать не нужно в виндоусе prikolist Windows 7 13.07.2009 21:05
Убрать лишнее из ячейки. `Dmitry Microsoft Office Excel 8 24.03.2009 19:07