david
458961b56c
git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@410 0c75b7a4-871f-7646-8a2f-f78d34cc349f
520 lines
16 KiB
ObjectPascal
520 lines
16 KiB
ObjectPascal
unit uGridClipboardUtils;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, cxGrid;
|
||
|
||
procedure PegarSeleccionGridDesdePortapapeles (AGrid : TcxGrid);
|
||
procedure CopiarSeleccionGridAlPortapapeles (AGrid : TcxGrid);
|
||
procedure CortarSeleccionGridAlPortapapeles (AGrid : TcxGrid);
|
||
function HayDatosEnPortapapeles: 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);
|
||
|
||
implementation
|
||
|
||
uses
|
||
cxVariants, CtlToRTF, Clipbrd, DB, cxExport, cxGridExportLink, cxCustomData,
|
||
uSistemaFunc, ClipboardUtils, cxDBData, cxGridLevel, uStringsUtils,
|
||
cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView,
|
||
cxGridTableView, cxGridDBTableView, cxGridDBDataDefinitions, uGridStatusUtils;
|
||
|
||
|
||
|
||
procedure RenumerarCampoPosicion(ADataSet : TDataSet);
|
||
var
|
||
iContador : Integer;
|
||
AField : TField;
|
||
begin
|
||
AField := ADataSet.FindField('POSICION');
|
||
if Assigned(AField) and not (ADataSet.IsEmpty) then
|
||
begin
|
||
ADataSet.Last;
|
||
iContador := ADataSet.RecordCount;
|
||
repeat
|
||
ADataSet.Edit;
|
||
AField.AsInteger := iContador - 1;
|
||
ADataSet.Post;
|
||
AdataSet.Prior;
|
||
iContador := iContador - 1;
|
||
until ADataSet.BOF;
|
||
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;
|
||
|
||
function _BuscarColumna (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;
|
||
|
||
|
||
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
|
||
ADataSet.Append
|
||
else begin
|
||
if iContador > 0 then
|
||
ADataSet.Next;
|
||
ADataSet.Insert;
|
||
end;
|
||
|
||
try
|
||
for iCols := 0 to NumCols - 1 do
|
||
begin
|
||
AValue := AReader.ReadVariant;
|
||
if (Pos(AValueNameList[iCols], AView.DataController.KeyFieldNames) = 0) then
|
||
if _BuscarColumna(AValueNameList[iCols], AValueTypeList[iCols], AIndex) then
|
||
begin
|
||
if AIndex <> -1 then
|
||
ADataSet.FieldByName(AView.DataController.GetItemField(AIndex).FieldName).Value := AValue;
|
||
end;
|
||
end;
|
||
finally
|
||
ADataSet.Post;
|
||
end;
|
||
end;
|
||
|
||
RenumerarCampoPosicion(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 + '<html>' + CR + '<head></head>' + '<body>' + '<!--StartFragment-->' + '<code><pre>';
|
||
end;
|
||
|
||
function GetFooter: string;
|
||
begin
|
||
Result := '</pre></code><!--EndFragment-->';
|
||
Result := Result + '</body>' + CR + '</html>'
|
||
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:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>' + CrLf;
|
||
Result := Result + HTMLText + CrLf;
|
||
Result := StringReplace(Result, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', 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 + '<html>' + CR + '<head></head>' + '<body>' + '<!--StartFragment-->' + '<code><pre>';
|
||
end;
|
||
|
||
function GetFooter: string;
|
||
begin
|
||
Result := '</pre></code><!--EndFragment-->';
|
||
Result := Result + '</body>' + CR + '</html>'
|
||
end;
|
||
|
||
var
|
||
AFicheroTMP : String;
|
||
AStringList : TStringList;
|
||
HTMLText : String;
|
||
CF_HTML : Cardinal;
|
||
begin
|
||
if not Assigned(AGrid) then
|
||
raise Exception.Create('Vista no asignada (CopiarSeleccionGridAlPortapapelesTXT)');
|
||
|
||
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);
|
||
|
||
CF_HTML := RegisterClipboardFormat ('HTML Format');
|
||
if CF_HTML = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_HTML (CopiarSeleccionGridAlPortapapelesHTML)');
|
||
|
||
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;
|
||
CF_RTF : Cardinal;
|
||
begin
|
||
if not Assigned(AGrid) then
|
||
raise Exception.Create('Grid no asignado (CopiarSeleccionGridAlPortapapelesTXT)');
|
||
|
||
ARTFConv := TCtrlToRTF.Create(NIL);
|
||
try
|
||
ARTFConv.cxGridViewToRTF(TcxGridTableView(AGrid.ActiveView));
|
||
|
||
CF_RTF := RegisterClipboardFormat('Rich Text Format');
|
||
if CF_RTF = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_RTF (CopiarSeleccionGridAlPortapapelesRTF)');
|
||
|
||
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;
|
||
CF_HTML : Cardinal;
|
||
begin
|
||
if not Assigned(AGrid) then
|
||
raise Exception.Create('Vista no asignada (CopiarSeleccionGridAlPortapapelesTXT)');
|
||
|
||
AFicheroTMP := DarFicheroExcelTemporal;
|
||
ExportGridToExcel(AFicheroTMP, AGrid, True, not ASoloSeleccion);
|
||
|
||
if FileExists(AFicheroTMP) then
|
||
begin
|
||
AStream := TFileStream.Create(AFicheroTMP, fmOpenRead);
|
||
try
|
||
CF_HTML := RegisterClipboardFormat ('HTML Format');
|
||
if CF_HTML = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_HTML (CopiarSeleccionGridAlPortapapelesHTML)');
|
||
|
||
CopyStreamToClipboard(CF_HTML, AStream);
|
||
finally
|
||
FreeANDNIL(AStream);
|
||
DeleteFile(AFicheroTMP)
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure CopiarSeleccionGridAlPortapapeles (AGrid : TcxGrid);
|
||
var
|
||
AMemStream : TMemoryStream;
|
||
CF_FACTUGES : Cardinal;
|
||
AGridStatus : TcxGridStatus;
|
||
begin
|
||
if not Assigned(AGrid) then
|
||
raise Exception.Create('Grid no asignado (CopiarSeleccionGridAlPortapapelesTXT)');
|
||
|
||
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);
|
||
CF_FACTUGES := RegisterClipboardFormat ('FactuGES Format');
|
||
if CF_FACTUGES = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_HTML (CopiarSeleccionGridAlPortapapelesHTML)');
|
||
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;
|
||
RenumerarCampoPosicion(TcxGridDBTableView(AGrid.ActiveView).DataController.DataSet);
|
||
finally
|
||
HideHourglassCursor;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure PegarSeleccionGridDesdePortapapeles (AGrid : TcxGrid);
|
||
var
|
||
AMemStream : TMemoryStream;
|
||
CF_FACTUGES : Cardinal;
|
||
ACaption : String;
|
||
AGridStatus : TcxGridStatus;
|
||
begin
|
||
if not Assigned(AGrid) then
|
||
raise Exception.Create('Grid no asignado (PegarSeleccionGridDesdePortapapeles)');
|
||
|
||
CF_FACTUGES := RegisterClipboardFormat ('FactuGES Format');
|
||
if CF_FACTUGES = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_FACTUGES (PegarSeleccionGridDesdePortapapeles)');
|
||
|
||
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;
|
||
|
||
function HayDatosEnPortapapeles: Boolean;
|
||
var
|
||
CF_FACTUGES : Cardinal;
|
||
begin
|
||
CF_FACTUGES := RegisterClipboardFormat ('FactuGES Format');
|
||
if CF_FACTUGES = 0 then
|
||
raise Exception.Create('Error al registrar formato CF_FACTUGES (HayDatosEnPortapapeles)');
|
||
|
||
Result := Clipboard.HasFormat(CF_FACTUGES);
|
||
end;
|
||
|
||
end.
|