LazReport, implements listing of printer fonts in report designer (windows), issue #11932

git-svn-id: trunk@43185 -
2025-10-03 09:59:28 +02:00 · 2013-10-09 05:29:04 +00:00 · 2013-10-09 05:29:04 +00:00 · 6099679fa6
commit 6099679fa6
parent e0905893f5
3 changed files with 156 additions and 49 deletions
--- a/components/lazreport/source/lr_desgn.lfm
+++ b/components/lazreport/source/lr_desgn.lfm
@ -1,4 +1,4 @@
-object frDesignerForm: TfrDesignerForm
+inherited frDesignerForm: TfrDesignerForm
  Left = 386
  Height = 434
  Top = 289
@ -9,7 +9,7 @@ object frDesignerForm: TfrDesignerForm
  VertScrollBar.Range = 149
  ActiveControl = frDock1
  Caption = 'Designer'
-  ClientHeight = 411
+  ClientHeight = 414
  ClientWidth = 695
  KeyPreview = True
  Menu = MainMenu1
@ -23,12 +23,11 @@ object frDesignerForm: TfrDesignerForm
  OnResize = FormResize
  OnShow = FormShow
  ShowHint = True
-  LCLVersion = '1.1'
  WindowState = wsMaximized
-  object StatusBar1: TStatusBar
+  object StatusBar1: TStatusBar[0]
    Left = 0
-    Height = 19
-    Top = 392
+    Height = 23
+    Top = 391
    Width = 695
    Panels = <    
      item
@ -45,7 +44,7 @@ object frDesignerForm: TfrDesignerForm
      end>
    SimplePanel = False
  end
-  object frDock1: TPanel
+  object frDock1: TPanel[1]
    Left = 0
    Height = 83
    Top = 0
@ -1895,10 +1894,10 @@ object frDesignerForm: TfrDesignerForm
        object C3: TComboBox
          Tag = 8
          Left = 161
-          Height = 27
+          Height = 21
          Top = 2
          Width = 67
-          ItemHeight = 0
+          ItemHeight = 13
          Items.Strings = (
            '5'
            '6'
@ -1927,10 +1926,10 @@ object frDesignerForm: TfrDesignerForm
        object C2: TComboBox
          Tag = 7
          Left = 1
-          Height = 27
+          Height = 21
          Top = 2
          Width = 155
-          ItemHeight = 0
+          ItemHeight = 13
          OnChange = DoClick
          OnDrawItem = C2DrawItem
          OnGetItems = C2GetItems
@ -2323,7 +2322,7 @@ object frDesignerForm: TfrDesignerForm
        object E1: TEdit
          Tag = 6
          Left = 4
-          Height = 25
+          Height = 21
          Top = 1
          Width = 31
          TabOrder = 0
@ -2386,23 +2385,23 @@ object frDesignerForm: TfrDesignerForm
      TabOrder = 3
    end
  end
-  object frDock2: TPanel
+  object frDock2: TPanel[2]
    Left = 0
-    Height = 309
+    Height = 308
    Top = 83
    Width = 27
    Align = alLeft
-    ClientHeight = 309
+    ClientHeight = 308
    ClientWidth = 27
    FullRepaint = False
    TabOrder = 1
    object panForDlg: TPanel
      Left = 1
-      Height = 307
+      Height = 306
      Top = 1
      Width = 25
      Align = alClient
-      ClientHeight = 307
+      ClientHeight = 306
      ClientWidth = 25
      FullRepaint = False
      TabOrder = 1
@ -2468,11 +2467,11 @@ object frDesignerForm: TfrDesignerForm
    end
    object Panel4: TPanel
      Left = 1
-      Height = 307
+      Height = 306
      Top = 1
      Width = 25
      Align = alClient
-      ClientHeight = 307
+      ClientHeight = 306
      ClientWidth = 25
      FullRepaint = False
      TabOrder = 0
@ -2769,9 +2768,9 @@ object frDesignerForm: TfrDesignerForm
      end
    end
  end
-  object Tab1: TTabControl
+  object Tab1: TTabControl[3]
    Left = 27
-    Height = 309
+    Height = 308
    Top = 83
    Width = 641
    TabStop = False
@ -2785,25 +2784,25 @@ object frDesignerForm: TfrDesignerForm
    TabOrder = 2
    object panTab: TPanel
      Left = 2
-      Height = 275
-      Top = 32
+      Height = 285
+      Top = 21
      Width = 637
      Align = alClient
      BevelOuter = bvNone
      Caption = 'panTab'
-      ClientHeight = 275
+      ClientHeight = 285
      ClientWidth = 637
      TabOrder = 1
      object ScrollBox1: TScrollBox
        Left = 0
-        Height = 275
+        Height = 285
        Top = 0
        Width = 637
-        HorzScrollBar.Page = 635
-        VertScrollBar.Page = 273
+        HorzScrollBar.Page = 633
+        VertScrollBar.Page = 281
        Align = alClient
-        ClientHeight = 273
-        ClientWidth = 635
+        ClientHeight = 281
+        ClientWidth = 633
        Color = clGray
        ParentColor = False
        TabOrder = 0
@ -4107,14 +4106,14 @@ object frDesignerForm: TfrDesignerForm
      end
    end
  end
-  object frDock4: TPanel
+  object frDock4: TPanel[4]
    Left = 668
-    Height = 309
+    Height = 308
    Top = 83
    Width = 27
    Align = alRight
    Anchors = [akTop, akRight]
-    ClientHeight = 309
+    ClientHeight = 308
    ClientWidth = 27
    FullRepaint = False
    TabOrder = 3
@ -4689,7 +4688,7 @@ object frDesignerForm: TfrDesignerForm
      end
    end
  end
-  object Panel7: TPanel
+  object Panel7: TPanel[5]
    Left = 78
    Height = 15
    Top = 134
@ -4709,7 +4708,7 @@ object frDesignerForm: TfrDesignerForm
      OnPaint = PBox1Paint
    end
  end
-  object Popup1: TPopupMenu
+  object Popup1: TPopupMenu[6]
    OnPopup = Popup1Popup
    left = 272
    top = 96
@ -4746,7 +4745,7 @@ object frDesignerForm: TfrDesignerForm
      OnClick = N6Click
    end
  end
-  object MainMenu1: TMainMenu
+  object MainMenu1: TMainMenu[7]
    Images = ActionsImageList
    left = 232
    top = 56
@ -4759,6 +4758,42 @@ object frDesignerForm: TfrDesignerForm
      end
      object N19: TMenuItem
        Action = FileOpen
+        Bitmap.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          20000000000000040000640000006400000000000000000000002C86D8D12D88
+          D8F72D87D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88
+          D8F72D88D8F72D87D8F72D88D8F72C86D8D1FFFFFF00FFFFFF00338ED9FBDCF0
+          FAFF98E1F6FF95E0F6FF92DFF6FF8EDEF5FF89DCF5FF85DAF4FF80D9F4FF7AD7
+          F3FF74D5F3FF70D3F2FFC2EAF8FF3594DAFFFFFFFF00FFFFFF003594DAF7EFFA
+          FEFF93E5F8FF8FE4F8FF89E3F8FF82E1F7FF7ADFF7FF71DEF6FF67DBF5FF5BD8
+          F4FF4DD4F3FF40D1F2FFCAF2FBFF3594DAFFFFFFFF00FFFFFF00369ADAF8F2FA
+          FDFF94E6F8FF92E5F8FF90E5F8FF8BE3F8FF86E2F7FF7FE1F7FF77DEF6FF6CDC
+          F6FF5ED9F4FF4FD5F3FFCCF2FBFF3594DAFFFFFFFF00FFFFFF0036A1DAF9F6FC
+          FEFF94E5F8FF93E5F8FF93E5F8FF91E5F8FF93DBE9FF93D7E3FF93D2DCFF90CE
+          D7FF8CC8CFFF86C1C6FFC9D8D6FF3594DAFFC57444E8CA7F53F137A6DAFAFEFF
+          FFFFF8FDFFFFF6FDFFFFF5FCFFFFF3FCFEFF9AE4F4FF9AE6F7FF9BE6F6FF9DE5
+          F5FF9EE5F5FF9FE5F4FFDAF3F8FF3594DAFFFDF4EEFFCA8054F935ABDAFAE8F6
+          FBFF70BCE7FF55AAE2FF4DA5E0FF91C9EBFFFAF3EFFFFDFEFDFFFFFDFCFFFFFD
+          FCFFFEFDFCFFFEFCFBFFFEFEFDFF3594DAFFEFF2E8FFCE8156FF36AADAF2F1FA
+          FDFF94DEF5FF93DCF4FF64BCE9FF3594DAFF3594DAFF3594DAFF3594DAFF3594
+          DAFF3594DAFF3594DAFF3594DAFF3594DAFFFBF6EFFFCC8355FE35AFDAF0F7FC
+          FEFF8EE4F8FF91DEF5FF9FE0F5FFACE1F6FFCA8452FFFFF7F1FFFFE9D9FFFFEA
+          DBFFFFE9D9FFFFE7D7FFFFE5D2FFFFE2CBFFFFF7F1FFCB8555FE36B3DAF8FDFE
+          FEFFFEFFFFFFFEFEFFFFFDFEFFFFFEFFFFFFE4BA91FFFFF7F0FFFFE7D5FFFDE7
+          D6FFFDE6D4FFFCE4D0FFFBE3CBFFFADCC2FFFEF3E8FFCC8656FE34B4D9D05EC2
+          E1FA60C3E2FA60C3E2FA60C3E2FA5FC3E2FAE4BB91FFFFF7F2FFFEE7D5FFFEE7
+          D5FFFDE5D1FFFAE0CAFFF9DEC4FFF7D9BCFFFDF2E7FFCC8757FEFFFFFF00FFFF
+          FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E4BB92FFFEF7F1FFFCE5D2FFFCE4
+          D1FFFBE2CCFFF9DDC4FFF6D7BBFFF3D1AFFFFAEFE4FFCC8758FEFFFFFF00FFFF
+          FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E4BB92FFFEF6F0FFFCE2CDFFFCE3
+          CDFFFADFC8FFF7D9BCFFF5E9DDFFFAF3EBFFFBF8F3FFCA8353FEFFFFFF00FFFF
+          FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E4BB93FFFEF5EDFFFCDEC5FFFBE0
+          C7FFF9DCC2FFF5D3B4FFFEF9F3FFFAE2C4FFECC193FFC37D4893FFFFFF00FFFF
+          FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E5BE96FFFFFFFEFFFDF3E9FFFDF3
+          EAFFFCF2E8FFFAEFE3FFFAF2E7FFEABB88FFCF8555B3B4693D0CFFFFFF00FFFF
+          FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00EAC39DFFE6BF96FFE4BB92FFE4BB
+          92FFD1A06CF5D09E6DF6CC965FDAC479427EB2673C09FFFFFF00
+        }
      end
      object N20: TMenuItem
        Action = FileSave
@ -5014,19 +5049,19 @@ object frDesignerForm: TfrDesignerForm
      end
    end
  end
-  object OpenDialog1: TOpenDialog
+  object OpenDialog1: TOpenDialog[8]
    FilterIndex = 0
    Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
    left = 288
    top = 200
  end
-  object SaveDialog1: TSaveDialog
+  object SaveDialog1: TSaveDialog[9]
    FilterIndex = 0
    Options = [ofHideReadOnly]
    left = 288
    top = 264
  end
-  object ImageList1: TImageList
+  object ImageList1: TImageList[10]
    Height = 15
    Width = 15
    left = 288
@ -5119,12 +5154,12 @@ object frDesignerForm: TfrDesignerForm
      00FFDCDCDCFF000000FFDCDCDCFF000000FFDCDCDCFF000000FF
    }
  end
-  object ImageList2: TImageList
+  object ImageList2: TImageList[11]
    Height = 14
    left = 288
    top = 312
    Bitmap = {
-      4C6902000000100000000E000000DCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDC
+      4C6903000000100000000E000000DCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDC
      DCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDC
      DCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFFDCDCDCFF0000FFFF0000FFFF0000
      FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFFDCDCDCFFDCDCDCFFDCDC
@ -5180,10 +5215,38 @@ object frDesignerForm: TfrDesignerForm
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
-      0000000000000000000000000000
+      0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00E8CEB9C3D7AA
+      7CCDC88C50FEC88C4FFFCA9155F7CB9055F7C5894DFEDDAF8DC1FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C5884DFAF7F2
+      ECFFF8F4EEFFF8F3EDFFF8F3EDFFF8F2ECFFF2E6D7FFE2B27DFFDB9569F6FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C88D52F6F9F5
+      F1FFFCE3CDFFFBE3CDFFF9E0C8FFF8DCC2FFFDFBF8FFFCE6CDFFE2B684FFD5A8
+      84C5FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C88D51F7F9F5
+      F1FFFCE3CFFFFCE4CFFFFAE1CAFFF9DDC4FFF4E9DFFFF7F2ECFFF5EFE9FFC380
+      48FBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C68C4FF9F9F4
+      F0FFFCE6D3FFFDE7D3FFFBE3CDFFFAE0C8FFF5D6BBFFF3D4B5FFF8F4F0FFC485
+      4AF9FFFFFF00FFFFFF00FFFFFF00FFFFFF00CECECEC2878787F4C5894CFFF9F4
+      EFFFFEE7D7FFFDE7D5FFFCE6D2FFFBE1CCFFF8DCC2FFF6DABDFFFAF4EFFFC483
+      48FF616161F4BCBCBCC2FFFFFF00DDDDDDCD9A9A9AFFCCCCCCFFC78B4EFFF9F4
+      EDFFFEE8D8FFFEE8D7FFFDE5D3FFFCE4D1FFFAE0C7FFF9DDC3FFFAF4EDFFC785
+      4AFFC3C3C3FF747474FFCDCDCDCD979797DAD2D2D2FFE8E8E8FF7D7D7DFF7D7D
+      7DFF7D7D7DFF7D7D7DFF7D7D7DFF7D7D7DFF7D7D7DFF7D7D7DFF7D7D7DFF7D7D
+      7DFFE8E8E8FFC4C4C4FF6D6D6DE1848484F9FCFCFCFFFCFCFCFFCBCBCBFFF2F2
+      F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFC6C6
+      C6FFFCFCFCFFFCFCFCFF717171FE7E7E7EFFF9F9F9FFF9F9F9FFABABABFFDFDF
+      DFFFCBCBCBFFCBCBCBFFCBCBCBFFCBCBCBFFCBCBCBFFCBCBCBFFDFDFDFFFA3A3
+      A3FFF9F9F9FFF9F9F9FF616161FF7A7A7AFFD7D7D7FFD7D7D7FF979797FFD8D8
+      D8FFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFD7D7D7FF8E8E
+      8EFFD7D7D7FFD7D7D7FF3F3F3FFF757575FFBBBBBBFFBBBBBBFF8D8D8DFFD4D4
+      D4FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFD3D3D3FF8383
+      83FFBBBBBBFFBBBBBBFF2A2A2AFF707070FFB5B5B5FFB5B5B5FF959595FF8181
+      81FF818181FF797979FF6E6E6EFF616161FF525252FF434343FF424242FF6E6E
+      6EFFB5B5B5FFB5B5B5FF252525FF6B6B6B00A7A7A7FFB5B5B5FF818181FFAFAC
+      AAFFC5C0BDFFC5C0BDFFC5C0BDFFC5C0BDFFC5C0BDFFC5C0BDFFADAAA8FF2C2C
+      2CFFB5B5B5FF9B9B9BFF232323FF
    }
  end
