1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:

unit Normieren_Unit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Math, Printers, StdCtrls, ComCtrls, Menus;

const
  WortMitRest  = 0;
  nurRest   = 1;
  WortUndRest = 2;

  abAnfang  = 0;
  abMittendrin = 1;

  ueberall  = 999;
  nurImplementation = 1;
  nurInterface = 0;
  AnzZeichen = 4;
  ImplementZeile : integer = 0;
  Leerzeile='                                                                                                                               ';
  KommentarZeile : boolean = FALSE;

  ErgebnisTyp  : string = '';
  AnzBegins : integer = 0;
  AnzEnds   : integer = 0;
  inCase    : boolean = FALSE;
  CaseElse  : boolean = FALSE;

type
  pWort  = ^WortRec;
  WortRec  = Record
        Bez,Start  : string;
        alleine, nurImplement, incl, NullEbene, AmAnfang   : boolean;
        DeltaEinzeln, Ebene            : integer;
      end;
  TForm1 = class(TForm)
  bu_laden: TButton;
  bu_Speichern: TButton;
  OpenDialog: TOpenDialog;
  bu_Norm: TButton;
  lb_Datei: TListBox;
  sb_Status: TStatusBar;
  bu_Druck: TButton;
  PrintDialog1: TPrintDialog;
    Label1: TLabel;
    e_n: TEdit;
    lb_Mask: TListBox;
    lb_Ebene: TListBox;
    lb_Komment: TListBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Optionen1: TMenuItem;
    mLaden: TMenuItem;
    mSpeichern: TMenuItem;
    mEnde: TMenuItem;
    mProzKomment: TMenuItem;
    mEndMarkierung: TMenuItem;
  procedure bu_SpeichernClick(Sender: TObject);
  procedure bu_ladenClick(Sender: TObject);
  procedure bu_NormClick(Sender: TObject);
  procedure bu_DruckClick(Sender: TObject);
    procedure lb_DateiKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lb_MaskKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lb_EbeneKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lb_KommentKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mEndMarkierungClick(Sender: TObject);
    procedure mProzKommentClick(Sender: TObject);
  private
  { Private-Deklarationen }
  public
  DName    : string;
  end;

const
  AnzWorte  = 10;
  CaseEbene  : integer = 0;
  Wort : Array[1..AnzWorte] of WortRec =
  ((Bez:'PROCEDURE'; Start : 'PROCEDURE'; alleine:FALSE; nurImplement:TRUE; incl:TRUE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:-1; Ebene:0),
   (Bez:'FUNCTION'; Start : 'FUNCTION'; alleine:FALSE; nurImplement:TRUE; incl:TRUE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:-1; Ebene:0),
   (Bez:'CASE'; Start : 'CASE'; alleine:FALSE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:-1; Ebene:1),
   (Bez:'TRY'; Start : 'TRY'; alleine:TRUE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:0; Ebene:1),
   (Bez:'WHILE'; Start : 'WHILE'; alleine:FALSE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:0; Ebene:0),
   (Bez:' CLASS('; Start : 'CLASS'; alleine:FALSE; nurImplement:FALSE; incl:FALSE; NullEbene:FALSE; AmAnfang:FALSE; DeltaEinzeln:-1; Ebene:1),
   (Bez:' RECORD'; Start : 'RECORD'; alleine:FALSE; nurImplement:FALSE; incl:FALSE; NullEbene:FALSE; AmAnfang:FALSE; DeltaEinzeln:-1; Ebene:1),
   (Bez:'WITH '; Start : 'WITH'; alleine:FALSE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:0; Ebene:0),
   (Bez:'IF '; Start : 'IF'; alleine:FALSE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:0; Ebene:0),
   (Bez:'FOR '; Start : 'FOR'; alleine:FALSE; nurImplement:TRUE; incl:FALSE; NullEbene:FALSE; AmAnfang:TRUE; DeltaEinzeln:0; Ebene:0)
  );

var
  KommentarWort : array[0..45] of string;
  ProzedurWort  : array[0..15] of string;
  BeginProc      : array[0..15] of boolean;
  ProzedurEbene  : integer;

  Form1: TForm1;


implementation

uses Fortschr;

{$R *.DFM}

procedure TForm1.bu_SpeichernClick(Sender: TObject);
begin
  copyFile(PChar(DNAME),PChar(DName+'.BAK'),FALSE);
  lb_Datei.Items.SaveToFile(DNAME);
  bu_Norm.Visible := FALSE;
  bu_Speichern.Visible := FALSE;
  lb_Datei.Font.Color := clBlue;
