RxFPC:TRxDBGridExportPDF - export images from grid cell

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5095 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-08-19 14:06:03 +00:00
parent 9be6f7eac5
commit 67fc1fc7e0
5 changed files with 177 additions and 137 deletions
--- a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps
@ -3,13 +3,13 @@
  <ProjectSession>
    <Version Value="9"/>
    <BuildModes Active="Default"/>
-    <Units Count="80">
+    <Units Count="82">
      <Unit0>
        <Filename Value="project1.lpr"/>
        <IsPartOfProject Value="True"/>
        <EditorIndex Value="-1"/>
        <CursorPos X="81" Y="12"/>
-        <UsageCount Value="107"/>
+        <UsageCount Value="108"/>
      </Unit0>
      <Unit1>
        <Filename Value="unit1.pas"/>
@ -18,9 +18,9 @@
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Unit1"/>
-        <TopLine Value="127"/>
-        <CursorPos Y="141"/>
-        <UsageCount Value="107"/>
+        <TopLine Value="110"/>
+        <CursorPos Y="125"/>
+        <UsageCount Value="108"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit1>
@ -34,10 +34,11 @@
      </Unit2>
      <Unit3>
        <Filename Value="../../rxdbgrid.pas"/>
-        <EditorIndex Value="-1"/>
-        <TopLine Value="482"/>
-        <CursorPos X="41" Y="496"/>
+        <EditorIndex Value="2"/>
+        <TopLine Value="3815"/>
+        <CursorPos X="18" Y="3837"/>
        <UsageCount Value="28"/>
+        <Loaded Value="True"/>
      </Unit3>
      <Unit4>
        <Filename Value="rxdbgridexportpdf.pas"/>
@ -88,14 +89,14 @@
        <UnitName Value="RxDBGridExportPdf"/>
        <IsVisibleTab Value="True"/>
        <EditorIndex Value="1"/>
-        <TopLine Value="381"/>
-        <CursorPos X="54" Y="381"/>
-        <UsageCount Value="51"/>
+        <TopLine Value="485"/>
+        <CursorPos Y="491"/>
+        <UsageCount Value="52"/>
        <Bookmarks Count="5">
-          <Item0 X="3" Y="856" ID="1"/>
-          <Item1 X="3" Y="457" ID="2"/>
-          <Item2 Y="418" ID="3"/>
-          <Item3 X="18" Y="519" ID="4"/>
+          <Item0 X="3" Y="927" ID="1"/>
+          <Item1 X="3" Y="456" ID="2"/>
+          <Item2 Y="417" ID="3"/>
+          <Item3 X="18" Y="566" ID="4"/>
          <Item4 X="15" Y="329" ID="5"/>
        </Bookmarks>
        <Loaded Value="True"/>
@ -486,17 +487,17 @@
      </Unit60>
      <Unit61>
        <Filename Value="/home/OPTORG/alexs/1/1/testfppdf.lpr"/>
-        <EditorIndex Value="3"/>
-        <UsageCount Value="33"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="34"/>
        <Loaded Value="True"/>
      </Unit61>
      <Unit62>
        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
        <UnitName Value="fpPDF"/>
-        <EditorIndex Value="4"/>
-        <TopLine Value="43"/>
-        <CursorPos X="12" Y="58"/>
-        <UsageCount Value="27"/>
+        <EditorIndex Value="5"/>
+        <TopLine Value="755"/>
+        <CursorPos X="27" Y="770"/>
+        <UsageCount Value="28"/>
        <Loaded Value="True"/>
      </Unit62>
      <Unit63>
@ -544,10 +545,10 @@
      <Unit69>
        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fpttf.pp"/>
        <UnitName Value="fpTTF"/>
-        <EditorIndex Value="2"/>
+        <EditorIndex Value="3"/>
        <TopLine Value="17"/>
        <CursorPos X="29" Y="21"/>
-        <UsageCount Value="23"/>
+        <UsageCount Value="24"/>
        <Loaded Value="True"/>
      </Unit69>
      <Unit70>
@ -622,120 +623,144 @@
        <CursorPos X="3" Y="565"/>
        <UsageCount Value="9"/>
      </Unit79>
