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

📄 tfilesframeunit.pas

📁 CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  if projectstatus.GetStatus(filename, filestatus) and
    (filestatus.IsValid) then
  begin
    if (filestatus.Conflict <> '') then
    begin
      statstring := FS_CONFLICT
    end
    else
    begin
      if (projectstatus.IsFileChanged(filestatus)) then
      begin
        statstring := FS_MODIFIED
      end
      else
      begin
        statstring := FS_NORMAL;
      end;
    end;
    item.Caption := ExtractFileName(filename);
    item.SubItems.Add(filestatus.Revision);
    item.SubItems.Add(filestatus.Options);
    item.SubItems.Add(statstring);
    item.SubItems.Add(filestatus.GetNiceTagdateString);
    item.SubItems.Add(SystemTimeString(filestatus.Timestamp));
    item.SubItems.Add(filestatus.Conflict);
    item.SubItems.Add(ExtractFilePath(filename));
  end
  else
  begin
    item.Caption := ExtractFileName(filename);
    item.SubItems.Add('');
    item.SubItems.Add('');
    item.SubItems.Add(FS_NOTINCVS);
    item.SubItems.Add('');
    item.SubItems.Add('');
    item.SubItems.Add('');
    item.SubItems.Add(ExtractFilePath(filename));
  end;
end;
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure TFilesFrame.ShowFileStatus(projectstatus: TProjectStatus;
  fAllChecked: boolean);
var
  count, i: integer;
  item: TListItem;
begin
  if (FFiles.Count > 0) then
    POpenDlg.InitialDir := ExtractFilePath(FFiles.Strings[0]);
  count := FFiles.Count;
  for i := 0 to count - 1 do
  begin
    item := PListView.Items.Add;
    item.Checked := fAllChecked;
    SetFileStatus(FFiles.Strings[i], item, projectstatus);
  end;
  if (FSortColumn >= 0) then
  begin
    PListView.SortType := stData;
    PListView.AlphaSort;
  end
  else
  begin
    PListView.SortType := stNone;
  end;
end;
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure TFilesFrame.RefreshFileStatus;
var
  count, i: integer;
  item: TListItem;
  filename: string;
begin
  DebugInfo('RefreshFileStatus begin');
  Screen.Cursor := crHourGlass;
  try
    FStatus.ReadStatus(FFiles);
    count := PListView.Items.Count;
    for i := 0 to count - 1 do
    begin
      item := PListView.Items.Item[i];
      if (item.SubItems.Count >= 7) then
      begin
        filename := item.SubItems.Strings[6] + item.Caption;
        item.SubItems.Clear;
        SetFileStatus(filename, item, FStatus);
      end;
    end;
    if (PListView.SortType = stData) then
      PListView.AlphaSort;
  finally
    Screen.Cursor := crDefault;
  end;
  DebugInfo('RefreshFileStatus End');
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActMarkAllExecute(Sender: TObject);
var
  count, i: integer;
begin
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    PListView.Items.Item[i].Checked := true;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActMarkAllModifiedExecute(Sender: TObject);
var
  count, i: integer;
  item: TListItem;
begin
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    item := PListView.Items.Item[i];
    if (item.SubItems.Count >= 3) and (item.SubItems.Strings[2] = FS_MODIFIED) then
      item.Checked := true;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActMarkAllConflictExecute(Sender: TObject);
var
  count, i: integer;
  item: TListItem;
begin
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    item := PListView.Items.Item[i];
    if (item.SubItems.Count >= 3) and (item.SubItems.Strings[2] = FS_CONFLICT) then
      item.Checked := true;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActMarkAllNotInCvsExecute(Sender: TObject);
var
  count, i: integer;
  item: TListItem;
begin
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    item := PListView.Items.Item[i];
    if (item.SubItems.Count >= 3) and (item.SubItems.Strings[2] = FS_NOTINCVS) then
      item.Checked := true;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActMarkNoneExecute(Sender: TObject);
var
  count, i: integer;
begin
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    PListView.Items.Item[i].Checked := false;
  end
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActAddExecute(Sender: TObject);
var
  i: integer;
  item: TListItem;
  filename: string;
begin
  // check path of added files
  if (POpenDlg.Execute) then
  begin
    for i := 0 to POpenDlg.Files.Count - 1 do
    begin
      filename := POpenDlg.Files.Strings[i];
      item := PListView.Items.Add;
      item.Checked := true;
      item.Caption := ExtractFileName(filename);
      item.SubItems.Add('');
      item.SubItems.Add('');
      item.SubItems.Add(FS_MANUAL);
      item.SubItems.Add('');
      item.SubItems.Add('');
      item.SubItems.Add('');
      item.SubItems.Add(ExtractFilePath(filename));
    end;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SelectionChanged(Sender: TObject;
  Item: TListItem; Selected: boolean);
var
  sel: boolean;
begin
  sel := (GetCurrentFile <> '');
  PActCmdLog.Enabled := sel;
  PActCmdDiff.Enabled := sel;
  PActSelectionChanged.Execute;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PListViewColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  assert(Column <> nil);
  if (FSortColumn = Column.Index) then
  begin
    if (FSortAsc) then
    begin
      FSortAsc := false;
    end
    else
    begin
      SetSortCaption(true);
      FSortColumn := -1;
    end;
  end
  else
  begin
    SetSortCaption(true);
    FSortColumn := Column.Index;
    FSortAsc := true;
  end;
  if (FSortColumn >= 0) then
  begin
    PListView.SortType := stData;
    SetSortCaption(false);
    PListView.AlphaSort;
  end
  else
  begin
    PListView.SortType := stNone;
  end;