end;

procedure TForm1.bu_ladenClick(Sender: TObject);
begin
  with OpenDialog do begin
    FilterIndex := 1;
    if Execute then begin
      DName := FileName;
      lb_Datei.Items.LoadFromFile(DName);
    end;
  end;
  bu_Norm.visible := TRUE;
  Form1.Caption := 'Datei : '+DName;
  lb_Datei.Font.Color := clRed;
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
end;

procedure TForm1.bu_NormClick(Sender: TObject);
var
  Ebene    : integer;
  p      : integer;

  function MaskKomment(s : string; var KommentZeile : boolean) : string;
  var
    Temp  : string;
    isKomment : boolean;
    i, j, p    : integer;
    c    : char;
  begin
    isKomment := KommentZeile;
    Temp := Trim(s);
    if s='' then begin
      Result := '';
      exit;
    end;
    if copy(s,1,2)='//' then begin
      for i:=3 to Length(Temp) do Temp[i] := '#';
    end else begin
      isKomment := FALSE;
      for i := 1 to Length(s) do begin
        c := s[i];
        if c = #39 then
          isKomment := not(isKomment);
        if isKomment then begin
          if copy(s,i+1,1)<>#39 then begin
            if i+1<=Length(s) then
              s[i+1] := '#';
          end;
        end;
      end;
      Temp := s;

      isKomment := KommentZeile;

      if IsKomment then begin
        p := Max(Pos('*)',s),Pos('}',s));
        if p>0 then KommentZeile := FALSE;
        for i := 1 to p-1 do
          Temp[i] := '#';
      end else begin
        isKomment := FALSE;
        for i := 1 to Length(s) do begin
          c := s[i];
          if (c = '(') and (s[i+1]='*') then begin
            isKomment := TRUE;
            if Copy(s,i+2,2)<>'*)' then
              if i+2<=Length(Temp) then
                Temp[i+2]:='#';
          end;
          if (c = '*') and (copy(s,i+1,1)=')') then begin
            isKomment := FALSE;
          end;
          KommentZeile := isKomment;
        end;
        isKomment := FALSE;
        for i := 1 to Length(s) do begin
          c := s[i];
          if c = '{' then
            isKomment := TRUE;
          if c = '}' then
            isKomment := FALSE;
          if isKomment then begin
            if Copy(s,i+1,1)<>'}' then begin
              if i+1<=Length(Temp) then
                Temp[i+1] := '#';
            end;
          end;
          KommentZeile := isKomment;
        end;
      end;
    end;
    Result := Temp;
  end;

  function GeheInImplementBereich : integer;
  var
    i : integer;
  begin
    if ImplementZeile>0 then begin
      result := ImplementZeile;
    end else begin
      i := 0;
      result := 0;
      with lb_Datei do begin
        while i<Items.Count do begin
          if (Pos('IMPLEMENTATION',Uppercase(items[i]))>0) then begin
            result := i+1;
            ImplementZeile := i+1;
            break;
          end;
          FF.FortschrittAktualisieren('bis Implementbereich ');
          inc(i);
        end;
      end;
    end;
  end;

  function LoescheTabs(s : string) : string;
  var
    Temp : string;
    i   : integer;
    c  : char;
  begin
    temp := '';
    i := 1;
    while i<=length(s) do begin
      c := s[i];
      if c = #9 then begin
        if temp<>'' then begin
          temp := temp+' ';
        end;
      end else begin
        temp := temp + c;
      end;
      inc(i);
    end;
    result := temp;
  end;


  procedure LoescheIndent;
  var
    i : integer;
    s, Zus : string;
  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      for i := 0 to Items.Count-1 do begin
        s := Items[i];
        if copy(Items[i],1,1)=chr(255) then
          Zus := chr(255)
        else
          Zus := '';
        Items[i] := Zus+Trim(LoescheTabs(Trim(s)));
        FF.FortschrittAktualisieren('LoescheIndents ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  function DelKomment(s : string) : string;
  var
    KommGef : boolean;
  begin
    s := Trim(Uppercase(s));
    if s = '' then begin
      Result := '';
    end else begin
      KommGef := (s[1]='/') or (s[1]='{');
      KommGef := KommGef or (copy(s,1,2)='(*');
    end;
    if KommGef then
      Result := ''
    else
      Result := s;
  end;

  procedure VerschiebeWort(was : string; wie : integer; abWo : integer);
  var
    p, i : integer;
    s, s1, s2, s3, Temp : string;
    s1m, s2m, s3m : string;
  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 0;
      i := GeheInImplementBereich;
      while (i<Items.Count) do begin
        Temp := Items[i];
        if Temp<>'' then begin
          s := lb_Mask.Items[i];
          Kommentarzeile := (lb_Komment.Items[i]='1');
          p := Pos(was,s);
          if Abwo=abAnfang then
            if p>1 then
              p := 0;
          if p>0 then begin
            case wie of
            WortMitRest :
              begin     // einschl. Wort
                s1 := Trim(copy(Temp,1,p-1));
                s2 := Trim(copy(Temp,p,255));
                s3 := '';
                s1m := Trim(copy(s,1,p-1));
                s2m := Trim(copy(s,p,255));
                s3m := '';
              end;
            nurRest :
              begin    // nur Rest
                s1 := Trim(copy(Temp,1,p+Length(was)-1));
                s2 := Trim(copy(Temp,p+Length(was),255));
                s3 := '';
                s1m := Trim(copy(s,1,p+Length(was)-1));
                s2m := Trim(copy(s,p+Length(was),255));
                s3m := '';
              end;
            else
  //          WortUndRest
                s1 := Trim(copy(Temp,1,p-1));
                s2 := Trim(copy(Temp,p,length(was)));
                s3 := Trim(copy(Temp,p+Length(was)+1,255));
                s1m := Trim(copy(s,1,p-1));
                s2m := Trim(copy(s,p,length(was)));
                s3m := Trim(copy(s,p+Length(was)+1,255));
            end;
          end else begin
            s1 := Trim(Temp);
            s2 := '';
            s3 := '';
            s1m := s;
            s2m := '';
            s3m := '';
          end;
          Items[i] := s1;
          s1m := DelKomment(s1m);
          lb_Mask.Items[i] := s1m;
          if s1m='' then
            lb_Komment.Items[i] := '1'
          else
            lb_Komment.Items[i] := '0';
          if s2<>'' then begin
            Items.Insert(i+1,s2);
            lb_Ebene.Items.Insert(i+1,'0');
            s2m := DelKomment(s2m);
            lb_Mask.Items.Insert(i+1,s2m);
            if s2m<>'' then
              lb_Komment.Items.Insert(i+1,'0')
            else
              lb_Komment.Items.Insert(i+1,'1');
            if s3<>'' then begin
              Items.Insert(i+2,s3);
              lb_Ebene.Items.Insert(i+2,'0');
              s3m := DelKomment(s3m);
              lb_Mask.Items.Insert(i+2,s3m);
              if s3m<>'' then
                lb_Komment.Items.Insert(i+2,'0')
              else
                lb_Komment.Items.Insert(i+2,'1');
            end;
          end;
        end;
        FF.FortschrittAktualisieren('Verschiebe '+was+' ');
        inc(i);
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure KommentarHinzufuegen;
  const
    NullEbeneWort : Array[1..2] of string =
    ('PROCEDURE','FUNCTION');
  var
    i : integer;
    gef  : boolean;
    s1, s : string;

    procedure EinfuegeText(var i : integer; s : string);
    var
      j : integer;
    begin
      with lb_Datei do begin
        Items.Insert(i,'|--------------------------------------------------------------------------}');
        Items.Insert(i,'| Anmerkungen:   ');
        Items.Insert(i,'| Bedingung:     ');
        Items.Insert(i,'| ErgebnisTyp:   '+lowercase(ErgebnisTyp));
        Items.Insert(i,'| Wirkung:      ');
        Items.Insert(i,'| '+s);
        Items.Insert(i,'{|--------------------------------------------------------------------------');
        for j := 1 to 7 do lb_Komment.Items.Insert(i,'1');
        for j := 1 to 7 do lb_Ebene.Items.Insert(i,'0');
        for j := 1 to 7 do lb_Mask.Items.Insert(i,'');
        inc(i,8);
      end;
    end;
  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := GeheInImplementBereich;
      while (i<Items.Count) do begin
        s := lb_Mask.Items[i];
        KommentarZeile := lb_Komment.Items[i]='1';
        gef := (Pos(NullebeneWort[1],s)=1) or (Pos(NullebeneWort[2],s)=1);
        if gef then gef := gef and not(copy(s,1,2)='//');
        if gef then begin
          if (Pos(NullEbeneWort[2],Trim(s))=1) then begin
            s1 := Trim(s);
            p := pos(')',s1);
            if p>0 then begin
              s1 := Copy(s1,p+1,255);
              p := pos(':',s1);
              if p>0 then begin
                s1 := Copy(s1,p+1,255);
                p := pos(';',s1);
                if p>0 then begin
                  ErgebnisTyp := chr(255)+Trim(Copy(s1,1,p-1));
                end else begin
                  Ergebnistyp := chr(255)+s1;
                end;
              end else begin
                Ergebnistyp := chr(255)+s1;
              end;
            end else begin
              p := pos(':',s1);
              if p>0 then begin
                s1 := Copy(s1,p+1,255);
                p := pos(';',s1);
                if p>0 then begin
                  ErgebnisTyp := Trim(Copy(s1,1,p-1));
                end else begin
                  Ergebnistyp := s1;
                end;
              end else begin
                Ergebnistyp := '??';
              end;
            end;
          end else begin
            ErgebnisTyp := '-';
          end;
          EinfuegeText(i, Items[i]);
        end;
        inc(i);
        FF.FortschrittAktualisieren('KommentarHinzufügen ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure LoescheDoppelteLeerzeichen;
  var
    i,j : integer;
    c : char;
    Temp, s : string;
  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 0;
      Kommentarzeile := FALSE;
      while i<Items.Count do begin
         s := MaskKomment(Items[i],KommentarZeile);
         Temp := '';
         j := 1;
         while j<=length(s) do begin
          c := s[j];
          if (copy(s,j,2) = '  ') then begin
            c := #0;
          end;
          if c<>#0 then Temp := Temp + Items[i][j];
          inc(j);
         end;
        Items[i] := Temp;
         inc(i);
        FF.FortschrittAktualisieren('LöscheDoppelteLeerzeichen ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure LoescheKommentare;
  var
    i, p : integer;
    s : string;

    function NichtkommentZeile(s : string) : boolean;
    begin
      s := Trim(Uppercase(s));
      Result := (Copy(s,1,9)='PROCEDURE') or (Copy(s,1,8)='FUNCTION');
    end;

    procedure LoescheText;
    var
      Ende : boolean;
      s  : string;
    begin
      with lb_Datei do begin
        repeat
          Items.Delete(i);
          lb_Mask.Items.Delete(i);
          lb_Komment.Items.Delete(i);
          lb_Ebene.Items.Delete(i);
          s := lb_Mask.Items[i];
          Ende := NichtKommentZeile(s);
        until (i>=Items.Count) or Ende;
      end;
    end;

  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 0;
      i := GeheInImplementBereich;
      while i<Items.Count do begin
        s := lb_Mask.Items[i];
        p := pos('END;',s);
        if p>0 then begin
          Items[i] := Copy(Items[i],1,p+4);
          lb_Mask.Items[i] := Copy(s,1,p+4);
        end;
        if (Pos('//****',s)>0) or (Pos('{|',s)>0) or (Pos('{****',s)>0) then begin
          LoescheText;
        end;
        inc(i);
        FF.FortschrittAktualisieren('LöscheKommentare ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure GrossKleinSchreibung;
  const
    AnzKleinWorte = 35;
    AnzGrossWorte = 2;
    KleinWort : Array[1..AnzKleinWorte] of string =
    ('BEGIN','VAR','TYPE','CONST','TRY','EXCEPT', 'PRIVATE','PUBLIC','ASM','FINALLY','REPEAT','USES',
    'CLASS',' OBJECT','PUBLISHED','IF ',' THEN','ELSE','WITH','WHILE','DO','FOR ','TO ','CASE ',' OF',
    'END;',' END','DOWNTO','UNTIL','BREAK','CONTINUE','UNIT','PROGRAM','INTERFACE','IMPLEMENTATION');
    GrossWort : Array[1..AnzGrossWorte] of string =
    ('TRUE','FALSE');
  var
    i,j,p,len : integer;
    s : string;
  begin
    with lb_Datei do begin
      Ebene := 0;
      i := 0;
      FF.FortschrittBeginnen(Items.Count,FALSE);
      KommentarZeile := FALSE;
      while (i<Items.Count) do begin
        s := Uppercase(MaskKomment(Items[i], KommentarZeile));
        for j := 1 to AnzKleinWorte do begin
          p := Pos(KleinWort[j],s);
          if p>0 then begin
            len := Length(KleinWort[j]);
            Items[i] := Copy(Items[i],1,p-1) + LowerCase(KleinWort[j])+ Copy(Items[i],p+len,255);
          end;
        end;
        for j := 1 to AnzGrossWorte do begin
          p := Pos(GrossWort[j],s);
          if p>0 then begin
            len := Length(GrossWort[j]);
            Items[i] := Copy(Items[i],1,p-1) + GrossWort[j]+ Copy(Items[i],p+len,255);
          end;
        end;
        inc(i);
        FF.FortschrittAktualisieren('GrossKleinschreibung ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure EndeMarkieren;
  var
    nEbene, i, j, p : integer;
    inCase    : boolean;
    CaseEbene : integer;
    s          : string;
    KWort      : string;
    gef        : boolean;
    CaseBereich : string;
  begin
    with lb_Datei do begin
      for i := 0 to 45 do KommentarWort[i] := '';
      KommentarZeile := FALSE;
      inCase := FALSE;
      for i := 0 to Items.Count-1 do begin
        s := Uppercase(MaskKomment(Items[i], KommentarZeile));
        if not(KommentarZeile) then begin
          nEbene := (Length(s)-Length(TrimLeft(s))) div 2;
          gef := FALSE;
          for j := 1 to AnzWorte do begin
            if (Wort[j].Start<>'') then begin
              if Wort[j].AmAnfang then begin
                gef := (Pos(Wort[j].Bez,TrimLeft(s))=1);
              end else begin
                gef := (Pos(Wort[j].Bez,s)>1);
              end;
              if gef then begin
                KommentarWort[nEbene] := Wort[j].Start;
                if (Wort[j].Start = 'CASE') then begin
                  CaseEbene := nEbene;
                  InCase := TRUE;
                end;
                break;
              end;
            end;
          end;
          if not(gef) and InCase then begin
            p := Pos(':',s);
            if (p<>Length(s)) then p := 0; 
            if p>0 then begin
              CaseBereich := Trim(Copy(s,1,p-1));
            end;
          end;
          p := pos('END;',s);
          if (p>0) then begin
            if InCase and (nEbene-CaseEbene=1) then begin
              KOmmentarWort[nEbene] := 'CASE '+CaseBereich;
            end;
            Items[i] := Items[i] + ' //'+UpperCase(KommentarWort[nEbene]);
            if inCase then begin
              inCase := CaseEbene<nEbene;
            end;
          end;
        end;
      end;
    end;
  end;

  procedure ListBoxenNullen;
  var
    i : integer;
  begin
    lb_Ebene.Items.Clear;
    lb_Komment.Items.Clear;
    lb_Mask.Items.Clear;
    i := 0;
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      while i<Items.Count do begin
        lb_Ebene.Items.Add('0');
        lb_Komment.Items.Add('0');
        lb_Mask.Items.Add('');
        inc(i);
        FF.FortschrittAktualisieren('ListBoxenNullen ');
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure EbenenBelegen;
  var
    i,Ebene : integer;
    Temp, s : string;
  begin
    with lb_Mask do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      Ebene := 0;
      i := 0;
      while i<Items.Count do begin
         s := Items[i];
         if s<>'' then begin
           if (s = 'BEGIN') or (s = 'TRY') or (copy(s,1,5) = 'CASE ') or
            (Pos(' RECORD',s)>0) or (Pos(' CLASS(',s)>0)then begin
            lb_Ebene.items[i] := IntToStr(Ebene);
            inc(Ebene);
          end else if (Pos('END',s) = 1) then begin
            Dec(Ebene);
            lb_Ebene.items[i] := IntToStr(Ebene);
          end else begin
            lb_Ebene.Items[i] := IntToStr(Ebene);
          end;
         end else begin
          lb_Ebene.Items[i] := IntToStr(Ebene);
         end;
         FF.FortschrittAktualisieren('Ebenenlistebelegen ');
       inc(i);
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure MaskEbeneBelegen;
  var
    i : integer;
    Temp, s : string;
  begin
    KommentarZeile := FALSE;
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 0;
      Kommentarzeile := FALSE;
      while i<Items.Count do begin
        s := MaskKomment(Items[i],KommentarZeile);
        if not(KommentarZeile) then begin
          if copy(s,1,2)='//' then begin
             lb_Mask.Items[i] := '';
          end else if copy(s,1,2)='(*' then begin
             lb_Mask.Items[i] := '';
          end else if copy(s,1,1)='{' then begin
             lb_Mask.Items[i] := '';
          end else if copy(s,1,1)='#' then begin
             lb_Mask.Items[i] := '';
          end else begin
             lb_Mask.Items[i] := Trim(Uppercase(s));
          end;
        end else begin
           lb_Mask.Items[i] := '';
          lb_Komment.Items[i] := '1';
        end;
           FF.FortschrittAktualisieren('MaskListebelegen ');
       inc(i);
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure IndentEbeneErzeugen;
  var
    i,Ebene : integer;
    Temp, s : string;
  begin
    with lb_Datei do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 0;
      while i<Items.Count do begin
        s := Items[i];
        Ebene := StrToInt(lb_Ebene.Items[i]);
        if Ebene<0 then Ebene := 0;
        s := Copy(Leerzeile,1,2*Ebene)+s;
        Items[i] := s;
        FF.FortschrittAktualisieren('Indent ');
         inc(i);
      end;
    end;
    FF.FortschrittBeenden;
  end;

  procedure VerschiebeEbene(BeginnWort : string; EndWort : Array of String; wo : integer);
  var
    i,j,k, Ebene, d  : integer;
    istBeginn, istEnde  : boolean;
    s,Vgl  : string;
    Ende  : integer;
    GesamterText  : boolean;
    PlusWort  : boolean;
    wieFinden  : char;
  begin
    Ebene := 0;
    GesamterText := (BeginnWort[1] = 'G');
    PlusWort := (BeginnWort[2] = '+');
    BeginnWort := Copy(BeginnWort,4,255);
    with lb_Mask do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      i := 1;
      d := 0;
      case wo of
        ueberall :
          begin
            i := 1;
            Ende := Items.Count;
          end;
        nurInterface :
          begin
            i := 1;
            Ende := ImplementZeile;
          end;
        else
          begin
            i := ImplementZeile;
            Ende := Items.Count;
          end;
      end;
      while i<Ende do begin
        s := Items[i];
        Ebene := StrToInt(lb_Ebene.Items[i]);
        istBeginn := FALSE;
        istEnde := FALSE;
        if GesamterText then begin
           istBeginn := (s = Beginnwort);
        end else begin
           istBeginn := Pos(Beginnwort,s)>0;
        end;
        if istBeginn then begin
          if not(PlusWort) then begin
            Dec(Ebene);
            lb_Ebene.Items[i] := IntToStr(Ebene);
            Inc(Ebene);
          end;
          inc(i);
          repeat
            s := Items[i];
            Ebene := StrToInt(lb_Ebene.Items[i]);
            for j:= Low(Endwort) to High(Endwort) do begin
              Vgl := EndWort[j];
              wieFinden := Vgl[1];
              Vgl := Copy(Vgl,3,255);
              case wieFinden of
                'G' : istEnde := (s = Vgl);
                'M' : istEnde := Pos(Vgl,s)>0;
                'E' : istEnde := Pos(Vgl,s)=Length(s)+1-Length(Vgl);
              else
                istEnde := Pos(Vgl,s)=1;
              end;
              if istEnde then break;
            end;
            if not(istEnde) then begin
              lb_Ebene.Items[i] := IntToStr(Ebene+1);
              inc(i);
            end;
          until istEnde or (i>=Items.Count);

        end else begin
          inc(i);
        end;
        FF.FortschrittAktualisieren('Ebene '+BeginnWort+' ');
      end;
      FF.FortschrittBeenden;
    end;
  end;

  procedure VerschiebeEbene2(BeginnWort : Array of string; wo : integer);
  var
    i,j,k, Ebene, d  : integer;
    istBeginn, istEnde  : boolean;
    s  : string;
    Temp : string;
    BeginnZeile, Endzeilke, BeginnEbene : integer;
    Anfang, Ende  : integer;
  begin
    Ebene := 0;
    with lb_Mask do begin
      FF.FortschrittBeginnen(Items.Count,FALSE);
      d := 0;
      case wo of
        ueberall :
          begin
            i := 1;
            Ende := Items.Count;
          end;
        nurInterface :
          begin
            i := 1;
            Ende := ImplementZeile;
          end;
        else
          begin
            i := ImplementZeile;
            Ende := Items.Count;
          end;
      end;
      while i<Ende do begin
        s := Items[i];
        Ebene := StrToInt(lb_Ebene.Items[i]);
        istBeginn := FALSE;
        istEnde := FALSE;
         for j:= Low(Beginnwort) to High(Beginnwort) do begin
          if Length(BeginnWort[j])<length(s) then begin
            if BeginnWort[j][1]='G' then begin
              istBeginn := (s = Copy(BeginnWort[j],3,255));
            end else if BeginnWort[j][1] = 'M' then begin
              istBeginn := Pos(Copy(BeginnWort[j],3,255),s)>0;
            end else if BeginnWort[j][1] = 'E' then begin
              Temp := Copy(s,Length(s)-Length(BeginnWort[j])+3,255);
              istBeginn := Pos(Copy(BeginnWort[j],3,255),Temp)=1;
            end else begin
              istBeginn := Pos(Copy(BeginnWort[j],3,255),s)=1;
            end;
             if istBeginn then begin
              istBeginn := Items[i+1]<>'BEGIN';
            end;
            if istBeginn then
               break;
          end;
         end;
        if istBeginn then begin
          BeginnZeile := i+1;
          BeginnEbene := Ebene;
          i := BeginnZeile;
          repeat
            s := Items[i];
            Ebene := StrToInt(lb_Ebene.Items[i]);
            if Ebene>BeginnEbene then inc(i);
          until (i>=Items.Count) or (Ebene<=BeginnEbene);
          for j := BeginnZeile to i do
            lb_Ebene.Items[j] := IntToStr(StrToInt(lb_Ebene.Items[j])+1);
          i := BeginnZeile;
        end else begin
          inc(i);
        end;
        FF.FortschrittAktualisieren('Ebene '+BeginnWort[0]+' ');
      end;
      FF.FortschrittBeenden;
    end;
  end;

  procedure IndentEbene2;
  begin
    VerschiebeEbene('G-_VAR',['G_VAR','G_TYPE','G_CONST','G_BEGIN','A_PROCEDURE ','A_FUNCTION ','G_IMPLEMENTATION'],ueberall);
    VerschiebeEbene('G-_TYPE',['G_VAR','G_TYPE','G_CONST','G_BEGIN','A_PROCEDURE ','A_FUNCTION ','G_IMPLEMENTATION'],ueberall);
    VerschiebeEbene('G-_CONST',['G_VAR','G_TYPE','G_CONST','G_BEGIN','A_PROCEDURE ','A_FUNCTION ','G_IMPLEMENTATION'],ueberall);
    VerschiebeEbene('G-_PRIVATE',['G_PUBLIC','G_PUBLISHED','G_END;'],nurInterface);
    VerschiebeEbene('G-_PUBLIC',['G_PRIVATE','G_PUBLISHED','G_END;'],nurInterface);
    VerschiebeEbene('G-_PUBLISHED',['G_PRIVATE','G_PUBLIC','G_END;'],nurInterface);
//    VerschiebeEbene('TRY',['G_EXCEPT','G_FINALLY'],nurImplementation);
    VerschiebeEbene('G-_FINALLY',['G_END;'],nurImplementation);
    VerschiebeEbene('G-_EXCEPT',['G_END;'],nurImplementation);
    VerschiebeEbene2(['E_ THEN','E_ DO','E_ TO'],nurImplementation);
    VerschiebeEbene('G-_USES',['E_;'],ueberall);
  end;


begin
  ImplementZeile := 0;

  LoescheIndent;
  Form1.Repaint;

  LoescheDoppelteLeerzeichen;
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  ListboxenNullen;
  Form1.Repaint;
  MaskEbeneBelegen;
  Form1.Repaint;
  LoescheKommentare;
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  VerschiebeWort(' ELSE',WortUndRest,abMittendrin);
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  VerschiebeWort(' THEN',NurRest,abMittendrin);
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  VerschiebeWort(' DO',NurRest,abMittendrin);
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  VerschiebeWort(' BEGIN',WortUndRest,abMittendrin);
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  EbenenBelegen;
  Form1.Repaint;
  ProzedurEbene := 0;
  IndentEbene2;
  Form1.Repaint;
  IndentEbeneErzeugen;
  Form1.Repaint;
  GrossKleinschreibung;
  if mEndMarkierung.checked then
    EndeMarkieren;
  if mProzKomment.checked then
    KommentarHinzufuegen;
  e_n.Text := FormatFloat('#,##0',lb_Datei.Items.Count);
  Form1.Repaint;
  bu_Speichern.visible := TRUE;
  mSpeichern.Enabled := TRUE;
  lb_Datei.SetFocus;
  lb_Datei.Font.Color := clBlack;
end;

procedure TForm1.bu_DruckClick(Sender: TObject);
var
  I : Integer;
  pr  : TextFile;
begin
  if PrintDialog1.Execute then begin
    with Printer do
    begin
      AssignPrn(pr);
      Rewrite(pr);
      with lb_Datei do begin
        for i := 0 to Items.Count-1 do begin
          WriteLn(pr,Items[i]);
        end;
      end;
    end;
  end;
end;

procedure TForm1.lb_DateiKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  lb_Mask.TopIndex := lb_Datei.TopIndex;
  lb_Ebene.TopIndex := lb_Datei.TopIndex;
  lb_Komment.TopIndex := lb_Datei.TopIndex;
end;

procedure TForm1.lb_MaskKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  lb_Datei.TopIndex := lb_Mask.TopIndex;
  lb_Ebene.TopIndex := lb_Mask.TopIndex;
  lb_Komment.TopIndex := lb_Mask.TopIndex;
end;

procedure TForm1.lb_EbeneKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  lb_Mask.TopIndex := lb_Ebene.TopIndex;
  lb_Datei.TopIndex := lb_Ebene.TopIndex;
  lb_Komment.TopIndex := lb_Ebene.TopIndex;
end;

procedure TForm1.lb_KommentKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  lb_Mask.TopIndex := lb_Komment.TopIndex;
  lb_Datei.TopIndex := lb_Komment.TopIndex;
  lb_Ebene.TopIndex := lb_Komment.TopIndex;
end;

procedure TForm1.mEndMarkierungClick(Sender: TObject);
begin
  mEndMarkierung.checked := not(mEndMarkierung.checked);
end;

procedure TForm1.mProzKommentClick(Sender: TObject);
begin
  mProzKomment.checked := not(mProzKomment.checked);
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

program Normieren;

uses
  Forms,
  Normieren_Unit in 'Normieren_Unit.pas' {Form1},
  Fortschr in 'Fortschr.pas' {FF};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TFF, FF);
  Application.Run;
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:

unit Fortschr;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Buttons;

var
  ProcAbbruch      : boolean = FALSE;

type

  TFF = class(TForm)
  p_Fortschritt: TPanel;
  l_FortschrTitel: TLabel;
  pb_Fortschritt: TProgressBar;
    sb_Abbruch: TSpeedButton;
    l_Zwischenergebnis: TStaticText;

  procedure FortschrittBeginnen(Anz : Integer; mitAbbruch : boolean);
  procedure FortschrittAktualisieren(Text : String);
  procedure FortschrittBeenden;
  procedure sb_AbbruchClick(Sender: TObject);
private
  FortschrStartZeit    : TDateTime;
  n              : TProgressRange;
  Abbr        : boolean;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
  FF: TFF;

implementation

uses
  Normieren_Unit;

{$R *.DFM}
procedure TFF.FortschrittBeginnen(Anz : Integer; mitAbbruch : boolean);
begin
  FortschrStartZeit := now;
  ProcAbbruch := FALSE;
  with pb_Fortschritt do begin
    Smooth := TRUE;
    min := 0;
    Position := 0;
    max := Anz;
    if max = 0 then max := 1;
  end; {WITH pb_Fortschritt}
  Abbr := mitAbbruch;
  sb_Abbruch.Enabled := mitAbbruch;
  FF.visible := TRUE;
  FF.Top := 10;
  n := 0;
end; {PROCEDURE}

procedure TFF.FortschrittAktualisieren(Text : String);
var
  FText  : String;
  Rest  : extended;
begin
  if Abbr then Application.ProcessMessages;
  pb_Fortschritt.Max := Form1.lb_Datei.Items.Count;
  if n>0 then begin
    Rest := 3600*24*(pb_Fortschritt.Max-n)/n*(now-FortschrStartZeit);
  end else begin
    Rest := 10000.0;
  end;
  inc(n);
  FText := Text + IntToStr(n) + ' von ' + IntToStr(pb_Fortschritt.Max);
  FText := FText + ',    Rest : ' + FormatFloat('#,##0.0',Rest)+' s      ';
  pb_Fortschritt.Position := n;
  l_ZwischenErgebnis.Caption := FText;
//  FF.BringToFront;
end; {PROCEDURE}

procedure TFF.FortschrittBeenden;
begin
  FF.Top := 2000;
  FF.Visible := FALSE;
end; {PROCEDURE}

procedure TFF.sb_AbbruchClick(Sender: TObject);
begin
  ProcAbbruch := TRUE;
end;

end.