Changeset 126 for trunk


Ignore:
Timestamp:
Apr 6, 2022, 11:36:27 AM (3 years ago)
Author:
chronos
Message:
  • Added: Action to remove exact duplicates.
  • Modified: Test cases definition moved to separate file.
Location:
trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r120 r126  
    11object FormMain: TFormMain
    22  Left = 553
    3   Height = 829
     3  Height = 796
    44  Top = 401
    5   Width = 1227
     5  Width = 1178
    66  Caption = 'vCard Studio'
    7   ClientHeight = 794
    8   ClientWidth = 1227
    9   DesignTimePPI = 150
     7  ClientHeight = 762
     8  ClientWidth = 1178
     9  DesignTimePPI = 144
    1010  Menu = MainMenu1
    1111  OnClose = FormClose
    … …  
    1818  object CoolBar1: TCoolBar
    1919    Left = 0
    20     Height = 44
     20    Height = 43
    2121    Top = 0
    22     Width = 1227
     22    Width = 1178
    2323    AutoSize = True
    2424    Bands = <   
    … …  
    3939      AnchorSideTop.Control = CoolBar1
    4040      Left = 24
    41       Height = 34
     41      Height = 33
    4242      Top = 5
    43       Width = 164
     43      Width = 159
    4444      Align = alNone
    4545      AutoSize = True
    … …  
    6060      end
    6161      object ToolButton2: TToolButton
    62         Left = 37
     62        Left = 36
    6363        Top = 0
    6464        Action = Core.AFileOpen
    … …  
    6767      end
    6868      object ToolButton3: TToolButton
    69         Left = 92
     69        Left = 89
    7070        Top = 0
    7171        Action = Core.AFileSave
    7272      end
    7373      object ToolButton4: TToolButton
    74         Left = 128
     74        Left = 124
    7575        Top = 0
    7676        Action = Core.AFileClose
    … …  
    8181      AnchorSideTop.Control = CoolBar1
    8282      Left = 188
    83       Height = 34
     83      Height = 33
    8484      Top = 5
    85       Width = 145
     85      Width = 141
    8686      Align = alNone
    8787      AutoSize = True
    … …  
    9797      Transparent = True
    9898      object ToolButton5: TToolButton
    99         Left = 109
     99        Left = 106
    100100        Top = 0
    101101        Action = Core.ASettings
    102102      end
    103103      object ToolButton6: TToolButton
    104         Left = 37
     104        Left = 36
    105105        Top = 0
    106106        Action = Core.AFindDuplicate
    … …  
    112112      end
    113113      object ToolButton8: TToolButton
    114         Left = 73
     114        Left = 71
    115115        Top = 0
    116116        Action = Core.AFileCompare
    … …  
    120120  object MainMenu1: TMainMenu
    121121    Images = Core.ImageList1
    122     Left = 200
    123     Top = 125
     122    Left = 192
     123    Top = 120
    124124    object MenuItemFile: TMenuItem
    125125      Caption = 'File'
    … …  
    186186        Caption = '-'
    187187      end
     188      object MenuItem13: TMenuItem
     189        Action = Core.ARemoveExactDuplicates
     190      end
    188191      object MenuItem5: TMenuItem
    189192        Action = Core.AGenerate
    … …  
    207210  end
    208211  object PopupMenuOpenRecent: TPopupMenu
    209     Left = 438
    210     Top = 125
     212    Left = 420
     213    Top = 120
    211214  end
    212215end

  • trunk/Forms/UFormMain.pas

    r120 r126  
    2020    MenuItem11: TMenuItem;
    2121    MenuItem12: TMenuItem;
     22    MenuItem13: TMenuItem;
    2223    MenuItem3: TMenuItem;
    2324    MenuItem4: TMenuItem;

  • trunk/Forms/UFormTest.pas

    r116 r126  
    3434      Selected: Boolean);
    3535  private
     36    FTestCases: TTestCases;
    3637    procedure ReloadList;
     38    procedure SetTestCases(AValue: TTestCases);
    3739    procedure UpdateInterface;
    38     procedure InitTestCases;
    3940  public
    40     TestCases: TTestCases;
     41    property TestCases: TTestCases read FTestCases write SetTestCases;
    4142  end;
    4243
    … …  
    5051
    5152uses
    52   UCore, UFormTestCase, UContact;
    53 
    54 resourcestring
    55   SPassed = 'Passed';
    56   SFailed = 'Failed';
     53  UCore, UFormTestCase, UContact, UTestCases;
    5754
    5855{ TFormTest }
    … …  
    8077end;
    8178
     79procedure TFormTest.SetTestCases(AValue: TTestCases);
     80begin
     81  if FTestCases = AValue then Exit;
     82  FTestCases := AValue;
     83  ReloadList;
     84  UpdateInterface;
     85end;
     86
    8287procedure TFormTest.UpdateInterface;
    8388var
    … …  
    101106  LabelResult.Caption := SPassed + ' ' + IntToStr(Passed) + ', ' +
    102107    SFailed + ' ' + IntToStr(Failed);
    103 end;
    104 
    105 procedure TFormTest.InitTestCases;
    106 const
    107   VCardVersion = 'VERSION:2.1';
    108 begin
    109   TestCases := TTestCases.Create;
    110   with TestCases do begin
    111     with TTestCaseLoadSave(AddNew('Load and save', TTestCaseLoadSave)) do begin
    112       Input := VCardBegin + LineEnding +
    113         VCardVersion + LineEnding +
    114         'N:Surname;Name' + LineEnding +
    115         'FN:Name Surname' + LineEnding +
    116         VCardEnd + LineEnding;
    117       Output := Input;
    118     end;
    119     with TTestCaseLoadSave(AddNew('Long text', TTestCaseLoadSave)) do begin
    120       Input := VCardBegin + LineEnding +
    121         VCardVersion + LineEnding +
    122         'NOTE:This is some long test which is really multi-lined each line is on dif' + LineEnding +
    123         ' ferent line so it is on multiple lines.' + LineEnding +
    124         VCardEnd + LineEnding;
    125       Output := Input;
    126     end;
    127     with TTestCaseLoadSave(AddNew('Multi-line', TTestCaseLoadSave)) do begin
    128       Input := VCardBegin + LineEnding +
    129         VCardVersion + LineEnding +
    130         'NOTE:First line\nsecond line\nempty line\n\nlast line' + LineEnding +
    131         VCardEnd + LineEnding;
    132      Output := Input;
    133     end;
    134     with TTestCaseLoadSave(AddNew('Quoted-printable load-save', TTestCaseLoadSave)) do begin
    135       Input := VCardBegin + LineEnding +
    136         VCardVersion + LineEnding +
    137         'FN;ENCODING=QUOTED-PRINTABLE:Jm=C3=A9no=20P=C5=99=C3=ADjmen=C3=AD' + LineEnding +
    138         VCardEnd + LineEnding;
    139       Output := Input;
    140     end;
    141     with TTestCaseLoadSave(AddNew('Quoted-printable load-save multi-line', TTestCaseLoadSave)) do begin
    142       Input := VCardBegin + LineEnding +
    143         VCardVersion + LineEnding +
    144         'FN;ENCODING=QUOTED-PRINTABLE:Jm=C3=A9no=20P=C5=99=C3=ADjmen=C3=ADJm=C3=A9n=' + LineEnding +
    145         'o=20P=C5=99=C3=ADjmen=C3=AD' + LineEnding +
    146         VCardEnd + LineEnding;
    147       Output := Input;
    148     end;
    149     with TTestCaseLoadSave(AddNew('Base64 load-save (encoding=base64)', TTestCaseLoadSave)) do begin
    150       Input := VCardBegin + LineEnding +
    151         VCardVersion + LineEnding +
    152         'FN;ENCODING=BASE64:VGVzdCBzdHJpbmc=' + LineEnding +
    153         VCardEnd + LineEnding;
    154       Output := Input;
    155     end;
    156     with TTestCaseLoadSave(AddNew('Base64 load-save (base64)', TTestCaseLoadSave)) do begin
    157       Input := VCardBegin + LineEnding +
    158         VCardVersion + LineEnding +
    159         'FN;BASE64:VGVzdCBzdHJpbmc=' + LineEnding +
    160         VCardEnd + LineEnding;
    161       Output := Input;
    162     end;
    163     with TTestCaseLoadSave(AddNew('Base64 load-save (encoding=b)', TTestCaseLoadSave)) do begin
    164       Input := VCardBegin + LineEnding +
    165         VCardVersion + LineEnding +
    166         'FN;ENCODING=B:VGVzdCBzdHJpbmc=' + LineEnding +
    167         VCardEnd + LineEnding;
    168       Output := Input;
    169     end;
    170     with TTestCaseLoadSave(AddNew('Base64 load-save multi-line', TTestCaseLoadSave)) do begin
    171       Input := VCardBegin + LineEnding +
    172         VCardVersion + LineEnding +
    173         'FN;ENCODING=BASE64:U29tZSB2ZXJ5IGxvbmcgc3RyaW5nIFNvbWUgdmVyeSBsb25nIHN0cmlu' + LineEnding +
    174         ' ZyBTb21lIHZlcnkgbG9uZyBzdHJpbmcgU29tZSB2ZXJ5IGxvbmcgc3RyaW5n' + LineEnding +
    175         VCardEnd + LineEnding;
    176       Output := Input;
    177     end;
    178     //AddNew('Image format', TTestCaseLoadSave);
    179     with TTestCaseLoadSave(AddNew('Empty', TTestCaseLoadSave)) do begin
    180       Input := '';
    181       Output := '';
    182     end;
    183     with TTestCaseLoadSave(AddNew('Begin only', TTestCaseLoadSave)) do begin
    184       Input := VCardBegin;
    185       Output := '';
    186     end;
    187     with TTestCaseLoadSave(AddNew('Missing end', TTestCaseLoadSave)) do begin
    188       Input := VCardBegin + LineEnding +
    189         VCardVersion + LineEnding +
    190         'N:Surname;Name' + LineEnding +
    191         'FN:Name Surname' + LineEnding;
    192       Output := '';
    193     end;
    194     with TTestCaseLoadSave(AddNew('Missing start', TTestCaseLoadSave)) do begin
    195       Input := VCardVersion + LineEnding +
    196         'N:Surname;Name' + LineEnding +
    197         'FN:Name Surname' + LineEnding +
    198         VCardEnd + LineEnding;
    199       Output := '';
    200     end;
    201     with TTestCaseCheckProperty(AddNew('Property FN', TTestCaseCheckProperty)) do begin
    202       Index := cfFullName;
    203       Value := 'Name Surname';
    204       Input := VCardBegin + LineEnding +
    205         VCardVersion + LineEnding +
    206         'FN:' + Value + LineEnding +
    207         VCardEnd + LineEnding;
    208     end;
    209     with TTestCaseCheckProperty(AddNew('Escaped new lines in text', TTestCaseCheckProperty)) do begin
    210       Index := cfNote;
    211       Value := 'Line' + #13#10 + 'Line';
    212       Input := VCardBegin + LineEnding +
    213         VCardVersion + LineEnding +
    214         'NOTE:Line\nLine' + LineEnding +
    215         VCardEnd + LineEnding;
    216     end;
    217     with TTestCaseCheckProperty(AddNew('Compound value', TTestCaseCheckProperty)) do begin
    218       Index := cfFirstName;
    219       Value := 'FirstName';
    220       Input := VCardBegin + LineEnding +
    221         VCardVersion + LineEnding +
    222         'N:Surname;FirstName;;;' + LineEnding +
    223         VCardEnd + LineEnding;
    224     end;
    225     with TTestCaseCheckProperty(AddNew('Quoted-printable special symbols', TTestCaseCheckProperty)) do begin
    226       Index := cfFullName;
    227       Value := 'Jméno Příjmení';
    228       Input := VCardBegin + LineEnding +
    229         VCardVersion + LineEnding +
    230         'FN;ENCODING=QUOTED-PRINTABLE:Jm=C3=A9no=20P=C5=99=C3=ADjmen=C3=AD' + LineEnding +
    231         VCardEnd + LineEnding;
    232     end;
    233     with TTestCaseCheckProperty(AddNew('Base64 special symbols', TTestCaseCheckProperty)) do begin
    234       Index := cfFullName;
    235       Value := 'Jméno Příjmení';
    236       Input := VCardBegin + LineEnding +
    237         VCardVersion + LineEnding +
    238         'FN;ENCODING=BASE64:Sm3DqW5vIFDFmcOtam1lbsOt' + LineEnding +
    239         VCardEnd + LineEnding;
    240     end;
    241   end;
    242108end;
    243109
    … …  
    282148  Core.Translator.TranslateComponentRecursive(Self);
    283149  Core.ThemeManager1.UseTheme(Self);
    284 
    285   InitTestCases;
    286150end;
    287151
    288152procedure TFormTest.FormDestroy(Sender: TObject);
    289153begin
    290   FreeAndNil(TestCases);
    291154end;
    292155

  • trunk/Languages/vCardStudio.cs.po

    r123 r126  
    8181msgstr "Nástroj pro správu souborů vCard"
    8282
     83#: tcore.aremoveexactduplicates.caption
     84msgid "Remove exact duplicates"
     85msgstr "Odstranit přesné duplikáty"
     86
    8387#: tcore.asettings.caption
    8488msgctxt "tcore.asettings.caption"
    … …  
    15691573
    15701574#: uformtest.sfailed
     1575msgctxt "uformtest.sfailed"
    15711576msgid "Failed"
    15721577msgstr "Selhalo"
    15731578
    15741579#: uformtest.spassed
     1580msgctxt "uformtest.spassed"
    15751581msgid "Passed"
    15761582msgstr "Prošlo"
    … …  
    15791585msgid "Decode error"
    15801586msgstr "Chyba dekódování"
     1587
     1588#: utest.sexpected
     1589msgid "Expected:"
     1590msgstr "Očekáváno:"
     1591
     1592#: utest.sfailed
     1593msgctxt "utest.sfailed"
     1594msgid "Failed"
     1595msgstr "Selhalo"
     1596
     1597#: utest.snone
     1598msgid "None"
     1599msgstr "Žádný"
     1600
     1601#: utest.soutput
     1602msgid "Output:"
     1603msgstr "Výstup:"
     1604
     1605#: utest.spassed
     1606msgctxt "utest.spassed"
     1607msgid "Passed"
     1608msgstr "Prošlo"

  • trunk/Languages/vCardStudio.pot

    r123 r126  
    7171msgstr ""
    7272
     73#: tcore.aremoveexactduplicates.caption
     74msgid "Remove exact duplicates"
     75msgstr ""
     76
    7377#: tcore.asettings.caption
    7478msgctxt "tcore.asettings.caption"
    … …  
    15411545
    15421546#: uformtest.sfailed
     1547msgctxt "uformtest.sfailed"
    15431548msgid "Failed"
    15441549msgstr ""
    15451550
    15461551#: uformtest.spassed
     1552msgctxt "uformtest.spassed"
    15471553msgid "Passed"
    15481554msgstr ""
    … …  
    15521558msgstr ""
    15531559
     1560#: utest.sexpected
     1561msgid "Expected:"
     1562msgstr ""
     1563
     1564#: utest.sfailed
     1565msgctxt "utest.sfailed"
     1566msgid "Failed"
     1567msgstr ""
     1568
     1569#: utest.snone
     1570msgid "None"
     1571msgstr ""
     1572
     1573#: utest.soutput
     1574msgid "Output:"
     1575msgstr ""
     1576
     1577#: utest.spassed
     1578msgctxt "utest.spassed"
     1579msgid "Passed"
     1580msgstr ""
     1581

  • trunk/Languages/vCardStudio.sv.po

    r123 r126  
    8282msgstr "vCard filhanteringsverktyg"
    8383
     84#: tcore.aremoveexactduplicates.caption
     85msgid "Remove exact duplicates"
     86msgstr ""
     87
    8488#: tcore.asettings.caption
    8589msgctxt "tcore.asettings.caption"
    … …  
    15791583
    15801584#: uformtest.sfailed
     1585msgctxt "uformtest.sfailed"
    15811586msgid "Failed"
    15821587msgstr ""
    15831588
    15841589#: uformtest.spassed
     1590msgctxt "uformtest.spassed"
    15851591msgid "Passed"
    15861592msgstr ""
    … …  
    15901596msgstr "Avkodningsfel"
    15911597
     1598#: utest.sexpected
     1599msgid "Expected:"
     1600msgstr ""
     1601
     1602#: utest.sfailed
     1603msgctxt "utest.sfailed"
     1604msgid "Failed"
     1605msgstr ""
     1606
     1607#: utest.snone
     1608msgid "None"
     1609msgstr ""
     1610
     1611#: utest.soutput
     1612msgid "Output:"
     1613msgstr ""
     1614
     1615#: utest.spassed
     1616msgctxt "utest.spassed"
     1617msgid "Passed"
     1618msgstr ""
     1619

  • trunk/UContact.pas

    r120 r126  
    136136      NoGroups: TStringArray): Boolean;
    137137    procedure Assign(Source: TContactProperty);
     138    function CompareTo(ContactProperty: TContactProperty): Boolean;
    138139    constructor Create;
    139140    destructor Destroy; override;
    … …  
    179180    procedure Assign(Source: TContact);
    180181    function UpdateFrom(Source: TContact): Boolean;
     182    function CompareTo(Contact: TContact): Boolean;
    181183    constructor Create;
    182184    destructor Destroy; override;
    … …  
    208210    procedure Merge(Contact: TContact; FieldIndex: TContactFieldIndex);
    209211    function ToString: ansistring; override;
     212    procedure RemoveExactDuplicates;
    210213  end;
    211214
    … …  
    10491052end;
    10501053
     1054function TContactProperty.CompareTo(ContactProperty: TContactProperty): Boolean;
     1055var
     1056  I: Integer;
     1057begin
     1058  Result := (Name = ContactProperty.Name) and (Value = ContactProperty.Value) and
     1059    (Attributes.Count = ContactProperty.Attributes.Count);
     1060  if Result then begin
     1061    for I := 0 to Attributes.Count - 1 do
     1062    if not (Attributes[I] = ContactProperty.Attributes[I]) then begin
     1063      Result := False;
     1064      Break;
     1065    end;
     1066  end;
     1067end;
     1068
    10511069constructor TContactProperty.Create;
    10521070begin
    … …  
    10801098
    10811099procedure TContacts.AddContacts(Contacts: TContacts);
    1082 var
    1083   I: Integer;
    1084   NewContact: TContact;
    1085 begin
    1086   for I := 0 to Contacts.Count - 1 do begin
    1087     NewContact := TContact.Create;
    1088     NewContact.Assign(Contacts[I]);
    1089     NewContact.ContactsFile := ContactsFile;
    1090     Add(NewContact);
    1091   end;
     1100begin
     1101  InsertContacts(Count, Contacts);
    10921102end;
    10931103
    … …  
    11041114    Inc(Index);
    11051115  end;
     1116end;
     1117
     1118procedure TContacts.RemoveExactDuplicates;
     1119var
     1120  I: Integer;
     1121  J: Integer;
     1122begin
     1123  for I := 0 to Count - 1 do
     1124    for J := Count - 1 downto I + 1 do
     1125      if Items[I].CompareTo(Items[J]) then begin
     1126        Remove(Items[J]);
     1127      end;
    11061128end;
    11071129
    … …  
    15541576end;
    15551577
     1578function TContact.CompareTo(Contact: TContact): Boolean;
     1579var
     1580  I: Integer;
     1581begin
     1582  Result := Properties.Count = Contact.Properties.Count;
     1583  if Result then begin
     1584    for I := 0 to Properties.Count - 1 do
     1585    if not Properties[I].CompareTo(Contact.Properties[I]) then begin
     1586      Result := False;
     1587      Break;
     1588    end;
     1589  end;
     1590end;
     1591
    15561592constructor TContact.Create;
    15571593begin

  • trunk/UCore.lfm

    r123 r126  
    33  OnDestroy = DataModuleDestroy
    44  OldCreateOrder = False
    5   Height = 551
    6   HorizontalOffset = 697
    7   VerticalOffset = 632
    8   Width = 756
    9   PPI = 150
     5  Height = 529
     6  HorizontalOffset = 669
     7  VerticalOffset = 607
     8  Width = 726
     9  PPI = 144
    1010  object ImageList1: TImageList
    11     Left = 120
    12     Top = 208
     11    Left = 115
     12    Top = 200
    1313    Bitmap = {
    1414      4C7A1300000010000000100000008B1500000000000078DADD9B075854C7DAC7
    … …  
    190190  object ActionList1: TActionList
    191191    Images = ImageList1
    192     Left = 400
    193     Top = 208
     192    Left = 384
     193    Top = 200
    194194    object AExit: TAction
    195195      Caption = 'Exit'
    … …  
    293293      OnExecute = AFileCompareExecute
    294294    end
     295    object ARemoveExactDuplicates: TAction
     296      Caption = 'Remove exact duplicates'
     297      OnExecute = ARemoveExactDuplicatesExecute
     298    end
    295299  end
    296300  object LastOpenedList1: TLastOpenedList
    297301    MaxCount = 10
    298302    OnChange = LastOpenedList1Change
    299     Left = 400
    300     Top = 300
     303    Left = 384
     304    Top = 288
    301305  end
    302306  object OpenDialog1: TOpenDialog
    303307    Title = 'Open existing file'
    304     Left = 400
    305     Top = 380
     308    Left = 384
     309    Top = 365
    306310  end
    307311  object SaveDialog1: TSaveDialog
    308312    Title = 'Save file as'
    309     Left = 120
    310     Top = 380
     313    Left = 115
     314    Top = 365
    311315  end
    312316  object ApplicationInfo1: TApplicationInfo
    … …  
    321325    AppName = 'vCard Studio'
    322326    Description = 'vCard files management tool'
    323     ReleaseDate = 44636
     327    ReleaseDate = 44687
    324328    RegistryKey = '\Software\Chronosoft\vCard Studio'
    325329    RegistryRoot = rrKeyCurrentUser
    … …  
    85218525      0000000000000000000000000000000000000000000000000000
    85228526    }
    8523     Left = 120
    8524     Top = 300
     8527    Left = 115
     8528    Top = 288
    85258529  end
    85268530  object PersistentForm1: TPersistentForm
    85278531    MinVisiblePart = 50
    85288532    EntireVisible = False
    8529     Left = 400
    8530     Top = 130
     8533    Left = 384
     8534    Top = 125
    85318535  end
    85328536  object Translator: TTranslator
    85338537    POFilesFolder = 'Languages'
    8534     Left = 120
    8535     Top = 50
     8538    OnTranslate = TranslatorTranslate
     8539    Left = 115
     8540    Top = 48
    85368541  end
    85378542  object ScaleDPI1: TScaleDPI
    85388543    AutoDetect = False
    8539     Left = 400
    8540     Top = 50
     8544    Left = 384
     8545    Top = 48
    85418546  end
    85428547  object ThemeManager1: TThemeManager
    8543     Left = 120
    8544     Top = 130
     8548    Left = 115
     8549    Top = 125
    85458550  end
    85468551  object AboutDialog1: TAboutDialog
    … …  
    85488553    ThemeManager = ThemeManager1
    85498554    ApplicationInfo = ApplicationInfo1
    8550     Left = 600
    8551     Top = 50
     8555    Left = 576
     8556    Top = 48
    85528557  end
    85538558  object SelectDirectoryDialog1: TSelectDirectoryDialog
    85548559    Title = 'Select directory'
    8555     Left = 602
    8556     Top = 392
     8560    Left = 578
     8561    Top = 376
    85578562  end
    85588563end

  • trunk/UCore.lrj

    r120 r126  
    1818{"hash":131740677,"name":"tcore.aviewsource.caption","sourcebytes":[86,105,101,119,32,115,111,117,114,99,101],"value":"View source"},
    1919{"hash":109897550,"name":"tcore.afilecompare.caption","sourcebytes":[67,111,109,112,97,114,101,46,46,46],"value":"Compare..."},
     20{"hash":78724163,"name":"tcore.aremoveexactduplicates.caption","sourcebytes":[82,101,109,111,118,101,32,101,120,97,99,116,32,100,117,112,108,105,99,97,116,101,115],"value":"Remove exact duplicates"},
    2021{"hash":218146437,"name":"tcore.opendialog1.title","sourcebytes":[79,112,101,110,32,101,120,105,115,116,105,110,103,32,102,105,108,101],"value":"Open existing file"},
    2122{"hash":159035875,"name":"tcore.savedialog1.title","sourcebytes":[83,97,118,101,32,102,105,108,101,32,97,115],"value":"Save file as"},

  • trunk/UCore.pas

    r123 r126  
    1717    AAbout: TAction;
    1818    AboutDialog1: TAboutDialog;
     19    ARemoveExactDuplicates: TAction;
    1920    AFileCompare: TAction;
    2021    AViewSource: TAction;
    … …  
    6061    procedure AGenerateExecute(Sender: TObject);
    6162    procedure AHomePageExecute(Sender: TObject);
     63    procedure ARemoveExactDuplicatesExecute(Sender: TObject);
    6264    procedure ASettingsExecute(Sender: TObject);
    6365    procedure ATestExecute(Sender: TObject);
    … …  
    6668    procedure DataModuleDestroy(Sender: TObject);
    6769    procedure LastOpenedList1Change(Sender: TObject);
     70    procedure TranslatorTranslate(Sender: TObject);
    6871  private
    6972    InitializeStarted: Boolean;
    … …  
    113116
    114117uses
    115   UFormMain, UFormSettings, UContact, UFormContacts, UFormFindDuplicity,
    116   UFormGenerate, UFormError, UFormFind, UFormTest, UFormSource, UFormCompare;
     118  UFormMain, UFormSettings, UContact, UFormContacts, UFormFindDuplicity, UTest,
     119  UFormGenerate, UFormError, UFormFind, UFormTest, UFormSource, UFormCompare,
     120  UTestCases;
    117121
    118122resourcestring
    … …  
    294298end;
    295299
     300procedure TCore.ARemoveExactDuplicatesExecute(Sender: TObject);
     301begin
     302  TContactsFile(DataFile).Contacts.RemoveExactDuplicates;
     303  UpdateFile;
     304end;
     305
    296306procedure TCore.ASettingsExecute(Sender: TObject);
    297307begin
    … …  
    313323  with TFormTest.Create(nil) do
    314324  try
    315     ShowModal;
     325    TestCases := InitTestCases;
     326    try
     327      ShowModal;
     328    finally
     329      TestCases.Free;
     330    end;
    316331  finally
    317332    Free;
    … …  
    428443  LastOpenedList1.LoadToMenuItem(FormMain.MenuItemFileOpenRecent, AFileOpenRecentExecute);
    429444  LastOpenedList1.LoadToMenuItem(FormMain.PopupMenuOpenRecent.Items, AFileOpenRecentExecute);
     445end;
     446
     447procedure TCore.TranslatorTranslate(Sender: TObject);
     448begin
     449  UTest.Translate;
    430450end;
    431451

  • trunk/UTest.pas

    r94 r126  
    3232  end;
    3333
     34  TTestCaseActionKind = (akNone, akRemoveExactDuplicates);
     35
    3436  { TTestCaseLoadSave }
    3537
    … …  
    3739    Input: string;
    3840    Output: string;
     41    Action: TTestCaseActionKind;
    3942    procedure Run; override;
    4043  end;
    … …  
    5053  end;
    5154
     55resourcestring
     56  SNone = 'None';
     57  SPassed = 'Passed';
     58  SFailed = 'Failed';
     59
    5260const
    53   ResultText: array[TTestResult] of string = ('None', 'Passed', 'Failed');
     61  ResultText: array[TTestResult] of string = (SNone, SPassed, SFailed);
     62
     63procedure Translate;
    5464
    5565
    5666implementation
     67
     68resourcestring
     69  SExpected = 'Expected:';
     70  SOutput = 'Output:';
     71
     72procedure Translate;
     73begin
     74 ResultText[trNone] := SNone;
     75 ResultText[trPassed] := SPassed;
     76 ResultText[trFailed] := SFailed;
     77end;
    5778
    5879{ TTestCaseCheckProperty }
    … …  
    7394        Evaluate(PropertyValue = Value);
    7495      end else Fail;
    75       Log := 'Expected:' + LineEnding +
     96      Log := SExpected + LineEnding +
    7697        '"' + Value + '"' + LineEnding + LineEnding +
    77         'Output:' + LineEnding +
     98        SOutput + LineEnding +
    7899        '"' + PropertyValue + '"';
    79100    finally
    … …  
    97118      Lines.Text := Input;
    98119      LoadFromStrings(Lines);
     120
     121      if Action = akRemoveExactDuplicates then
     122        Contacts.RemoveExactDuplicates;
     123
    99124      Lines.Text := '';
    100125      SaveToStrings(Lines);
    101126      Evaluate(Lines.Text = Output);
    102       Log := 'Expected:' + LineEnding +
     127      Log := SExpected + LineEnding +
    103128        '"' + Output + '"' + LineEnding + LineEnding +
    104         'Output:' + LineEnding +
     129        SOutput + LineEnding +
    105130        '"' + Lines.Text + '"';
    106131    finally

  • trunk/vCardStudio.lpi

    r123 r126  
    119119      </Item6>
    120120    </RequiredPackages>
    121     <Units Count="25">
     121    <Units Count="26">
    122122      <Unit0>
    123123        <Filename Value="vCardStudio.lpr"/>
    … …  
    271271        <IsPartOfProject Value="True"/>
    272272      </Unit24>
     273      <Unit25>
     274        <Filename Value="UTestCases.pas"/>
     275        <IsPartOfProject Value="True"/>
     276      </Unit25>
    273277    </Units>
    274278  </ProjectOptions>

  • trunk/vCardStudio.lpr

    r120 r126  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UCore, Diff, Common, SysUtils, UFormCompare;
     10  Forms, UFormMain, UCore, Diff, Common, SysUtils, UFormCompare, UTestCases;
    1111
    1212{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.