unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,RegExpr, strutils;
type
{ TForm1 }
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function string_zaehlen(substr:
string; str:
string): integer;
var
a: integer;
z,posi: integer;
begin
// ===== Ein paar sachen nicht zählen:
// === einzeiliges...
// kommentare ignorieren
Delete(str,pos('
//',str),length(str));
// texte innerhalb von ' ignorieren
Delete(str,posEx('
''
',str,1),
(posEx('
''
',str, posEx('
''
',str,1)+1 ) - posEx('
''
',str,1)+1 ) );
// ab hier zählen
z := 0; posi := 0;
For a := 0
to str.Length-1
do begin
posi := posEx(substr, str, posi+1);
if posi > 0
then begin
z := z+1;
end;
if posi = 0
then begin break;
end;
end;
Result := z;
end;
//https://www.delphi-treff.de/tipps-tricks/object-pascal/strings/zeichen-wiederholen/
function Replicate(ch: char; anzahl: integer):
string;
begin
SetLength(Result,Anzahl);
if Length(Result)>0
then
FillChar(Result[1],Length(Result),ch);
end;
procedure Split(Delimiter: Char; Str:
string; ListOfStrings: TStrings) ;
begin
ListOfStrings.Clear;
ListOfStrings.Delimiter := Delimiter;
ListOfStrings.StrictDelimiter := True;
// Requires D2006 or newer.
ListOfStrings.DelimitedText := Str;
end;
function Implode(
const Strings: TStrings;
const separator:
string):
String;
var
i: Integer;
begin
Result := Strings[0];
for i := 1
to Strings.Count - 1
do
Result := Result + separator + Strings[i];
end;
procedure TForm1.Button1Click(Sender: TObject);
var
input: TSTringList;
// Datei einlesen
output: TStringList;
// verarbeitete daeti ausgeben
trenner: TSTringList;
a: integer;
temp,txt,txt2:
string;
leerzeichen: integer;
d: textfile;
begin
// ===== Datei einlesen - begin
input := TStringList.Create;
input.LoadFromFile('
input.txt');
// ===== Datei einlesen - end
// ===== Datei verarbeiten - begin
trenner := TStringList.Create;
trenner.Add('
');
trenner.Add('
//');
trenner.Add('
;');
trenner.Add('
var');
trenner.Add(#13#10);
trenner.Add('
begin');
trenner.Add('
end');
trenner.Add('
{');
trenner.Add('
}');
trenner.Add('
[');
trenner.Add('
]');
trenner.Add('
(');
trenner.Add('
)');
trenner.Add('
"');
trenner.Add('
''
');
txt := input.Text;
For a := 0
to trenner.Count-1
do begin
txt := StringReplace(txt,trenner[a],#13#10+trenner[a]+#13#10,[rfReplaceAll, rfIgnoreCase]);
end;
input.text := txt;
input.Text.Split(#13#10);
// === Elemente prüfen und bearbeiten
For a := 0
to input.Count-1
do begin
// allgemeines
if pos('
interface',input.Strings[a]) >0
then begin input.Strings[a] := #13#10#13#10+'
interface'+#13#10;
end;
if pos('
uses',input.Strings[a]) >0
then begin input.Strings[a] := #13#10+'
uses'+#13#10;
end;
if pos('
type',input.Strings[a]) >0
then begin input.Strings[a] := #13#10+'
type'+#13#10;
end;
if pos('
private',input.Strings[a]) >0
then begin input.Strings[a] := #13#10+'
private'+#13#10;
end;
if pos('
public',input.Strings[a]) >0
then begin input.Strings[a] := #13#10+'
public'+#13#10;
end;
if pos('
implementation',input.Strings[a]) >0
then begin input.Strings[a] := #13#10+'
implementation'+#13#10;
end;
//if pos('type',input.Strings[a]) >0 then begin input.Strings[a] := #13#10+'type'+#13#10; end;
// ===== Zeilenumbrüche
// Zeilenumbruch aber nicht weniger Text als X zeichen ist.
if posEx('
var',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
var',#13#10+'
var'+#13#10,[rfReplaceAll, rfIgnoreCase]);
end;
//if posEx('begin',input.Strings[a],1) >0 then begin input.Strings[a] := StringReplace(input.Strings[a],'begin','begin '+#13#10,[rfReplaceAll, rfIgnoreCase]); end;
if posEx('
begin',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
begin','
begin'+#13#10,[rfReplaceAll, rfIgnoreCase]);
end;
if posEx('
end;',input.Strings[a],90) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
end;','
end;'+#13#10#13#10,[rfReplaceAll, rfIgnoreCase]);
end;
if (posEx('
procedure',input.Strings[a],1) >0)
then begin input.Strings[a] := StringReplace(input.Strings[a],'
procedure',#13#10#13#10#13#10+'
procedure',[rfReplaceAll, rfIgnoreCase]);
end;
if posEx('
function',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
function',#13#10#13#10#13#10+'
function',[rfReplaceAll, rfIgnoreCase]);
end;
if posEx('
if',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
if',#13#10+'
if',[rfReplaceAll, rfIgnoreCase]);
end;
if posEx('
while',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
while',#13#10+'
while',[rfReplaceAll, rfIgnoreCase]);
end;
if posEx('
for',input.Strings[a],1) >0
then begin input.Strings[a] := StringReplace(input.Strings[a],'
for',#13#10+'
for',[rfReplaceAll, rfIgnoreCase]);
end;
temp := input.Strings[a];
//Delete(temp,pos('//',temp),length(temp)); // kein zeilenumbruch im kommentar
if (posEx('
;',temp,1) >0)
then begin input.Strings[a] := StringReplace(input.Strings[a],'
;','
;'+#13#10,[rfReplaceAll, rfIgnoreCase]);
end;
end;
// ===== Datei verarbeiten - end
// ===== leerzeichen - begin
// leerzeichen muss am schluss gemacht werden
// === Vorformatieren - begin
output := TStringList.Create;
txt2 := '
';
For a := 0
to input.Count-1
do begin
txt2 := (txt2+input.Strings[a]);
end;
output.text := txt2;
output.text.Split(#13#10);
//jetzt zeilenweiße bearbeitne
// === Vorformatieren - end
leerzeichen := 1;
// linker rand
For a := 0
to output.Count-1
do begin
output.strings[a] := trimleft(output.strings[a]);
temp := StringReplace(output.strings[a],'
end;','
endXXX',[rfReplaceAll, rfIgnoreCase]);
temp := StringReplace(temp,'
end ','
endXXX',[rfReplaceAll, rfIgnoreCase]);
leerzeichen := leerzeichen - string_zaehlen('
endXXX',temp);
//leerzeichen := leerzeichen - string_zaehlen('end;',temp);
//output.strings[a] := IntTostr(leerzeichen)+Replicate(' ',leerzeichen) + output.strings[a]; //zum testen
output.strings[a] := Replicate('
',leerzeichen) + output.strings[a];
leerzeichen := leerzeichen + string_zaehlen('
begin',output.strings[a]);
leerzeichen := leerzeichen + string_zaehlen('
class(',output.strings[a]);
leerzeichen := leerzeichen + string_zaehlen('
finally',output.strings[a]);
label1.caption := IntToStr(leerzeichen);
//zum testen ob leerzeichen noch stimmen...
output.strings[a] := output.strings[a]+#13#10;
end;
// ===== Schönheitskorrekturen
// leerzeilen korrigieren
For a := output.Count-1
downto 0
do begin
// procedure zusätzliche leerzeilen wieder entfernen / korrigieren
if (pos('
procedure',output.strings[a]) > 0)
and ((trim(output.strings[a-1]) = '
'))
and (pos('
procedure',output.strings[a-4]) > 0)
then begin
output.Delete(a-1);
output.Delete(a-2);
output.Delete(a-3);
end;
// var zusätzliche leerzeilen wieder entfernen / korrigieren
if (pos('
var',output.strings[a]) > 0)
and (trim(output.strings[a-1]) = '
')
then begin
output.Delete(a-1);
end;
end;
input := output;
// ===== leerzeichen - end
// ===== Temporär anzeigen - begin
Memo2.text := '
'; txt2 := '
';
For a := 0
to input.Count-1
do begin
//txt2 := (txt2+input.Strings[a])+#13#10; // anzeige um die einzelnen objekte zu erkennen.
txt2 := (txt2+input.Strings[a]);
end;
Memo2.text := txt2;
// ===== Temporär anzeigen - end
// ===== Datei schreiben - begin
assignfile(d, '
output.pas');
rewrite(d);
writeln(d, txt2);
closefile(d);
// ===== Datei schreiben - bend
end;