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

📄 tupdatefrmunit.pas

📁 CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise
💻 PAS
字号:
(* $Id: TUpdateFrmunit.pas,v 1.5 2002/12/30 22:31:02 turbo Exp $
 *
 * Form for updating a project to a version in the repository (cvs update)
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TUpdateFrmunit;
{$I BORCVS.inc}
interface
//---------------------------------------------------------------------------
uses
  Classes,
  Controls,
  StdCtrls,
  Forms,
  TCvsBaseFrmunit,
  TFilesFrameunit,
  TRunCvsFrmunit,
  TStickyOptionsFrameunit,
  ComCtrls;
//---------------------------------------------------------------------------
type
  TUpdateFrm = class(TCvsBaseFrm)
    PPageControl: TPageControl;
    PUpdateTab: TTabSheet;
    PFilesTab: TTabSheet;
    PFilesFrame: TFilesFrame;
    PCreateDirCheck: TCheckBox;
    PResetStickyCheck: TCheckBox;
    PCleanCopyCheck: TCheckBox;
    PStickyOptionsFrame: TStickyOptionsFrame;
    PMergeTab: TTabSheet;
    PMergeNone: TRadioButton;
    PMergeOneRev: TRadioButton;
    PMergeTwoRev: TRadioButton;
    PFilesCheck: TCheckBox;
    PMergeFirst: TComboBox;
    PMergeSecond: TComboBox;
    procedure FormShow(Sender: TObject);
    procedure POkBtnClick(Sender: TObject);
    procedure PMergeChange(Sender: TObject);
    procedure PResetStickyCheckClick(Sender: TObject);
    procedure PFilesCheckClick(Sender: TObject);
  private
    FWhichFiles: TWhichFilesMode;
  protected
    procedure GetDirectories(Dirs: TStrings); override;
    procedure ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = ''); override;
    procedure ProcessResult(output: TStrings; runcvs: TRunCvsFrm); override;
    procedure AddConflictMessages(filename: string);
  public // Anwender-Deklarationen
    constructor create(Owner: TComponent); override;
    property WhichFiles: TWhichFilesMode read FWhichFiles write FWhichFiles;
  end;
//---------------------------------------------------------------------------
var
  UpdateFrm: TUpdateFrm;
//---------------------------------------------------------------------------

implementation
uses
//limits.h >
  sysutils,
  dialogs,
  SettingsStorage,
  TToolsApiHelperunit,
  Utilityunit;
//---------------------------------------------------------------------------
{$R *.dfm}
//---------------------------------------------------------------------------

constructor TUpdateFrm.create(Owner: TComponent);
begin
  inherited create(owner);
  FWhichFiles := wfmCustom;
  PFilesFrame.SetCommandsEnabled(false, false);
  PFilesFrame.OnlyFileNameasParameter := true;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.FormShow(Sender: TObject);
begin
  PPageControl.ActivePage := PUpdateTab;
  ActiveControl := PCleanCopyCheck;
  PFilesFrame.LoadSettings;
  case (FWhichFiles) of
    wfmCustom:
      begin
        PFilesCheck.Visible := false;
        PFilesCheck.Checked := false;
        PFilesTab.TabVisible := true;
      end;
    wfmModule:
      begin
        PFilesFrame.SetFilesFromCurrentModule(true);
        PFilesCheck.Visible := false;
        PFilesCheck.Checked := false;
        PFilesTab.TabVisible := true;
      end;
    wfmProject:
      begin
        PFilesFrame.SetFilesFromProject(false);
        PFilesCheck.Visible := true;
        PFilesCheck.Checked := false;
        PFilesTab.TabVisible := true;
      end;
    wfmProjectGroup:
      begin
        PFilesFrame.SetFilesFromProjectGroup(false);
        PFilesCheck.Visible := true;
        PFilesCheck.Checked := false;
        PFilesTab.TabVisible := true;
      end;
  else
    assert(false);
  end;
  PMergeNone.Checked := true;
  PMergeChange(self);
  PCleanCopyCheck.Checked := false;
  PResetStickyCheck.Checked := false;
  PResetStickyCheckClick(self);
//  // load settings
  try
    BEGIN_LOAD_SETTINGS('Update');
    LOAD_COMBOLIST_SETTING('MergeFirst', PMergeFirst, '');
    LOAD_COMBOLIST_SETTING('MergeSecond', PMergeSecond, '');
    PCreateDirCheck.Checked := LOAD_BOOL_SETTING('CreateDir', true);
    PStickyOptionsFrame.LoadSettings(reg);
    END_LOAD_SETTINGS;
  except
  end;

end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.PMergeChange(Sender: TObject);
begin
  if (PMergeNone.Checked) then
  begin
    PMergeFirst.Enabled := false;
    PMergeSecond.Enabled := false;
  end
  else
    if (PMergeOneRev.Checked) then
  begin
    PMergeFirst.Enabled := true;
    PMergeSecond.Enabled := false;
  end
  else
    if (PMergeTwoRev.Checked) then
  begin
    PMergeFirst.Enabled := true;
    PMergeSecond.Enabled := true;
  end;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.POkBtnClick(Sender: TObject);
