fpspreadsheet: Add hyperlink to image. Supported by ODS writer, so far.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6671 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -7271,6 +7271,9 @@ var
   r1,c1,r2,c2: Cardinal;
   roffs1,coffs1, roffs2, coffs2: Double;
   x, y, w, h: Double;
+  xml: String;
+  target, bookmark: String;
+  u: TURI;
 begin
   if (ASheet as TsWorksheet).GetImageCount = 0 then
     exit;
@@ -7290,7 +7293,7 @@ begin
       roffs1, coffs1, roffs2, coffs2,  // mm
       x, y, w, h);                     // mm
 
-    AppendToStream(AStream, Format(
+    xml := Format(
       '<draw:frame draw:z-index="%d" draw:name="Image %d" '+
         'draw:style-name="gr1" draw:text-style-name="P1" '+
         'svg:width="%.2fmm" svg:height="%.2fmm" '+
@@ -7303,7 +7306,27 @@ begin
       w, h,
       x, y,
       img.Index+1, GetImageTypeExt(imgType)
-    ], FPointSeparatorSettings));
+    ], FPointSeparatorSettings);
+
+    if img.HyperlinkTarget <> '' then begin
+      SplitHyperlink(img.HyperlinkTarget, target, bookmark);
+      if (target <> '') and (pos('file:', target) = 0) then
+      begin
+        u := ParseURI(target);
+        if u.Protocol = '' then
+          target := '../' + target;
+      end;
+
+      // ods absolutely wants "/" path delimiters in the file uri!
+      FixHyperlinkPathdelims(target);
+
+      if (bookmark <> '') then
+        target := target + '#' + bookmark;
+
+      xml := Format('<draw:a xlink:type="simple" xlink:href="%s">%s</draw:a>', [target, xml]);
+    end;
+
+    AppendToStream(AStream, xml);
   end;
 
   AppendToStream(AStream,

components/fpspreadsheet/source/common/fpspreadsheet.pas

@@ -555,6 +555,8 @@ type
     function WriteImage(ARow, ACol: Cardinal; AImageIndex: Integer;
       AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; AScaleX: Double = 1.0;
       AScaleY: Double = 1.0): Integer; overload;
+    procedure AddHyperlinkToImage(AImageIndex: Integer; ATarget: String;
+      AToolTip: String = '');
 
     { Protection }
     procedure Protect(AEnable: Boolean);
@@ -4017,6 +4019,20 @@ begin
   Result := FImages.Add(img);
 end;
 
+{@@ Assigns a hyperlink to an image. The image is specified by its index in the
+  internal image list}
+procedure TsWorksheet.AddHyperlinkToImage(AImageIndex: Integer; ATarget: String;
+  AToolTip: String = '');
+var
+  img: PsImage;
+begin
+  img := GetPointerToImage(AImageIndex);
+  if Assigned(img) then begin
+    img^.HyperlinkTarget := ATarget;
+    img^.HyperlinkToolTip := AToolTip;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Removes an image from the internal image list.
   The image is identified by its index.
@@ -4027,7 +4043,11 @@ var
   img: PsImage;
 begin
   img := PsImage(FImages[AIndex]);
-  if (img <> nil) and (img^.Bitmap <> nil) then img^.Bitmap.Free;
+  if (img <> nil) then begin
+    if (img^.Bitmap <> nil) then img^.Bitmap.Free;
+    img^.HyperlinkTarget := '';
+    img^.HyperlinkToolTip := '';
+  end;
   Dispose(img);
   FImages.Delete(AIndex);
 end;

components/fpspreadsheet/source/common/fpstypes.pas

@@ -823,6 +823,8 @@ type
     OffsetX, OffsetY: Double; // mm, relative to anchor
     ScaleX, ScaleY: Double;   // scaling factor of image
     Bitmap: TObject;          // used for bitmap for display in grid
+    HyperlinkTarget: String;  // Hyperlink assigned to the image
+    HyperlinkToolTip: String; // Tooltip for hyperlink of the image
   end;
   PsImage = ^TsImage;
 

components/fpspreadsheet/source/common/fpsutils.pas

@@ -2495,6 +2495,8 @@ begin
   AValue.ScaleY := AScaleY;
   AValue.Bitmap := nil;     // to be initialized by viewing application
   AValue.Index := -1;
+  AValue.HyperlinkTarget := '';
+  AValue.HyperlinkToolTip := '';
 end;
 
 {@@ ----------------------------------------------------------------------------