delfor1.pas

适用于 Delphi 2-7 的Delphi控件

{|----------------------------------------------------------------------
 | Class:       TPascalParser
 |
 | Author:      Egbert van Nes
 |
 | Description: Format pascal code
 |
 | Copyright (c) 2000  Egbert van Nes
 |
 | Redistribution and use in source and binary form, with or without
 | modification, are permitted provided that the following conditions
 | are met:
 |
 | 1. Redistributions of source code must retain the above copyright
 |    notice, this list of conditions and the following disclaimer.
 |    If the source is modified, the complete original and unmodified
 |    source code has to distributed with the modified version.
 |
 | 2. Redistributions in binary form must reproduce the above
 |    copyright notice, these licence conditions and the disclaimer
 |    found at the end of this licence agreement in the documentation
 |    and/or other materials provided with the distribution.
 |
 | 3. Software using this code must contain a visible line of credit.
 |
 | 4. If my code is used in a "for profit" product, you have to donate
 |    to a registered charity in an amount that you feel is fair.
 |    You may use it in as many of your products as you like.
 |    Proof of this donation must be provided to the author of
 |    this software.
 |
 | 5. If you for some reasons don't want to give public credit to the
 |    author, you have to donate three times the price of your software
 |    product, or any other product including this component in any way,
 |    but no more than $500 US and not less than $200 US, or the
 |    equivalent thereof in other currency, to a registered charity.
 |    You have to do this for every of your products, which uses this
 |    code separately.
 |    Proof of this donations must be provided to the author of
 |    this software.
 |
 | DISCLAIMER:
 |
 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
 |
 | ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 | PARTICULAR PURPOSE ARE DISCLAIMED.
 |
 | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |
 |---------------------------------------------------------------------- |----------------------------------------------------------------------}

unit Delfor1;

interface

uses SysUtils, OObjects, Classes, ExtCtrls, Menus, DelForTypes, DelforEng
{$IFDEF CS_TRACE} ,CodeSiteLogging {$ENDIF};
{
  Main interface methods:

  TPascalParser = class(TObject)
  public
    constructor Create(ARootdir: PChar);
    procedure SetDefault;
    procedure LoadFromFile(AFileName: PChar);
    procedure LoadFromList(AList: TStringList);
    function Parse: Boolean;
    procedure WriteToFile(AFileName: PChar);
    destructor Destroy; override;
    property Text: PChar read GetTextStr write SetTextStr;
    property Settings: TSettings read FSettings write FSettings;
  end;
}
type
 TPascalParser = class(TObject)
 private
//  Timer: TTimer;
  FSettings: TSettings;
  FCapFileName: PChar;
  CapFileTime: Integer;
  FOnProgress: TProgressEvent;
  FCfgFile: string;
  FRootDir: string;
  procedure SetFillNewWords(AFillNewWords: TFillMode);
  procedure SetCapFileName(AFileName: PChar);
