delfor1.pas

适用于 Delphi 2-7 的Delphi控件

begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetBorland' );{$ENDIF}
 SetDefault;
 WrapLines := True;
 IndentComments := True;
 FeedAfterThen := True;
 ExceptSingle := False;
 NoFeedBeforeThen := True;
 FeedAfterVar := True;
 FeedBeforeEnd := True;
 FeedRoundBegin := NewLine;
 FeedAfterSemiColon := True;
 RemoveDoubleBlank := True;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetBorland' );{$ENDIF}
end;

function TPascalParser.GetNewCapFileTime: Integer;
var
 Handle: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetNewCapFileTime' );{$ENDIF}
 Handle := FileOpen(FCapFileName, fmOpenRead);
 Result := FileGetDate(Handle);
 FileClose(Handle);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetNewCapFileTime' );{$ENDIF}
end;

procedure TPascalParser.SetCapFileName(AFileName: PChar);
var
 P: PChar;
 S: array[0..400] of Char;
 TimeStamp: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetCapFileName' );{$ENDIF}
 if AFileName <> FCapFileName then
  begin
   StrDispose(FCapFileName);
   if AFileName <> nil then
    begin
     while AFileName^ = ' ' do
      inc(AFileName);
     P := StrEnd(StrCopy(S, AFileName)) - 1;
     while P^ = ' ' do
      Dec(P);
     (P + 1)^ := #0;
     FCapFileName := StrNew(S);
    end
   else
    FCapFileName := nil;

   if (FCapFileName <> nil) and FileExists(FCapFileName) then
    begin
     TimeStamp := GetNewCapFileTime;
     if (TimeStamp <> CapFileTime) then
      LoadCapFile(FCapFileName);
    end
   else
    begin
     Formatter_LoadCapFile(nil);
     CapFileTime := -1;
    end;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetCapFileName' );{$ENDIF}
end;

procedure TPascalParser.SetShortCutText(AShortCut: string);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetShortCutText' );{$ENDIF}
 ShortCut := TextToShortCut(AShortCut);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetShortCutText' );{$ENDIF}
end;

function TPascalParser.GetShortCutText: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetShortCutText' );{$ENDIF}
 Result := ShortCutToText(ShortCut);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetShortCutText' );{$ENDIF}
end;

procedure TPascalParser.SaveCapFile(AFileName: PChar);
var
 Path: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SaveCapFile' );{$ENDIF}
 try
  Path := ExtractFilePath(ExpandFileName(AFileName));
  if not DirectoryExists(Path) then
   ForceDirectories(Path);
  Formatter_SaveCapFile(AFileName);
 except
 end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SaveCapFile' );{$ENDIF}
end;

procedure TPascalParser.Clear;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Clear' );{$ENDIF}
 try
//    if CurrentDllVersion <> Formatter_Version then
//     Exception.Create('Wrong version of DELFORDLL');
  Formatter_clear;
 except
 end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Clear' );{$ENDIF}
end;

procedure TPascalParser.LoadFromFile(AFileName: PChar);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'LoadFromFile' );{$ENDIF}
 Formatter_LoadFromFile(AFileName, @FSettings, SizeOf(TSettings));
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'LoadFromFile' );{$ENDIF}
end;

procedure TPascalParser.LoadFromList(AList: TStringList);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'LoadFromList' );{$ENDIF}
 Formatter_LoadFromList(AList, @FSettings, SizeOf(TSettings));
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'LoadFromList' );{$ENDIF}
end;

function TPascalParser.Parse: Boolean;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Parse' );{$ENDIF}
 Result := Formatter_Parse(@FSettings, SizeOf(TSettings));
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Parse' );{$ENDIF}
end;

procedure TPascalParser.Config(DoRead: Boolean);
{$IFDEF ver100}
type
 Cardinal = Integer;
 {$ENDIF}
const
 Sign: Cardinal = $623DFE51;