+      <Unit80>
+        <Filename Value="/home/install/source/fpcsrc/packages/fcl-image/src/fpimage.pp"/>
+        <UnitName Value="FPimage"/>
+        <EditorIndex Value="6"/>
+        <TopLine Value="10"/>
+        <CursorPos X="3" Y="25"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit80>
+      <Unit81>
+        <Filename Value="/home/install/source/fpcsrc/packages/fcl-image/src/fpreadbmp.pp"/>
+        <UnitName Value="FPReadBMP"/>
+        <EditorIndex Value="-1"/>
+        <TopLine Value="25"/>
+        <CursorPos X="15" Y="33"/>
+        <UsageCount Value="10"/>
+      </Unit81>
    </Units>
-    <JumpHistory Count="29" HistoryIndex="28">
+    <JumpHistory Count="30" HistoryIndex="29">
      <Position1>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="428" Column="41" TopLine="413"/>
+        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
+        <Caret Line="920" Column="14" TopLine="907"/>
      </Position1>
      <Position2>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="426" TopLine="413"/>
+        <Caret Line="538" Column="13" TopLine="548"/>
      </Position2>
      <Position3>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="177" Column="7" TopLine="153"/>
+        <Caret Line="162" Column="60" TopLine="148"/>
      </Position3>
      <Position4>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="784" Column="7" TopLine="770"/>
+        <Caret Line="576" TopLine="561"/>
      </Position4>
      <Position5>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="923" Column="39" TopLine="894"/>
+        <Caret Line="472" Column="30" TopLine="458"/>
      </Position5>
      <Position6>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="425" Column="28" TopLine="418"/>
+        <Caret Line="162" Column="44" TopLine="162"/>
      </Position6>
      <Position7>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="480" Column="21" TopLine="472"/>
      </Position7>
      <Position8>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="420" Column="59" TopLine="391"/>
+        <Caret Line="479" Column="36" TopLine="465"/>
      </Position8>
      <Position9>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="427" Column="44" TopLine="400"/>
+        <Filename Value="/home/OPTORG/alexs/1/1/testfppdf.lpr"/>
+        <Caret Line="286" TopLine="269"/>
      </Position9>
      <Position10>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="443" Column="98" TopLine="418"/>
+        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
+        <Caret Line="770" Column="27" TopLine="755"/>
      </Position10>
      <Position11>
-        <Filename Value="/home/OPTORG/alexs/1/1/testfppdf.lpr"/>
-        <Caret Line="133" Column="49" TopLine="108"/>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="196" Column="73" TopLine="176"/>
      </Position11>
      <Position12>
-        <Filename Value="/home/OPTORG/alexs/1/1/testfppdf.lpr"/>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="480" Column="61" TopLine="465"/>
      </Position12>
      <Position13>
-        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="481" Column="5" TopLine="465"/>
      </Position13>
      <Position14>
-        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
-        <Caret Line="1015" Column="12" TopLine="1005"/>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="482" Column="5" TopLine="467"/>
      </Position14>
      <Position15>
-        <Filename Value="/home/install/source/fpcsrc/packages/fcl-pdf/src/fppdf.pp"/>
-        <Caret Line="1137" Column="3" TopLine="1130"/>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="483" Column="5" TopLine="467"/>
      </Position15>
      <Position16>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="202" Column="22" TopLine="191"/>
+        <Caret Line="482" Column="5" TopLine="468"/>
      </Position16>
      <Position17>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="203" Column="48" TopLine="191"/>
+        <Caret Line="486" Column="61" TopLine="467"/>
      </Position17>
      <Position18>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="327" Column="29" TopLine="302"/>
+        <Caret Line="580" Column="39" TopLine="565"/>
      </Position18>
      <Position19>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="581" Column="53" TopLine="566"/>
      </Position19>
      <Position20>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="203" Column="36" TopLine="178"/>
+        <Filename Value="../../rxdbgrid.pas"/>
+        <Caret Line="4534" Column="28" TopLine="4534"/>
      </Position20>
      <Position21>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="202" Column="52" TopLine="178"/>