//  procedure TimerTimer(Sender: TObject);
  function GetNewCapFileTime: Integer;
  procedure SetTextStr(AText: PChar);
  function GetShortCut: TShortCut;
  procedure SetShortCut(AShortCut: TShortCut);
  procedure SetShortCutText(AShortCut: string);
  function GetShortCutText: string;
  function GetTextStr: PChar;
  function GetRootDir: string;
  procedure SetRootdir(const Value: string);
  procedure SetOnProgress(const Value: TProgressEvent);
 public
  procedure Activate;
  procedure deActivate;
  procedure SaveCapFile(AFileName: PChar);
  procedure LoadCapFile(AFileName: PChar);
  constructor Create(ARootdir: PChar);
  procedure Clear;
  procedure SetDefault;
  procedure SetBorland;
  procedure LoadFromFile(AFileName: PChar);
  procedure LoadFromList(AList: TStringList);
  function Parse: Boolean;
  procedure Config(DoRead: Boolean);
  procedure WriteToFile(AFileName: PChar);
  destructor Destroy; override;
  property SpacePerIndent: Integer read FSettings.SpacePerIndent write
   FSettings.SpacePerIndent;
  property SpaceOperators: TSpaceBefore read FSettings.SpaceOperators write
   FSettings.SpaceOperators;
  property SpaceEqualOper: TSpaceBefore read FSettings.SpaceEqualOper write
   FSettings.SpaceEqualOper;
  property SpaceColon: TSpaceBefore read FSettings.SpaceColon write
   FSettings.SpaceColon;
  property SpaceComma: TSpaceBefore read FSettings.SpaceComma write
   FSettings.SpaceComma;
  property SpaceSemiColon: TSpaceBefore read FSettings.SpaceSemiColon write
   FSettings.SpaceSemiColon;
  property SpaceLeftBr: TSpaceBefore read FSettings.SpaceLeftBr write
   FSettings.SpaceLeftBr;
  property SpaceRightBr: TSpaceBefore read FSettings.SpaceRightBr write
   FSettings.SpaceRightBr;
  property SpaceLeftHook: TSpaceBefore read FSettings.SpaceLeftHook write
   FSettings.SpaceLeftHook;
  property SpaceRightHook: TSpaceBefore read FSettings.SpaceRightHook write
   FSettings.SpaceRightHook;
  property UpperCompDirectives: Boolean read FSettings.UpperCompDirectives
   write FSettings.UpperCompDirectives;
  property UpperNumbers: Boolean read FSettings.UpperNumbers write
   FSettings.UpperNumbers;
  property ReservedCase: TCase read FSettings.ReservedCase write
   FSettings.ReservedCase;
  property StandDirectivesCase: TCase read FSettings.StandDirectivesCase write
   FSettings.StandDirectivesCase;
  property ChangeIndent: Boolean read FSettings.ChangeIndent write
   FSettings.ChangeIndent;
  property indentBegin: Boolean read FSettings.indentBegin write
   FSettings.indentBegin;
  property NoIndentElseIf: Boolean read FSettings.NoIndentElseIf write
   FSettings.NoIndentElseIf;
  property IndentComments: Boolean read FSettings.IndentComments write
   FSettings.IndentComments;
  property IndentCompDirectives: Boolean read FSettings.IndentCompDirectives
   write FSettings.IndentCompDirectives;
  property IndentTry: Boolean read FSettings.IndentTry write
   FSettings.IndentTry;
  property IndentTryElse: Boolean read FSettings.IndentTryElse write
   FSettings.IndentTryElse;
  property IndentCaseElse: Boolean read FSettings.IndentCaseElse write
   FSettings.IndentCaseElse;
  property BlankProc: Boolean read FSettings.BlankProc write
   FSettings.BlankProc;
  property RemoveDoubleBlank: Boolean read FSettings.RemoveDoubleBlank write
   FSettings.RemoveDoubleBlank;
  property FeedRoundBegin: TFeedBegin read FSettings.FeedRoundBegin write
   FSettings.FeedRoundBegin;
  property FeedAfterThen: Boolean read FSettings.FeedAfterThen write
   FSettings.FeedAfterThen;
  property ExceptSingle: Boolean read FSettings.ExceptSingle write
   FSettings.ExceptSingle;
  property NoFeedBeforeThen: Boolean read FSettings.NoFeedBeforeThen write
   FSettings.NoFeedBeforeThen;
  property FeedElseIf: Boolean read FSettings.FeedElseIf write
   FSettings.FeedElseIf;
  property FeedEachUnit: Boolean read FSettings.FeedEachUnit write
   FSettings.FeedEachUnit;
  property FeedAfterVar: Boolean read FSettings.FeedAfterVar write
   FSettings.FeedAfterVar;
  property WrapLines: Boolean read FSettings.WrapLines write
   FSettings.WrapLines;
  property WrapPosition: Byte read FSettings.WrapPosition write
   FSettings.WrapPosition;
  property AlignCommentPos: Byte read FSettings.AlignCommentPos write
   FSettings.AlignCommentPos;
  property AlignComments: Boolean read FSettings.AlignComments write
   FSettings.AlignComments;
  property AlignVarPos: Byte read FSettings.AlignVarPos write
   FSettings.AlignVarPos;
  property AlignVar: Boolean read FSettings.AlignVar write
   FSettings.AlignVar;
  property FeedBeforeEnd: Boolean read FSettings.FeedBeforeEnd write
   FSettings.FeedBeforeEnd;
  property FillNewWords: TFillMode read FSettings.FillNewWords write
   SetFillNewWords;
  property FeedAfterSemiColon: Boolean read FSettings.FeedAfterSemiColon write
   FSettings.FeedAfterSemiColon;
  property BlankSubProc: Boolean read FSettings.BlankSubProc write
   FSettings.BlankSubProc;
  property CommentFunction: Boolean read FSettings.CommentFunction write
   FSettings.CommentFunction;
  property CommentUnit: Boolean read FSettings.CommentUnit write
   FSettings.CommentUnit;
  property StartCommentOut: TCommentArray read FSettings.StartCommentOut write
   FSettings.StartCommentOut;
  property EndCommentOut: TCommentArray read FSettings.EndCommentOut write
   FSettings.EndCommentOut;
  property CapFileName: PChar read FCapFileName write SetCapFileName;
  property Text: PChar read GetTextStr write SetTextStr;
  property OnProgress: TProgressEvent read FOnProgress write SetOnProgress;
  property ShortCutText: string read GetShortCutText write SetShortCutText;
  property ShortCut: TShortCut read GetShortCut write SetShortCut;
  property CfgFile: string read FCfgFile write FCfgFile;
  property RootDir: string read GetRootDir write SetRootdir;
  property Settings: TSettings read FSettings write FSettings;
 end;
 
