Changeset 121 for trunk/Forms/UFormCompare.pas

Timestamp:

Feb 22, 2022, 11:07:27 AM (2 years ago)

Author:

chronos

Message:

• Modified: Improved compare dialog to show text compare of vcard data.
• Modified: Both compare sides now have scrollbar synced.
• Modified: Compare panels keep horizontal size ratio during window resize.

File:

• trunk/Forms/UFormCompare.pas (modified) (6 diffs)

trunk/Forms/UFormCompare.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
-  UContact, Diff, LCLType, LCLIntf, ComCtrls, SynEdit;
+  UContact, Diff, LCLType, LCLIntf, ComCtrls, Buttons, Menus, ActnList, SynEdit,
+  SynEditMiscClasses, SynHighlighterPosition,
+  SynEditHighlighter, UCommon, USynEditEx;
 
 type
@@ -14 +16 @@
 
   TFormCompare = class(TForm)
+    ASwitchSides: TAction;
+    AReloadFiles: TAction;
+    AFileOpenLeft: TAction;
+    AFileOpenRight: TAction;
+    ActionList1: TActionList;
     EditLeftFileName: TEdit;
     EditRightFileName: TEdit;
+    MainMenu1: TMainMenu;
+    MenuItem1: TMenuItem;
+    MenuItem2: TMenuItem;
+    MenuItem3: TMenuItem;
+    MenuItem4: TMenuItem;
+    MenuItem5: TMenuItem;
+    MenuItemClose: TMenuItem;
+    OpenDialogSide: TOpenDialog;
     PanelLeft: TPanel;
     PanelRight: TPanel;
+    SpeedButtonOpenLeft: TSpeedButton;
+    SpeedButtonOpenRight: TSpeedButton;
     Splitter1: TSplitter;
-    SynEdit1: TSynEdit;
-    SynEdit2: TSynEdit;
+    SynEditLeft: TSynEditEx;
+    SynEditRight: TSynEditEx;
+    procedure AFileOpenLeftExecute(Sender: TObject);
+    procedure AFileOpenRightExecute(Sender: TObject);
+    procedure AReloadFilesExecute(Sender: TObject);
+    procedure ASwitchSidesExecute(Sender: TObject);
+    procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure FormResize(Sender: TObject);
     procedure FormShow(Sender: TObject);
-    procedure PaintBoxLeftPaint(Sender: TObject);
+    procedure MenuItemCloseClick(Sender: TObject);
+    procedure SynEditLeftChange(Sender: TObject);
+    procedure SynEditLeftScroll(Sender: TObject);
+    procedure SynEditRightChange(Sender: TObject);
+    procedure SynEditRightScroll(Sender: TObject);
   private
-    FLeftSide: TContactsFile;
-    FRightSide: TContactsFile;
-    S1, S2: string;
+    FLeftSide: string;
+    FRightSide: string;
     Diff: TDiff;
-    procedure SetLeftSide(AValue: TContactsFile);
-    procedure SetRightSide(AValue: TContactsFile);
+    HighlighterLeft: TSynPositionHighlighter;
+    HighlighterRight: TSynPositionHighlighter;
+    AttrAdded: TtkTokenKind;
+    AttrDeleted: TtkTokenKind;
+    AttrModified: TtkTokenKind;
+    LastWidth: Integer;
+    procedure SetLeftSide(AValue: string);
+    procedure SetRightSide(AValue: string);
     procedure ReloadContent;
     procedure UpdateInterface;
+    procedure UpdateHighlight;
+    function LoadFile(AFileName: string): string;
   public
-    property LeftSide: TContactsFile read FLeftSide write SetLeftSide;
-    property RightSide: TContactsFile read FRightSide write SetRightSide;
+    procedure LoadFileLeft(FileName: string);
+    procedure LoadFileRight(FileName: string);
+    property LeftSide: string read FLeftSide write SetLeftSide;
+    property RightSide: string read FRightSide write SetRightSide;
   end;
 
@@ -56 +92 @@
 begin
   Core.PersistentForm1.Save(Self);
