picpas.~pas

PIC 单片机 PAS SOURCE CODE SAMPLES

unit picpas;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
   Controls, Forms, Dialogs, Buttons, 
  ImgList, StdActns,printers, ActnList, ComCtrls, ToolWin,
   StdCtrls, Menus, ExtActns, psvRTFText, RichEditHighlight;

type
  TForm1 = class(TForm)

    Label1: TLabel;
    ListBox1: TListBox;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    ComboBox1: TComboBox;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    ListBox4: TListBox;
    StaticText6: TStaticText;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    ReplaceDialog1: TReplaceDialog;
    RichEdit1: TRichEditSyntax;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    Label3: TLabel;
    ToolButton8: TToolButton;
    ToolbarImages: TImageList;
    ActionList1: TActionList;
    ColorSelect1: TColorSelect;
    undocmd: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    EditUndo1: TEditUndo;
    PrintDialog1: TPrintDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    Print1: TMenuItem;
    N2: TMenuItem;
    SaveAs1: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    PrintDlg1: TPrintDlg;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    FileRun1: TFileRun;
    N3: TMenuItem;
    PopupMenu1: TPopupMenu;
    Paste1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    Undo1: TMenuItem;

    procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RichEdit1Change(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolButton4Click(Sender: TObject);
    procedure position;
    procedure AfterCompiling;
    procedure FormCreate(Sender: TObject);
    procedure varvalogat(gg:string);
    procedure funcvalogat(ff:string);
    procedure ListBox3DblClick(Sender: TObject);
    procedure undocmdClick(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ToolButton6Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure unitvalogat(nn:string);
    procedure ToolButton13Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 {$R *.DFM}
var
  Form1: TForm1;
  a,b,egysor,fajlnev,hely,szin,unitdir,nev,lastfile:string;
  F,fi:text;
var sor,oszlop:longint;
implementation

uses Unit2;
procedure tform1.unitvalogat(nn:string);
var usess,dd:string;
begin 
 system.AssignFile(f,nev); 
 system.Reset(F);
 if richedit1.FindText('uses',0,Length(richedit1.Text),[stWholeWord]) < 0  then
 begin
 closefile(f);
 exit;
 end
 else
 begin
 //readln(F,dd);
 //dd:=sysutils.LowerCase(dd);
   end;
   while  system.Pos('uses ',dd)=0 do
 begin
 readln(F,dd);
 dd:=sysutils.LowerCase(dd);
  end;
  closefile(f);
  //if system.Pos('uses ',dd) = 0 then exit;
   while system.Pos(' ',dd)<>0 do
 begin
 system.Delete(dd,system.Pos(' ',dd),1);
  end;
    system.Delete(dd,1,4);
     system.Insert(',',dd,pos(';',dd));
    system.Delete(dd,pos(';',dd),1);
 while dd<>''  do
 begin
  listbox3.Items.Add('');
  usess:='UNIT '+sysutils.UpperCase(system.Copy(dd,1,pos(',',dd)-1));
 listbox3.Items.Add(usess);
 usess:=unitdir+'\'+(system.Copy(dd,1,pos(',',dd)-1)+'.pas');
 funcvalogat(usess);
   system.Delete(dd,1,system.pos(',',dd));
   end;
   end;

procedure tform1.funcvalogat(ff:string);
 begin
 system.AssignFile(f,ff);
 system.Reset(F);
 while not eof(F) do
 begin
  readln(F,egysor);
  egysor:=sysutils.LowerCase(egysor);
    if (Pos('procedure ',egysor)<>0) or (Pos('function ',egysor)<>0) then
  begin
   while (Pos(' ',egysor)=1) do
   begin
   system.Delete(egysor,Pos(' ',egysor),1);
   end;
   //system.Delete(egysor,Pos(',',egysor),1);
   //system.Delete(egysor,Pos(';',egysor),1);
    if (Pos('procedure ',egysor)<>0) then
    begin
     system.Delete(egysor,Pos('edure ',egysor),5);
    listbox3.Items.Add(egysor);
    combobox1.Items.Add(egysor);
   end;
   
   //system.Delete(egysor,Pos(',',egysor),1);
   //system.Delete(egysor,Pos(';',egysor),1);
   if (Pos('function ',egysor)<>0) then
   begin
   system.Delete(egysor,Pos('tion ',egysor),4);
   listbox3.Items.Add(egysor);
   combobox1.Items.Add(egysor);
  end;
  end;
 end;
 system.CloseFile(F);
 end;

procedure TForm1.varvalogat(gg:string);
begin
 system.AssignFile(f,gg);
 system.Reset(F);
 while not eof(F) do
 begin
  readln(F,egysor);
    if Pos('var ',egysor)<>0 then
  begin
  while (Pos(' ',egysor)=1) do
   begin
   system.Delete(egysor,Pos(' ',egysor),1);
   end;
   system.Delete(egysor,Pos('var ',egysor),4);
   //system.Delete(egysor,Pos(',',egysor),1);
   system.Delete(egysor,Pos(';',egysor),1);
   listbox1.Items.Add(egysor);
  end;
 end;
 system.CloseFile(F);

end;

procedure TForm1.position;
 begin
 oszlop:=Richedit1.caretpos.x;
sor:=Richedit1.caretpos.y;
a:=inttostr(oszlop+1);
b:=inttostr(sor+1);
label1.Caption:='Line='+' '+b+' Col='+a;
 end;

procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);

begin
position;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);