var
 Formatter: TPascalParser;
 
implementation

uses Dialogs, {FileCtrl,} DelForExpert;

constructor TPascalParser.Create(ARootdir: PChar);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Create' );{$ENDIF}
 Formatter := Self;
 CapFileTime := -1;
 SetDefault;
// Timer := TTimer.Create(nil);
// Timer.Interval := 1000;
// Timer.OnTimer := TimerTimer;
 RootDir := ARootdir;
 Activate;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Create' );{$ENDIF}
end;

procedure TPascalParser.Activate;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Activate' );{$ENDIF}
 LoadDll(PChar(RootDir));
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Activate' );{$ENDIF}
end;

procedure TPascalParser.deActivate;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'deActivate' );{$ENDIF}
 FreeDll;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'deActivate' );{$ENDIF}
end;

procedure TPascalParser.SetDefault;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetDefault' );{$ENDIF}
 CapFileName := nil;
 WrapLines := False;
 WrapPosition := 81;
 AlignCommentPos := 40;
 AlignComments := False;
 AlignVarPos := 20;
 AlignVar := False;
 SpaceEqualOper := spBoth;
 SpaceOperators := spBoth;
 SpaceColon := spAfter;
 SpaceComma := spAfter;
 SpaceSemiColon := spAfter;
 SpaceLeftBr := spNone;
 SpaceRightBr := spNone;
 SpaceLeftHook := spNone;
 SpaceRightHook := spNone;
 ReservedCase := rfLowerCase;
 StandDirectivesCase := rfLowerCase;
 ChangeIndent := True;
 indentBegin := False;
 IndentComments := False;
 IndentCompDirectives := False;
 IndentTryElse := False;
 IndentCaseElse := False;
 FeedAfterThen := False;
 ExceptSingle := False;
 FeedElseIf := False;
 FeedEachUnit := False;
 NoFeedBeforeThen := False;
 NoIndentElseIf := False;
 FeedAfterVar := False;
 FeedBeforeEnd := False;
 FeedRoundBegin := UnChanged;
 FeedAfterSemiColon := False;
 FillNewWords := fmUnchanged;
 IndentTry := False;
 UpperCompDirectives := True;
 UpperNumbers := True;
 SpacePerIndent := 2;
 BlankProc := True;
 RemoveDoubleBlank := False;
 BlankSubProc := False;
 CommentFunction := False;
 CommentUnit := False;
 StrCopy(StartCommentOut, '{(*}');
 StrCopy(EndCommentOut, '{*)}');
 ShortCut := Menus.ShortCut(Word('D'), [ssCtrl]);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetDefault' );{$ENDIF}
end;

procedure TPascalParser.SetBorland;