Changeset 115 for trunk/UContact.pas


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.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.