qexport4common.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

    S_DOCX_UseBackground = 'UseBackground';
    S_DOCX_BackgroundColor = 'BackgroundColor';
    S_DOCX_UseHighlight = 'UseHighlight';
    S_DOCX_HighlightColor = 'HighlightColor';
  S_DOCX_OPTIONS = 'DOCX_OPTIONS_';
  S_DOCX_STRIP_STYLE = 'DOCX_STRIP_STYLE_';
  
  //--- TFont
  S_FontName      = 'FontName';
  S_FontSize      = 'FontSize';
  S_FontBold      = 'FontBold';
  S_FontItalic    = 'FontItalic';
  S_FontUnderline = 'FontUnderline';
  S_FontStrikeOut = 'FontStrikeOut';
  S_FontColor     = 'FontColor';
  S_FontCharset   = 'FontCharset';

  S_Commit = 'COMMIT WORK;';
  S_CreateTable = 'CREATE TABLE %s';
  S_Insert = 'INSERT INTO %s';
  S_Values = 'VALUES';

  S_Index = 'Index';
  S_First = 'First';
  S_Prior = 'Prior';
  S_Next = 'Next';
  S_Last = 'Last';

  DefaultDotPerInch = 72;
  DefaultMMPerInch  = 25.4;

var
  DefaultDateFormat: string;
  DefaultTimeFormat: string;
  DefaultDateTimeFormat: string;
  DefaultCurrencyFormat: string;

procedure EditFontStyle(Font: TFont; Style: TFontStyle; Add: boolean);
procedure EditFontStyleXLS(Font: TxlsFont; Style: TxlsFontStyle; Add: boolean);
procedure SaveFontToIniFile(Font: TFont; IniFile: TQIniFile;
  const Section: string);
procedure LoadFontFromIniFile(Font, Default: TFont; IniFile: TQIniFile;
  const Section: string);

{$IFNDEF NOGUI}
procedure RTFItemEditFontStyle(Item: TListItem; Style: TFontStyle;
  Add: boolean);
procedure XLSItemEditFontStyle(Item: TListItem; Style: TxlsFontStyle;
  Add: boolean); // uncomment by pai
procedure XLSCustomFormatEditFontStyle(Item: TxlsCustomItem;
  Style: TxlsFontStyle; Add: boolean);
procedure PaintXLSColors(PaintBox: TPaintBox; AColor: TxlsColor);
procedure PaintStandardColors(PaintBox: TPaintBox; AColor: TColor);
procedure XLSItemSetUnderline(Item: TListItem; Underline: TxlsFontUnderline); // uncomment by pai
procedure XLSCustomItemSetUnderline(Item: TxlsCustomItem;
  Underline: TxlsFontUnderline);
procedure XLSItemSetHorAlignment(Item: TListItem;
  HorAlignment: TxlsHorizontalAlignment); // uncomment by pai
procedure XLSCustomItemSetHorAlignment(Item: TxlsCustomItem;
  HorAlignment: TxlsHorizontalAlignment);
procedure RTFItemSetAlignment(Item: TListItem; Alignment: TrtfTextAlignment);
procedure XLSItemSetVertAlignment(Item: TListItem;
  VertAlignment: TxlsVerticalAlignment); // uncomment by pai
procedure XLSCustomItemSetVertAlignment(Item: TxlsCustomItem;
  VertAlignment: TxlsVerticalAlignment);
procedure DrawXLSCell(PaintBox: TPaintBox; Format: TxlsFormat);
procedure DrawRTFSample(PaintBox: TPaintBox; rtfStyle: TrtfStyle);
procedure DrawBorderStyle(Style: TxlsBorderStyle; Canvas: TCanvas; Rect: TRect);
procedure DrawPDFSample(PaintBox: TPaintBox; PDFFont: TFont);


procedure SelectFontForPaintBox(FontDialog: TFontDialog; AFont: TFont;
  APaintBox: TPaintBox);
procedure PaintSampleFont(AFont: TFont; APaintBox: TPaintBox;
  PaintColor: boolean);

procedure DrawPattern(Canvas: TCanvas; Index, X, Y: integer);

procedure IncLeftAndTop(Control: TControl);
procedure DecLeftAndTop(Control: TControl);

procedure SetListItemIndex(Item: TListItem; Index: integer);
function MoveListItem(Item: TListItem; Dst: TListView; Move: boolean;
  Index: integer): TListItem;

function GetTextWidth(Control: TControl; const Text: string): integer;

procedure ForAllListViewItems(ListView: TListView; Proc: TListItemProc;
  IsDownTo, All: boolean);
procedure ForAllListViewCustomItems(ListView: TListView;
  Proc: TxlsCustomItemProc; IsDownTo, All: boolean);

function GetMemoCaretPos(Memo: TMemo): {$IFDEF WIN32}TPoint{$ELSE}TCaretPos{$ENDIF};
{$ENDIF}

procedure SetDefaultRTFCaption(Style: TrtfStyle);
procedure SetDefaultXLSCaption(Format: TxlsFormat);
function ColorByXLSColor(XLSColor: TxlsColor): TColor;
function ColorToXLSColor(Color: TColor): TxlsColor;
function ColorToHex(Color: TColor) : string;

