Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ] > Код на шару!
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.05.2016, 10:45
simbios simbios вне форума
Прохожий
 
Регистрация: 15.05.2016
Сообщения: 4
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Программа обработки pas файлов

Помогите пожалуйста дописать программу. Программа работает не совсем корректно. Ключевые слова выводит вроде правильно, а вот перечень имен простых переменных и перечень меток выводит не совсем правильно.
вот код программы.
Код:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ImgList;
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Memo2: TMemo;
    SaveDialog1: TSaveDialog;
    ImageList1: TImageList;
    Label1: TLabel;
    Label2: TLabel;
    N6: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
  private
  procedure ShowResult;
  procedure Work;
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
 var f: textFile;
    k: array [1..84] of integer;
    s,sl,nm,lb: string;
    i,j: byte;
    c: char;
implementation
uses Unit2;
 const ks: array [1..84] of string=('program','uses','const','var','label','type','begin','end',
                                   'and','or','not','div','mod','if','then','else','case','of',                                'byte','integer','real','char','string','array','record','file','set',                                  'for','to','do','downto','goto','in','nil','repeat','until','while',                                 'function','procedure','as','asm','class','constructor','destructor',                               'dispinterface','except','exports','finalization','finally','implementation',                                'inherited','initialization','inline','interface','is','library','object','out',                                'packed','property','raise','resourcestring','shl','shr','threadvar','try',
                                   'unit','with','xor','public','private','protected',                                 'published','copy','pos','delete','length','setlength','now','read','write',
                                   'override','overwrite','virtual');
      r: set of char=[' ',':',';',','];
function CutName (str: string; q: byte): string;
var sss: string;
begin
sss:='';
while (q>=1) and (str[q] in ['a'..'z','0'..'9']) do
      begin
      sss:=str[q]+sss;
      dec(q);
      end;
CutName:=sss;
end;
function CutNameF (str: string; q: byte): string;
var sss: string;
begin
sss:='';
while (q<=length(str)) and (str[q] in ['a'..'z','0'..'9']) do
      begin
      sss:=sss+str[q];
      inc(q);
      end;
CutNameF:=sss;
end;
{$R *.dfm}
{ TForm1 }
procedure TForm1.ShowResult;
var
  i,j:integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Add('Ключевые слова:');
  j:=0;
  for i:=1 to 84 do
    if k[i]<>0 then
       begin
       inc(j);
       Memo1.Lines.Add(ks[i]+'- '+IntToStr(k[i]));
       end;
  Memo1.Lines.Add('Перечень простых переменных: '+nm);
  Memo1.Lines.Add('Перечень меток в алфавитном порядке: '+lb);
end;
procedure TForm1.Work;
begin
  AssignFile(f, OpenDialog1.Filename);
reset(f); nm:=''; sl:=''; lb:=''; j:=0;
while not (eof(f)) do     
      begin
      readln(f,s);
      s:=' '+s+' ';
      if pos('label',s)<>0 then
         begin
         sl:=copy(s,pos('label',s)+5,pos(';',s)-pos('label',s)+5);
         for c:='a' to 'z' do
             for j:=2 to length(s) do
                if (sl[j]=c) and  (sl[j-1] in r)then lb:=lb+CutNameF (sl,j)+' '; 
         sl:='';
         end;
      for i:=2 to length(s) do
          if copy(s,i,2)=':=' then nm:=nm+CutName (s,i-1)+', ';
      for i:=1 to length(s) do
          if not (s[i] in r) then sl:=sl+s[i] else
             if length(sl)>0 then
                begin
                for j:=1 to 84 do
                    if sl=ks[j] then inc(k[j]);
                sl:='';
                end;
      end;
CloseFile(f);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Work;
  ShowResult;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
Memo1.ScrollBars:=ssVertical;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
AboutBox.Showmodal;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
Work;
  ShowResult;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
if OpenDialog1.Execute then
 Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
Edit1.Text:=ChangeFileExt(ExtractFileName(OpenDialog1.Filename),'');
end;
 procedure TForm1.Memo2Change(Sender: TObject);
begin
Memo2.ScrollBars:=ssVertical;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
   Memo2.Lines.SaveToFile(OpenDialog1.FileName);
end;
procedure TForm1.N6Click(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
end;
end.
Ответить с цитированием
 


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 01:29.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter