DBMS/UConflictTreeViewForm.pas at master · ptsolg/DBMS · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
unit UConflictTreeViewForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ComCtrls, Menus, UConflicts, UVector, UDBObjects;

type

  TConflictTreeViewForm = class(TForm)
  private
    FTable: TDBTable;
    FRoot: TTreeNode;
    FConflicts: TConflictPanels;
    procedure MakeBranch(ConflictPanel: TConflictPanel);
    procedure MakeLVL(AParent: TTreeNode; SameRecs, Recs: TStringV);
    function FindSameRecs(AData: TDataTuple): TStringV;
  public
    procedure Load(Table: TDBTable; Conflicts: TConflictPanels);
  published
    FTreeView: TTreeView;
    FActions: TPopupMenu;
    FExpandChild: TMenuItem;
    FCollapseChild: TMenuItem;
    procedure FCollapseChildClick(Sender: TObject);
    procedure FExpandChildClick(Sender: TObject);
    procedure FTreeViewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
  end;

implementation

{$R *.lfm}

procedure TConflictTreeViewForm.Load(Table: TDBTable; Conflicts: TConflictPanels);
var
  i: integer;
begin
  FConflicts := Conflicts;
  FTable := Table;
  FTreeView.Items.Clear;
  FRoot := FTreeView.Items.Add(nil, 'Конфликты');
  FTreeView.Selected := FRoot;
  for i := 0 to FConflicts.Size - 1 do
    MakeBranch(FConflicts[i]);
end;

procedure TConflictTreeViewForm.FCollapseChildClick(Sender: TObject);
begin
  FTreeView.Selected.Collapse(True);
end;

procedure TConflictTreeViewForm.FExpandChildClick(Sender: TObject);
begin
  FTreeView.Selected.Expand(True);
end;

procedure TConflictTreeViewForm.FTreeViewMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if Button = mbRight then
    FActions.PopUp(X + Left, Y + Top);
end;

procedure TConflictTreeViewForm.MakeLVL(AParent: TTreeNode; SameRecs, Recs: TStringV);
var
  AName: string = '';
  i: integer;
begin
  for i := 0 to Recs.Size - 1 do
    if SameRecs[i] = '' then
      if FTable.Fields[i].Visible then
        AName += FTable.Fields[i].Name + ': ' + Recs[i] + ', ';
  FTreeView.Items.AddChild(AParent, AName);
end;

procedure TConflictTreeViewForm.MakeBranch(ConflictPanel: TConflictPanel);
var
  Branch: TTreeNode;
  Cell: TTreeNode;
  SameRecs: TStringV;
  AName: string;
  i: integer;
  j: integer;
begin
  with ConflictPanel do begin
    if Conflict.Data = nil then
      Exit;

    Branch := FTreeView.Items.AddChild(FRoot, Conflict.Name);
    Branch.Data := Conflict;
    for i := 0 to Conflict.Data.Size - 1 do begin
      SameRecs := FindSameRecs(Conflict.Data[i]);
      AName := '';
      for j := 0 to SameRecs.Size - 1 do
        if SameRecs[j] <> '' then
          AName += FTable.Fields[j].Name + ': ' + SameRecs[j] + ', ';
      Cell := FTreeView.Items.AddChild(Branch, AName);
      for j := 0 to Conflict.Data[i].Size - 1 do
        MakeLVL(Cell, SameRecs, Conflict.Data[i][j]);
    end;
  end;
end;

function TConflictTreeViewForm.FindSameRecs(AData: TDataTuple): TStringV;
var
  i: integer;
  j: integer;
begin
  Result := TStringV.Create;
  Result.Resize(AData[0].Size);
  for i := 0 to Result.Size - 1 do
    Result[i] := AData[0][i];

  for i := 0 to AData.Size - 1 do
    for j := 0 to AData[i].Size - 1 do
      if Result[j] <> AData[i][j] then
        Result[j] := '';
end;

end.