var
 Signature: Cardinal;
 Err, Size: Integer;
 Cfg: file;
 S: array[0..260] of Char;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Config' );{$ENDIF}
 if CfgFile = '' then
  CfgFile := 'DelForExp.cfg';
 CfgFile := ChangeFileExt(CfgFile, '.cfg');
 if DoRead then
  begin
   if not FileExists(CfgFile) then
    CapFileName := nil
   else
    begin
     if FillNewWords in [fmAddNewWord, fmAddUse, fmAddUseExcept] then
      SaveCapFile(CapFileName);
     AssignFile(Cfg, CfgFile);
     try
      Reset(Cfg, 1);
      BlockRead(Cfg, Signature, SizeOf(Signature), Err);
      if (Err = SizeOf(Signature)) and (Signature = Sign) then
       begin
        BlockRead(Cfg, FSettings, SizeOf(Settings), Err);
        BlockRead(Cfg, Size, SizeOf(Integer));
        if Size > 0 then
         begin
          BlockRead(Cfg, S, Size);
          CapFileName := S;
         end
        else
         CapFileName := nil;
        ShortCut := Settings.ShortCut;
       end;
     finally
      CloseFile(Cfg);
     end;
    end;
  end
 else
  begin
   AssignFile(Cfg, CfgFile);
   try
    Rewrite(Cfg, 1);
    Signature := Sign;
    BlockWrite(Cfg, Signature, SizeOf(Signature));
    BlockWrite(Cfg, Settings, SizeOf(Settings));
    if CapFileName = nil then
     begin
      Size := 0;
      BlockWrite(Cfg, Size, SizeOf(Integer));
     end
    else
     begin
      Size := StrLen(CapFileName) + 1;
      BlockWrite(Cfg, Size, SizeOf(Integer));
      StrCopy(S, CapFileName);
      BlockWrite(Cfg, S, Size);
     end;
   finally
    CloseFile(Cfg);
   end;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Config' );{$ENDIF}
end;

procedure TPascalParser.WriteToFile(AFileName: PChar);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'WriteToFile' );{$ENDIF}
 Formatter_writeToFile(AFileName);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'WriteToFile' );{$ENDIF}
end;

procedure TPascalParser.SetTextStr(AText: PChar);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetTextStr' );{$ENDIF}
 Formatter_SetTextStr(AText);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetTextStr' );{$ENDIF}
end;

function TPascalParser.GetTextStr: PChar;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetTextStr' );{$ENDIF}
 Result := Formatter_GetTextStr;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetTextStr' );{$ENDIF}
end;

destructor TPascalParser.Destroy;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Destroy' );{$ENDIF}
 try
 if @Formatter_Destroy <> nil then
  begin
   if FillNewWords in [fmAddNewWord, fmAddUse, fmAddUseExcept] then
    SaveCapFile(CapFileName);
   CapFileName := nil;
   Formatter_Destroy;
  end;
 except end;
 inherited Destroy;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Destroy' );{$ENDIF}
end;

procedure TPascalParser.SetShortCut(AShortCut: TShortCut);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetShortCut' );{$ENDIF}
 FSettings.ShortCut := AShortCut;
 if IDETextExpert <> nil then
  IDETextExpert.MenuShortCut := AShortCut;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetShortCut' );{$ENDIF}
end;

//procedure TPascalParser.TimerTimer(Sender: TObject);
//begin
//  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'TimerTimer' );{$ENDIF}
//// ShortCut := Settings.ShortCut;
//// Timer.Free;
//// Timer := nil;
//  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'TimerTimer' );{$ENDIF}
//end;

procedure TPascalParser.SetFillNewWords(AFillNewWords: TFillMode);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetFillNewWords' );{$ENDIF}
 if Settings.FillNewWords in [fmAddNewWord, fmAddUse, fmAddUseExcept] then
  SaveCapFile(CapFileName);
 FSettings.FillNewWords := AFillNewWords;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetFillNewWords' );{$ENDIF}
end;

function TPascalParser.GetRootDir: string;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetRootDir' );{$ENDIF}
 if FRootDir = '' then
  FRootDir := ExtractFilePath(ParamStr(0));
 Result := FRootDir;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetRootDir' );{$ENDIF}
end;

procedure TPascalParser.SetRootdir(const Value: string);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetRootdir' );{$ENDIF}
 FRootDir := Value;
 if FRootDir[Length(FRootDir)] <> '\' then
  FRootDir := FRootDir + '\';
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetRootdir' );{$ENDIF}
end;

function TPascalParser.GetShortCut: TShortCut;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetShortCut' );{$ENDIF}
 Result := TShortCut(Settings.ShortCut);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetShortCut' );{$ENDIF}
end;

procedure TPascalParser.LoadCapFile(AFileName: PChar);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'LoadCapFile' );{$ENDIF}
 Formatter_LoadCapFile(AFileName);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'LoadCapFile' );{$ENDIF}
end;

procedure TPascalParser.SetOnProgress(const Value: TProgressEvent);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetOnProgress' );{$ENDIF}
 FOnProgress := Value;
 Formatter_SetOnProgress(Value);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetOnProgress' );{$ENDIF}
end;

end.