function CalcStringType(const S,
  BooleanTrue, BooleanFalse: QEString): TQExportColType;

procedure QExportCheckSource(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4 
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
function QExportSource(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): TComponent;
procedure QExportGetColumns(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4; 
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF}ExportedFields, AvailableCols,
  ExportedCols: TStrings);
function QExportIsActive(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): boolean;
function QExportIsEmpty(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): boolean;
function QExportGetBookmark(ExportSource: TQExportSource; DataSet: TDataSet;
  CustomSource: TqeCustomSource4{$IFNDEF NOGUI}; DBGrid: TDBGrid;
  ListView: TListView; StringGrid: TStringGrid{$ENDIF}): TBookmark;
procedure QExportGotoBookmark(ExportSource: TQExportSource; DataSet: TDataSet;
  CustomSource: TqeCustomSource4;{$IFNDEF NOGUI}DBGrid: TDBGrid;
  ListView: TListView; StringGrid: TStringGrid;{$ENDIF} Bookmark: TBookmark);
procedure QExportFreeBookmark(ExportSource: TQExportSource; DataSet: TDataSet;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} Bookmark: TBookmark);
procedure QExportFirst(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI};DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
procedure QExportNext(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} var RecordCounter: integer);
procedure QExportSkip(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} SkipRecCount: integer;
  SkipEvent: TExportedRecordEvent; Sender: TObject; var RecordCounter: integer);
function QExportEof(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} RecordCounter, ExportRecCount,
  SkipRecCount: integer): boolean;
procedure QExportGetColData(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView; StringGrid: TStringGrid;{$ENDIF}
  Columns: TQExportColumns; Formats: TQExportFormats;
  Index, RecordCounter, SkipRecCount: integer;
  var Value: QEString; var Data: Variant);
procedure QExportDisableControls(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
procedure QExportEnableControls(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource4
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});

procedure ClearIniFile(IniFile: TQIniFile);
function Replace(const S, OldPattern, NewPattern: string): string;
function GetListSeparator: char;

function MinimumInt(V1, V2: integer): integer;
function MaximumInt(V1, V2: integer): integer;

{$IFNDEF NOGUI}
{$IFDEF WIN32}
function GetDisplayTextWidth(const Text: string; Font: TFont): integer;
{$ENDIF}
{$ENDIF}

{$IFDEF LINUX}
function RGB(Red, Green, Blue: byte): integer;
{$ENDIF}

function Str2Char(const Str: string): char;
function Char2Str(Chr: char): string;
function StrToDblDef(const Str: string; Default: double): double;

function InchToDot(const Value: double): integer;
function MMToDot(const Value: double): integer;
function DotToInch(const Value: integer): double;
function DotToMM(const Value: integer): double;
function GetPageFormatString(const pfFormat: TQExportPageFormat): string;
function GetPageFormatInchWidth(const pfFormat: TQExportPageFormat): double;
function GetPageFormatInchHeight(const pfFormat: TQExportPageFormat): double;
function RoundFraction(const X: double; const Digit: integer): double;
function Units2Dot(Units: TQExportUnits; Value: double): integer;
function Dot2Units(Units: TQExportUnits; Value: integer): double;

function AddNumberToFileName(const FileName: string; Number, Digits: integer): string;
function IniFileSectionExists(IniFile: TQIniFile; const Section: string): Boolean;
function IniFileValueExists(IniFile: TQIniFile; const Section, Ident: string): Boolean;

{$IFDEF QE_UNICODE}
function WideStringToString (const ws: WideString; codePage: Word): AnsiString;
{$ENDIF}
{$IFNDEF VCL7}
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
{$ENDIF}

implementation

uses {$IFDEF WIN32}QExport4StrIDs{$ENDIF}
     {$IFDEF LINUX}QExport4Consts, SysUtils{$ENDIF}, SysUtils, Math;

procedure EditFontStyle(Font: TFont; Style: TFontStyle; Add: boolean);
begin
  if Add
    then Font.Style := Font.Style + [Style]
    else Font.Style := Font.Style - [Style];
end;


procedure EditFontStyleXLS(Font: TxlsFont; Style: TxlsFontStyle; Add: boolean);
begin
  if Add
    then Font.Style := Font.Style + [Style]
    else Font.Style := Font.Style - [Style];
end;

{$IFNDEF NOGUI}
procedure RTFItemEditFontStyle(Item: TListItem; Style: TFontStyle;
  Add: boolean);
begin
  EditFontStyle(TrtfStyle(Item.Data).Font, Style, Add);
end;

procedure XLSItemEditFontStyle(Item: TListItem; Style: TxlsFontStyle;
  Add: boolean);
begin
  EditFontStyleXLS(TxlsFormat(Item.Data).Font, Style, Add);
end;

procedure XLSCustomFormatEditFontStyle(Item: TxlsCustomItem;
  Style: TxlsFontStyle; Add: boolean);
var
  Font: TxlsFont;