begin
position;
label2.Caption:='Yes';
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

begin
position;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
 begin
  opendialog1.FileName:='*.pas';
  listbox4.Items.Clear;
if OpenDialog1.Execute then
begin
   if OpenDialog1.FileName <>'*.pas'  then
 begin
 nev:=OpenDialog1.FileName;
 RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
 sysutils.LowerCase(richedit1.text);
 richedit1.UpdateSyntax;
 RichEdit1.SelStart := 0;
 label2.Caption:='No';
 listbox3.Items.Clear;
 combobox1.Items.Clear;
 listbox1.Items.Clear;
 varvalogat(nev);
 funcvalogat(nev);
 unitvalogat(nev);
 label3.Caption:=nev;
 
 end;
 end;
  
 end;
procedure TForm1.ToolButton2Click(Sender: TObject);

 begin
 if savedialog1.Execute then
 begin
RichEdit1.lines.SaveToFile(savedialog1.filename);
nev:=savedialog1.filename;
label3.Caption:=nev;
//opendialog1.FileName:=nev;
label2.Caption:='No';
listbox3.Items.Clear;
 combobox1.Items.Clear;
 listbox1.Items.Clear;
varvalogat(nev);
funcvalogat(nev);
unitvalogat(nev);
richedit1.UpdateSyntax;
end;
end;

procedure TForm1.ListBox2DblClick(Sender: TObject);
var hozzaad:string;
begin
 egysor:= richedit1.Lines[sor];
hozzaad:=' '+(listbox2.Items [listbox2.ItemIndex]+' ');
insert(hozzaad,egysor,(oszlop+1));
richedit1.Lines[sor]:=egysor;
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
position;
end;
procedure tform1.AfterCompiling;
var uzenet:string;
begin
     
   end;

procedure TForm1.ToolButton4Click(Sender: TObject);
 var fnev:string;
 i:integer;
 sor,x1,y1:string;
begin
listbox4.Items.Clear;
if label2.Caption='Yes'then RichEdit1.lines.SaveToFile(nev);
label2.Caption:='No';
sysutils.SetCurrentDir(sysutils.ExtractFileDir(hely));
//sysutils.DeleteFile('err.txt');
system.AssignFile(f,'picpas.bat');
system.Rewrite(f);
fnev:=nev;
system.Delete(fnev,system.Pos('.pas',fnev),4);
writeln(f,hely,' ',fnev,' +s >err.txt');
closefile(f);
windows.WinExec('picpas.bat',SW_Normal);
ShowMessage('Finished');
system.AssignFile(fi,'err.txt');
reset(fi);
{for i:=0 to 8 do
begin}
readln(fi,sor);
readln(fi,sor);
{end;}
closefile(fi);
listbox4.Font.Color:=clgreen;
listbox4.Items.add(sor);

if system.Pos('Error:',sor)>0 then
begin
listbox4.Font.Color:=clred;
system.Delete(sor,1,pos(',',sor));
y1:=system.Copy(sor,1,pos(',',sor)-1);
system.Delete(sor,1,pos(',',sor));
x1:=system.copy(sor,1,pos(' ',sor)-1);
richedit1.SelectLine(strtoint(y1)-1);

end;
 sysutils.SetCurrentDir(sysutils.ExtractFileDir(nev));
 listbox3.Items.Clear;
 combobox1.Items.Clear;
 listbox1.Items.Clear;
 varvalogat(nev);
funcvalogat(nev);
unitvalogat(nev);

 end;

