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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 10.05.2009, 23:55   #1
REztor
Форумчанин
 
Регистрация: 28.02.2009
Сообщений: 302
По умолчанию Не работает destructor

Код:
unit tree1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Grids,tree2;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    TREE1: TMenuItem;
    CreateOrd1: TMenuItem;
    QUIT1: TMenuItem;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Nodes1: TMenuItem;
    Memo1: TMemo;
    Load1: TMenuItem;
    GetWords1: TMenuItem;
    od: TOpenDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    sd: TSaveDialog;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Edit2: TEdit;
    Label4: TLabel;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    procedure QUIT1Click(Sender: TObject);
    procedure CreateOrd1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Load1Click(Sender: TObject);
    procedure wrds;
    procedure GetWords1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N6Click(Sender: TObject);
    procedure Edit2DblClick(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
  private
    { Private declarations }
    procedure obhod;
  public
    { Public declarations }
  end;
REztor вне форума Ответить с цитированием
Старый 10.05.2009, 23:55   #2
REztor
Форумчанин
 
Регистрация: 28.02.2009
Сообщений: 302
По умолчанию

Код:
var
  Form1: TForm1;Tree:Ttree;
  r:string; words,wurds:array of str;
  k,ke:integer;//число слов программы
  m,w:integer;//номер позиции текста и слова

implementation

{$R *.DFM}

procedure TForm1.QUIT1Click(Sender: TObject);
begin
 halt
end;

procedure TForm1.wrds;
var i:integer;p:string;
begin i:=1; k:=0;r:=memo1.Text;
  while i<=length(r) do begin
  p:='';
  while (r[i] in ['A'..'Z','a'..'z'])and(r[i]<>#0) do
  begin p:=p+r[i];i:=i+1; end;
  setlength(words,k+1);
  words[k]:=p;k:=k+1;
  while  not(r[i] in ['A'..'Z','a'..'z'])and(r[i]<>#0) do
  i:=i+1;
  end;
  end;

procedure TForm1.CreateOrd1Click(Sender: TObject);
begin
 Tree:=TTree.init(memo1);
 Tree.first:=nil;
 Tree.createord;
 tree.vivod(tree.first,0);
 label1.caption:=tree.S;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 memo1.clear; ke:=0;
 m:=0;
 end;

procedure TForm1.obhod;var i:integer;
 begin with label3 do begin caption:='';
 for i:=1 to l do
 caption:=caption+b[i]+',';
 end end;

procedure TForm1.Load1Click(Sender: TObject);
begin  if od.Execute then
  memo1.lines.LoadFromFile(od.FileName);
end;

procedure TForm1.GetWords1Click(Sender: TObject);
var i:integer;
begin
 wrds; with memo1 do begin clear;
 for i:=0 to k-1 do
  lines.Add(words[i])
end;
label2.Caption:='Число слов программы';
edit1.Text:=inttostr(k)
end;

procedure TForm1.N3Click(Sender: TObject);
var i:integer;
begin with memo1 do begin
 for i:=0 to lines.Count-1 do
 lines[i]:=lowercase(lines[i]);
if sd.Execute then
    lines.SaveToFile(sd.filename);
   end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin  memo1.Clear;
  if od.Execute then
  memo1.lines.LoadFromFile(od.FileName);
   tree:=TTree.init(memo1);
   edit1.Text:=inttostr(Tree.n);
   label2.Caption:='Число узлов дерева';
end;

procedure TForm1.N1Click(Sender: TObject);
var i:integer;
  begin  p:='';
  for i:=0 to k-1 do  begin
  flag:=true;
  tree.findel(tree.first,0,lowercase(words[i]));
  if flag then
  begin setlength(wurds,ke+1);
  wurds[ke]:=words[i];
  ke:=ke+1;
  p:=p+words[i]+'- Неправильное слово'+#13;end;
   end;
 label3.caption:=p;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  memo1.Lines.Clear
end;

procedure TForm1.N5Click(Sender: TObject);
begin
 with memo1 do begin //clear;
 text:=r;w:=0 end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  var p:string;
begin  with memo1 do begin
  if key=vk_f2 then  begin
  p:=seltext;
  {.............................}
  end;
 if key=vk_f3 then
    begin
    if w>=ke then begin
    showmessage('Больше ошибок нет');exit end;
    m:=pos(wurds[w],text);
   selstart:=m-1;
   sellength:=length(wurds[w]);
   wurds[w]:='';
   w:=w+1;
   end;
   end; end;
   
procedure TForm1.N6Click(Sender: TObject);
begin
 tree.init(memo1);
end;

procedure TForm1.Edit2DblClick(Sender: TObject);
begin p:='';
 tree.findel(tree.first,0,edit2.Text);
 label3.Caption:=p;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
 Tree.s:='';
 Tree.leaves(Tree.first,0);
 label3.Caption:=Tree.s;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
  Tree.s:='';
 Tree.prefix(Tree.first,0);
 label3.Caption:=Tree.s;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
  Tree.s:='';
 Tree.infix(Tree.first,0);
 label3.Caption:=Tree.s;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
   Tree.s:='';
 Tree.postfix(Tree.first,0);
 label3.Caption:=Tree.s;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
write('Завершение задачи');
tree.done(tree.first);
halt
end;
end.
REztor вне форума Ответить с цитированием
Старый 10.05.2009, 23:55   #3
REztor
Форумчанин
 
Регистрация: 28.02.2009
Сообщений: 302
По умолчанию

Код:
unit tree2;

interface uses grids,sysutils,stdctrls;
  type pnode=^node;
  str=string[12];
node=record key:str;left,right:pnode end;
arr=array of str;
  TTree=class
  n:integer; nds:arr;
first:pnode;
 s:string;
constructor init(g:TMemo);
destructor done (t:pnode);
procedure createord;
procedure vivod(var t:pnode;m:integer);
 procedure findel(var t:pnode;m:integer;ikey:string);
  procedure addel(ikey:string;var t:pnode);
procedure leaves(var t:pnode;m:integer);
 procedure prefix(var t:pnode;m:integer);
 procedure postfix(var t:pnode;m:integer);
 procedure infix(var t:pnode;m:integer);
  end;

var b:arr;k,l:integer;p:string;
{k-index on nodes;
l-index on b(obxod)
s-рисунок дерева}
flag:boolean;//флаг поиска

implementation
 constructor TTree.init(g:TMemo);
 var i,nn:integer;
 begin first:=nil;k:=0;s:='';l:=0;n:=0;
  with g do begin nn:=lines.count;
  setlength(nds,nn);
  for i:=0 to nn-1 do
  if trim(lines[i])<>'' then begin
  nds[n]:=trim(lowercase(lines[i]));
  n:=n+1 end;
  end end;

  destructor TTree.done(t:pnode);
  begin
  if t<>nil then
  begin
  with t^do begin
  done(left);
  done(right);
  dispose(t);
  end;
  end;
  end;



 procedure TTree.vivod(var t:pnode;m:integer);
 var i:integer;
  begin if t<>nil then with t^ do begin
  vivod(left,m+1);
  for i:=1 to m do s:=s+'*******';s:=s+key;
  vivod(right,m+1) end else
  s:=s+#13+#10;
  end;

 procedure TTree.findel(var t:pnode;m:integer;ikey:string);
 begin if t<>nil then
 begin with t^ do begin
 findel(left,m+1,ikey);
 if lowercase(ikey)=lowercase(key) then begin flag:=false;
  p:=p+ikey+' - '+inttostr(m)+'-й уровень'+#13;     end;
   findel(right,m+1,ikey) end end;
 end;

 procedure TTree.addel(ikey:string;var t:pnode);
 begin if t=nil then begin new(t);
 with t^ do begin
 key:=ikey;left:=nil;right:=nil;
 end;end else {Add The Element}
 if uppercase(t^.key)>uppercase(ikey)
  then addel(ikey,t^.left) else
 addel(ikey,t^.right) end;

procedure TTree.createord;var i:integer;
 begin for i:=0 to n-1 do
 addel(nds[i],first);end;

procedure TTree.leaves(var t:pnode;m:integer);
   begin if t<>nil then
 begin with t^ do begin
 leaves(left,m+1);
 leaves(right,m+1);
 if (left=nil)and(right=nil) then
   s:=s+key+', ';
  end end;
 end;

 procedure TTree.prefix(var t:pnode;m:integer);
   begin if t<>nil then
 begin with t^ do begin
  s:=s+key+', ';
 prefix(left,m+1);
 prefix(right,m+1);
   end end;
 end;

procedure TTree.postfix(var t:pnode;m:integer);
   begin if t<>nil then
 begin with t^ do begin
  postfix(left,m+1);
 postfix(right,m+1);
  s:=s+key+', ';
   end end;
 end;

 procedure TTree.infix(var t:pnode;m:integer);
   begin if t<>nil then
 begin with t^ do begin
 infix(left,m+1);
 s:=s+key+', ';
 infix(right,m+1);
   end end;
 end;


   end.
Помогите плиз
REztor вне форума Ответить с цитированием
Старый 11.05.2009, 20:26   #4
REztor
Форумчанин
 
Регистрация: 28.02.2009
Сообщений: 302
По умолчанию

Код:
procedure TForm1.N12Click(Sender: TObject);
begin
write('Завершение задачи');
tree.done(tree.first);
halt
end;
end.
Код:
  destructor TTree.done(t:pnode);
  begin
  if t<>nil then
  begin
  with t^do begin
  done(left);
  done(right);
  dispose(t);
  end;
  end;
  end;
REztor вне форума Ответить с цитированием
Старый 12.05.2009, 22:37   #5
uberchel
Участник клуба
 
Аватар для uberchel
 
Регистрация: 19.01.2009
Сообщений: 1,486
По умолчанию

Напиши просто!

Код:
procedure TForm1.N12Click(Sender: TObject);
begin
ShowMessage('Завершение задачи'+#13);
halt
end;
А память и сома потом всё выгрузит !!!

Помог? если да, то нажмите на весы с лева
uberchel на форуме Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не работает TP -HunteR- Паскаль, Turbo Pascal, PascalABC.NET 2 11.02.2009 19:16
constructor / destructor Altera Общие вопросы Delphi 3 08.02.2009 13:56
Почему не работает тег align=right?valign работает а align нет! aviv HTML и CSS 5 21.01.2009 17:46
Проблема с UserForm. То работает, то НЕ работает Maxx Microsoft Office Excel 6 19.11.2008 14:51
constructor, destructor override. Подправить код. Roof Общие вопросы Delphi 9 31.07.2008 13:41