mxexport.pas

Export dbgrid to other doc

  FOptions := [ reSetMargins, reUseBorders ];
  FTopMargin := 0.30;
  FBottomMargin := 0.30;
  FLeftMargin := 0.30;
  FRightMargin := 0.30;

  FHeader := '';
  FFooter := '&P';
  FExcelVersion := xls50;
  FDefaultFont := TFont.Create;

  FHeaderFont := TFont.Create;
  FHeaderFont.Style := [ fsBold ];

  FTableFont := TFont.Create;

{$ELSE}

  FOptions := [ ];
  FPageSetup := TmxExcelPageSetup.Create;
  FExcelVersion := fvExcel97;
  FDefaultFont := TmxExcelFont.Create;
  FSummaryInfo := TmxSummaryInfo.Create;

  Codepage := cp1252_Latin1;
  CustomCodepage := 1252;

  FHeaderFormat := TmxExportCellFormat.Create;
  FTableFormat := TmxExportCellFormat.Create;
{$ENDIF}
End;

// *************************************************************************************
// ** TmxExcelOptions.Destroy, 6/7/01 4:11:28 PM
// *************************************************************************************

Destructor TmxExcelOptions.Destroy;
Begin
  FDefaultFont.Free;

{$IFDEF NATIVEEXCEL_STANDARD}
  FHeaderFont.Free;
  FTableFont.Free;
{$ELSE}
  FSummaryInfo.Free;
  FHeaderFormat.Free;
  FTableFormat.Free;
  FPageSetup.Free;
{$ENDIF}
  Inherited Destroy;
End;

// *************************************************************************************
// ** TmxExcelOptions.AssignTo, 6/7/01 4:32:09 PM
// *************************************************************************************

Procedure TmxExcelOptions.AssignTo( Dest: TPersistent );
Begin
  If Dest Is TmxExcelOptions Then
    With TmxExcelOptions( Dest ) Do
    Begin
      FOptions := Self.Options;

{$IFDEF NATIVEEXCEL_STANDARD}
      FTopMargin := Self.TopMargin;
      FBottomMargin := Self.BottomMargin;
      FLeftMargin := Self.LeftMargin;
      FRightMargin := Self.RightMargin;

      FHeader := Self.Header;
      FFooter := Self.Footer;
      FHeaderFont.Assign( Self.HeaderFont );
      FTableFont.Assign( Self.TableFont );
{$ELSE}
      FPageSetup.Assign( Self.PageSetup );
      FHeaderFormat.Assign( Self.HeaderFormat );
      FTableFormat.Assign( Self.TableFormat );
{$ENDIF}
      FColumnWidth := Self.ColumnWidth;
      FProtected := Self.Protected;
      FExcelVersion := Self.ExcelVersion;

      FDefaultFont.Assign( Self.DefaultFont );
    End
  Else Inherited AssignTo( Dest );
End;

// *************************************************************************************
// ** TmxExcelOptions.SetDefaultFont, 6/7/01 4:38:20 PM
// *************************************************************************************

{$IFDEF NATIVEEXCEL_STANDARD}

Procedure TmxExcelOptions.SetDefaultFont( AValue: TFont );
Begin
  FDefaultFont.Assign( AValue );
End;

{$ELSE}

Procedure TmxExcelOptions.SetDefaultFont( AValue: TmxExcelFont );
Begin
  FDefaultFont.Assign( AValue );
End;

{$ENDIF}

// *************************************************************************************
// ** TmxExcelOptions.SetHeaderFont, 6/5/01 10:42:07 AM
// *************************************************************************************

{$IFDEF NATIVEEXCEL_STANDARD}

Procedure TmxExcelOptions.SetHeaderFont( AValue: TFont );
Begin
  FHeaderFont.Assign( AValue );
End;

{$ENDIF}

// *************************************************************************************
// ** TmxExcelOptions.SetTableFont, 6/5/01 10:42:04 AM
// *************************************************************************************

{$IFDEF NATIVEEXCEL_STANDARD}

Procedure TmxExcelOptions.SetTableFont( AValue: TFont );
Begin
  FTableFont.Assign( AValue );
End;

{$ENDIF}