procedure TForm1.FormCreate(Sender: TObject);
var szin:string;
begin
system.AssignFile(f,'picpas.ini');
reset(f);
readln(f,hely);
readln(f,szin);
richedit1.color:=sysutils.StrToInt(szin);
readln(f,szin);
listbox1.Color:=sysutils.StrToInt(szin);
listbox2.Color:=sysutils.StrToInt(szin);
listbox3.Color:=sysutils.StrToInt(szin);
readln(f,unitdir);
readln(f,nev);
closefile(f);
listbox2.Items.LoadFromFile({sysutils.ExtractFileDir(hely)+}'list.txt');
if nev<>'' then
begin
richedit1.LoadFromFile(nev);
label3.Caption:=nev;
//opendialog1.FileName:=szin;
label2.Caption:='No';
varvalogat(nev);
funcvalogat(nev);
unitvalogat(nev);
RichEdit1.DefAttributes.Name:='Courier New';
RichEdit1.SelAttributes.Name:='Courier New';
end;
//label3.Caption:='FileName?';
//listbox3.Items.Clear;
// combobox1.Items.Clear;
// listbox1.Items.Clear;
end;

procedure TForm1.ListBox3dblClick(Sender: TObject);
var hozzaad:string;

begin

egysor:= richedit1.Lines[sor];
hozzaad:=' '+(listbox3.Items [listbox3.ItemIndex]+' ');
insert(hozzaad,egysor,(oszlop+1));
system.Delete(egysor,Pos('proc ',egysor),4);
system.Delete(egysor,Pos('func ',egysor),4);
richedit1.Lines[sor]:=egysor;
end;


procedure TForm1.undocmdClick(Sender: TObject);
begin
//if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
//if richedit1.CanUndo then richedit1.Undo;

end;

procedure TForm1.ToolButton11Click(Sender: TObject);

var
  r: TRect;
  i: Integer;
begin
  with Printer do
    begin
    //printers.font????
      r := Rect(200,200,(Pagewidth - 200),(PageHeight - 200));
      BeginDoc;
      for i := 0 to richedit1.Lines.Count do
       Canvas.TextOut(200,200 + (i *
Canvas.TextHeight(richedit1.Lines.Strings[i])),
                                   richedit1.Lines.Strings[i]);
      Canvas.Brush.Color := clBlack;
      //Canvas.FrameRect(r);
      EndDoc;
    end;
  end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var aa:array[1..5] of string;
i:integer;
begin
if label2.Caption='No' then Action := cafree
else
begin
if savedialog1.Execute then
RichEdit1.lines.SaveToFile(savedialog1.filename);
label2.Caption:='No';
end;
 sysutils.SetCurrentDir(sysutils.ExtractFileDir(Application.ExeName));
 system.AssignFile(f,'picpas.ini');
 reset(f);
 for i:=1 to 5 do
 begin
 readln(f,aa[i]);
 end;
 closefile(f);
 system.AssignFile(f,'picpas.ini');
 rewrite(f);
 for i:=1 to 4 do
 begin
 writeln(f,aa[i]);
 end;
 writeln(f,nev);
 closefile(f);
 end;
 
procedure TForm1.ToolButton6Click(Sender: TObject);
begin

form2.Showmodal;
system.AssignFile(f,'picpas.ini');
reset(f);
readln(f,hely);
readln(f,szin);
richedit1.color:=sysutils.StrToInt(szin);
readln(f,szin);
listbox1.Color:=sysutils.StrToInt(szin);
listbox2.Color:=sysutils.StrToInt(szin);
listbox3.Color:=sysutils.StrToInt(szin);
readln(f,unitdir);
closefile(f);
end;

procedure TForm1.New1Click(Sender: TObject);
begin
richedit1.Lines.Clear;
//opendialog1.FileName:='Untitled.pas';
label3.Caption:='*.pas';
savedialog1.FileName:='*.pas';
savedialog1.Filter:='*.pas';
savedialog1.FilterIndex:=0;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin

if label2.Caption='No' then close
else
begin
if savedialog1.Execute then
RichEdit1.lines.SaveToFile(savedialog1.filename);
label2.Caption:='No';

end;
end;

procedure TForm1.ToolButton13Click(Sender: TObject);
begin
listbox4.Items.Clear;
richedit1.Lines.Clear;
nev:=sysutils.GetCurrentDir+'\Untitled.pas';

richedit1.Lines.Add('PROCESSOR 16F877;');
richedit1.Lines.Add('');
richedit1.Lines.Add('cfgword cp_off,pwrte_on,wdt_off,hs_osc,lvp_off,bod_off;');
richedit1.Lines.Add('');
richedit1.Lines.Add('USES lcdunit;');
richedit1.Lines.Add('');
richedit1.Lines.Add('PROCEDURE main;');
richedit1.Lines.Add('');
richedit1.Lines.Add('BEGIN');
richedit1.Lines.Add('');
richedit1.Lines.Add('END;');
richedit1.UpdateSyntax;
listbox3.Items.Clear;
listbox1.Items.Clear;
richedit1.SaveToFile(nev);
varvalogat(nev);
funcvalogat(nev);
unitvalogat(nev);
label3.Caption:=nev;
label2.Caption:='No';
end;

end.