+        <Filename Value="../../rxdbgrid.pas"/>
+        <Caret Line="4540" Column="3" TopLine="4534"/>
      </Position21>
      <Position22>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="204" Column="52" TopLine="178"/>
+        <Filename Value="../../rxdbgrid.pas"/>
      </Position22>
      <Position23>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="426" Column="44" TopLine="398"/>
+        <Filename Value="../../rxdbgrid.pas"/>
+        <Caret Line="715" Column="29" TopLine="691"/>
      </Position23>
      <Position24>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="428" Column="96" TopLine="401"/>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="145" TopLine="70"/>
      </Position24>
      <Position25>
-        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="427" Column="9" TopLine="414"/>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="123" TopLine="109"/>
      </Position25>
      <Position26>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="452" Column="6" TopLine="423"/>
+        <Caret Line="588" Column="36" TopLine="563"/>
      </Position26>
      <Position27>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="149" TopLine="136"/>
+        <Caret Line="162" Column="59" TopLine="148"/>
      </Position27>
      <Position28>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="381" Column="75" TopLine="371"/>
+        <Caret Line="518" Column="50" TopLine="488"/>
      </Position28>
      <Position29>
        <Filename Value="../../rxdbgridexportpdf.pas"/>
-        <Caret Line="149" Column="38" TopLine="149"/>
+        <Caret Line="521" Column="32" TopLine="491"/>
      </Position29>
+      <Position30>
+        <Filename Value="../../rxdbgridexportpdf.pas"/>
+        <Caret Line="625" Column="55" TopLine="603"/>
+      </Position30>
    </JumpHistory>
  </ProjectSession>
  <Debugging>
--- a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm
@ -11,12 +11,12 @@ object Form1: TForm1
  LCLVersion = '1.7'
  object Panel1: TPanel
    Left = 0
-    Height = 51
-    Top = 346
+    Height = 50
+    Top = 347
    Width = 1043
    Align = alBottom
    AutoSize = True
-    ClientHeight = 51
+    ClientHeight = 50
    ClientWidth = 1043
    TabOrder = 0
    object Button1: TButton
@ -33,64 +33,23 @@ object Form1: TForm1
      OnClick = Button1Click
      TabOrder = 0
    end
-    object CheckBox1: TCheckBox
-      AnchorSideLeft.Control = Panel1
-      AnchorSideBottom.Control = Edit1
-      AnchorSideBottom.Side = asrBottom
-      Left = 7
-      Height = 24
-      Top = 20
-      Width = 85
-      Anchors = [akLeft, akBottom]
-      BorderSpacing.Left = 6
-      Caption = 'Use filter'
-      OnChange = CheckBox1Change
-      TabOrder = 1
-    end
-    object Edit1: TEdit
-      AnchorSideLeft.Control = Label1
-      AnchorSideLeft.Side = asrBottom
-      AnchorSideTop.Control = Panel1
-      AnchorSideRight.Control = Button1
-      Left = 247
-      Height = 37
-      Top = 7
-      Width = 223
-      Anchors = [akTop, akLeft, akRight]
-      BorderSpacing.Around = 6
-      TabOrder = 2
-      Text = 'ID=1'
-    end
-    object Label1: TLabel
-      AnchorSideLeft.Control = CheckBox1
-      AnchorSideLeft.Side = asrBottom
-      AnchorSideBottom.Control = Edit1
-      AnchorSideBottom.Side = asrBottom
-      Left = 92
-      Height = 20
-      Top = 24
-      Width = 149
-      Anchors = [akLeft, akBottom]
-      Caption = 'Enter filter expression^'
-      ParentColor = False
-    end
  end
  object PageControl1: TPageControl
    Left = 0
-    Height = 346
+    Height = 347
    Top = 0
    Width = 1043
-    ActivePage = TabSheet2
+    ActivePage = TabSheet1
    Align = alClient
-    TabIndex = 1
+    TabIndex = 0
    TabOrder = 1
    object TabSheet1: TTabSheet
      Caption = 'Test data'
-      ClientHeight = 312
+      ClientHeight = 313
      ClientWidth = 1033
      object RxDBGrid1: TRxDBGrid
        Left = 0