// *************************************************************************************
// *************************************************************************************
// *************************************************************************************
// ** TmxMessagesOptions.Create, 5/17/01 5:26:57 PM
// *************************************************************************************
// *************************************************************************************
// *************************************************************************************

Constructor TmxMessagesOptions.Create;
Begin
  Inherited Create;

  FCaption := rsExportCaption;
  FCreatedText := rsCreated;
  FText := rsProcessing;
  FWidth := 300;
  FHeight := 80;
  FFalseText := rsFalse;
  FTrueText := rsTrue;
  FExportCaption := rsExport;
  FCancelCaption := rsCancel;
  FSelectFormat := rsSelectFormat;
  FExportToFile := rsExportToFile;
  FViewOnly := rsViewOnly;
  FCopiedToClipboard := rsCopiedToClipboard;
  FDocumentFilter := TmxDocumentFilter.Create;
  FSaveTitle := rsSaveTitle;
End;

// *************************************************************************************
// ** TmxMessagesOptions.Destroy, 5/30/01 4:38:43 PM
// *************************************************************************************

Destructor TmxMessagesOptions.Destroy;
Begin
  FDocumentFilter.Free;

  Inherited Destroy;
End;

// *************************************************************************************
// *************************************************************************************
// *************************************************************************************
// ** TmxCustomExport.Create, 5/16/01 2:25:39 PM
// *************************************************************************************
// *************************************************************************************
// *************************************************************************************

Constructor TmxCustomExport.Create( AOwner: TComponent );
Var
  Buffer: Array[ 0..512 ] Of Char;
Begin
  Inherited Create( AOwner );

  FVersion := mxExportVersion;

  FExportTypes := [ xtHTML, xtExcel, xtWord, xtTXT, xtCSV, xtTAB, xtRTF, xtDIF, xtSYLK, xtClipboard ];
  FOptions := [ xoShowProgress, xoClipboardMessage, xoHeaderLine, xoFooterLine, xoShowHeader, xoShowExportDate, xoUseAlignments ];

  FCaptions := TStringList.Create;
  FColumnWidths := TStringList.Create;

  FFileName := '';
  FExportType := xtExcel;
  FExportStyle := xsView;
  FTruncateSymbol := '...';

  SetString( FTempDirectory, Buffer, GetTempPath( 512, Buffer ) );

  FHTML := TmxHTMLOptions.Create;
  FDOC_RTF := TmxRTFOptions.Create;

  FMessages := TmxMessagesOptions.Create;

  FRowNumberFormat := '%d';

  FDateFormat := ShortDateFormat;
  FTimeFormat := ShortTimeFormat;
  FDateTimeFormat := ShortTimeFormat + ' ' + ShortDateFormat;

  FRTFStream := TMemoryStream.Create;

  FExcel := TmxExcelOptions.Create;

  FmxNativeExcel := TmxNativeExcel.Create( Self );

{$IFNDEF NATIVEEXCEL_STANDARD}
  FmxNativeExcel.SheetNumber := 1;
{$ENDIF}

  frm_ProgressForm := Tfrm_ProgressForm.Create( Nil );
  frm_Selection := Tfrm_Selection.Create( Nil );
  frm_Selection.IconImage.OnPaint := IconImagePaint;
End;

// *************************************************************************************
// ** TmxCustomExport.Destroy, 5/16/01 2:25:37 PM
// *************************************************************************************

Destructor TmxCustomExport.Destroy;
Begin
  frm_Selection.IconImage.OnPaint := Nil;
  frm_Selection.Free;
  frm_ProgressForm.Free;

  FExcel.Free;
  FmxNativeExcel.Free;
  FCaptions.Free;
  FColumnWidths.Free;
  FHTML.Free;
  FDOC_RTF.Free;
  FMessages.Free;
  FRTFStream.Free;
  Inherited Destroy;
End;

// *************************************************************************************
// ** RemoveBackSlash, 8/10/01 7:31:00 AM
// *************************************************************************************