end;
//---------------------------------------------------------------------------

function GetStatusNumber(item: TListItem): integer;
var
  str: string;
begin
  // Not very elegant, I know, but it works...
  result := 0;
  str := item.SubItems.Strings[2];
  if (str = FS_MANUAL) then
    result := 0
  else
    if (str = FS_NORMAL) then
    result := 10
  else
    if (str = FS_NOTINCVS) then
    result := 20
  else
    if (str = FS_MODIFIED) then
    result := 30
  else
    if (str = FS_CONFLICT) then
    result := 40
end;

procedure TFilesFrame.PListViewCompare(Sender: TObject;
  Item1: TListItem; Item2: TListItem; Data: integer; var Compare: integer);
var
  tmp: TListItem;
begin
  assert(FSortColumn >= 0);
  if (not FSortAsc) then
  begin
    tmp := Item1;
    Item1 := Item2;
    Item2 := tmp;
  end;
  if (FSortColumn = 0) then
  begin
    Compare := CompareText(Item1.Caption, Item2.Caption);
  end
  else
    if (FSortColumn = 3) then
  begin
    // Sort status by severity
    Compare := GetStatusNumber(Item2) - GetStatusNumber(Item1);
  end
  else
  begin
    Compare := CompareText(Item1.SubItems.Strings[FSortColumn - 1],
      Item2.SubItems.Strings[FSortColumn - 1]);
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PMarkBtnClick(Sender: TObject);
var
  menu: TPopupMenu;
  po: TPoint;
begin
  menu := PMarkBtn.PopupMenu;
  assert(assigned(menu));
  po := ClientToScreen(Point(PMarkBtn.Left, PMarkBtn.Top + PMarkBtn.Height));
  menu.Popup(po.x, po.y);
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetCommandsEnabled(fUpdate: boolean; fCommit: boolean);
begin
  PActCmdUpdate.Visible := fUpdate;
  PActCmdCommit.Visible := fCommit;
end;
//---------------------------------------------------------------------------

function TFilesFrame.SetSelectedFilesToFrame(frame: TFilesFrame): integer;
var
  selfiles: TStrings;
begin
  selfiles := SelectedFiles;
  result := selfiles.Count;
  if (result <= 0) then
  begin
    ShowMessage('You have to mark some files first!');
    exit;
  end;
  frame.Clear;
  frame.FFiles.Assign(selfiles);
  frame.ShowFileStatus(FStatus, true);
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActCmdUpdateExecute(Sender: TObject);
begin
  if SetSelectedFilesToFrame(UpdateFrm.PFilesFrame) > 0 then
  begin
    UpdateFrm.WhichFiles := wfmCustom;
    UpdateFrm.Exec;
    RefreshFileStatus;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActCmdCommitExecute(Sender: TObject);
begin
  if SetSelectedFilesToFrame(CommitFrm.PFilesFrame) > 0 then
  begin
    CommitFrm.WhichFiles := wfmCustom;
    CommitFrm.Exec;
    RefreshFileStatus;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActCmdLogExecute(Sender: TObject);
var
  afile: string;
begin
  afile := GetCurrentFile;
  if (afile <> '') then
  begin
    LogFrm.FileNames.Clear;
    LogFrm.FileNames.Add(afile);
    LogFrm.Exec;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.PActCmdDiffExecute(Sender: TObject);
var
  afile: string;
begin
  afile := GetCurrentFile;
  if (afile <> '') then
  begin
    DiffFrm.FileNames.Clear;
    DiffFrm.FileNames.Add(afile);
    DiffFrm.Exec;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.LoadSettings;
begin
  SetSortCaption(true);
  // store settings for this frame globally for all dialogs
  try
    BEGIN_LOAD_SETTINGS('FilesList');
    FSortColumn := LOAD_INT_SETTING('SortColumn', -1);
    FSortAsc := LOAD_BOOL_SETTING('SortAsc', true);
    END_LOAD_SETTINGS;
  except
  end;

  SetSortCaption(false);
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SaveSettings;
begin
  // store settings for this frame globally for all dialogs
  BEGIN_SAVE_SETTINGS('FilesList');
  SAVE_INT_SETTING('SortColumn', FSortColumn);
  SAVE_BOOL_SETTING('SortAsc', FSortAsc);
  END_SAVE_SETTINGS;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetSortCaption(fClear: boolean);
var
  caption: string;
begin
  if (FSortColumn >= 0) then
  begin
    case FSortColumn of
      0: caption := 'Name';
      1: caption := 'Revision';
      2: caption := 'Options';
      3: caption := 'Status';
      4: caption := 'Sticky Tag/Date';
      5: caption := 'Date';
      6: caption := 'Conflict';
      7: caption := 'Path';
    else
      assert(false);
    end;
    if (fClear) then
    begin
      PListView.Columns.Items[FSortColumn].Caption := caption;
    end
    else
    begin
      if (FSortAsc) then
      begin
        PListView.Columns.Items[FSortColumn].Caption := caption + ' (+)';
      end
      else
      begin
        PListView.Columns.Items[FSortColumn].Caption := caption + ' (-)';
      end;
    end;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetCVSROOT(const Value: string);
begin
  FCVSROOT := Value;
end;

procedure TFilesFrame.DebugInfo(const s: string);
begin
{$IFOPT D+}
  DebugStr('in ' + self.ClassName + ' :' + s);
{$ENDIF D+}
end;


end.

⌨️ 快捷键说明

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