qexport3common.pas

DELPHI开发VCL

  DataSet: TDataSet; CustomSource: TqeCustomSource
  {$IFNDEF NOGUI};DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
procedure QExportNext(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} var RecordCounter: integer);
procedure QExportSkip(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource;
  {$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: TqeCustomSource;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid;{$ENDIF} RecordCounter, ExportRecCount,
  SkipRecCount: integer): boolean;
function QExportGetColData(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource;
  {$IFNDEF NOGUI}DBGrid: TDBGrid; ListView: TListView; StringGrid: TStringGrid;{$ENDIF}
  Columns: TQExportColumns; Formats: TQExportFormats; NormalFunc: TNormalFunc;
  Index, RecordCounter, SkipRecCount: integer; NeedFormat: boolean): string;
function QExportFormatData(const DataStr, Format: string;
  ColType: TQExportColType; NormalFunc: TNormalFunc): string;
procedure QExportDisableControls(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
procedure QExportEnableControls(ExportSource: TQExportSource;
  DataSet: TDataSet; CustomSource: TqeCustomSource
  {$IFNDEF NOGUI}; DBGrid: TDBGrid; ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});

procedure ClearIniFile(IniFile: TIniFile);
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: TIniFile; const Section: string): Boolean;
function IniFileValueExists(IniFile: TIniFile; const Section, Ident: string): Boolean;

implementation

uses {$IFDEF WIN32}QExport3StrIDs{$ENDIF}
     {$IFDEF LINUX}QExport3Consts, 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;

{$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;

var
  x, y, l: integer;
begin
  with Canvas do begin
    Pen.Style := psSolid;
    case Style of
      bstMedium,
      bstMediumDashed,
      bstMediumDashDot,
      bstSlantedDashDot,
      bstMediumDashDotDot: Pen.Width := 2;
      bstThick: Pen.Width := 3;
      else Pen.Width := 1;
    end;

    l := (Rect.Right - Rect.Left) - 10;
    y := (Rect.Bottom + Rect.Top) div 2;
    x := 10;
    case Style of
      bstNone: TextOut((Rect.Right + Rect.Left - TextWidth({$IFDEF WIN32}QExportLoadStr(QED_XLS_Border_None){$ENDIF}
                                                           {$IFDEF LINUX}QED_XLS_Border_None{$ENDIF})) div 2,
                       (Rect.Bottom + Rect.Top - TextHeight({$IFDEF WIN32}QExportLoadStr(QED_XLS_Border_None){$ENDIF}
                                                            {$IFDEF LINUX}QED_XLS_Border_None{$ENDIF})) div 2,
                                                            {$IFDEF WIN32}QExportLoadStr(QED_XLS_Border_None){$ENDIF}
                                                            {$IFDEF LINUX}QED_XLS_Border_None{$ENDIF});

      bstThin,
      bstMedium,
      bstThick: DrawLine(Canvas, x, y, x + l, y, l);

      bstDashed,
      bstMediumDashed: while DrawLine(Canvas, x, y, x + 7, y, l) = 0  do Inc(x, 14);

      bstDotted: while DrawLine(Canvas, x, y, x + 3, y, l) = 0  do Inc(x, 6);

      bstDouble: begin
        DrawLine(Canvas, x, y - 1, x + l, y - 1, l);
        DrawLine(Canvas, x, y + 1, x + l, y + 1, l);
      end;

      bstHair: while DrawLine(Canvas, x, y, x + 2, y, l) = 0  do Inc(x, 4);

      bstDashDot,
      bstMediumDashDot,
      bstSlantedDashDot:
        while (DrawLine(Canvas, x, y, x + 7, y, l) = 0) do begin
          if DrawLine(Canvas, x + 11, y, x + 14, y, l) <> 0 then Break;
          Inc(x, 18);
        end;

      bstDashDotDot,
      bstMediumDashDotDot:
        while DrawLine(Canvas, x, y, x + 7, y, l) = 0 do begin
          if DrawLine(Canvas, x + 11, y, x + 14, y, l) <> 0 then Break;
          if DrawLine(Canvas, x + 18, y, x + 21, y, l) <> 0 then Break;
          Inc(x, 25);
        end
    end;
  end;
end;

procedure DrawPattern(Canvas: TCanvas; Index, X, Y: integer);
begin
  with Canvas do
    case Index of
      $02: begin
        MoveTo(X, Y);
        LineTo(X + 1, Y);
        MoveTo(X + 2, Y);
        LineTo(X + 3, Y);

        MoveTo(X + 1, Y + 1);
        LineTo(X + 2, Y + 1);
        MoveTo(X + 3, Y + 1);
        LineTo(X + 4, Y + 1);

        MoveTo(X, Y + 2);
        LineTo(X + 1, Y + 2);
        MoveTo(X + 2, Y + 2);
        LineTo(X + 3, Y + 2);

        MoveTo(X + 1, Y + 3);
        LineTo(X + 2, Y + 3);
        MoveTo(X + 3, Y + 3);
        LineTo(X + 4, Y + 3);
      end;
      $03: begin
        MoveTo(X + 1, Y);
        LineTo(X + 4, Y);

        MoveTo(X, Y + 1);
        LineTo(X + 2, Y + 1);
        MoveTo(X + 3, Y + 1);
        LineTo(X + 4, Y + 1);

        MoveTo(X + 1, Y + 2);
        LineTo(X + 4, Y + 2);

        MoveTo(X, Y + 3);
        LineTo(X + 2, Y + 3);
        MoveTo(X + 3, Y + 3);
        LineTo(X + 4, Y + 3);
      end;
      $04: begin
        MoveTo(X, Y);
        LineTo(X + 1, Y);

        MoveTo(X + 2, Y + 1);
        LineTo(X + 3, Y + 1);

        MoveTo(X, Y + 2);
        LineTo(X + 1, Y + 2);

        MoveTo(X + 2, Y + 3);
        LineTo(X + 3, Y + 3);
      end;
      $05: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y);

        MoveTo(X, Y + 1);
        LineTo(X + 4, Y + 1);
      end;
      $06: begin
        MoveTo(X, Y);
        LineTo(X, Y + 4);

        MoveTo(X + 1, Y);
        LineTo(X + 1, Y + 4);
      end;
      $07: begin
        MoveTo(X + 1, Y);
        LineTo(X + 5, Y + 4);

        MoveTo(X, Y);
        LineTo(X + 4, Y + 4);
      end;
      $08: begin
        MoveTo(X + 3, Y);
        LineTo(X - 1, Y + 4);

        MoveTo(X + 4, Y);
        LineTo(X, Y + 4);
      end;
      $09: begin
        MoveTo(X, Y);
        LineTo(X + 2, Y);

        MoveTo(X, Y + 1);
        LineTo(X + 2, Y + 1);

        MoveTo(X + 2, Y + 2);
        LineTo(X + 4, Y + 2);

        MoveTo(X + 2, Y + 3);
        LineTo(X + 4, Y + 3);
      end;
      $0A: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y);

        MoveTo(X, Y + 1);
        LineTo(X + 2, Y + 1);

        MoveTo(X + 2, Y + 2);
        LineTo(X + 4, Y + 2);

        MoveTo(X, Y + 3);
        LineTo(X + 4, Y + 3);
      end;
      $0B: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y);
      end;
      $0C: begin
        MoveTo(X, Y);
        LineTo(X, Y + 4);
      end;
      $0D: begin
        MoveTo(X, Y);
        LineTo(X + 4, Y + 4);
      end;
      $0E: begin
        MoveTo(X + 4, Y);
        LineTo(X, Y + 4);