viewwnd.pas

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

end;
 }

procedure TViewForm.FormatterProgress(Sender: TObject; Progress: Integer);
begin
  ProgressDlg.ProgressBar1.Position := Progress;
end;

procedure TViewForm.FormatPascal(TabNo: Integer);
var
  AFileContent: TFileContent;
  IsCurrentTab: Boolean;
begin
  if {(not Formatted) and }(ProgressDlg <> nil) and (TheList <> nil)
    and (ProgressDlg.Visible) then
    with MainForm do
    begin
      Formatter.OnProgress := FormatterProgress;
      Formatter.Clear;
      IsCurrentTab := TabNo = PageControl1.ActivePage.PageIndex;
      AFileContent := TFileContent(TheList.Items[TabNo]);
      ProgressDlg.SetFileName(AFileContent.FileName);
      ProgressDlg.ProgressBar1.Position := 0;
      Application.ProcessMessages;
      if IsCurrentTab then
      begin
        AFileContent.Text := PChar(Memo1.Lines.Text);
        Memo1.Modified := False;
      end;
      AFileContent.Format;
      if IsCurrentTab then
        TabSheet1Show(PageControl1.ActivePage);
      ProgressDlg.ProgressBar1.Position := 100;
       {
      Memo1.Lines.BeginUpdate;
      CurLine := SendMessage(Memo1.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
      Memo1.Lines.Clear;
      S := Formatter.Text;
      Memo1.Lines.Text := S;
      StrDispose(S);
      SendMessage(Memo1.Handle, EM_LINESCROLL, 0, CurLine);
      Memo1.Modified := False;
      Memo1.Lines.EndUpdate;
      Formatted := True;   }
      UpdateStatusBar;
    end;
end;

procedure TViewForm.Memo1Change(Sender: TObject);
begin
  TFileContent(CurrentFileContent).Formatted := False;
  Memo1.Modified := True;
  MainForm.UpdateMenu;
  UpdateStatusBar;
end;

function TViewForm.CurrentFileContent: TObject;
begin
  Result := TheList.Items[PageControl1.ActivePage.PageIndex];
end;

destructor TViewForm.Destroy;
var
  TheItem: TFileContent;
  Item: TObject;
  I: Integer;
begin
  inherited Destroy;
  with TheList do
    for I := 0 to Count - 1 do
    begin
      TheItem := TFileContent(Items[I]);
      if not GlobalFindFile(Item, I, TheItem.FileName) then
        TheItem.Free
      else
        Insert(I, nil);
    end;
  if MainForm <> nil then
    MainForm.UpdateMenu;
end;

procedure TViewForm.SetCurrentFileName(FileName: string);
var
  S: string;
  P: PChar;
begin
  Caption := ExpandFileName(FileName);
  TFileContent(CurrentFileContent).FileName := PChar(FileName);
  S := ExtractFileName(FileName);
  P := StrScan(PChar(S), '.');
  if P <> nil then P^ := #0;
  PageControl1.ActivePage.Caption := S;
end;

procedure TViewForm.Memo1Click(Sender: TObject);
begin
  MainForm.UpdateMenu;
  UpdateStatusBar;
end;

procedure TViewForm.FormActivate(Sender: TObject);
var
  FileContent: TFileContent;
begin
  MainForm.ViewForm := Self;
  Memo1.Parent := TTabSheet(PageControl1.ActivePage);
  Memo1.Modified := False;
  Memo1.ClearUndo;
  MemoReset;
  if TheList <> nil then
  begin
    FileContent := TFileContent(TheList.Items[PageControl1.ActivePage.PageIndex]);
    Memo1.Lines := FileContent.List;
    FileContent.SetMemoSettings(Memo1);
    Caption := string(FileContent.FileName);
  end;
  MainForm.UpdateMenu;
end;

procedure TViewForm.TabSheet1Show(Sender: TObject);
var
  FileContent: TFileContent;
begin
  Memo1.BeginUpdate;
  if TheList <> nil then
  begin
    FileContent := TFileContent(CurrentFileContent);
    if Memo1.Modified then
      FileContent.Text := PChar(Memo1.Lines.Text);
    FileContent.SaveMemoSettings(Memo1);
  end;
  Memo1.Parent := TTabSheet(Sender);
  Memo1.Modified := False;
  Memo1.ClearUndo;
  MemoReset;
  if TheList <> nil then
  begin
    FileContent := TFileContent(TheList.Items[TTabSheet(Sender).PageIndex]);
    Memo1.Lines := FileContent.List;
    FileContent.SetMemoSettings(Memo1);
    Caption := string(FileContent.FileName);
  end;
  Memo1.EndUpdate;
end;

procedure TViewForm.FormDestroy(Sender: TObject);
begin
  if MainForm <> nil then MainForm.ViewForm := nil;
end;

procedure TViewForm.MemoReset;
begin
  Memo1.TopLine := 0;
  Memo1.CaretX := 0;
  Memo1.CaretY := 0;
  SelStart := 0;
  SelLength := 0;
end;
{ TFileContent }

constructor TFileContent.Create(AFileName: string);
begin
  inherited Create;
  FileName := StrNew(PChar(ExpandFileName(AFileName)));
  FList := TStringList.Create;
  FList.LoadFromFile(FileName);
  Modified := False;
end;

destructor TFileContent.Destroy;
begin
  Text := nil;
  FileName := nil;
  inherited Destroy;
end;

procedure TFileContent.Format;
begin
  MainForm.Formatter.Clear;
  MainForm.Formatter.LoadFromList(FList);
  if MainForm.Formatter.Parse then
  begin
    Text := MainForm.Formatter.Text;
    Formatted := True;
  end;
end;

function TFileContent.GetText: PChar;
begin
  Result := PChar(FList.Text);
end;

procedure TFileContent.SaveFile;
var
  BakFile: array[0..255] of Char;
begin
  if Modified then
  begin
    MakeBakFile(BakFile, FileName);
    FList.SaveToFile(FileName);
  end;
  Modified := False;
end;

procedure TFileContent.SaveMemoSettings(AMemo: TmwCustomEdit);
begin
  FTopLine := AMemo.TopLine;
  FCaretX := AMemo.CaretX;
  FCaretY := AMemo.CaretY;
  FBlockStart := AMemo.BlockBegin;
  FBlockEnd := AMemo.BlockEnd;
end;

procedure TFileContent.SetFileName(const Value: PChar);
begin
  Modified := True;
  StrDispose(FFileName);
  FFileName := StrNew(PChar(ExpandFileName(string(Value))));
end;

procedure TFileContent.SetMemoSettings(AMemo: TmwCustomEdit);
begin
  with AMemo do
  begin
    TopLine := FTopLine;
    CaretX := FCaretX;
    CaretY := FCaretY;
    TopLine := FTopLine;
    BlockBegin := FBlockStart;
    BlockEnd := FBlockEnd;
  end;
end;

procedure TFileContent.SetText(const Value: PChar);
begin
  if Value = nil then
  begin
    FList.Free;
    FList := nil;
    Exit;
  end;
  if FList = nil then FList := TStringList.Create;
  FList.Text := string(Value);
  Modified := True;
end;

procedure TViewForm.FormatAll;
var
  I: Integer;
begin
  if TheList <> nil then
    with TheList do
      for I := 0 to Count - 1 do
        FormatPascal(I);
end;

procedure TViewForm.FormatFormatted;
var
  I: Integer;
  FileContent: TFileContent;
begin
  if TheList <> nil then
    with TheList do
      for I := 0 to Count - 1 do
      begin
        FileContent := TFileContent(Items[I]);
        if (FileContent <> nil) and FileContent.Formatted then
        begin
          FileContent.Formatted := False;
          FormatPascal(I);
        end;
      end;
end;

procedure TViewForm.FormatCurrent;
begin
  FormatPascal(PageControl1.ActivePage.PageIndex);
end;

procedure TViewForm.PageControl1Change(Sender: TObject);
begin
  MainForm.UpdateMenu;
  UpdateStatusBar;
end;

function TViewForm.AllFormatted: Boolean;
var
  I: Integer;
begin
  Result := True;
  if TheList <> nil then
    for I := 0 to TheList.Count - 1 do
      if not TFileContent(TheList.Items[I]).Formatted then
      begin
        Result := False;
        Exit;
      end;
end;

procedure TViewForm.ClosepageItemClick(Sender: TObject);
var
  I: Integer;
  DoubleFile: Boolean;
  TheContent, Item: TObject;
begin
  if SaveCurrent then
  begin
    I := PageControl1.ActivePage.PageIndex;
    PageControl1.ActivePage.Free;
    if TheList.Count = 1 then
      Close
    else
    begin
      TheContent := TheList.Items[I];
      TheList.Delete(I);
      if TheContent <> nil then
      begin
        DoubleFile := GlobalFindFile(Item, -1, TFileContent(TheContent).FileName);
        if not DoubleFile then
          TheContent.Free;
      end;
    end;
  end;
end;

function TViewForm.GlobalFindFile(var Item: TObject; NotIndex: Integer; FileName: PChar): Boolean;
var
  I: Integer;
  Child: TForm;
begin
  Result := False;
  with MainForm do
    if (MainForm=nil) or (MDIChildCount = 0) then
      Result := FindFile(Item, NotIndex, FileName)
    else
      for I := 0 to MDIChildCount - 1 do
      begin
        Child := MDIChildren[I];
        if Child is TViewForm then
          if Child = Self then
            Result := FindFile(Item, NotIndex, FileName)
          else
            Result := TViewForm(Child).FindFile(Item, -1, FileName);
        if Result then
          Exit;
      end;
end;

function TViewForm.FindFile(var Item: TObject; NotIndex: Integer; FileName: PChar): Boolean;
var
  I: Integer;
begin
  Result := False;
  if TheList <> nil then
    for I := 0 to TheList.Count - 1 do
      if (I <> NotIndex) and (TheList.Items[I] <> nil) and
        (StrIComp(TFileContent(TheList.Items[I]).FileName, FileName) = 0) then
      begin
        Item := TheList.Items[I];
        Result := True;
      end;
end;

function TViewForm.SaveCurrent: Boolean;
var
  ModifiedFile: TFileContent;
begin
  Result := True;
  ModifiedFile := TFileContent(CurrentFileContent);
  if Memo1.Modified then
  begin
    Memo1.Modified := False;
    if (TheList <> nil) then
      ModifiedFile.Text := PChar(Memo1.Lines.Text)
    else
      Exit;
  end;
  if ModifiedFile.Modified then
  begin
    case (MessageDlg('Do you want to save changes in ' +
      string(ModifiedFile.FileName),
      mtConfirmation, [mbYes, mbNo, mbCancel], 0)) of
      mrYes:
        ModifiedFile.SaveFile;
      mrCancel: Result := False;
    end;
  end;
end;

procedure TViewForm.Openneweditwindow1Click(Sender: TObject);
begin
  MainForm.ViewForm := nil;
  MainForm.PerformFileOpen(TFileContent(CurrentFileContent).FileName);
end;

procedure TViewForm.Formatpage1Click(Sender: TObject);
begin
  MainForm.FormatCurrentItemClick(nil);
end;

procedure TViewForm.FormDeactivate(Sender: TObject);
var
  FileContent: TFileContent;
begin
  if TheList <> nil then
  begin
    FileContent := TFileContent(CurrentFileContent);
    if Memo1.Modified then
      FileContent.Text := PChar(Memo1.Lines.Text);
    FileContent.SaveMemoSettings(Memo1);
  end;
end;

procedure TViewForm.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  UpdateStatusBar;
end;

function TViewForm.GelSelLength: Integer;
begin
  Result := Memo1.GetSelEnd - Memo1.GetSelStart;
end;

function TViewForm.GetSelStart: Integer;
begin
  Result := Memo1.GetSelStart;
end;

procedure TViewForm.SetSelLength(const Value: Integer);
begin
  with Memo1 do
    SetSelEnd(GetSelStart + Value);
end;

procedure TViewForm.SetSelStart(const Value: Integer);
begin
  Memo1.SetSelStart(Value);
end;

end.