⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 delexpert.pas

📁 适用于 Delphi 2-7 的Delphi控件
💻 PAS
字号:
{|----------------------------------------------------------------------
 | Unit:        DelExpert
 |
 | Author:      Egbert van Nes
 |
 | Description: The main form of DelForExp
 |
 | Copyright (c) 2000  Egbert van Nes
 |   All rights reserved
 |   Disclaimer and licence notes: see license.txt
 |
 |----------------------------------------------------------------------
}
unit DelExpert;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
 Buttons, ExtCtrls, Delfor1, {$IFDEF CS_TRACE}CodeSiteLogging, {$ENDIF}ToolsAPI {,DesignWindows};
type
 TDelForEx9DelExpertDlg = class(TForm)  //TForm
  Label1: TLabel;
  Label2: TLabel;
  CurrentBtn: TButton;
  WholeProjBtn: TButton;
  OptionsButton: TButton;
  CancelBtn: TButton;
  HelpBtn: TButton;
  AllButton: TButton;
  Label3: TLabel;
  Label4: TLabel;
  procedure CancelBtnClick(Sender: TObject);
  procedure CurrentBtnClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure OptionsButtonClick(Sender: TObject);
  procedure WholeProjBtnClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure AllButtonClick(Sender: TObject);
  procedure HelpBtnClick(Sender: TObject);
  procedure FormShow(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
  procedure Label4Click(Sender: TObject);
 private
  { Private declarations }
  procedure FormatterProgress(Sender: TObject; Progress: Integer);
  procedure CapFileNameEditChange(Sender: TObject);
 public
  HelpFile: string;
  CfgFile: string;
  procedure DoFormatFile(AFileName: string);
  { Public declarations }
 end;
 
var
 DelForEx9DelExpertDlg: TDelForEx9DelExpertDlg = nil;
 Formatter: TPascalParser = nil;
 
implementation
uses DelForExpert, DelForTypes, MyIDEStream, Progr, OptDlg, {Winfunc,} Dialogs,
 {FileFunc,}
   {Setup1,}ShellAPI;
{$R *.DFM}

function IsReadonlyFile(const FileName: string): Boolean;
var
 Attributes: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'IsReadonlyFile' );{$ENDIF}
 Attributes := FileGetAttr(FileName);
 Result := ((Attributes and faReadOnly) > 0);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'IsReadonlyFile' );{$ENDIF}
end;

function StrInsert(Str1, Str2: PChar; I: Integer): PChar;
var
 LenStr2: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'StrInsert' );{$ENDIF}
 if I < 0 then
  I := 0;
 LenStr2 := StrLen(Str2);
 StrMove(Str1 + I + LenStr2, Str1 + I, Integer(StrLen(Str1)) - I + 1);
 StrMove(Str1 + I, Str2, LenStr2);
 StrInsert := Str1;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'StrInsert' );{$ENDIF}
end;

function MakeBakFile(Dest, FileName: PChar): PChar;
var
 F: file;
 P: PChar;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'MakeBakFile' );{$ENDIF}
 if FileExists(FileName) then
  begin
   MakeBakFile := StrCopy(Dest, FileName);
   P := StrRScan(Dest, '.');
   if P = nil then
    StrCat(Dest, '.~')
   else
    begin
     (StrEnd(P) - 1)^ := #0;
     StrInsert(P + 1, '~', 0);
    end;
   DeleteFile(string(Dest));
   AssignFile(F, FileName);
   {try}
   Rename(F, Dest);
   {except
     on EInOutError do ;
   end;}
  end
 else
  begin
   Dest[0] := #0;
   MakeBakFile := Dest;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'MakeBakFile' );{$ENDIF}
end;

function FormatFile(Param: Pointer; const FileName, UnitName,
 FormName: string): Boolean stdcall;
