Changeset 115


Ignore:
Timestamp:
Feb 15, 2022, 3:46:22 PM (2 years ago)
Author:
chronos
Message:
  • Added: New tool action View source to show source code for loaded contacts. Source text can be edited and saved back. The editor shows line numbers and use color highlighting.
Location:
trunk
Files:
4 added
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r108 r115  
    184184        Action = Core.ATest
    185185      end
     186      object MenuItem11: TMenuItem
     187        Action = Core.AViewSource
     188      end
    186189    end
    187190    object MenuItemHelp: TMenuItem

  • trunk/Forms/UFormMain.pas

    r107 r115  
    1818    MenuItem1: TMenuItem;
    1919    MenuItem10: TMenuItem;
     20    MenuItem11: TMenuItem;
    2021    MenuItem3: TMenuItem;
    2122    MenuItem4: TMenuItem;

  • trunk/Languages/vCardStudio.cs.po

    r113 r115  
    4242
    4343#: tcore.afilesave.caption
     44msgctxt "tcore.afilesave.caption"
    4445msgid "Save"
    4546msgstr "Uložit"
    … …  
    8586msgstr "Testování"
    8687
     88#: tcore.aviewsource.caption
     89msgid "View source"
     90msgstr "Zobrazit zdroj"
     91
    8792#: tcore.opendialog1.title
    8893msgctxt "tcore.opendialog1.title"
    … …  
    566571
    567572#: tformcontacts.acopy.caption
     573msgctxt "tformcontacts.acopy.caption"
    568574msgid "Copy"
    569575msgstr "Kopírovat"
    570576
    571577#: tformcontacts.acut.caption
     578msgctxt "tformcontacts.acut.caption"
    572579msgid "Cut"
    573580msgstr "Vyříznout"
    … …  
    584591
    585592#: tformcontacts.apaste.caption
     593msgctxt "tformcontacts.apaste.caption"
    586594msgid "Paste"
    587595msgstr "Vložit"
    … …  
    949957msgid "DPI:"
    950958msgstr "DPI:"
     959
     960#: tformsource.acopy.caption
     961msgctxt "tformsource.acopy.caption"
     962msgid "Copy"
     963msgstr "Kopírovat"
     964
     965#: tformsource.acut.caption
     966msgctxt "tformsource.acut.caption"
     967msgid "Cut"
     968msgstr "Vyříznout"
     969
     970#: tformsource.apaste.caption
     971msgctxt "tformsource.apaste.caption"
     972msgid "Paste"
     973msgstr "Vložit"
     974
     975#: tformsource.aselectall.caption
     976msgctxt "tformsource.aselectall.caption"
     977msgid "Select all"
     978msgstr "Vybrat vše"
     979
     980#: tformsource.buttoncancel.caption
     981msgctxt "tformsource.buttoncancel.caption"
     982msgid "Cancel"
     983msgstr "Zrušit"
     984
     985#: tformsource.buttonok.caption
     986msgctxt "tformsource.buttonok.caption"
     987msgid "Save"
     988msgstr "Uložit"
     989
     990#: tformsource.caption
     991msgid "Source"
     992msgstr "Zdroj"
    951993
    952994#: tformtest.arun.caption
    … …  
    14781520msgid "Decode error"
    14791521msgstr "Chyba dekódování"
    1480 

  • trunk/Languages/vCardStudio.pot

    r110 r115  
    3232
    3333#: tcore.afilesave.caption
     34msgctxt "tcore.afilesave.caption"
    3435msgid "Save"
    3536msgstr ""
    … …  
    7576msgstr ""
    7677
     78#: tcore.aviewsource.caption
     79msgid "View source"
     80msgstr ""
     81
    7782#: tcore.opendialog1.title
    7883msgctxt "tcore.opendialog1.title"
    … …  
    556561
    557562#: tformcontacts.acopy.caption
     563msgctxt "tformcontacts.acopy.caption"
    558564msgid "Copy"
    559565msgstr ""
    560566
    561567#: tformcontacts.acut.caption
     568msgctxt "tformcontacts.acut.caption"
    562569msgid "Cut"
    563570msgstr ""
    … …  
    573580
    574581#: tformcontacts.apaste.caption
     582msgctxt "tformcontacts.apaste.caption"
    575583msgid "Paste"
    576584msgstr ""
    … …  
    924932msgstr ""
    925933
     934#: tformsource.acopy.caption
     935msgctxt "tformsource.acopy.caption"
     936msgid "Copy"
     937msgstr ""
     938
     939#: tformsource.acut.caption
     940msgctxt "tformsource.acut.caption"
     941msgid "Cut"
     942msgstr ""
     943
     944#: tformsource.apaste.caption
     945msgctxt "tformsource.apaste.caption"
     946msgid "Paste"
     947msgstr ""
     948
     949#: tformsource.aselectall.caption
     950msgctxt "tformsource.aselectall.caption"
     951msgid "Select all"
     952msgstr ""
     953
     954#: tformsource.buttoncancel.caption
     955msgctxt "tformsource.buttoncancel.caption"
     956msgid "Cancel"
     957msgstr ""
     958
     959#: tformsource.buttonok.caption
     960msgctxt "tformsource.buttonok.caption"
     961msgid "Save"
     962msgstr ""
     963
     964#: tformsource.caption
     965msgid "Source"
     966msgstr ""
     967
    926968#: tformtest.arun.caption
    927969msgctxt "tformtest.arun.caption"

  • trunk/Packages/Common/UTheme.pas

    r69 r115  
    4141    property Theme: TTheme read FTheme write SetTheme;
    4242  end;
     43
     44const
     45  ThemeNameSystem = 'System';
     46  ThemeNameLight = 'Light';
     47  ThemeNameDark = 'Dark';
    4348
    4449procedure Register;
    … …  
    105110  inherited;
    106111  Themes := TThemes.Create;
    107   with Themes.AddNew('System') do begin
     112  with Themes.AddNew(ThemeNameSystem) do begin
    108113    ColorWindow := clWindow;
    109114    ColorWindowText := clWindowText;
    … …  
    113118  end;
    114119  Theme := TTheme(Themes.First);
    115   with Themes.AddNew('Dark') do begin
     120  with Themes.AddNew(ThemeNameDark) do begin
    116121    ColorWindow := RGBToColor($20, $20, $20);
    117122    ColorWindowText := clWhite;
    … …  
    120125    ColorControlSelected := RGBToColor(96, 125, 155);
    121126  end;
    122   with Themes.AddNew('Light') do begin
     127  with Themes.AddNew(ThemeNameLight) do begin
    123128    ColorWindow := clWhite;
    124129    ColorWindowText := clBlack;
    … …  
    175180procedure TThemeManager.UseTheme(Form: TForm);
    176181begin
    177   if not Used and (FTheme.Name = 'System') then Exit;
     182  if not Used and (FTheme.Name = ThemeNameSystem) then Exit;
    178183  ApplyTheme(Form);
    179184  Used := True;

  • trunk/UContact.pas

    r112 r115  
    158158    FOnModify: TNotifyEvent;
    159159    class var FFields: TContactFields;
     160    procedure DoOnModify;
     161    procedure DetectMaxLineLength(Text: string);
    160162    function GetField(Index: TContactFieldIndex): string;
     163    function GetString: string;
    161164    procedure SetField(Index: TContactFieldIndex; AValue: string);
    162165    procedure SetModified(AValue: Boolean);
    163     procedure DoOnModify;
    164     procedure DetectMaxLineLength(Text: string);
     166    procedure SetString(AValue: string);
    165167  public
    166168    Properties: TContactProperties;
    … …  
    182184    property Fields[Index: TContactFieldIndex]: string read GetField write SetField;
    183185    property Modified: Boolean read FModified write SetModified;
     186    property AsString: string read GetString write SetString;
     187  published
    184188    property OnModify: TNotifyEvent read FOnModify write FOnModify;
    185189  end;
    … …  
    209213    FOnError: TErrorEvent;
    210214    procedure Error(Text: string; Line: Integer);
     215    function GetString: string;
    211216    function NewItem(Key, Value: string): string;
     217    procedure SetString(AValue: string);
    212218  public
    213219    Contacts: TContacts;
    … …  
    221227    constructor Create; override;
    222228    destructor Destroy; override;
     229    property AsString: string read GetString write SetString;
    223230  published
    224231    property OnError: TErrorEvent read FOnError write FOnError;
    … …  
    13581365end;
    13591366
     1367function TContact.GetString: string;
     1368var
     1369  Lines: TStringList;
     1370begin
     1371  Lines := TStringList.Create;
     1372  try
     1373    SaveToStrings(Lines);
     1374    Result := Lines.Text;
     1375  finally
     1376    Lines.Free;
     1377  end;
     1378end;
     1379
    13601380procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
    13611381var
    … …  
    14191439end;
    14201440
     1441procedure TContact.SetString(AValue: string);
     1442var
     1443  Lines: TStringList;
     1444  StartLine: Integer;
     1445begin
     1446  Lines := TStringList.Create;
     1447  try
     1448    Lines.Text := AValue;
     1449    StartLine := 0;
     1450    LoadFromStrings(Lines, StartLine);
     1451  finally
     1452    Lines.Free;
     1453  end;
     1454end;
     1455
    14211456function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
    14221457var
    … …  
    15151550  CutLength: Integer;
    15161551begin
    1517     with Output do begin
    1518       Add(VCardBegin);
    1519       for I := 0 to Properties.Count - 1 do
    1520       with Properties[I] do begin
    1521         NameText := Name;
    1522         if Attributes.Count > 0 then
    1523           NameText := NameText + ';' + Attributes.DelimitedText;
    1524         if Encoding <> '' then begin
    1525           Value2 := GetEncodedValue;
    1526           NameText := NameText + ';ENCODING=' + Encoding;
    1527         end else Value2 := Value;
    1528         if Pos(LineEnding, Value2) > 0 then begin
    1529           Add(NameText + ':' + GetNext(Value2, LineEnding));
    1530           while Pos(LineEnding, Value2) > 0 do begin
    1531             Add(' ' + GetNext(Value2, LineEnding));
    1532           end;
     1552  with Output do begin
     1553    Add(VCardBegin);
     1554    for I := 0 to Properties.Count - 1 do
     1555    with Properties[I] do begin
     1556      NameText := Name;
     1557      if Attributes.Count > 0 then
     1558        NameText := NameText + ';' + Attributes.DelimitedText;
     1559      if Encoding <> '' then begin
     1560        Value2 := GetEncodedValue;
     1561        NameText := NameText + ';ENCODING=' + Encoding;
     1562      end else Value2 := Value;
     1563      if Pos(LineEnding, Value2) > 0 then begin
     1564        Add(NameText + ':' + GetNext(Value2, LineEnding));
     1565        while Pos(LineEnding, Value2) > 0 do begin
    15331566          Add(' ' + GetNext(Value2, LineEnding));
    1534           Add('');
    1535         end else begin
    1536           OutText := NameText + ':' + Value2;
    1537           LineIndex := 0;
    1538           LinePrefix := '';
    1539           while True do begin
    1540             if UTF8Length(OutText) > ContactsFile.MaxLineLength then begin
    1541               CutLength := ContactsFile.MaxLineLength;
    1542               if Encoding = VCardQuotedPrintable then begin
    1543                 Dec(CutLength); // There will be softline break at the end
    1544                 // Do not cut encoded items at the end of line
    1545                 if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = QuotedPrintableEscapeCharacter) then
    1546                   Dec(CutLength, 2)
    1547                 else if OutText[CutLength] = QuotedPrintableEscapeCharacter then
    1548                   Dec(CutLength, 1);
    1549               end;
    1550 
    1551               CutText := UTF8Copy(OutText, 1, CutLength);
    1552               System.Delete(OutText, 1, Length(CutText));
    1553               if Encoding = VCardQuotedPrintable then
    1554                 CutText := CutText + QuotedPrintableEscapeCharacter; // Add soft line break
    1555               Add(LinePrefix + CutText);
    1556               if Encoding <> VCardQuotedPrintable then
    1557                 LinePrefix := ' ';
    1558               Inc(LineIndex);
    1559               Continue;
    1560             end else begin
    1561               Add(LinePrefix + OutText);
    1562               Break;
     1567        end;
     1568        Add(' ' + GetNext(Value2, LineEnding));
     1569        Add('');
     1570      end else begin
     1571        OutText := NameText + ':' + Value2;
     1572        LineIndex := 0;
     1573        LinePrefix := '';
     1574        while True do begin
     1575          if UTF8Length(OutText) > ContactsFile.MaxLineLength then begin
     1576            CutLength := ContactsFile.MaxLineLength;
     1577            if Encoding = VCardQuotedPrintable then begin
     1578              Dec(CutLength); // There will be softline break at the end
     1579              // Do not cut encoded items at the end of line
     1580              if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = QuotedPrintableEscapeCharacter) then
     1581                Dec(CutLength, 2)
     1582              else if OutText[CutLength] = QuotedPrintableEscapeCharacter then
     1583                Dec(CutLength, 1);
    15631584            end;
     1585
     1586            CutText := UTF8Copy(OutText, 1, CutLength);
     1587            System.Delete(OutText, 1, Length(CutText));
     1588            if Encoding = VCardQuotedPrintable then
     1589              CutText := CutText + QuotedPrintableEscapeCharacter; // Add soft line break
     1590            Add(LinePrefix + CutText);
     1591            if Encoding <> VCardQuotedPrintable then
     1592              LinePrefix := ' ';
     1593            Inc(LineIndex);
     1594            Continue;
     1595          end else begin
     1596            Add(LinePrefix + OutText);
     1597            Break;
    15641598          end;
    15651599        end;
    15661600      end;
    1567       Add(VCardEnd);
    1568     end;
     1601    end;
     1602    Add(VCardEnd);
     1603  end;
    15691604end;
    15701605
    … …  
    16951730end;
    16961731
     1732function TContactsFile.GetString: string;
     1733var
     1734  I: Integer;
     1735begin
     1736  Result := '';
     1737  for I := 0 to Contacts.Count - 1 do
     1738    Result := Result + Contacts[I].AsString;
     1739end;
     1740
    16971741function TContactsFile.GetFileName: string;
    16981742begin
    … …  
    17481792end;
    17491793
     1794procedure TContactsFile.SetString(AValue: string);
     1795var
     1796  Lines: TStringList;
     1797begin
     1798  Lines := TStringList.Create;
     1799  try
     1800    Lines.Text := AValue;
     1801    LoadFromStrings(Lines);
     1802    Modified := True;
     1803  finally
     1804    Lines.Free;
     1805  end;
     1806end;
     1807
    17501808procedure TContactsFile.SaveToFile(FileName: string);
    17511809var

  • trunk/UCore.lfm

    r113 r115  
    33  OnDestroy = DataModuleDestroy
    44  OldCreateOrder = False
    5   Height = 529
    6   HorizontalOffset = 669
    7   VerticalOffset = 607
    8   Width = 726
    9   PPI = 144
     5  Height = 551
     6  HorizontalOffset = 697
     7  VerticalOffset = 632
     8  Width = 756
     9  PPI = 150
    1010  object ImageList1: TImageList
    11     Left = 115
    12     Top = 200
     11    Left = 120
     12    Top = 208
    1313    Bitmap = {
    1414      4C7A120000001000000010000000801200000000000078DADD9A095855D5DAC7
    … …  
    165165  object ActionList1: TActionList
    166166    Images = ImageList1
    167     Left = 384
    168     Top = 200
     167    Left = 400
     168    Top = 208
    169169    object AExit: TAction
    170170      Caption = 'Exit'
    … …  
    224224      ImageIndex = 8
    225225      OnExecute = ASettingsExecute
     226      ShortCut = 121
    226227    end
    227228    object AFileCombine: TAction
    … …  
    238239      Caption = 'Generate contacts'
    239240      OnExecute = AGenerateExecute
     241      ShortCut = 116
    240242    end
    241243    object AFileSplit: TAction
    … …  
    253255      Caption = 'Test'
    254256      OnExecute = ATestExecute
     257      ShortCut = 115
     258    end
     259    object AViewSource: TAction
     260      Caption = 'View source'
     261      OnExecute = AViewSourceExecute
     262      ShortCut = 114
    255263    end
    256264  end
    … …  
    258266    MaxCount = 10
    259267    OnChange = LastOpenedList1Change
    260     Left = 384
    261     Top = 288
     268    Left = 400
     269    Top = 300
    262270  end
    263271  object OpenDialog1: TOpenDialog
    264272    Title = 'Open existing file'
    265     Left = 384
    266     Top = 365
     273    Left = 400
     274    Top = 380
    267275  end
    268276  object SaveDialog1: TSaveDialog
    269277    Title = 'Save file as'
    270     Left = 115
    271     Top = 365
     278    Left = 120
     279    Top = 380
    272280  end
    273281  object ApplicationInfo1: TApplicationInfo
    … …  
    84828490      0000000000000000000000000000000000000000000000000000
    84838491    }
    8484     Left = 115
    8485     Top = 288
     8492    Left = 120
     8493    Top = 300
    84868494  end
    84878495  object PersistentForm1: TPersistentForm
    84888496    MinVisiblePart = 50
    84898497    EntireVisible = False
    8490     Left = 384
    8491     Top = 125
     8498    Left = 400
     8499    Top = 130
    84928500  end
    84938501  object Translator: TTranslator
    84948502    POFilesFolder = 'Languages'
    8495     Left = 115
    8496     Top = 48
     8503    Left = 120
     8504    Top = 50
    84978505  end
    84988506  object ScaleDPI1: TScaleDPI
    84998507    AutoDetect = False
    8500     Left = 384
    8501     Top = 48
     8508    Left = 400
     8509    Top = 50
    85028510  end
    85038511  object ThemeManager1: TThemeManager
    8504     Left = 115
    8505     Top = 125
     8512    Left = 120
     8513    Top = 130
    85068514  end
    85078515  object AboutDialog1: TAboutDialog
    … …  
    85098517    ThemeManager = ThemeManager1
    85108518    ApplicationInfo = ApplicationInfo1
    8511     Left = 576
    8512     Top = 48
     8519    Left = 600
     8520    Top = 50
    85138521  end
    85148522  object SelectDirectoryDialog1: TSelectDirectoryDialog
    85158523    Title = 'Select directory'
    8516     Left = 578
    8517     Top = 376
     8524    Left = 602
     8525    Top = 392
    85188526  end
    85198527end

  • trunk/UCore.lrj

    r113 r115  
    1616{"hash":218394958,"name":"tcore.afind.caption","sourcebytes":[70,105,110,100,46,46,46],"value":"Find..."},
    1717{"hash":371876,"name":"tcore.atest.caption","sourcebytes":[84,101,115,116],"value":"Test"},
     18{"hash":131740677,"name":"tcore.aviewsource.caption","sourcebytes":[86,105,101,119,32,115,111,117,114,99,101],"value":"View source"},
    1819{"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"},
    1920{"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

    r103 r115  
    1717    AAbout: TAction;
    1818    AboutDialog1: TAboutDialog;
     19    AViewSource: TAction;
    1920    ATest: TAction;
    2021    AFind: TAction;
    … …  
    5960    procedure ASettingsExecute(Sender: TObject);
    6061    procedure ATestExecute(Sender: TObject);
     62    procedure AViewSourceExecute(Sender: TObject);
    6163    procedure DataModuleCreate(Sender: TObject);
    6264    procedure DataModuleDestroy(Sender: TObject);
    … …  
    106108uses
    107109  UFormMain, UFormSettings, UContact, UFormContacts, UFormFindDuplicity,
    108   UFormGenerate, UFormError, UFormFind, UFormTest;
     110  UFormGenerate, UFormError, UFormFind, UFormTest, UFormSource;
    109111
    110112resourcestring
    … …  
    274276  try
    275277    ShowModal;
     278  finally
     279    Free;
     280  end;
     281end;
     282
     283procedure TCore.AViewSourceExecute(Sender: TObject);
     284begin
     285  with TFormSource.Create(nil) do
     286  try
     287    Source := TContactsFile(DataFile).AsString;
     288    if ShowModal = mrOk then begin
     289      TContactsFile(DataFile).AsString := Source;
     290      UpdateFile;
     291    end;
    276292  finally
    277293    Free;

  • trunk/vCardStudio.lpi

    r112 r115  
    9595      </Modes>
    9696    </RunParams>
    97     <RequiredPackages Count="2">
     97    <RequiredPackages Count="3">
    9898      <Item1>
     99        <PackageName Value="SynEdit"/>
     100      </Item1>
     101      <Item2>
    99102        <PackageName Value="Common"/>
    100103        <DefaultFilename Value="Packages\Common\Common.lpk" Prefer="True"/>
    101       </Item1>
    102       <Item2>
     104      </Item2>
     105      <Item3>
    103106        <PackageName Value="LCL"/>
    104       </Item2>
     107      </Item3>
    105108    </RequiredPackages>
    106     <Units Count="21">
     109    <Units Count="23">
    107110      <Unit0>
    108111        <Filename Value="vCardStudio.lpr"/>
    … …  
    234237        <ResourceBaseClass Value="Form"/>
    235238      </Unit20>
     239      <Unit21>
     240        <Filename Value="Forms\UFormSource.pas"/>
     241        <IsPartOfProject Value="True"/>
     242        <ComponentName Value="FormSource"/>
     243        <HasResources Value="True"/>
     244        <ResourceBaseClass Value="Form"/>
     245      </Unit21>
     246      <Unit22>
     247        <Filename Value="UVCardHighlighter.pas"/>
     248        <IsPartOfProject Value="True"/>
     249      </Unit22>
    236250    </Units>
    237251  </ProjectOptions>

  • trunk/vCardStudio.lpr

    r110 r115  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UCore, Common, SysUtils, UFormImage, UContactImage,
    11 UFormNameDetails;
     10  Forms, UFormMain, UCore, Common, SysUtils;
    1211
    1312{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.