+end;
+
+procedure TFormCompare.ASwitchSidesExecute(Sender: TObject);
+var
+  TempFileName: string;
+  TempContent: string;
+begin
+  TempContent := SynEditLeft.Text;
+  SynEditLeft.Text := SynEditRight.Text;
+  SynEditRight.Text := TempContent;
+
+  TempFileName := EditLeftFileName.Text;
+  EditLeftFileName.Text := EditRightFileName.Text;
+  EditRightFileName.Text := TempFileName;
+
+  UpdateInterface;
+  UpdateHighlight;
+end;
+
+procedure TFormCompare.FormActivate(Sender: TObject);
+begin
+  if LastWidth = -1 then LastWidth := Width;
+end;
+
+procedure TFormCompare.AReloadFilesExecute(Sender: TObject);
+begin
+  LoadFileLeft(EditLeftFileName.Text);
+  LoadFileRight(EditRightFileName.Text);
+  UpdateHighlight;
+  UpdateInterface;
+end;
+
+procedure TFormCompare.AFileOpenLeftExecute(Sender: TObject);
+begin
+  OpenDialogSide.InitialDir := ExtractFileDir(EditLeftFileName.Text);
+  OpenDialogSide.FileName := ExtractFileName(EditLeftFileName.Text);
+  if OpenDialogSide.Execute then begin
+    EditLeftFileName.Text := OpenDialogSide.FileName;
+    SynEditLeft.Text := LoadFileToStr(OpenDialogSide.FileName);
+  end;
+end;
+
+procedure TFormCompare.AFileOpenRightExecute(Sender: TObject);
+begin
+  OpenDialogSide.InitialDir := ExtractFileDir(EditRightFileName.Text);
+  OpenDialogSide.FileName := ExtractFileName(EditRightFileName.Text);
+  if OpenDialogSide.Execute then begin
+    EditRightFileName.Text := OpenDialogSide.FileName;
+    SynEditRight.Text := LoadFileToStr(OpenDialogSide.FileName);
+  end;
+  UpdateHighlight;
 end;
 
@@ -63 +150 @@
   Core.ThemeManager1.UseTheme(Self);
   Diff := TDiff.Create(Self);
+
+  HighlighterLeft := TSynPositionHighlighter.Create(Self);
+  with HighlighterLeft do begin
+    AttrAdded := CreateTokenID('Added', clNone, clLightGreen, []);
+    AttrDeleted := CreateTokenID('Deleted', clNone, clLightBlue, []);
+    AttrModified := CreateTokenID('Modified', clNone, clLightRed, []);
+  end;
+  SynEditLeft.Highlighter := HighlighterLeft;
+
+  HighlighterRight := TSynPositionHighlighter.Create(Self);
+  with HighlighterRight do begin
+    AttrAdded := CreateTokenID('Added', clNone, clLightGreen, []);
+    AttrDeleted := CreateTokenID('Deleted', clNone, clLightBlue, []);
+    AttrModified := CreateTokenID('Modified', clNone, clLightRed, []);
+  end;
+  SynEditRight.Highlighter := HighlighterRight;
+
+  LastWidth := -1;
 end;
 
 procedure TFormCompare.FormDestroy(Sender: TObject);
 begin
+  FreeAndNil(HighlighterLeft);
+  FreeAndNil(HighlighterRight);
   FreeAndNil(Diff);
+end;
+
+procedure TFormCompare.FormResize(Sender: TObject);
+var
+  LastHandler: TNotifyEvent;
+  NewPanelWidth: Integer;
+const
+  MaxRatio = 0.8;
+begin
+  if LastWidth <> -1 then begin
+    LastHandler := PanelLeft.OnResize;
+    try
+      PanelLeft.OnResize := nil;
+      NewPanelWidth := Round((PanelLeft.Width / LastWidth) * Width);
+      if NewPanelWidth > Round(Width * MaxRatio) then NewPanelWidth := Round(Width * MaxRatio);
+      PanelLeft.Width := NewPanelWidth;
+    finally
+      PanelLeft.OnResize := LastHandler;
+    end;
+    LastWidth := Width;
+  end;
 end;
 
@@ -77 +205 @@
 end;
 
