unit uGridClipboardUtils; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxGrid; procedure PegarAlGridDesdePortapapeles (AGrid : TcxGrid); procedure CopiarSeleccionGridAlPortapapeles (AGrid : TcxGrid); procedure CortarSeleccionGridAlPortapapeles (AGrid : TcxGrid); function HayDatosEnPortapapeles(AFormat: Cardinal = 0): Boolean; procedure CopiarGridAlPortapapelesRTF (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false); procedure CopiarGridAlPortapapelesHTML (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false); procedure CopiarGridAlPortapapelesTXT (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false); procedure CopiarGridAlPortapapelesExcel (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false); var CF_FACTUGES : Cardinal; CF_RTF : Cardinal; CF_HTML: Cardinal; implementation uses cxVariants, CtlToRTF, Clipbrd, DB, cxExport, cxGridExportLink, cxCustomData, uSistemaFunc, ClipboardUtils, cxDBData, cxGridLevel, uStringsUtils, cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridDBDataDefinitions, uGridStatusUtils, uDADataTable, uCalculosUtils, uControllerDetallesBase; type TTipoAnadir = (taAnadir, taInsertar); procedure RegistrarFormatos; begin CF_FACTUGES := RegisterClipboardFormat ('FactuGES Format'); if CF_FACTUGES = 0 then raise Exception.Create('Error al registrar formato CF_FACTUGES'); CF_HTML := RegisterClipboardFormat ('HTML Format'); if CF_HTML = 0 then raise Exception.Create('Error al registrar formato CF_HTML'); CF_RTF := RegisterClipboardFormat('Rich Text Format'); if CF_RTF = 0 then raise Exception.Create('Error al registrar formato CF_RTF (CopiarSeleccionGridAlPortapapelesRTF)'); end; function _BuscarColumna (AView: TcxGridDBTableView; const AName, ATypeValue : String; var AIndex : Integer) : Boolean; var i : Integer; bNombreOk : Boolean; begin AIndex := -1; Result := False; for i := 0 to AView.ItemCount - 1 do begin if (AView.Items[i].DataBinding is TcxGridItemDBDataBinding) then with (AView.Items[i].DataBinding as TcxGridItemDBDataBinding) do bNombreOk := (FieldName = AName) else bNombreOk := (AView.Items[i].Caption = AName); if bNombreOk and (AView.Items[i].DataBinding.ValueType = ATypeValue) then begin AIndex := i; Result := True; Break; end; end; end; {$REGION 'LoadGridRowsFromStream'} procedure LoadGridRowsFromStream(AView : TcxGridDBTableView; AStream: TStream; var ACaption : String); var AValueNameList: TStringList; AValueTypeList: TStringList; ARecordID : Integer; ARecordIndex : Integer; bEstabaVacia : Boolean; iContador : Integer; AValueName, AValueType : String; iCols, NumCols : integer; NumFilas: Integer; AReader: TcxReader; AValue : Variant; AIndex : integer; //Se adapta para que se utilicen las mismas funciones que en el controllerbase AControllerDetallesBase: IControllerDetallesBase; ADataTable: IDAStronglyTypedDataTable; begin if not Assigned(AView) then raise Exception.Create('Vista no asignada (SaveGridViewToStream)'); if not Assigned(AStream) then raise Exception.Create('Stream no asignado (SaveGridViewToStream)'); if not Supports((AView.DataController.DataSource as TDADataSource).DataTable, IDAStronglyTypedDataTable, ADataTable) then raise Exception.Create('DataTable asignado no soporta IDAStronglyTypedDataTable)'); AReader := TcxReader.Create(AStream); AValueNameList := TStringList.Create; AValueTypeList := TStringList.Create; try AControllerDetallesBase:= TControllerDetallesBase.Create; AIndex := -1; ACaption := AReader.ReadAnsiString; NumCols := AReader.ReadInteger; // nº de columnas for iContador := 0 to NumCols - 1 do begin AValueName := AReader.ReadAnsiString; AValueType := AReader.ReadAnsiString; AValueNameList.Add(AValueName); AValueTypeList.Add(AValueType); end; NumFilas := AReader.ReadInteger; bEstabaVacia := ADataTable.IsEmpty; AView.DataController.BeginUpdate; try // Localizar el punto donde se empieza a insertar if not bEstabaVacia then begin ARecordIndex := AView.DataController.FocusedRecordIndex; if ARecordIndex >= 0 then begin ARecordID := AView.DataController.GetRecordId(ARecordIndex); ADataTable.Locate(AView.DataController.KeyFieldNames, ARecordID, []); end; end; for iContador := 0 to NumFilas - 1 do begin // Insertar una tupla de la forma adecuada if bEstabaVacia then begin AControllerDetallesBase.Add(ADataTable,TIPO_DETALLE_CONCEPTO); ADataTable.Edit; end else begin if iContador = 0 then ADataTable.Edit else begin AControllerDetallesBase.Add(ADataTable,TIPO_DETALLE_CONCEPTO); ADataTable.Edit; end; end; try for iCols := 0 to NumCols - 1 do begin AValue := AReader.ReadVariant; if (Pos(AValueNameList[iCols], AView.DataController.KeyFieldNames) = 0) then begin if (AValueNameList[iCols] <> CAMPO_POSICION) then if _BuscarColumna(AView, AValueNameList[iCols], AValueTypeList[iCols], AIndex) then begin if AIndex <> -1 then ADataTable.DataTable.FieldByName(AView.DataController.GetItemField(AIndex).FieldName).Value := AValue; end; end; end; finally ADataTable.Post; end; end; finally AView.DataController.EndUpdate; end; finally FreeANDNIL(AReader); FreeANDNIL(AValueNameList); FreeANDNIL(AValueTypeList); AControllerDetallesBase := Nil; end; end; {$ENDREGION} {$REGION 'SaveGridRowsToStream'} procedure SaveGridRowsToStream(AView : TcxGridDBTableView; AStream: TStream; const ACaption : String; const ASoloSeleccion : Boolean = false); var AWriter: TcxWriter; i, j : integer; AName, AValueType : String; procedure _CopyForEachRowProc(ARowIndex: Integer; ARowInfo: TcxRowInfo); var iCols: Integer; begin for iCols := 0 to AView.ItemCount - 1 do AWriter.WriteVariant(AView.DataController.GetRowValue(ARowInfo, iCols)); end; begin if not Assigned(AView) then raise Exception.Create('Vista no asignada (SaveGridViewToStream)'); if not Assigned(AStream) then raise Exception.Create('Stream no asignado (SaveGridViewToStream)'); if EsCadenaVacia(ACaption) then raise Exception.Create('Etiqueta no asignada (SaveGridViewToStream)'); AWriter := TcxWriter.Create(AStream); try AWriter.WriteAnsiString(ACaption); AWriter.WriteInteger(AView.ItemCount); for i := 0 to AView.ItemCount - 1 do begin AName := ''; AValueType := ''; if AView.Items[i].DataBinding is TcxGridItemDBDataBinding then AName := (AView.Items[i].DataBinding as TcxGridItemDBDataBinding).FieldName; if EsCadenaVacia(AName) then AName := AView.Items[i].Caption; AValueType := AView.Items[i].DataBinding.ValueType; AWriter.WriteAnsiString(AName); AWriter.WriteAnsiString(AValueType); end; with AView.DataController do begin if ASoloSeleccion then begin AWriter.WriteInteger(GetSelectedCount); for I := 0 to GetSelectedCount - 1 do begin J := GetSelectedRowIndex(I); _CopyForEachRowProc(J, GetRowInfo(J)); end; end else begin AWriter.WriteInteger(GetRowCount); for I := 0 to GetRowCount - 1 do _CopyForEachRowProc(I, GetRowInfo(I)); end; end; finally FreeANDNIL(AWriter); end; end; {$ENDREGION} function HTMLToClipFmt(const AHTML: string): string; const CR = #13#10; DescriptionSize = 105; HeaderSize = 47; FooterSize1 = 58; FooterSize2 = 24; function GetHeader: string; begin Result := 'Version:0.9' + CR; Result := Result + Format('StartHTML:%.10d', [DescriptionSize]) + CR; Result := Result + Format('EndHTML:%.10d', [DescriptionSize + HeaderSize + Length(AHTML) + FooterSize1]) + CR; Result := Result + Format('StartFragment:%.10d', [DescriptionSize + HeaderSize]) + CR; Result := Result + Format('EndFragment:%.10d', [DescriptionSize + HeaderSize + Length(AHTML) + FooterSize2]) + CR; Result := Result + '' + CR + '
' + '' + '' + '';
end;
function GetFooter: string;
begin
Result := '';
Result := Result + '' + CR + ''
end;
begin
Result := GetHeader + AHTML + GetFooter;
end;
function FormatHTMLClipboardHeader(HTMLText: string): string;
{http://www.swissdelphicenter.ch/torry/showcode.php?id=1391}
const
CrLf = #13#10;
begin
Result := 'Version:0.9' + CrLf;
Result := Result + 'StartHTML:-1' + CrLf;
Result := Result + 'EndHTML:-1' + CrLf;
Result := Result + 'StartFragment:000081' + CrLf;
Result := Result + 'EndFragment:°°°°°°' + CrLf;
Result := Result + HTMLText + CrLf;
Result := StringReplace(Result, '°°°°°°', Format('%.6d', [Length(Result)]), []);
end;
procedure CopiarGridAlPortapapelesHTML (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false);
const
CR = #13#10;
DescriptionSize = 105;
HeaderSize = 47;
FooterSize1 = 58;
FooterSize2 = 24;
function GetHeader(const AHTML: string): string;
begin
Result := 'Version:0.9' + CR;
Result := Result + Format('StartHTML:%.10d', [DescriptionSize]) + CR;
Result := Result + Format('EndHTML:%.10d', [DescriptionSize + HeaderSize + Length(AHTML) + FooterSize1]) + CR;
Result := Result + Format('StartFragment:%.10d', [DescriptionSize + HeaderSize]) + CR;
Result := Result + Format('EndFragment:%.10d', [DescriptionSize + HeaderSize + Length(AHTML) + FooterSize2]) + CR;
Result := Result + '' + CR + '' + '' + '' + '';
end;
function GetFooter: string;
begin
Result := '';
Result := Result + '' + CR + ''
end;
var
AFicheroTMP : String;
AStringList : TStringList;
HTMLText : String;
begin
if not Assigned(AGrid) then
raise Exception.Create('Vista no asignada (CopiarSeleccionGridAlPortapapelesTXT)');
RegistrarFormatos;
AFicheroTMP := DarFicheroHTMLTemporal;
ExportGridToHTML(AFicheroTMP, AGrid, True, not ASoloSeleccion);
if FileExists(AFicheroTMP) then
begin
AStringList := TStringList.Create;
try
AStringList.LoadFromFile(AFicheroTMP);
HTMLText := AStringList.Text;
AStringList.Insert(0, GetHeader(HTMLText));
AStringList.Add(GetFooter);
CopyStringsToClipboard(CF_HTML, AStringList);
finally
FreeANDNIL(AStringList);
DeleteFile(AFicheroTMP)
end;
end;
end;
procedure CopiarGridAlPortapapelesRTF (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false);
var
ARTFConv : TCtrlToRTF;
AStringList : TStringList;
begin
if not Assigned(AGrid) then
raise Exception.Create('Grid no asignado (CopiarSeleccionGridAlPortapapelesTXT)');
RegistrarFormatos;
ARTFConv := TCtrlToRTF.Create(NIL);
try
ARTFConv.cxGridViewToRTF(TcxGridTableView(AGrid.ActiveView));
AStringList := TStringList.Create;
try
AStringList.Add(ARTFConv.RTFText);
CopyStringsToClipboard(CF_RTF, AStringList);
finally
FreeANDNIL(AStringList);
end;
finally
FreeANDNIL(ARTFConv);
end;
end;
procedure CopiarGridAlPortapapelesTXT (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false);
{var
iFilas, iCols : Integer;}
begin
if not Assigned(AGrid) then
raise Exception.Create('Grid no asignado (CopiarSeleccionGridAlPortapapelesTXT)');
TcxGridTableView(AGrid.ActiveView).CopyToClipboard(not ASoloSeleccion);
{ for iFilas := 0 to AGrid.ActiveView.Controller.SelectedRowCount-1 do
begin
for iCols := 0 to cxGridView.VisibleColumnCount-1 do
begin
end;
StreamWriteStr(RTF, cxGridView.DataController.DisplayTexts[cxGridView.Controller.SelectedRows[i].RecordIndex, cxGridView.VisibleColumns[j].Index] +'\cell ');
}
end;
procedure CopiarGridAlPortapapelesExcel (AGrid : TcxGrid; const ASoloSeleccion : Boolean = false);
var
AFicheroTMP : String;
AStream : TFileStream;
begin
if not Assigned(AGrid) then
raise Exception.Create('Vista no asignada (CopiarSeleccionGridAlPortapapelesTXT)');
RegistrarFormatos;
AFicheroTMP := DarFicheroExcelTemporal;
ExportGridToExcel(AFicheroTMP, AGrid, True, not ASoloSeleccion);
if FileExists(AFicheroTMP) then
begin
AStream := TFileStream.Create(AFicheroTMP, fmOpenRead);
try
CopyStreamToClipboard(CF_HTML, AStream);
finally
FreeANDNIL(AStream);
DeleteFile(AFicheroTMP)
end;
end;
end;
procedure CopiarSeleccionGridAlPortapapeles (AGrid : TcxGrid);
var
AMemStream : TMemoryStream;
AGridStatus : TcxGridStatus;
begin
if not Assigned(AGrid) then
raise Exception.Create('Grid no asignado (CopiarSeleccionGridAlPortapapelesTXT)');
ShowHourglassCursor;
try
RegistrarFormatos;
AGridStatus := TcxGridStatus.Create(TcxGridDBTableView(AGrid.ActiveView));
Clipboard.Open;
try
CopiarGridAlPortapapelesTXT(AGrid, True);
CopiarGridAlPortapapelesRTF(AGrid, True);
CopiarGridAlPortapapelesHTML(AGrid, True);
AMemStream := TMemoryStream.Create;
try
SaveGridRowsToStream(TcxGridDBTableView(AGrid.ActiveView), AMemStream, AGrid.ActiveView.Name, True);
CopyStreamToClipboard(CF_FACTUGES, AMemStream);
finally
FreeAndNil(AMemStream);
end;
finally
Clipboard.Close;
AGridStatus.Restore(TcxGridDBTableView(AGrid.ActiveView));
FreeAndNil(AGridStatus);
end;
finally
HideHourglassCursor;
end;
end;
procedure CortarSeleccionGridAlPortapapeles (AGrid : TcxGrid);
var
//Se adapta para que se utilicen las mismas funciones que en el controllerbase
AControllerDetallesBase: IControllerDetallesBase;
ADataTable : TDADataTable;
begin
if Assigned(AGrid) then
ADataTable := ((AGrid.ActiveView as TcxGridDBTableView).DataController.DataSource as TDADataSource).DataTable;
ShowHourglassCursor;
try
AControllerDetallesBase := TControllerDetallesBase.Create;
CopiarSeleccionGridAlPortapapeles(AGrid);
AGrid.ActiveView.DataController.DeleteSelection;
AControllerDetallesBase.Renumerar(ADataTable, ADataTable.FieldByName(CAMPO_POSICION).AsInteger);
finally
AControllerDetallesBase := Nil;
HideHourglassCursor;
end;
end;
procedure PegarSeleccionGridDesdePortapapeles (AGrid : TcxGrid);
var
AMemStream : TMemoryStream;
ACaption : String;
AGridStatus : TcxGridStatus;
begin
if not Assigned(AGrid) then
raise Exception.Create('Grid no asignado (PegarSeleccionGridDesdePortapapeles)');
RegistrarFormatos;
if not Clipboard.HasFormat(CF_FACTUGES) then
raise Exception.Create('No hay nada en el portapapeles');
AGridStatus := TcxGridStatus.Create(TcxGridDBTableView(AGrid.ActiveView));
Clipboard.Open;
try
AMemStream := TMemoryStream.Create;
try
CopyStreamFromClipboard(CF_FACTUGES, AMemStream);
LoadGridRowsFromStream(TcxGridDBTableView(AGrid.ActiveView), AMemStream, ACaption);
finally
FreeAndNil(AMemStream);
end;
finally
Clipboard.Close;
AGridStatus.Restore(TcxGridDBTableView(AGrid.ActiveView));
FreeAndNil(AGridStatus);
end;
end;
procedure PegarTextoDesdePortapapeles (AGrid : TcxGrid);
var
AGridStatus : TcxGridStatus;
ATextList : TStringList;
ARecordID : Integer;
ARecordIndex : Integer;
bEstabaVacia : Boolean;
AView : TcxGridDBTableView;
iContador : Integer;
//Se adapta para que se utilicen las mismas funciones que en el controllerbase
AControllerDetallesBase: IControllerDetallesBase;
ADataTable: IDAStronglyTypedDataTable;
begin
if not Assigned(AGrid) then
raise Exception.Create('Grid no asignado (PegarTextoDesdePortapapeles)');
if not Supports(((AGrid.ActiveView as TcxGridDBTableView).DataController.DataSource as TDADataSource).DataTable, IDAStronglyTypedDataTable, ADataTable) then
raise Exception.Create('DataTable asignado no soporta IDAStronglyTypedDataTable)');
RegistrarFormatos;
if not Clipboard.HasFormat(CF_TEXT) then
raise Exception.Create('No hay nada en el portapapeles');
AView := TcxGridDBTableView(AGrid.ActiveView);
AGridStatus := TcxGridStatus.Create(TcxGridDBTableView(AGrid.ActiveView));
Clipboard.Open;
try
ATextList := TStringList.Create;
try
CopyStringsFromClipboard(CF_TEXT, ATextList);
AControllerDetallesBase := TControllerDetallesBase.Create;
bEstabaVacia := ADataTable.IsEmpty;
AView.DataController.BeginUpdate;
try
// Localizar el punto donde se empieza a insertar
if not bEstabaVacia then
begin
ARecordIndex := AView.DataController.FocusedRecordIndex;
if ARecordIndex >= 0 then
begin
ARecordID := AView.DataController.GetRecordId(ARecordIndex);
ADataTable.Locate(AView.DataController.KeyFieldNames, ARecordID, []);
end;
end;
for iContador := 0 to ATextList.Count - 1 do
begin
// Insertar una tupla de la forma adecuada
if bEstabaVacia then
begin
AControllerDetallesBase.Add(ADataTable,TIPO_DETALLE_CONCEPTO);
ADataTable.Edit;
end
else begin
if iContador = 0 then
ADataTable.Edit
else begin
AControllerDetallesBase.Add(ADataTable,TIPO_DETALLE_CONCEPTO);
ADataTable.Edit;
end;
end;
try
ADataTable.Edit;
ADataTable.DataTable.FieldByName('CONCEPTO').AsString := ATextList[iContador];
finally
ADataTable.Post;
end;
end;
finally
AView.DataController.EndUpdate;
end;
finally
FreeANDNIL(ATextList);
end;
finally
Clipboard.Close;
AGridStatus.Restore(TcxGridDBTableView(AGrid.ActiveView));
FreeAndNil(AGridStatus);
AControllerDetallesBase := Nil;
end;
end;
function HayDatosEnPortapapeles(AFormat: Cardinal): Boolean;
begin
RegistrarFormatos;
if AFormat = 0 then
Result := Clipboard.HasFormat(CF_FACTUGES) or Clipboard.HasFormat(CF_TEXT)
else
Result := Clipboard.HasFormat(AFormat);
end;
procedure PegarAlGridDesdePortapapeles (AGrid : TcxGrid);
begin
{ Aqui se determina qué hacer. Si en el portapapeles hay datos en formato...
1. CF_FACTUGES -> pegar conceptos
2. CF_TEXT -> tratar y pegar texto plano
}
ShowHourglassCursor;
try
RegistrarFormatos;
if Clipboard.HasFormat(CF_FACTUGES) then
begin
PegarSeleccionGridDesdePortapapeles(AGrid);
Exit;
end;
if Clipboard.HasFormat(CF_TEXT) then
begin
PegarTextoDesdePortapapeles(AGrid);
Exit;
end;
finally
HideHourglassCursor;
end;
end;
end.