-  object Popup2: TPopupMenu
+  object Popup2: TPopupMenu[12]
    left = 272
    top = 56
    object N41: TMenuItem
@ -5196,7 +5259,7 @@ object frDesignerForm: TfrDesignerForm
      Caption = '        '
    end
  end
-  object ImgIndic: TImageList
+  object ImgIndic: TImageList[13]
    Height = 8
    Width = 8
    left = 328
@ -5229,7 +5292,7 @@ object frDesignerForm: TfrDesignerForm
      00FF000000FF000000FF000000FF
    }
  end
-  object actList: TActionList
+  object actList: TActionList[14]
    Images = ActionsImageList
    left = 560
    top = 36
@ -5276,7 +5339,7 @@ object frDesignerForm: TfrDesignerForm
      OnExecute = FileBeforePrintScriptExecute
    end
  end
-  object ActionsImageList: TImageList
+  object ActionsImageList: TImageList[15]
    left = 328
    top = 156
    Bitmap = {
--- a/components/lazreport/source/lr_desgn.pas
+++ b/components/lazreport/source/lr_desgn.pas
@ -2845,10 +2845,12 @@ function EnumFontsProc(
  {%H-}Data: LParam):LongInt; stdcall;
 var
  S: String;
+  Lst: TStrings;
 begin
  s := StrPas(LogFont.elfLogFont.lfFaceName);
-  if TfrDesignerForm(frDesigner).C2.Items.IndexOf(S)<0 then
-    TfrDesignerForm(frDesigner).C2.Items.AddObject(S, TObject(PtrInt(FontType)));
+  Lst := TStrings(PtrInt(Data));
+  if Lst.IndexOf(S)<0 then
+    Lst.AddObject(S, TObject(PtrInt(FontType)));
  Result := 1;
 end;

@ -2890,6 +2892,11 @@ procedure TfrDesignerForm.GetFontList;
 var
  DC: HDC;
  Lf: TLogFont;
+  {$IFDEF USE_PRINTER_FONTS}
+  Lst: TStrings;
+  i: Integer;
+  j: PtrInt;
+  {$ENDIF}
 begin
  C2.Items.Clear;
  DC := GetDC(0);
@ -2897,10 +2904,31 @@ begin
    Lf.lfFaceName := '';
    Lf.lfCharSet := DEFAULT_CHARSET;
    Lf.lfPitchAndFamily := 0;
-    EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, 0, 0);
+    EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, PtrInt(C2.Items), 0);
  finally
    ReleaseDC(0, DC);
  end;