var
 BakFile: array[0..255] of Char;
 ExtName: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'FormatFile' );{$ENDIF}
 Result := True;
 ExtName := LowerCase(ExtractFileExt(FileName));
 if ((ExtName = '.pas') {or (ExtName = '.dpr')})
  and (Trim(FileName) <> '') then
  begin
   if IsFileOpen(FileName) then
    DelForEx9DelExpertDlg.DoFormatFile(FileName)
   else if (Param = nil) then
    begin
     if FileExists(FileName) and not
      IsReadonlyFile(FileName) then
      begin
       { IF PARAM<>NIL then only open files}
       if DelForEx9ProgressDlg.Visible then
        begin
         {if file not open then load from file}
         DelForEx9ProgressDlg.SetFileName(FileName);
         Application.ProcessMessages;
         //Formatter.Clear;
         with Formatter do
          begin
           try
            Clear;
            try
             MakeBakFile(BakFile, PChar(FileName));
             LoadFromFile(BakFile);
             if Parse then
              WriteToFile(PChar(FileName));
            except
             on E: EInOutError do
              ShowMessage('I/O Error [' + E.Message + '] with "' +
               FileName
               +
               '"');
            end;
           finally
            Formatter.Clear;
           end;
          end;
        end;
      end
     else
      begin
       ShowMessage('Can not find "' + FileName + '"');
      end;
    end;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'FormatFile' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.CapFileNameEditChange(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'CapFileNameEditChange' );{$ENDIF}
 if (DelForEx9OptionsDlg <> nil) then
  with DelForEx9OptionsDlg do
   SaveFile(CapFileNameEdit.Text);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'CapFileNameEditChange' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.FormatterProgress(Sender: TObject; Progress: Integer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FormatterProgress' );{$ENDIF}
 DelForEx9ProgressDlg.ProgressBar1.Position := Progress;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FormatterProgress' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.CurrentBtnClick(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'CurrentBtnClick' );{$ENDIF}
 DelForEx9ProgressDlg.Show;
 DoFormatFile('');
 DelForEx9ProgressDlg.Hide;
 //Hide;//Hide;
  ModalResult := mrOK;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'CurrentBtnClick' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.DoFormatFile(AFileName: string);
var
 IDEStream: TIDEStream;
 P: PANSIChar;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'DoFormatFile' );{$ENDIF}
 if (DelForEx9ProgressDlg.Visible) then
  begin
   IDEStream := TIDEStream.Create(AFileName);
   try
    if (not IsReadonlyFile(IDEStream.FileName)) and
     (not IsReadonlyBuffer(IDEStream.FileName)) then
     begin
      Formatter.Clear;
      DelForEx9ProgressDlg.SetFileName(IDEStream.FileName);
      Application.ProcessMessages;

      Formatter.LoadFromList(IDEStream.Lines);
      IDEStream.Lines.Clear;
      if Formatter.Parse then
       begin
        P := PANSIChar(Formatter.Text);
        IDEStream.WriteText(P);
      end;
     end
    else
     ShowMessage(ExtractFileName(IDEStream.FileName) +
      ': File or buffer is read only, or not yet saved');
   finally
    Formatter.Clear;
    IDEStream.Free;
   end;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'DoFormatFile' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.FormCreate(Sender: TObject);
var
 DelForName: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FormCreate' );{$ENDIF}
 DelForName := IDETextExpert.DLLFileName;
 if DelForName <> '' then
  begin
   if Formatter = nil then
    Formatter := TPascalParser.Create(PChar(ExtractFilePath(DelForName)));
   HelpFile := Formatter.RootDir + 'DelFor.hlp';
   CfgFile := Formatter.RootDir + ExtractFileName(DelForName);
   CfgFile := ChangeFileExt(CfgFile, '.cfg');
  end
 else
  begin
   if Formatter = nil then
    Formatter := TPascalParser.Create('');
   HelpFile := 'DelFor.hlp';
   CfgFile := '';
  end;

 Formatter.CfgFile := CfgFile;
 Formatter.Config(True);
 if not Assigned(DelForEx9ProgressDlg) then
  DelForEx9ProgressDlg := TDelForEx9ProgressDlg.Create(nil);
//  Application.CreateForm(TDelForEx9ProgressDlg, DelForEx9ProgressDlg);
 if (Assigned(Formatter)) and (Assigned(DelForEx9ProgressDlg)) then
  Formatter.OnProgress := FormatterProgress;
 if CurrentBtn.Enabled then
  ActiveControl := CurrentBtn
 else
  ActiveControl := OptionsButton;
 Formatter.Deactivate;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FormCreate' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.OptionsButtonClick(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'OptionsButtonClick' );{$ENDIF}
 if not assigned(DelForEx9OptionsDlg) then
  begin
   DelForEx9OptionsDlg := TDelForEx9OptionsDlg.Create(nil);