Function RemoveBackSlash( Const DirectoryName: String ): String;
Begin
  Result := DirectoryName;
  If ( Length( Result ) > 1 ) And ( Result[ Length( Result ) ] = '\' ) Then
  Begin
    If Not ( ( Length( Result ) = 3 ) And ( UpCase( Result[ 1 ] ) In [ 'A'..'Z' ] ) And ( Result[ 2 ] = ':' ) ) Then
      Delete( Result, Length( Result ), 1 );
  End;
End;

// *************************************************************************************
// ** TmxCustomExport.IsTempStored, 8/3/01 9:46:19 AM
// *************************************************************************************

Function TmxCustomExport.IsTempStored: Boolean;
Var
  Buffer: Array[ 0..512 ] Of Char;
Begin
  Result := FALSE;
  If FTempDirectory = '' Then Exit;

  GetTempPath( 512, Buffer );
  Result := AnsiCompareText( RemoveBackSlash( FTempDirectory ), RemoveBackSlash( String( Buffer ) ) ) <> 0;
End;

// *************************************************************************************
// ** TmxCustomExport.SetTempDirectory, 8/10/01 7:32:36 AM
// *************************************************************************************

Procedure TmxCustomExport.SetTempDirectory( AValue: String );
Begin
  If AnsiCompareText( RemoveBackSlash( FTempDirectory ), RemoveBackSlash( AValue ) ) <> 0 Then
  Begin
    FTempDirectory := AValue;
  End;
End;

// *************************************************************************************
// ** TmxCustomExport.BeforeExecute, 6/12/01 9:32:07 AM
// *************************************************************************************

Procedure TmxCustomExport.BeforeExecute;
Begin
        // *** Does Nothing ***
End;

// *************************************************************************************
// ** TmxCustomExport.AfterExecute, 6/12/01 9:32:00 AM
// *************************************************************************************

Procedure TmxCustomExport.AfterExecute;
Begin
        // *** Does Nothing ***
End;

// *************************************************************************************
// ** TmxCustomExport.SetVersion, 5/17/01 9:42:44 AM
// *************************************************************************************

Procedure TmxCustomExport.SetVersion( AValue: String );
Begin
        // *** Does nothing ***
End;

// *************************************************************************************
// ** TmxCustomExport.GetVersion, 5/17/01 9:42:49 AM
// *************************************************************************************

Function TmxCustomExport.GetVersion: String;
Begin
{$WARNINGS OFF}
  Result := Format( '%d.%d', [ Hi( FVersion ), Lo( FVersion ) ] );
{$WARNINGS ON}
End;

// *************************************************************************************
// ** TmxCustomExport.SetExportTypes, 5/29/01 2:25:53 PM
// *************************************************************************************

Procedure TmxCustomExport.SetExportTypes( AValues: TmxExportTypeSet );
Begin
  If FExportTypes <> AValues Then
  Begin
    FExportTypes := AValues;
    If Not ( FExportType In FExportTypes ) Then Include( FExportTypes, FExportType );
  End;
End;

// *************************************************************************************
// ** TmxCustomExport.SetExportType, 5/29/01 2:31:09 PM
// *************************************************************************************

Procedure TmxCustomExport.SetExportType( AValue: TmxExportType );
Begin
  If FExportType <> AValue Then
  Begin
    FExportType := AValue;
    If Not ( FExportType In FExportTypes ) Then Include( FExportTypes, FExportType );
  End;
End;

// *************************************************************************************
// ** TmxCustomExport._GetFieldLength, 5/28/01 12:24:53 PM
// *************************************************************************************

Function TmxCustomExport._GetFieldLength( Index: Integer; Len: Integer ): Integer;
Var
  ResCode: Integer;
  TempInt: Integer;
Begin
  Result := Len;
  If Index > GetFieldCount - 1 Then Exit;

  If FColumnWidths.Count - 1 >= Index Then
  Begin
    Val( FColumnWidths[ Index ], TempInt, ResCode );

    If ResCode = 0 Then Result := TempInt Else Result := Len;

          {Try
               Result := StrToInt( FColumnWidths[ Index ] );
          Except
               Result := Len;
          End;}
  End;
End;

// *************************************************************************************
// ** TmxCustomExport.AddHorizontalLine, 5/29/01 12:15:48 PM
// *************************************************************************************

Function TmxCustomExport.AddHorizontalLine( Header: Boolean ): String;
Begin
  Res