Changeset 126 for trunk/Forms


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/Forms
Files:
3 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
Note: See TracChangeset for help on using the changeset viewer.