Стартовый пул

RXLib/.svn/pristine/67/67bad51a834ef2c8d0ecf05f4799d2e5ef9a9f7c.svn-base

@@ -0,0 +1,170 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, rxmemds, rxdbgrid, RxDBGridExportPdf,
+  Forms, Controls,
+  Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Spin, db;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Button1: TButton;
+    CheckBox1: TCheckBox;
+    DataSource1: TDataSource;
+    ImageList1: TImageList;
+    Memo1: TMemo;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    RxDBGrid1: TRxDBGrid;
+    RxDBGridExportPDF1: TRxDBGridExportPDF;
+    RxMemoryData1: TRxMemoryData;
+    RxMemoryData1Country: TStringField;
+    RxMemoryData1FLAG: TLongintField;
+    RxMemoryData1ID: TAutoIncField;
+    RxMemoryData1NAME: TStringField;
+    RxMemoryData1PDATE: TDateField;
+    RxMemoryData1Sity: TStringField;
+    RxMemoryData1SUM: TCurrencyField;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    procedure Button1Click(Sender: TObject);
+    procedure CheckBox1Change(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+  private
+    FontDirList: TStrings;
+    procedure InitFonts;
+    procedure ShowInfo(AText:string; AParams : array of const);
+    procedure DebugFonts;
+    procedure CreateFontDirList;
+  public
+    { public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+uses fpTTF, LazFileUtils;
+
+{$R *.lfm}
+const
+  TestText = 'Образец текста';
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  RxDBGridExportPDF1.ShowSetupForm:=true;
+  PageControl1.ActivePageIndex:=0;
+  RxMemoryData1.Open;
+  RxMemoryData1.AppendRecord([1, 'Строка с длинным текстом 1', now, 100, 'Россия', 'Москва', 0]);
+  RxMemoryData1.AppendRecord([2, 'Строка с длинным текстом 2', now - 1, 100, 'Россия', 'Ставрополь', 1]);
+  RxMemoryData1.AppendRecord([3, 'Строка с длинным текстом 3', now - 2, 110, 'Россия', 'Калининград', 2]);
+  RxMemoryData1.AppendRecord([4, 'Строка с длинным текстом 4', now - 3, 5000, 'Россия', 'Владивасток', 0]);
+  RxMemoryData1.AppendRecord([5, 'Строка с длинным текстом 5', now - 4, 123.31, 'USA', 'New-York', 0]);
+  RxMemoryData1.AppendRecord([6, 'Строка с длинным текстом 6', now, 100, 'Россия', 'Москва', 0]);
+  RxMemoryData1.AppendRecord([7, 'Строка с длинным текстом 7', now - 1, 100, 'Россия', 'Ставрополь', 2]);
+  RxMemoryData1.AppendRecord([8, 'Строка с длинным текстом 8', now - 2, 110, 'Россия', 'Калининград', 1]);
+  RxMemoryData1.AppendRecord([9, 'Строка с длинным текстом 9', now - 3, 5000, 'Россия', 'Владивасток', 0]);
+  RxMemoryData1.AppendRecord([10,'Строка с длинным текстом 10', now - 4, 123.31, 'USA', 'New-York', 3]);
+  RxMemoryData1.AppendRecord([11,'Строка с длинным текстом 11', now, 100, 'Россия', 'Москва', 2]);
+  RxMemoryData1.AppendRecord([12,'Строка с длинным текстом 12', now - 1, 100, 'Россия', 'Ставрополь', 1]);
+  RxMemoryData1.AppendRecord([13,'Строка с длинным текстом 13', now - 2, 110, 'Россия', 'Калининград', 0]);
+  RxMemoryData1.AppendRecord([14,'Строка с длинным текстом 14', now - 3, 5000, 'Россия', 'Владивасток', 3]);
+  RxMemoryData1.AppendRecord([15,'Строка с длинным текстом 15', now - 4, 123.31, 'USA', 'New-York', 2]);
+  RxMemoryData1.AppendRecord([16,'Строка с длинным текстом 16', now, 100, 'Россия', 'Москва', 1]);
+  RxMemoryData1.AppendRecord([17,'Строка с длинным текстом 17', now - 1, 100, 'Россия', 'Ставрополь', 0]);
+  RxMemoryData1.AppendRecord([18,'Строка с длинным текстом 18', now - 2, 110, 'Россия', 'Калининград', 3]);
+  RxMemoryData1.AppendRecord([19,'Строка с длинным текстом 19', now - 3, 5000, 'Россия', 'Владивасток', 2]);
+  RxMemoryData1.AppendRecord([20,'Строка с длинным текстом 20', now - 4, 123.31, 'USA', 'New-York', 1]);
+  RxMemoryData1.First;
+
+  CreateFontDirList;
+  DebugFonts;
+end;
+
+procedure TForm1.CreateFontDirList;
+var
+  s: String;
+begin
+  FontDirList := TStringList.Create;
+ {$IFDEF WINDOWS}
+  s := SHGetFolderPathUTF8(20); // CSIDL_FONTS = 20
+  if s <> '' then
+    FontDirList.Add(s);
+ {$ENDIF}
+ {$IFDEF linux}
+  FontDirList.Add('/usr/share/cups/fonts/');
+  FontDirList.Add('/usr/share/fonts/');
+  FontDirList.Add('/usr/local/lib/X11/fonts/');
+  FontDirList.Add(GetUserDir + '.fonts/');
+ {$ENDIF}
+end;
+
+procedure TForm1.InitFonts;
+begin
+  if FontDirList = nil then
+    CreateFontDirList;
+end;
+
+procedure TForm1.ShowInfo(AText: string; AParams: array of const);
+begin
+  Memo1.Lines.Add(Format(AText, AParams));
+end;
+
+procedure TForm1.DebugFonts;
+var
+  i: Integer;
+begin
+  Memo1.Lines.Clear;
+  gTTFontCache.BuildFontCacheIgnoresErrors:=true;
+  gTTFontCache.SearchPath.Assign(FontDirList);
+  gTTFontCache.BuildFontCache;
+
+  for i:=0 to gTTFontCache.Count-1 do
+  begin
+    ShowInfo('%s - %s - %s', [gTTFontCache.Items[i].FileName, gTTFontCache.Items[i].FamilyName,  gTTFontCache.Items[i].PostScriptName]);
+  end;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  RxDBGridExportPDF1.ShowSetupForm:=false;
+  RxDBGridExportPDF1.Execute;
+  RxDBGridExportPDF1.ShowSetupForm:=true;
+end;
+
+procedure TForm1.CheckBox1Change(Sender: TObject);
+begin
+  RxDBGridExportPDF1.Enabled:=CheckBox1.Checked;
+end;
+
+procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  FreeAndNil(FontDirList);
+end;
+
+end.
+
+{
+'Conakry'
+'DejaVu Sans'
+'DejaVu Sans Condensed'
+'DejaVu Sans Light'
+'DejaVu Sans Mono'
+'DejaVu Serif'
+'DejaVu Serif Condensed'
+
+'Denemo'
+
+'FreeSans'
+'Caladea'
+'Carlito'
+}