+  {$IFDEF USE_PRINTER_FONTS}
+  if not CurReport.PrintToDefault then
+  begin
+    // we could use prn.Printer.Fonts but we would be tied to
+    // implementation detail of list.objects[] encoded with fonttype
+    // that's why we collect the fonts ourselves here
+    //
+    Lst := TStringList.Create;
+    try
+      EnumFontFamiliesEx(Prn.Printer.Canvas.Handle, @Lf, @EnumFontsProc, PtrInt(Lst), 0);
+      for i:=0 to Lst.Count-1 do
+        if C2.Items.IndexOf(Lst[i])<0 then begin
+          j := PtrInt(Lst.Objects[i]) or $100;
+          C2.Items.AddObject(Lst[i], TObject(j));
+        end;
+    finally
+      Lst.free;
+    end;
+  end;
+  {$ENDIF}
+
  if C2.Items.Count>0 then
    LastFontName := C2.Items[0]
  else
@ -5311,12 +5339,20 @@ end;

 procedure TfrDesignerForm.C2DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
+var
+  j: PtrInt;
 begin
  with C2.Canvas do
  begin
    Font.Name := 'default';
    FillRect(Rect);
-    if (PtrInt(C2.Items.Objects[Index]) and TRUETYPE_FONTTYPE) <> 0 then
+    j := PtrInt(C2.Items.Objects[Index]);
+    {$IFDEF USE_PRINTER_FONTS}
+    if (j and $100 <> 0) then
+      ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top +1, 2)
+    else
+    {$ENDIF}
+    if ( j and TRUETYPE_FONTTYPE) <> 0 then
      ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top + 1, 0);
    TextOut(Rect.Left + 20, Rect.Top + 1, C2.Items[Index]);
  end;
@ -5967,6 +6003,10 @@ begin
      CurReport.PrintToDefault := not CB1.Checked;
      CurReport.DoublePass := CB2.Checked;
      CurReport.ChangePrinter(Prn.PrinterIndex, ListBox1.ItemIndex);
+      {$IFDEF USE_PRINTER_FONTS}
+      // printer may have been changed, invalidate current list of fonts
+      C2.Items.Clear;
+      {$ENDIF}
      CurReport.Title:=edTitle.Text;
      CurReport.Subject:=edSubject.Text;
      CurReport.KeyWords:=edKeyWords.Text;
--- a/components/lazreport/source/lr_vers.inc
+++ b/components/lazreport/source/lr_vers.inc
@ -61,3 +61,7 @@
  {$DEFINE noautomatedbookmark}
 {$endif}

+{$IFDEF MSWINDOWS}
+  {$DEFINE USE_PRINTER_FONTS}
+{$ENDIF}
+