-procedure MarkupTextOut(Canvas: TCanvas; X, Y: Integer; Text: string);
-var
-  I: Integer;
-  Len: Integer;
-  Clr: Integer;
-  SavedTextAlign: Cardinal;
-  SavedBkColor: Cardinal;
-  SavedTextColor: Cardinal;
-  SavedPt: TPoint;
-begin
-  I := Pos('<', Text);
-  if I = 0 then begin
-    Canvas.TextOut(X, Y, Text);
-    Exit;
-  end;
-
-  SavedTextColor := GetTextColor(Canvas.Handle);
-  SavedBkColor := GetBkColor(Canvas.Handle);
-  //SavedTextAlign := GetTextAlign(Canvas.Handle);
-  //SetTextAlign(Canvas.Handle, SavedTextAlign or TA_UPDATECP);
-  MoveToEx(Canvas.Handle, X, Y, @SavedPt);
-
-  repeat
-    if I > 1 then TextOut(Canvas.Handle, 0, 0, PChar(Text), I - 1);
-    Delete(Text, 1, I);
-    Len := Length(Text);
-    if Len < 3 then Break
-    else if (Text[1] = 'F') and (Text[2] = 'C') and (Text[3] = ':') and
-      (Len > 9) and (Text[10] = '>') then begin
-      Clr := StrToIntDef('$' + Copy(Text, 4, 6), 0);
-      SetTextColor(Canvas.Handle, Clr);
-      Delete(Text, 1, 10);
-      Dec(Len, 10);
-    end
-    else if (Text[1] = 'B') and (Text[2] = 'C') and (Text[3] = ':') and
-      (Len > 9) and (Text[10] = '>') then
-    begin
-      Clr := StrToIntDef('$' + Copy(Text, 4, 6), $1FFFFFF);
-      if Clr > $FFFFFF then
-        SetBkColor(Canvas.Handle, SavedBkColor) else
-        SetBkColor(Canvas.Handle, Clr);
-      Delete(Text, 1, 10);
-      Dec(Len, 10);
-    end
-    else Break;
-    I := Pos('<', Text);
-  until (I = 0);
-  TextOut(Canvas.Handle, 0, 0, PChar(Text), Len);
-
-  SetTextColor(Canvas.Handle, SavedTextColor);
-  SetBkColor(Canvas.Handle, SavedBkColor);
-  //SetTextAlign(Canvas.Handle, SavedTextAlign);
-  with SavedPt do MoveToEx(Canvas.Handle, X, Y, nil);
-end;
-
-procedure TFormCompare.PaintBoxLeftPaint(Sender: TObject);
-begin
-  with TPaintBox(Sender) do begin
-    MarkupTextOut(Canvas, 0, 5, S1);
-    MarkupTextOut(Canvas, 0, 25, S2);
-    Canvas.TextOut(0, 55, 'Compare Statistics ...');
-    with Diff.DiffStats do begin
-      MarkupTextOut(Canvas, 0, 75, '  Matches : ' + IntToStr(Matches));
-      MarkupTextOut(Canvas, 0, 95, '  <BC:AAFFAA>Modifies:<BC:------> ' + IntToStr(Modifies));
-      MarkupTextOut(Canvas, 0, 115, '  <BC:FFAAAA>Adds    :<BC:------> ' + IntToStr(Adds));
-      MarkupTextOut(Canvas, 0, 135, '  <BC:AAAAFF>Deletes :<BC:------> ' + IntToStr(Deletes));
-    end;
-  end;
-end;
-
-procedure TFormCompare.SetLeftSide(AValue: TContactsFile);
+procedure TFormCompare.MenuItemCloseClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TFormCompare.SynEditLeftChange(Sender: TObject);
+begin
+  UpdateHighlight;
+end;
+
+procedure TFormCompare.SynEditLeftScroll(Sender: TObject);
+begin
+  SynEditRight.TopLine := SynEditLeft.TopLine;
+end;
+
+procedure TFormCompare.SynEditRightChange(Sender: TObject);
+begin
+  UpdateHighlight;
+end;
+
+procedure TFormCompare.SynEditRightScroll(Sender: TObject);
+begin
+  SynEditLeft.TopLine := SynEditRight.TopLine;
+end;
+
+procedure TFormCompare.SetLeftSide(AValue: string);
 begin
   if FLeftSide = AValue then Exit;
   FLeftSide := AValue;
-  ReloadContent;
-  UpdateInterface;
-end;
-
-procedure TFormCompare.SetRightSide(AValue: TContactsFile);
+end;
+
+procedure TFormCompare.SetRightSide(AValue: string);
 begin
   if FRightSide = AValue then Exit;
   FRightSide := AValue;
-  ReloadContent;
-  UpdateInterface;
 end;
 
 procedure TFormCompare.ReloadContent;
+begin
+  UpdateHighlight;
+end;
+
+procedure TFormCompare.UpdateInterface;
+begin
+end;
+
+procedure TFormCompare.UpdateHighlight;
 var
   LeftText: string;
@@ -169 +257 @@
   I: Integer;
   LastKind: TChangeKind;
-
-  //AddCharToStr() adds color markup to strings which will be parsed later by
-  //my MarkupTextOut() function where diffs (additions, modifications and
-  //deletions) will be displayed in Paintbox1 with different colors ...
-  //<BC:------> change background color to original (transparent) color
-  //<BC:AAFFAA> change background color to pale green
-  //<BC:AAAAFF> change background color to pale red
-  //<BC:FFAAAA> change background color to pale blue
-  procedure AddCharToStr(var s: string; c: char; Kind, LastKind: TChangeKind);
-  begin
-    if (Kind = LastKind) then
-      s := s + c //no need to change colors
-    else
-    case Kind of
-      ckNone: s := s + '<BC:------>' + c;
-      ckAdd: s := s + '<BC:FFAAAA>' + c;
-      ckDelete: s := s + '<BC:AAAAFF>' + c;
-      ckModify: s := s + '<BC:AAFFAA>' + c;
-    end;
-  end;
-
-begin
-  if Assigned(FLeftSide) then begin
-    FLeftSide.Sort;
-    LeftText := FLeftSide.AsString;
-  end else LeftText := '';
-  if Assigned(FRightSide) then begin
-    FRightSide.Sort;
-    RightText := FRightSide.AsString;
-  end else RightText := '';
+  P1: TPoint;
+  P2: TPoint;
+  Rec: TCompareRec;
+  NextToken1: TtkTokenKind;
+  NextToken2: TtkTokenKind;
+begin
+  LeftText := SynEditLeft.Lines.Text;
+  RightText := SynEditRight.Lines.Text;
 
   Diff.Execute(PChar(LeftText), PChar(RightText), Length(LeftText), Length(RightText));
 
