Показать сообщение отдельно
  #1  
Старый 02.05.2011, 19:17
fabregaz fabregaz вне форума
Прохожий
 
Регистрация: 24.03.2011
Сообщения: 1
Версия Delphi: Delphi 7 Lite
Репутация: 10
Восклицание Курсовой проект

Задача проекта написать программу, которая позволяет кодировать и декодировать сообщения, заданными способами, например "Шифр Цезаря".
Проблема в том, что я не знаю как это реализовать т.е. как в программу вставить нужный программный код. Если ещё проще, то как сделать так, чтобы после нажатия на кнопку введёный текст зашифровывался?
За основу взят обычный текстовый редактор...

Редактор...
Код:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, XPMan, ToolWin, Printers, Buttons;

type
  TForm1 = class(TForm)
    stat1: TStatusBar;
    tlb1: TToolBar;
    XPManifest1: TXPManifest;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    redt1: TRichEdit;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N25: TMenuItem;
    pm1: TPopupMenu;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    dlgFind1: TFindDialog;
    dlgReplace1: TReplaceDialog;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    dlgPnt1: TPrintDialog;
    dlgPntSet1: TPrinterSetupDialog;
    N32: TMenuItem;
    dlgFont1: TFontDialog;
    dlgColor1: TColorDialog;
    btn1: TSpeedButton;

    procedure N2Click(Sender: TObject);
    procedure StatusBar(Sender: TObject; var Done:Boolean);
    procedure FormCreate(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure dlgFind1Find(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure dlgReplace1Find(Sender: TObject);
    procedure dlgReplace1Replace(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
//    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  EditFile:string;


implementation

{$R *.dfm}


procedure TForm1.N2Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.StatusBar(Sender: TObject; var Done:Boolean);
var
  MS: TMemoryStatus;
begin
 stat1.Panels[0].Text:='  ' + Application.Hint;
 stat1.Panels[2].Text:='  Время: ' + TimeToStr(Time);
 if GetKeyState(VK_Numlock)=1
 then stat1.Panels[1].Text:='  ' + '"Num Lock" Включен'
 else stat1.Panels[1].Text:='  ' + '"Num Lock" Выключен';
 if GetKeyState(VK_Insert)=1
 then stat1.Panels[3].Text:='  ' + 'Режим замены'
 else stat1.Panels[3].Text:='  ' + 'Режим вставки';
  GlobalMemoryStatus(MS);
 stat1.Panels[4].Text:='  Память загружена на: ' + Format('%d %%', [MS.dwMemoryLoad]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle:=StatusBar;
end;



procedure TForm1.N13Click(Sender: TObject);                  // Вырезать
begin
redt1.CutToClipboard;
end;

procedure TForm1.N14Click(Sender: TObject);                  // Копировать
begin
redt1.CopyToClipboard;
end;

procedure TForm1.N15Click(Sender: TObject);                  // Вставить
begin
redt1.PasteFromClipboard;
end;

procedure TForm1.N18Click(Sender: TObject);                  // Удалить
begin
redt1.ClearSelection;
end;

procedure TForm1.N17Click(Sender: TObject);                  // Выделить всё
begin
redt1.SelectAll;
end;

procedure TForm1.N19Click(Sender: TObject);
begin
dlgFind1.Execute;
end;

procedure TForm1.dlgFind1Find(Sender: TObject);              // Найти
var
 Buff,P,FT: PChar;
 BuffLen: Word;
begin
 with Sender as TFindDialog do
  begin
   GetMem(FT, Length(FindText) + 1);
   StrPCopy(FT, FindText);
   BuffLen:= redt1.GetTextLen + 1;
   GetMem(Buff, BuffLen);
   redt1.GetTextBuf(Buff, BuffLen);
   P:= Buff + redt1.SelStart + redt1.SelLength;
   P:= StrPos(P, FT);
   if P=nil then MessageBeep(0)
   else
    begin
     redt1.SelStart:= P - Buff;
     redt1.SelLength:= Length(FindText);
    end;
   FreeMem(FT, Length(FindText) + 1);
   FreeMem(Buff, BuffLen);
  end;
end;

procedure TForm1.N20Click(Sender: TObject);
begin
dlgReplace1.Execute;
end;

procedure TForm1.dlgReplace1Find(Sender: TObject);           // Найти чтобы заменить
begin
with Sender as TReplaceDialog do
  while True do
   begin
    if redt1.SelText <> FindText then
    dlgFind1Find(Sender);
    if redt1.SelLength = 0 then Break;
    redt1.SelText:= ReplaceText;
    if not (frReplaceAll in Options) then Break;
   end;
end;

procedure TForm1.dlgReplace1Replace(Sender: TObject);        // Заменить
label 10;
begin
 redt1.HideSelection:=true;
 10:
  if pos(dlgReplace1.FindText,redt1.Text)<>0 then
   begin
    redt1.SelStart:=pos(dlgReplace1.FindText,redt1.Text)-1;
    redt1.SelLength:=Length(dlgReplace1.FindText);
    redt1.SelText:=dlgReplace1.ReplaceText;
    goto 10;
   end;
 redt1.HideSelection:=false;
end;

procedure TForm1.N3Click(Sender: TObject);       // Создать
begin
redt1.Lines.Clear;
end;

procedure TForm1.N4Click(Sender: TObject);       // Открыть
begin
if dlgOpen1.Execute then
  begin
   EditFile:=dlgOpen1.FileName;
   redt1.Lines.LoadFromFile(EditFile);
   Form1.Caption:='Документ - '+ExtractFileName(EditFile);
  end;
end;



procedure TForm1.N6Click(Sender: TObject);       // Сохранить
begin
if dlgSave1.Execute then
redt1.Lines.SaveToFile(EditFile);
if redt1.Modified then redt1.Modified:=false;
end;

procedure TForm1.N7Click(Sender: TObject);       // Сохранить как
begin
 if dlgSave1.Execute then
  begin
   EditFile:=dlgSave1.FileName;
   redt1.Lines.SaveToFile(EditFile);
   Form1.Caption:='Документ - '+ExtractFileName(EditFile);
   if redt1.Modified then redt1.Modified:=false;
  end;
end;

procedure TForm1.N32Click(Sender: TObject);      // Настройка печати
begin
dlgPntSet1.Execute;
end;

procedure TForm1.N9Click(Sender: TObject);      // Печать
var
 Stroka:System.TextFile;
 i:integer;
begin
 if dlgPnt1.Execute then
  begin
   AssignPrn(Stroka);
   Rewrite(Stroka);
   Printer.Canvas.Font:=redt1.Font;
   for i:=0 to redt1.Lines.Count-1 do
    Writeln(Stroka,redt1.Lines[i]);
   System.CloseFile(Stroka);
  end;

end;



procedure TForm1.N23Click(Sender: TObject);                 // Шрифт
begin
if dlgFont1.Execute then redt1.Font:=dlgFont1.Font;
end;

procedure TForm1.N25Click(Sender: TObject);                 // Цвет фона
begin
if dlgColor1.Execute then redt1.Color:=dlgColor1.Color;
end;



end.

Код:
/Шифрование Цезаря
function Cesar_Crypt(s:string):string;
const
  SizeA = 33; //Размер алфавита
  RusA = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P :integer;
    temp:string;
begin
s:=AnsiLowerCase(s);
temp:='';
//удаление символов сообщения, не входящих в наш алфавит
for i := 1 to length(s) do if pos(s[i],RusA)<>0 then temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
  begin
  P:=pos(s[i],RusA)+3;
  if P>SizeA then P:=P-SizeA;
  Result:=Result+RusA[P];
  end;
end;

//Дешифрование Цезаря
function Cesar_DeCrypt(s:string):string;
const
  SizeA = 33; //Размер алфавита
  RusA = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P :integer;
    temp:string;
begin
s:=AnsiLowerCase(s);
temp:='';
//удаление символов сообщения, не входящих в наш алфавит
for i := 1 to length(s) do if pos(s[i],RusA)<>0 then temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
  begin
  P:=pos(s[i],RusA)-3;
  if P<=0 then P:=P+SizeA;
  Result:=Result+RusA[P];
  end;
end;
Ответить с цитированием