-        Height = 312
+        Height = 313
        Top = 0
        Width = 1033
        ColumnDefValues.BlobText = '(данные)'
@ -193,6 +152,7 @@ object Form1: TForm1
              end>
          end        
          item
+            Alignment = taCenter
            Title.Alignment = taCenter
            Title.Orientation = toHorizontal
            Title.Caption = 'Статус'
@ -316,11 +276,11 @@ object Form1: TForm1
    end
    object TabSheet2: TTabSheet
      Caption = 'Debug window'
-      ClientHeight = 312
+      ClientHeight = 313
      ClientWidth = 1033
      object Memo1: TMemo
        Left = 0
-        Height = 312
+        Height = 313
        Top = 0
        Width = 1033
        Align = alClient
@ -455,7 +415,7 @@ object Form1: TForm1
    FileName = 'test111.pdf'
    Options = [repExportTitle, repExportColors, repExportFooter, repOverwriteExisting]
    PdfOptions.PaperOrientation = ppoLandscape
-    PdfOptions.Options = []
+    PdfOptions.Options = [poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG]
    OpenAfterExport = True
    AuthorPdf = 'Лагунов А.А.'
    ProducerPdf = 'alexs'
--- a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas
@ -15,11 +15,8 @@ type

  TForm1 = class(TForm)
    Button1: TButton;
-    CheckBox1: TCheckBox;
    DataSource1: TDataSource;
-    Edit1: TEdit;
    ImageList1: TImageList;
-    Label1: TLabel;
    Memo1: TMemo;
    PageControl1: TPageControl;
    Panel1: TPanel;
@ -36,7 +33,6 @@ type
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    procedure Button1Click(Sender: TObject);
-    procedure CheckBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
@ -123,13 +119,9 @@ end;

 procedure TForm1.DebugFonts;
 var
-  i, C, L1, L3: Integer;
-  K: TFPFontCacheItem;
-  L: Single;
-
+  i: Integer;
 begin
  Memo1.Lines.Clear;
-  C:=FontDirList.Count;
  gTTFontCache.BuildFontFacheIgnoresErrors:=true;
  gTTFontCache.SearchPath.Assign(FontDirList);
  gTTFontCache.BuildFontCache;
@ -147,15 +139,6 @@ begin
  RxDBGridExportPDF1.ShowSetupForm:=true;
 end;

-procedure TForm1.CheckBox1Change(Sender: TObject);
-begin
-  if CheckBox1.Checked then
-  begin
-    RxMemoryData1.Filter:=Edit1.Text;
-  end;
-  RxMemoryData1.Filtered:=CheckBox1.Checked;
-end;
-
 procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
  FreeAndNil(FontDirList);
--- a/components/rx/trunk/rxdbgrid.pas
+++ b/components/rx/trunk/rxdbgrid.pas
@ -3834,7 +3834,7 @@ begin
      Assigned(RxColumn.ImageList) then
    begin
      AImageIndex := StrToIntDef(RxColumn.KeyList.Values[RxColumn.Field.AsString],
-        RxColumn.FNotInKeyListIndex);
+        RxColumn.NotInKeyListIndex);
      if (AImageIndex > -1) and (AImageIndex < RxColumn.ImageList.Count) then
        DrawCellBitmap(RxColumn, aRect, aState, AImageIndex);
    end
--- a/components/rx/trunk/rxdbgridexportpdf.pas
+++ b/components/rx/trunk/rxdbgridexportpdf.pas
@ -159,7 +159,7 @@ type
    //
    procedure WriteTextRect(AExportFont:TExportFontItem; X, Y, W, H:integer; AText:string; ATextAlign:TAlignment);
    procedure DrawRect(X, Y, W, H: integer; ABorderColor, AFillColor: TColor);
-    //procedure DrawImage(X, Y, W, H: integer; ABorderColor, AFillColor: TColor);
+    procedure DrawImage(X, Y, W, H: integer; ABmp:TBitmap; ATextAlign:TAlignment);

    procedure StartNewPage;

@ -193,7 +193,7 @@ type
 implementation

 {$IF (FPC_FULLVERSION >= 30101)}