-  //now, display the diffs ...
+  HighlighterLeft.ClearAllTokens;
+  HighlighterRight.ClearAllTokens;
+  LeftText := '';
+  RightText := '';
   LastKind := ckNone;
-  S1 := '';
-  S2 := '';
+  P1 := Point(1, 0);
+  P2 := Point(1, 0);
+  NextToken1 := tkText;
+  NextToken2 := tkText;
   for I := 0 to Diff.Count - 1 do
     with Diff.Compares[I] do begin
-      //show changes to first string (with spaces for adds to align with second string)
-      if Kind = ckAdd then AddCharToStr(S1, ' ', Kind, LastKind)
-      else AddCharToStr(S1, Chr1, Kind, LastKind);
-
-      //show changes to second string (with spaces for deletes to align with first string)
-      if Kind = ckDelete then AddCharToStr(S2, ' ', Kind, LastKind)
-      else AddCharToStr(S2, Chr2, Kind, LastKind);
+      Rec := Diff.Compares[I];
+      if Rec.Chr1 = LineEnding then begin
+        if NextToken1 <> tkText then begin
+          HighlighterLeft.AddToken(P1.Y, 0, NextToken1);
+          NextToken1 := tkText;
+        end;
+        Inc(P1.Y);
+        P1.X := 0;
+        LeftText := LeftText + Rec.Chr1;
+      end else begin
+        if Kind = ckAdd then LeftText := LeftText + ' '
+          else LeftText := LeftText + Rec.chr1;
+        if Kind <> LastKind then begin
+          HighlighterLeft.AddToken(P1.Y, P1.X, NextToken1);
+          if Kind = ckNone then NextToken1 := tkText
+          //else if Kind = ckAdd then NextToken1 := AttrAdded
+          else if Kind = ckDelete then NextToken1 := AttrDeleted
+          else if Kind = ckModify then NextToken1 := AttrModified;
+        end;
+        Inc(P1.X);
+      end;
+
+      if Rec.Chr2 = LineEnding then begin
+        if NextToken2 <> tkText then begin
+          HighlighterRight.AddToken(P2.Y, 0, NextToken2);
+          NextToken2 := tkText;
+        end;
+        Inc(P2.Y);
+        P2.X := 0;
+        RightText := RightText + Rec.Chr2;
+      end else begin
+        if Kind = ckDelete then RightText := RightText + ' '
+          else RightText := RightText + Rec.Chr2;
+        if Kind <> LastKind then begin
+          HighlighterRight.AddToken(P2.Y, P2.X, NextToken2);
+          if Kind = ckNone then NextToken2 := tkText
+          else if Kind = ckAdd then NextToken2 := AttrAdded
+          //else if Kind = ckDelete then NextToken2 := AttrDeleted
+          else if Kind = ckModify then NextToken2 := AttrModified;
+        end;
+        Inc(P2.X);
+      end;
 
       LastKind := Kind;
     end;
-end;
-
-procedure TFormCompare.UpdateInterface;
-begin
-  if Assigned(FLeftSide) then EditLeftFileName.Text := FLeftSide.FileName
-    else EditLeftFileName.Text := '';
-  if Assigned(FRightSide) then EditRightFileName.Text := FRightSide.FileName
-    else EditRightFileName.Text := '';
+
+  //SynEditLeft.Lines.Text := LeftText;
+  //SynEditRight.Lines.Text := RightText;
+end;
+
+function TFormCompare.LoadFile(AFileName: string): string;
+var
+  Ext: string;
+begin
+  Ext := ExtractFileExt(AFileName);
+  if Ext = VCardFileExt then begin
+    with TContactsFile.Create do
+    try
+      LoadFromFile(AFileName);
+      Result := AsString;
+    finally
+      Free;
+    end;
+  end else Result := LoadFileToStr(AFileName);
+end;
+
+procedure TFormCompare.LoadFileLeft(FileName: string);
+begin
+  EditLeftFileName.Text := FileName;
+  LeftSide := LoadFile(FileName);
+  SynEditLeft.Text := LeftSide;
+end;
+
+procedure TFormCompare.LoadFileRight(FileName: string);
+begin
+  EditRightFileName.Text := FileName;
+  RightSide := LoadFile(FileName);
+  SynEditRight.Text := RightSide;
 end;