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; const TIPO_DETALLE_CONCEPTO = 'Concepto'; CAMPO_ID = 'ID'; CAMPO_POSICION = 'POSICION'; CAMPO_TIPO = 'TIPO_DETALLE'; CAMPO_CONCEPTO = 'CONCEPTO'; 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 _DesplazarNPosiciones(ADataSet: TDataSet; NumOrdenIni: Variant; NPosiciones: Variant): Integer; { Función que desplaza NPosiciones el numero de orden a partir del elemento con el número de orden dado. Devuelve el numero de orden del primer elemento del hueco generado } var AuxNumOrden: Integer; AuxNumPos: Integer; AField: TField; begin AField := ADataSet.FindField(CAMPO_POSICION); if not Assigned(AField) then raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (DesplazarNPosiciones)'); if VarIsNull(NPosiciones) then AuxNumPos := 1 else AuxNumPos := NPosiciones; if VarIsNull(NumOrdenIni) then AuxNumOrden := 0 else AuxNumOrden := NumOrdenIni + 1; //Añadimos por abajo siempre Result := AuxNumOrden; with ADataSet do begin First; while not EOF do begin if (FieldByName(CAMPO_POSICION).AsInteger >= AuxNumOrden) then begin if not (State in dsEditModes) then Edit; FieldByName(CAMPO_POSICION).AsInteger := FieldByName(CAMPO_POSICION).AsInteger + AuxNumPos; Post; end; Next; end; end; end; procedure _NuevaTupla(ADataSet: TDataSet; ATipoAnadir: TTipoAnadir = taInsertar); var AuxNumOrden : Integer; begin ADataSet.DisableControls; try with ADataSet do begin AuxNumOrden := _DesplazarNPosiciones(ADataSet, FieldByName(CAMPO_POSICION).AsVariant, 1); case ATipoAnadir of taAnadir: Append; taInsertar: Insert; end; FieldByName(CAMPO_POSICION).AsInteger := AuxNumOrden; FieldByName(CAMPO_TIPO).AsVariant := TIPO_DETALLE_CONCEPTO; end; finally ADataSet.EnableControls; end; end; procedure _Renumerar(ADataSet: TDataSet); { procedimiento que renumera todos los conceptos de la tabla dada por parametro } var i, j : Integer; AField: TField; begin AField := ADataSet.FindField(CAMPO_POSICION); if not Assigned(AField) then raise Exception.Create('Campo ' + CAMPO_POSICION + ' no encontrado (renumerar)'); with ADataSet do begin for i:=0 to RecordCount-1 do begin First; if not Locate(CAMPO_POSICION, i, []) then begin j := i; First; while not Locate(CAMPO_POSICION, j, []) do begin Inc(j); First; end; if not (State in dsEditModes) then Edit; FieldByName(CAMPO_POSICION).AsInteger := i; Post; end; end; end; end; {procedure RenumerarCampoPosicion(ADataSet : TDataSet); var i, j : Integer; AField : TField; AList : TStringList; begin AList := TStringList.Create; try ADataSet.First; for i:=0 to ADataSet.RecordCount-1 do begin AList.Add(ADataSet.FieldByName('POSICION').AsString); ADataSet.Next; end; ShowMessage(AList.Text); finally FreeANDNIL(AList); end; AField := ADataSet.FindField('POSICION'); if Assigned(AField) and not (ADataSet.IsEmpty) then begin with ADataSet do begin for i:=0 to RecordCount-1 do begin First; if not Locate('POSICION', i, []) then begin j := i; First; while not Locate('POSICION', j, []) do begin Inc(j); First; end; end; Edit; FieldByName('POSICION').AsInteger := i; Post; end; end; end; 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; ADataSet : TDataSet; ARecordID : Integer; ARecordIndex : Integer; bEstabaVacia : Boolean; iContador : Integer; AValueName, AValueType : String; iCols, NumCols : integer; NumFilas: Integer; AReader: TcxReader; AValue : Variant; AIndex : integer; 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)'); ADataSet := AView.DataController.DataSource.DataSet; AReader := TcxReader.Create(AStream); AValueNameList := TStringList.Create; AValueTypeList := TStringList.Create; try AIndex := -1; ACaption := AReader.ReadString; NumCols := AReader.ReadInteger; // nº de columnas for iContador := 0 to NumCols - 1 do begin AValueName := AReader.ReadString; AValueType := AReader.ReadString; AValueNameList.Add(AValueName); AValueTypeList.Add(AValueType); end; NumFilas := AReader.ReadInteger; bEstabaVacia := ADataSet.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); ADataSet.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 _NuevaTupla(ADataSet, taAnadir) else begin if iContador = 0 then ADataSet.Edit else begin ADataSet.Next; if ADataSet.EOF then _NuevaTupla(ADataSet, taAnadir) else _NuevaTupla(ADataSet, taInsertar) 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] = 'POSICION') then ADataSet.FieldByName('POSICION').Value := ADataSet.RecNo else if _BuscarColumna(AView, AValueNameList[iCols], AValueTypeList[iCols], AIndex) then begin if AIndex <> -1 then ADataSet.FieldByName(AView.DataController.GetItemField(AIndex).FieldName).Value := AValue; end; end; end; finally ADataSet.Post; end; end; _Renumerar(ADataSet); finally AView.DataController.EndUpdate; end; finally FreeANDNIL(AReader); FreeANDNIL(AValueNameList); FreeANDNIL(AValueTypeList); 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.WriteString(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.WriteString(AName); AWriter.WriteString(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)'); RegistrarFormatos; AGridStatus := TcxGridStatus.Create(TcxGridDBTableView(AGrid.ActiveView)); Clipboard.Open; try CopiarGridAlPortapapelesTXT(AGrid); CopiarGridAlPortapapelesRTF(AGrid); CopiarGridAlPortapapelesHTML(AGrid); 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; end; procedure CortarSeleccionGridAlPortapapeles (AGrid : TcxGrid); begin ShowHourglassCursor; try CopiarSeleccionGridAlPortapapeles(AGrid); AGrid.ActiveView.DataController.DeleteSelection; _Renumerar(TcxGridDBTableView(AGrid.ActiveView).DataController.DataSet); finally 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; ADataSet : TDataSet; ARecordID : Integer; ARecordIndex : Integer; bEstabaVacia : Boolean; AView : TcxGridDBTableView; iContador : Integer; begin if not Assigned(AGrid) then raise Exception.Create('Grid no asignado (PegarTextoDesdePortapapeles)'); 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); ADataSet := AView.DataController.DataSource.DataSet; bEstabaVacia := ADataSet.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); ADataSet.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 _NuevaTupla(ADataSet, taAnadir) else begin if iContador = 0 then ADataSet.Edit else begin ADataSet.Next; if ADataSet.EOF then _NuevaTupla(ADataSet, taAnadir) else _NuevaTupla(ADataSet, taInsertar) end; end; try ADataSet.Edit; ADataSet.FieldByName('CONCEPTO').AsString := ATextList[iContador]; finally ADataSet.Post; end; end; _Renumerar(ADataSet); finally AView.DataController.EndUpdate; end; finally FreeANDNIL(ATextList); end; finally Clipboard.Close; AGridStatus.Restore(TcxGridDBTableView(AGrid.ActiveView)); FreeAndNil(AGridStatus); 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 } RegistrarFormatos; if Clipboard.HasFormat(CF_FACTUGES) then begin PegarSeleccionGridDesdePortapapeles(AGrid); Exit; end; if Clipboard.HasFormat(CF_TEXT) then begin PegarTextoDesdePortapapeles(AGrid); Exit; end; end; end.