begin
  Font := nil;
  case Item.ItemType of
    itFormat,
    itFieldFormat: Font := (Item as TxlsFormat).Font;
    itNoteFormat: Font := (Item as TxlsNoteFormat).Font;
    itHyperlink: Font := (Item as TxlsHyperlink).Format.Font;
    itNote: Font := (Item as TxlsNote).Format.Font;
  end;

  if Assigned(Font) then
    EditFontStyleXLS(Font, Style, Add);
end;

procedure PaintXLSColors(PaintBox: TPaintBox; AColor: TxlsColor);
begin
  with PaintBox.Canvas do begin
    Brush.Color := ColorByXLSColor(AColor);
    FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;
end;

procedure PaintStandardColors(PaintBox: TPaintBox; AColor: TColor);
begin
  with PaintBox.Canvas do begin
    Brush.Color := AColor;
    FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;
end;

procedure XLSItemSetUnderline(Item: TListItem; Underline: TxlsFontUnderline);
begin
  TxlsFormat(Item.Data).Font.Underline := Underline;
end;

procedure XLSCustomItemSetUnderline(Item: TxlsCustomItem;
  Underline: TxlsFontUnderline);
begin
  if not Assigned(Item) then Exit;
  case Item.ItemType of
    itFormat,
    itFieldFormat: (Item as TxlsFormat).Font.Underline := Underline;
    itNoteFormat: (Item as TxlsNoteFormat).Font.Underline := Underline;
    itHyperlink: (Item as TxlsHyperlink).Format.Font.Underline := Underline;
    itNote: (Item as TxlsNote).Format.Font.Underline := Underline;
  end;
end;

procedure XLSItemSetHorAlignment(Item: TListItem;
  HorAlignment: TxlsHorizontalAlignment);
begin
  TxlsFormat(Item.Data).Alignment.Horizontal := HorAlignment;
end;

procedure XLSCustomItemSetHorAlignment(Item: TxlsCustomItem;
  HorAlignment: TxlsHorizontalAlignment);
begin
  if not Assigned(Item) then Exit;
  case Item.ItemType of
    itFormat,
    itFieldFormat: (Item as TxlsFormat).Alignment.Horizontal := HorAlignment;
    itNoteFormat: (Item as TxlsNoteFormat).Alignment.Horizontal := HorAlignment;
    itHyperlink: (Item as TxlsHyperlink).Format.Alignment.Horizontal := HorAlignment;
    itNote: (Item as TxlsNote).Format.Alignment.Horizontal := HorAlignment;
  end;
end;

procedure RTFItemSetAlignment(Item: TListItem; Alignment: TrtfTextAlignment);
begin
  TrtfStyle(Item.Data).Alignment := Alignment;
end;

procedure XLSItemSetVertAlignment(Item: TListItem;
  VertAlignment: TxlsVerticalAlignment);
begin
  TxlsFormat(Item.Data).Alignment.Vertical := VertAlignment;
end;

procedure XLSCustomItemSetVertAlignment(Item: TxlsCustomItem;
  VertAlignment: TxlsVerticalAlignment);
begin
  if not Assigned(Item) then Exit;
  case Item.ItemType of
    itFormat,
    itFieldFormat: (Item as TxlsFormat).Alignment.Vertical := VertAlignment;
    itNoteFormat: (Item as TxlsNoteFormat).Alignment.Vertical := VertAlignment;
    itHyperlink: (Item as TxlsHyperlink).Format.Alignment.Vertical := VertAlignment;
    itNote: (Item as TxlsNote).Format.Alignment.Vertical := VertAlignment;
  end;
end;

{$ENDIF}

procedure SetDefaultRTFCaption(Style: TrtfStyle);
begin
  Style.SetDefault;
  EditFontStyle(Style.Font, fsBold, true);
  Style.Alignment := talCenter;
end;

procedure SetDefaultXLSCaption(Format: TxlsFormat);
begin
  Format.SetDefault;
  EditFontStyleXLS(Format.Font, xfsBold, true);
end;

function ColorByXLSColor(XLSColor: TxlsColor): TColor;
begin
  Result := XLS_STANDARD_PALETTE[Integer(XLSColor)];
end;

function ColorToXLSColor(Color: TColor): TxlsColor;
var
  i: integer;
begin
  Result := clrBlack;
  for i := 0 to 39 do
    if XLS_STANDARD_PALETTE[i] = Color then begin
      Result := TxlsColor(i);
      Break;
    end;
end;

function ColorToHex(Color: TColor) : string;
begin
  Result :=
    IntToHex(GetRValue(Color), 2) +
    IntToHex(GetGValue(Color), 2) +
    IntToHex(GetBValue(Color), 2) ;
end;

{$IFNDEF NOGUI}
procedure DrawBorderStyle(Style: TxlsBorderStyle; Canvas: TCanvas; Rect: TRect);

  function DrawLine(Canvas: TCanvas; x1, y1, x2, y2, x3: integer): integer;
  begin
    Result := 0;
    with Canvas do begin
      MoveTo(x1, y1);
      if x2 >= x3 then begin
        x2 := x3;
        Result := -1;
      end;
      LineTo(x2, y2);
    end;
  end;