Changeset 59

Timestamp:

Dec 8, 2021, 11:33:52 PM (3 years ago)

Author:

chronos

Message:

• Added: Support for GIF images for contact photo.
• Fixed: Saving multi-line values.
• Fixed: Escaping combined values with backslash symbol.

Location:

trunk

Files:

• Forms/UFormContact.pas (modified) (4 diffs)
• Languages/vCardStudio.cs.po (modified) (2 diffs)
• Languages/vCardStudio.po (modified) (1 diff)
• UContact.pas (modified) (13 diffs)

trunk/Forms/UFormContact.pas

@@ -288 +288 @@
   Stream: TMemoryStream;
   JpegImage: TJpegImage;
+  GifImage: TGIFImage;
   PngImage: TPortableNetworkGraphic;
 begin
@@ -344 +345 @@
           PngImage.Free;
         end;
+      end else
+      if PhotoProperty.Attributes.IndexOf('GIF') <> -1 then begin
+        GifImage := TGIFImage.Create;
+        try
+          try
+            GifImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height);
+            GifImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap);
+            GifImage.SaveToStream(Stream);
+          except
+          end;
+        finally
+          GifImage.Free;
+        end;
       end else begin
         try
@@ -372 +386 @@
   JpegImage: TJpegImage;
   PngImage: TPortableNetworkGraphic;
+  GifImage: TGIFImage;
   Stream: TMemoryStream;
   PhotoProperty: TContactProperty;
@@ -436 +451 @@
             PngImage.Free;
           end;
+        end else
+        if PhotoProperty.Attributes.IndexOf('GIF') <> -1 then begin
+          GifImage := TGIFImage.Create;
+          try
+            try
+              GifImage.LoadFromStream(Stream);
+              with ImagePhoto.Picture.Bitmap do begin
+                PixelFormat := pf24bit;
+                SetSize(GifImage.Width, GifImage.Height);
+                Canvas.Draw(0, 0, GifImage);
+              end;
+              ProfilePhotoActive := True;
+            except
+              ProfilePhotoActive := False;
+            end;
+          finally
+            GifImage.Free;
+          end;
         end else begin
           try

trunk/Languages/vCardStudio.cs.po

@@ -758 +758 @@
 msgstr "Křestní jméno"
 
-#: ucontact.sfoundblockendwithoutblockstart
-msgid "Found block end without block start"
-msgstr "Nalezen konec bloku bez začátku bloku"
-
-#: ucontact.sfoundpropertiesbeforeblockstart
-msgid "Found properties before the start of block"
-msgstr "Nalezena vlastnost před začátkem bloku"
-
 #: ucontact.sfullname
 msgctxt "ucontact.sfullname"
@@ -1136 +1128 @@
 msgid "Invalid line length for encoded text"
 msgstr "Neplatná délka řádky kódovaného textu"
+

trunk/Languages/vCardStudio.po

@@ -746 +746 @@
 msgstr ""
 
-#: ucontact.sfoundblockendwithoutblockstart
-msgid "Found block end without block start"
-msgstr ""
-
-#: ucontact.sfoundpropertiesbeforeblockstart
-msgid "Found properties before the start of block"
-msgstr ""
-
 #: ucontact.sfullname
 msgctxt "ucontact.sfullname"

trunk/UContact.pas

@@ -169 +169 @@
 resourcestring
   SVCardFile = 'vCard file';
-  SFoundPropertiesBeforeBlockStart = 'Found properties before the start of block';
-  SFoundBlockEndWithoutBlockStart = 'Found block end without block start';
   SExpectedVCardBegin = 'Expected vCard begin';
   SFieldIndexNotDefined = 'Field index not defined';
@@ -279 +277 @@
 end;
 
