viewwnd.pas

来自「delphi代码格式化,最新汉化版」· PAS 代码 · 共 887 行 · 第 1/2 页

{|----------------------------------------------------------------------
 | Unit:        ViewWnd
 |
 | Author:      Egbert van Nes
 |
 | Description: Edit form for DelFor
 |
 | Copyright (c) 2000  Egbert van Nes
 |   All rights reserved
 |   Disclaimer and licence notes: see license.txt
 |
 |----------------------------------------------------------------------
}
unit ViewWnd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, mwCustomEdit, mwHighlighter, mwPasSyn, Menus;

type
  TViewForm = class(TForm)
    FindDialog1: TFindDialog;
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Memo1: TmwCustomEdit;
    PopupMenu1: TPopupMenu;
    ClosepageItem: TMenuItem;
    Openneweditwindow1: TMenuItem;
    N1: TMenuItem;
    Formatpage1: TMenuItem;
    mwPasSyn1: TmwPasSyn;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Memo1Change(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure ClosepageItemClick(Sender: TObject);
    procedure Openneweditwindow1Click(Sender: TObject);
    procedure Formatpage1Click(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    TheList: TList;
    procedure UpdateStatusBar;
    procedure FormatterProgress(Sender: TObject; Progress: Integer);
    procedure FormatPascal(TabNo: Integer);
    function GlobalFindFile(var Item: TObject; NotIndex: Integer;
      FileName: PChar): Boolean;
    procedure MemoReset;
    function GelSelLength: Integer;
    function GetSelStart: Integer;
    procedure SetSelLength(const Value: Integer);
    procedure SetSelStart(const Value: Integer);
    { Private declarations }
  public
    destructor Destroy; override;
    function FindFile(var Item: TObject; NotIndex: Integer;
      FileName: PChar): Boolean;
    procedure LoadFile(AFileName: string);
    function CurrentFileContent: TObject;
    procedure FormatAll;
    procedure FormatFormatted;
    procedure SetCurrentFileName(FileName: string);
    procedure FormatCurrent;
    function SaveCurrent: Boolean;
    function CurrentFormatted: Boolean;
    function AllFormatted: Boolean;
    procedure FormatToFile(FromFile, ToFile: string);
    procedure SaveTo(AFileName: string);
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelLength: Integer read GelSelLength write SetSelLength;
    { Public declarations }
  end;

var
  ViewForm: TViewForm;

implementation
uses Delfor1, Progr, Main;

{$R *.DFM}
const
  MaxMemoSize = 65535 - 2500;
type
  TFileContent = class
  private
    FList: TStringList;
    FFileName: PChar;
    FModified: Boolean;
    FFormatted: Boolean;
    FTopLine: Integer;
    FCaretX: Integer;
    FCaretY: Integer;
    FBlockStart: TPoint;
    FBlockEnd: TPoint;
    procedure SetFileName(const Value: PChar);
    procedure SetText(const Value: PChar);
    function GetText: PChar;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    procedure Format;
    procedure SaveFile;
    procedure SaveMemoSettings(AMemo: TmwCustomEdit);
    procedure SetMemoSettings(AMemo: TmwCustomEdit);
    property FileName: PChar read FFileName write SetFileName;
    property Text: PChar read GetText write SetText;
    property Modified: Boolean read FModified write FModified;
    property Formatted: Boolean read FFormatted write FFormatted;
    property List: TStringList read FList write FList;
  end;

procedure TViewForm.UpdateStatusBar;
begin
  if Memo1.Modified then
    StatusBar1.Panels[1].Text := 'Modified'
  else if CurrentFormatted then
    StatusBar1.Panels[1].Text := 'Formatted'
  else
    StatusBar1.Panels[1].Text := '';
  StatusBar1.Panels[0].Text := Format('%5d :%5d', [Memo1.CaretY, Memo1.CaretX]);
  if Memo1.InsertMode then
    StatusBar1.Panels[2].Text := 'Insert'
  else
    StatusBar1.Panels[2].Text := 'Overwrite';
end;

function TViewForm.CurrentFormatted: Boolean;
begin
  Result := (TheList <> nil) and TFileContent(CurrentFileContent).Formatted;
end;

procedure TViewForm.LoadFile(AFileName: string);
var
  ATab: TTabSheet;
  Name: string;
  P: PChar;
  FileContent: TFileContent;
  Item: TObject;
  NewList: Boolean;
  FileInList: Boolean;
begin
  if FileExists(AFileName) then
  begin
    NewList := False;
    Name := ExtractFileName(AFileName);
    AFileName := ExpandFileName(AFileName);
    P := StrScan(PChar(Name), '.');
    P^ := #0;
    if TheList <> nil then
    begin
      ATab := TTabSheet.Create(PageControl1);
      ATab.Parent := PageControl1;
      ATab.PageControl := PageControl1;
      ATab.OnShow := TabSheet1Show;
      ATab.Caption := Name;
    end
    else
    begin
      NewList := True;
      TabSheet1.Caption := Name;
      TheList := TList.Create;
    end;
    FileInList := False;
    FileContent := nil;
    if GlobalFindFile(Item, -1, PChar(AFileName)) then
    begin
      FileInList := True;
      FileContent := TFileContent(Item);
    end;
    if not FileInList then
      FileContent := TFileContent.Create(AFileName);
    if FileContent.Text <> nil then
      TheList.Add(FileContent);
    if NewList then TabSheet1Show(TabSheet1);
  end;
  (*
  Formatted := False;
  LargeFile := True;
  Memo1.Lines.Clear;
  if not FileExists(aFileName) then
    Caption := ''
  else
  begin
    Caption := aFileName;
    Memo1.Lines.BeginUpdate;
    try
      MemoryStream := TMemoryStream.Create;
      try
        MemoryStream.LoadFromFile(aFileName);
        SetString(S, PChar(MemoryStream.memory), MemoryStream.Size);
      finally
        MemoryStream.Free;
      end;
      AdjustLineBreaks(S);
      if Strlen(PChar(S)) > MaxMemoSize then
      begin
        LargeFile := True;
        (PChar(S) + MaxMemoSize)^ := #0;
        Memo1.Lines.Text := S;
        Memo1.Lines.Add('{***  FILE TOO LARGE, CAN ONLY VIEW PART OF THIS FILE  ***}');
        Memo1.Lines.Add('{***  BUT STILL POSSIBLE TO FORMAT AND SAVE            ***}');
      end
      else
      begin
        LargeFile := False;
        Memo1.Lines.Text := S;
      end;
    except
      on EInvalidOperation do
      begin
        LargeFile := True;
        Memo1.Lines.Clear;
        Memo1.Lines.Add('{***  FILE TOO LARGE, CAN ONLY VIEW PART OF THIS FILE  ***}');
        Memo1.Lines.Add('{***  BUT STILL POSSIBLE TO FORMAT AND SAVE            ***');
        Memo1.ReadOnly := True;
        AssignFile(InFile, aFileName);
        try
          Reset(InFile);
          while not Eof(InFile) do
          begin
            ReadLn(InFile, S);
            Memo1.Lines.Add(S);
          end;
        finally
          CloseFile(InFile);
        end;
      end;
    end;
    Memo1.Modified := False;
    UpdateStatusBar;
    List:=TList.Create;
    List.Add(Memo1.Lines);
    Memo1.Lines.EndUpdate;
  end;
  end;*)
end;

function StrInsert(Str1, Str2: PChar; I: Integer): PChar;
var
  LenStr2: Integer;
begin
  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;
end;

function MakeBakFile(Dest, FileName: PChar): PChar;
var
  F: file;
  P: PChar;
begin
  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;
    if FileExists(Dest) then
    begin
      AssignFile(F, Dest);
      Erase(F);
    end;
    AssignFile(F, FileName);
    try
      Rename(F, Dest);
    except
      on EInOutError do ;
    end;
  end
  else MakeBakFile := StrCopy(Dest, '');
end;

procedure TViewForm.SaveTo(AFileName: string);
var
  BakFile: array[0..255] of Char;
  FromFile: string;
begin
  Screen.Cursor := crHourGlass;
  try
    if CurrentFormatted or  Memo1.Modified then
    begin
      FromFile := Caption;
      if AFileName = '' then
        AFileName := Caption
      else
        Caption := AFileName;
      MakeBakFile(BakFile, PChar(AFileName));
      if (FromFile = Caption) and (StrComp(BakFile, '') <> 0) then
        FromFile := string(BakFile);
      Memo1.Lines.SaveToFile(AFileName);
      Memo1.Modified := False;
      TFileContent(CurrentFileContent).Modified:=False;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
  UpdateStatusBar;
end;

procedure TViewForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ModifiedFile: TFileContent;
  I, Istart: Integer;
  function Modified(var Istart: Integer): Boolean;
  var
    I: Integer;
  begin
    ModifiedFile := nil;
    Result := False;
    with TheList do
    begin
      for I := Istart to Count - 1 do
        if TFileContent(Items[I]).Modified then
        begin
          Result := True;
          Istart := I + 1;
          ModifiedFile := TFileContent(Items[I]);
          Exit;
        end;
      Istart := Count;
    end;
  end;
begin
  Istart := 0;
  if (Memo1 <> nil) and Memo1.Modified then
  begin
    Memo1.Modified := False;
    ModifiedFile := TFileContent(CurrentFileContent);
    if (TheList <> nil) then
      ModifiedFile.Text := PChar(Memo1.Lines.Text);
  end;
  while Modified(Istart) do
  begin
    case (MessageDlg('Do you want to save changes in ' +
      string(ModifiedFile.FileName),
      mtConfirmation, [mbYes, mbNo, mbCancel, mbYesToAll,mbNoToAll], 0)) of
      mrYes: ModifiedFile.SaveFile;
      mrNo: ModifiedFile.Modified := False;
      mrNoToAll:
          with TheList do
          begin
            for I := 0 to Count - 1 do
              TFileContent(Items[I]).Modified:=False;
          end;
      mrYesToAll:
          with TheList do
          begin
            for I := 0 to Count - 1 do
              TFileContent(Items[I]).SaveFile;
          end;
      mrCancel:
        begin
          Action := caNone;
          ModalResult:=mrCancel;
          Exit;
        end;
    end;
  end;
  Action := caFree;
  ModalResult:=mrOK;
end;

procedure TViewForm.FormatToFile(FromFile, ToFile: string);
begin
  with MainForm.Formatter do
  begin
    Clear;
    OnProgress := nil;
    LoadFromFile(PChar(FromFile));
    if Parse then
      WriteToFile(PChar(ToFile));
  end;
  {Formatted := True;}
  UpdateStatusBar;
end;

{procedure TViewForm.FormatPascal;
var
  buff: array[0..400] of char;
  i, k: integer;
  CurLine: integer;
  oldLargeFile:boolean;
begin
  if (not Formatted) and (ProgressDlg <> nil)
     and (ProgressDlg.Visible) then
    with MainForm do
    begin
      OldLargeFile:=LargeFile;
      largeFile:=True;
      Formatter.Clear;
      ProgressDlg.FileLabel.Caption := self.Caption;
      Application.processMessages;
      with memo1.Lines do
        for i := 0 to count - 1 do
        begin
          Formatter.add(strPCopy(buff, memo1.Lines[i]));
          ProgressDlg.ProgressBar1.Position := i * 100 div count div 3;
        end;
      Formatter.Parse;
      ProgressDlg.ProgressBar1.Position := 66;
      Memo1.Lines.BeginUpdate;
      CurLine := SendMessage(Memo1.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
      Memo1.Clear;
      Memo1.Lines.Clear;
      i := 0;
      k := 0;
      with Formatter do
        while i < count do
        begin
          GetString(buff, i);
          inc(k);
          Memo1.Lines.add(buff);
          if (i mod 50 = 0) then
            ProgressDlg.ProgressBar1.Position := 66 + i * 100 div count div 3;
        end;
      if k <> Memo1.Lines.Count then
        Memo1.ReadOnly := True
      else
        LargeFile:=OldLargeFile;
      k := memo1.Lines.count - 1;
      while (Memo1.lines[k] = '') do
      begin
        Memo1.Lines.delete(k);
        dec(k);
      end;
      SendMessage(memo1.handle, EM_LINESCROLL, 0, curLine);
      memo1.Modified:=False;
      Memo1.Lines.EndUpdate;
      Formatted := True;
    end;