begin
  Debuginfo('POkBtnClick');
  if (not PStickyOptionsFrame.IsValid) then
  begin
    ShowMessage('You have to set the sticky options correctly!');
    PPageControl.ActivePage := PUpdateTab;
    ActiveControl := PStickyOptionsFrame;
    exit;
  end;
  if (PFilesTab.TabVisible and not PFilesFrame.IsValid(1)) then
  begin
    ShowMessage('You have to select at least one file!');
    PPageControl.ActivePage := PFilesTab;
    ActiveControl := PFilesFrame;
    exit;
  end;
  if PMergeOneRev.Checked and (Trim(PMergeFirst.Text) = '') then
  begin
    ShowMessage('You have to enter a revision to merge!');
    PPageControl.ActivePage := PMergeTab;
    ActiveControl := PMergeFirst;
    exit;
  end;
  if PMergeTwoRev.Checked and
    ((Trim(PMergeFirst.Text) = '') or (Trim(PMergeSecond.Text) = '')) then
  begin
    ShowMessage('You have to enter a revision to merge!');
    PPageControl.ActivePage := PMergeTab;
//    ActiveControl := (Trim(PMergeFirst.Text) = '')? PMergeFirst: PMergeSecond;
    exit;
  end;
  // handle MRU lists
  ADD_COMBO_MRU_ENTRY_MAX(PMergeFirst, DEFAULT_MRU_ENTRIES);
  ADD_COMBO_MRU_ENTRY_MAX(PMergeSecond, DEFAULT_MRU_ENTRIES);
  // save settings
  BEGIN_SAVE_SETTINGS('Update');
  SAVE_COMBOLIST_SETTING('MergeFirst', PMergeFirst);
  SAVE_COMBOLIST_SETTING('MergeSecond', PMergeSecond);
  SAVE_BOOL_SETTING('CreateDir', PCreateDirCheck.Checked);
  PStickyOptionsFrame.SaveSettings(reg);
  END_SAVE_SETTINGS;
  PFilesFrame.SaveSettings;
  ModalResult := mrOk;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = '');
begin
  runcvs.Command := CVSCMD_UPDATE;
  if (PCleanCopyCheck.Checked) then
    runcvs.CommandOptions.Add('-C');
  if (PCreateDirCheck.Checked) then
    runcvs.CommandOptions.Add('-d');
  if (PResetStickyCheck.Checked) then
    runcvs.CommandOptions.Add('-A');
  if (PFilesTab.TabVisible) then
    PFilesFrame.ApplyParameters(runcvs, InDirectory);
  PStickyOptionsFrame.ApplyParameters(runcvs, InDirectory);
  if (PMergeOneRev.Checked) then
  begin
    runcvs.CommandOptions.Add('-j' + GetOptQuotedString(PMergeFirst.Text));
  end
  else
    if (PMergeTwoRev.Checked) then
  begin
    runcvs.CommandOptions.Add('-j' + GetOptQuotedString(PMergeFirst.Text));
    runcvs.CommandOptions.Add('-j' + GetOptQuotedString(PMergeSecond.Text));
  end;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.GetDirectories(Dirs: TStrings);
begin
  PFilesFrame.GetDirectories(Dirs);
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.PResetStickyCheckClick(Sender: TObject);
begin
  PStickyOptionsFrame.Enabled := not PResetStickyCheck.Checked;
  if (PResetStickyCheck.Checked) then
    PStickyOptionsFrame.Reset;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.ProcessResult(output: TStrings; runcvs: TRunCvsFrm);
var
  line, workdir, fname: string;
  fInit: boolean;
  i: integer;
begin
  workdir := IncludeTrailingBackslash(runcvs.WorkingDirectory);
  fInit := false;
  for i := 0 to output.Count - 1 do
  begin
    line := output.Strings[i];
    if (Length(line) > 2) and (line[2] = ' ') then
    begin
      case (line[1]) of
        'U', 'P', 'M':
          begin
            fname := GetCorrectFilename(copy(line, 3, MAXint), workdir);
            DebugInfo(format('ToolsApiHelper.ReloadFile(%s)', [fname]));
            ToolsApiHelper.ReloadFile(fname);
          end;
        'C':
          begin
            if (not fInit) then
            begin
              ToolsApiHelper.InitMessages;
              fInit := true;
            end;
            fname := GetCorrectFilename(copy(line, 3, MAXint), workdir);
            DebugInfo(format('AddConflictMessages(%s)', [fname]));
            AddConflictMessages(fname);
          end;
      end;
    end;
  end;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.AddConflictMessages(filename: string);
var
  files: TStringList;
  i: integer;
  fLoaded: boolean;
begin
  files := TStringList.Create;
  try
    files.LoadFromFile(filename);
    fLoaded := false;
    for i := 0 to files.Count - 1 do
    begin
      if (Copy(files.Strings[i], 1, 7) = '<<<<<<<') then
      begin
        if (not fLoaded) then
        begin
          ToolsApiHelper.OpenFileInEditor(filename, i + 1);
          fLoaded := true;
        end;
        ToolsApiHelper.AddMessage(filename,
          'File was changed locally and in the repository!', 'CVS Conflict', i +
          1);
      end;
    end;
    if (not fLoaded) then
    begin
      ShowMessage('BorCVS error: CVS reported a conflict, but no conflict markers found!');
      ToolsApiHelper.OpenFileInEditor(filename, -1);
    end;
  finally
    files.free;
  end;
end;
//---------------------------------------------------------------------------

procedure TUpdateFrm.PFilesCheckClick(Sender: TObject);
begin
  PFilesTab.TabVisible := not PFilesCheck.Checked;
end;
//---------------------------------------------------------------------------

end.

⌨️ 快捷键说明

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