+function EndsWith(Text, What: string): Boolean;
+begin
+  Result := Copy(Text, Length(Text) - Length(What) + 1, MaxInt) = What;
+  if Result then begin
+    Result := Result;
+  end;
+end;
+
+function EncodeEscaped(Text: string): string;
+var
+  I: Integer;
+begin
+  Result := '';
+  I := 1;
+  while I <= Length(Text) do begin
+    if Text[I] in [',', '\', ';'] then Result := Result + '\' + Text[I]
+      else Result := Result + Text[I];
+    Inc(I);
+  end;
+end;
+
+function DecodeEscaped(Text: string): string;
+var
+  I: Integer;
+  Escaped: Boolean;
+begin
+  Result := '';
+  I := 1;
+  Escaped := False;
+  while I <= Length(Text) do begin
+    if Escaped then begin
+      Result := Result + Text[I];
+      Escaped := False;
+    end else begin
+      if Text[I] = '\' then begin
+        Escaped := True;
+      end else Result := Result + Text[I];
+    end;
+    Inc(I);
+  end;
+end;
+
 { TContactField }
 
@@ -342 +382 @@
 begin
   I := 0;
-  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
+  while (I < Count) and (Items[I].Name <> Name) and (not EndsWith(Items[I].Name, '.' + Name)) do Inc(I);
   if I < Count then Result := Items[I]
     else Result := nil;
@@ -473 +513 @@
   I: Integer;
 begin
-  Result := Name = AName;
+  Result := (Name = AName) or EndsWith(Name, '.' + AName);
   if Result and (Length(Groups) > 0) then begin
     for I := 0 to Length(Groups) - 1 do
@@ -639 +679 @@
       Field := Parent.Fields.GetByIndex(Index);
       if Field.ValueIndex <> -1 then begin
-        Result := Prop.ValueItem[Field.ValueIndex]
+        Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
       end else Result := Prop.Value;
     end else Result := '';
@@ -664 +704 @@
     if Assigned(Prop) then begin
       if Field.ValueIndex <> -1 then begin
-        Prop.ValueItem[Field.ValueIndex] := AValue;
+        Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
       end else Prop.Value := AValue;
 
@@ -747 +787 @@
   OutText: string;
   LinePrefix: string;
+  CutLength: Integer;
 const
   MaxLineLength = 73;
@@ -774 +815 @@
           while True do begin
             if Length(OutText) > MaxLineLength then begin
-              if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
-              Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
-              System.Delete(OutText, 1, MaxLineLength);
+              CutLength := MaxLineLength;
+              if Encoding = 'QUOTED-PRINTABLE' then begin
+                // Do not cut encoded items
+                if ((CutLength - 2) >= 1) and (OutText[CutLength - 2] = '=') then
+                  Dec(CutLength, 2)
+                else if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = '=') then
+                  Dec(CutLength, 1);
+              end;
+              Add(LinePrefix + Copy(OutText, 1, CutLength));
+              LinePrefix := ' ';
+              System.Delete(OutText, 1, CutLength);
               Inc(LineIndex);
               Continue;
@@ -852 +901 @@
           NewProperty.Attributes.Delete(0);
         end;
-        NewProperty.Value := Value;
+        NewProperty.Value := DecodeEscaped(Value);
         NewProperty.EvaluateAttributes;
       end else begin
@@ -881 +930 @@
 var
   Lines: TStringList;
-  I: Integer;
 begin
   Lines := TStringList.Create;
@@ -892 +940 @@
       end;
     end;
-    I := LoadFromStrings(Lines);
+    LoadFromStrings(Lines);
   finally
     Lines.Free;
@@ -1053 +1101 @@
   Contact: TContact;
   I: Integer;
+  NewI: Integer;
 begin
   inherited;
@@ -1069 +1118 @@
       Contact := TContact.Create;
       Contact.Parent := Self;
-      I := Contact.LoadFromStrings(Lines, I);
-      if (I <= Lines.Count) and (I <> -1) then Contacts.Add(Contact)
-      else begin
+      NewI := Contact.LoadFromStrings(Lines, I);
+      if NewI <= Lines.Count then begin
+        if NewI <> -1 then begin
+          Contacts.Add(Contact);
+          I := NewI;
+        end else begin
+          FreeAndNil(Contact);
+          Inc(I);
+        end;
+      end else begin
         FreeAndNil(Contact);
         Break;