-uses Grids, rxdconst, FileUtil, Forms, Controls, LCLIntf, LazFileUtils, RxDBGridExportPdfSetupUnit;
+uses Grids, rxdconst, FileUtil, Forms, Controls, LCLIntf, LazFileUtils, FPReadBMP, RxDBGridExportPdfSetupUnit;

 const
  cInchToMM = 25.4;
@ -469,6 +469,54 @@ begin
  FCurPage.DrawRect(fX, fY, fW, fH, 1, AFillColor <> clNone, ABorderColor <> clNone);
 end;

+procedure TRxDBGridExportPDF.DrawImage(X, Y, W, H: integer; ABmp: TBitmap;
+  ATextAlign: TAlignment);
+var
+  S:TMemoryStream;
+  IDX: Integer;
+  fW, fH, fX, fY, X1, Y1, fW1, fH1: TPDFFloat;
+begin
+  S:=TMemoryStream.Create;
+  try
+    ABmp.SaveToStream(S);
+    S.Position:=0;
+    IDX := FPDFDocument.Images.AddFromStream(S, TFPReaderBMP, False);
+    fW1 := ConvetUnits(FPDFDocument.Images[IDX].Width);
+    fH1 := ConvetUnits(FPDFDocument.Images[IDX].Height);
+    fX:=ConvetUnits(X);
+    fY:=ConvetUnits(Y);
+    fW:=ConvetUnits(W);
+    fH:=ConvetUnits(H);
+
+    case ATextAlign of
+      taLeftJustify:
+        begin
+          Y1:=fY {+ ConvetUnits(constCellPadding)};
+          X1:=fX + ConvetUnits(constCellPadding);
+        end;
+      taRightJustify:
+        begin
+          Y1:=fY {+ ConvetUnits(constCellPadding)};
+          X1:=fX + fW - fW1 - ConvetUnits(constCellPadding);
+          if X1 < fX then
+            X1:=fX;
+        end;
+      taCenter:
+        begin
+          Y1:=fY {+ ConvetUnits(constCellPadding)};
+          X1:=fX + fW / 2 - fW1 / 2 - ConvetUnits(constCellPadding);
+          if X1 < fX then
+            X1:=fX;
+        end;
+    end;
+
+    FCurPage.DrawImage(X1, Y1, fW1, fH1, IDX);  // left-bottom coordinate of image
+
+  finally
+    S.Free;
+  end;
+end;
+
 procedure TRxDBGridExportPDF.StartNewPage;
 var
  P: TPDFPage;
@ -530,6 +578,8 @@ var
  i, X, CP: Integer;
  C: TRxColumn;
  S: String;
+  B: TBitmap;
+  AImageIndex: LongInt;
 begin
  X:=FPageWidth + FPageMargin.Right;
  CP:=-1;
@ -551,7 +601,29 @@ begin
      DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, FRxDBGrid.BorderColor, C.Color);

      if Assigned(C.Field) then
-        WriteTextRect(ActivateFont(C.Font, FRxDBGrid.Font), X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Field.DisplayText, C.Alignment);
+      begin
+        if Assigned(C.ImageList) then
+        begin
+          AImageIndex := StrToIntDef(C.KeyList.Values[C.Field.AsString], C.NotInKeyListIndex);
+          if (AImageIndex > -1) and (AImageIndex < C.ImageList.Count) then
+          begin
+            B:=TBitmap.Create;
+            try
+              B.Width:=C.ImageList.Width;
+              B.Height:=C.ImageList.Height;
+              B.Canvas.Brush.Color:=clWhite;
+              B.Canvas.FillRect(0, 0, B.Width, B.Height);
+
+              C.ImageList.StretchDraw(B.Canvas, AImageIndex, Rect(0, 0,  B.Width, B.Height));
+              DrawImage(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, B, C.Alignment);
+            finally
+              B.Free
+            end;
+          end
+        end
+        else
+          WriteTextRect(ActivateFont(C.Font, FRxDBGrid.Font), X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Field.DisplayText, C.Alignment);
+      end;

      X:=X + C.Width;
    end;