//   Application.CreateForm(TDelForEx9OptionsDlg, DelForEx9OptionsDlg);
   DelForEx9OptionsDlg.HelpFile := PChar(HelpFile);
   DelForEx9OptionsDlg.CapFileNameEdit.OnChange := CapFileNameEditChange;
  end;
 DelForEx9OptionsDlg.ShowModal;
 FreeAndNil(DelForEx9OptionsDlg);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'OptionsButtonClick' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.WholeProjBtnClick(Sender: TObject);
var
 j: Integer;
 Dir: string;
 ProjectFiles: TStringList;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'WholeProjBtnClick' );{$ENDIF}
 DelForEx9ProgressDlg.Show;
 Dir := ExtractFileDir(ExpandFileName(GetProjectName));
 if Dir <> '' then
  Chdir(Dir);
 ProjectFiles := TStringList.Create;
 try
  GetProjectFileNames(ProjectFiles);
  for j := 0 to ProjectFiles.Count - 1 do
   FormatFile(nil, ProjectFiles[j], '', '');
 finally
  DelForEx9ProgressDlg.Hide;
  projectFiles.Free;
 end;
 //Hide;
  ModalResult := mrOk;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'WholeProjBtnClick' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.FormClose(Sender: TObject;
 var Action: TCloseAction);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FormClose' );{$ENDIF}
 try
  if (Assigned(DelForEx9ProgressDlg)) and (DelForEx9ProgressDlg.Showing) then
   DelForEx9ProgressDlg.Hide;
  if assigned(Formatter) then
   begin
    with Formatter do
     begin
      //      try Clear except end;  //This always AV's on close
      if (FillNewWords = fmAddNewWord) then
       SaveCapFile(CapFileName);
      Deactivate;
     end;
   end;
 except
 end;
 FreeAndNil(DelForEx9ProgressDlg);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FormClose' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.AllButtonClick(Sender: TObject);
var
 OpenFiles: TStringList;
 k: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'AllButtonClick' );{$ENDIF}
 OpenFiles := TStringList.Create;
 try
  DelForEx9ProgressDlg.Show;
  GetOpenFileList(OpenFiles);
  for k := 0 to OpenFiles.Count - 1 do
   FormatFile(nil, OpenFiles[k], '', '')

 finally
  DelForEx9ProgressDlg.Hide;
  OpenFiles.Free;
 end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'AllButtonClick' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.HelpBtnClick(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'HelpBtnClick' );{$ENDIF}
 WinHelp(0, PChar(HelpFile), Help_Contents, 0);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'HelpBtnClick' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.FormShow(Sender: TObject);
var
 ProjectOpened: Boolean;
 S: array[0..260] of Char;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FormShow' );{$ENDIF}
 Formatter.Activate;
 with Formatter do
  if CapFileName <> nil then
   begin
    SaveFile(CapFileName);
    CapFileName := StrCopy(S, CapFileName);
   end;
 {if file is changed reread}
 ProjectOpened := GetProjectName <> '';
 AllButton.Enabled := ProjectOpened;
 WholeProjBtn.Enabled := ProjectOpened;
 CurrentBtn.Enabled := GetCurrentFile <> '';
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FormShow' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.FormDestroy(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FormDestroy' );{$ENDIF}
 try
  Formatter.Config(False);
  Formatter.Free;
  Formatter := nil;
 except
 end;
 try
  if Assigned(DelForEx9ProgressDlg) then
   FreeAndNil(DelForEx9ProgressDlg);
 except
 end;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FormDestroy' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.Label4Click(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Label4Click' );{$ENDIF}
 {opens default explorer with the URL of the homepage}
 ShellExecute(GetDesktopWindow, 'open', 'http://www.dow.wau.nl/aew/delforexp.html',
  nil, nil, SW_SHOW);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Label4Click' );{$ENDIF}
end;

procedure TDelForEx9DelExpertDlg.CancelBtnClick(Sender: TObject);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'CancelBtnClick' );{$ENDIF}
 //Hide;
 ModalResult := mrCancel;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'CancelBtnClick' );{$ENDIF}
end;

end.


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -