¿Cómo coloco algún texto formateado en el Portapapeles?

Question

Estoy escribiendo una prueba de unidad para una utilidad "Text Scrubber" que eliminará cualquier formato, etc. del texto en el portapapeles.

Por ejemplo, si copia un texto de un documento de Word o una página web con toneladas de formato, puede pegarlo en otro Word DOC como texto normal antiguo.

Para escribir una prueba unitaria para esto, necesito, por supuesto, escribir un código que realmente coloque texto formateado en el portapapeles.

Así que mi pregunta es: ¿cómo hago eso en el código Delphi?

Answer 1

He aquí un ejemplo de cómo copiar al portapapeles en formato html: http://www.swissdelphicenter.ch/torry/showcode.php?id=1391

He modificado ligeramente el código para que funcione en Delphi 2009.

// If you've ever tried sticking html into the clipboard using the usual CF_TEXT 
// format then you might have been disappointed to discover that wysiwyg html 
// editors paste your offering as if it were just text, 
// rather than recognising it as html. For that you need the CF_HTML format. 
// CF_HTML is entirely text format and uses the transformation format UTF-8. 
// It includes a description, a context, and within the context, the fragment. 
// 
// As you may know one can place multiple items of data onto the clipboard for 
// a single clipboard entry, which means that the same data can be pasted in a 
// variety of different formats in order to cope with target 
// applications of varying sophistocation. 
// 
// The following example shows how to stick CF_TEXT (and CF_HTML) 
// into the clipboard. 

function FormatHTMLClipboardHeader(HTMLText: string): string; 
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; 

//The second parameter is optional and is put into the clipboard as CF_HTML. 
//Function can be used standalone or in conjunction with the VCL clipboard so long as 
//you use the USEVCLCLIPBOARD conditional define 
//($define USEVCLCLIPBOARD} 
//(and clipboard.open, clipboard.close). 
//Code from http://www.lorriman.com 
procedure CopyHTMLToClipBoard(const str: AnsiString; const htmlStr: AnsiString = ''); 
var 
    gMem: HGLOBAL; 
    lp: PChar; 
    Strings: array[0..1] of AnsiString; 
    Formats: array[0..1] of UINT; 
    i: Integer; 
begin 
    gMem := 0; 
    {$IFNDEF USEVCLCLIPBOARD} 
    Win32Check(OpenClipBoard(0)); 
    {$ENDIF} 
    try 
    //most descriptive first as per api docs 
    Strings[0] := FormatHTMLClipboardHeader(htmlStr); 
    Strings[1] := str; 
    Formats[0] := RegisterClipboardFormat('HTML Format'); 
    Formats[1] := CF_TEXT; 
    {$IFNDEF USEVCLCLIPBOARD} 
    Win32Check(EmptyClipBoard); 
    {$ENDIF} 
    for i := 0 to High(Strings) do 
    begin 
     if Strings[i] = '' then Continue; 
     //an extra "1" for the null terminator 
     gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(Strings[i]) + 1); 
     {Succeeded, now read the stream contents into the memory the pointer points at} 
     try 
     Win32Check(gmem <> 0); 
     lp := GlobalLock(gMem); 
     Win32Check(lp <> nil); 
     CopyMemory(lp, PChar(Strings[i]), Length(Strings[i]) + 1); 
     finally 
     GlobalUnlock(gMem); 
     end; 
     Win32Check(gmem <> 0); 
     SetClipboardData(Formats[i], gMEm); 
     Win32Check(gmem <> 0); 
     gmem := 0; 
    end; 
    finally 
    {$IFNDEF USEVCLCLIPBOARD} 
    Win32Check(CloseClipBoard); 
    {$ENDIF} 
    end; 
end; 

// Example: 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    CopyHTMLToClipBoard('Hello world', 'Hello <b>world</b>'); 
end; 

Si pega este en MS Word, verá esto:

Hola mundo

Answer 2

En DSiWin32 tenemos:

var 
    GCF_HTML: UINT; 

{:Checks if HTML format is stored on the clipboard. 
    @since 2008-04-29 
    @author gabr 
} 
function DSiIsHtmlFormatOnClipboard: boolean; 
begin 
    Result := IsClipboardFormatAvailable(GCF_HTML); 
end; { DSiIsHtmlFormatOnClipboard } 

{:Retrieves HTML format from the clipboard. If there is no HTML format on the clipboard, 
    function returns empty string. 
    @since 2008-04-29 
    @author MP002, gabr 
} 
function DSiGetHtmlFormatFromClipboard: string; 
var 
    hClipData  : THandle; 
    idxEndFragment : integer; 
    idxStartFragment: integer; 
    pClipData  : PChar; 
begin 
    Result := ''; 
    if DSiIsHtmlFormatOnClipboard then begin 
    Win32Check(OpenClipboard(0)); 
    try 
     hClipData := GetClipboardData(GCF_HTML); 
     if hClipData <> 0 then begin 
     pClipData := GlobalLock(hClipData); 
     Win32Check(assigned(pClipData)); 
     try 
      idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20 
      idxEndFragment := Pos('<!--EndFragment-->', pClipData); 
      if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then 
      Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20); 
     finally GlobalUnlock(hClipData); end; 
     end; 
    finally Win32Check(CloseClipboard); end; 
    end; 
end; { DSiGetHtmlFormatFromClipboard } 

{:Copies HTML (and, optionally, text) format to the clipboard. 
    @since 2008-04-29 
    @author MP002, gabr 
} 
procedure DSiCopyHtmlFormatToClipboard(const sHtml, sText: string); 

    function MakeFragment(const sHtml: string): string; 
    const 
    CVersion  = 'Version:1.0'#13#10; 
    CStartHTML  = 'StartHTML:'; 
    CEndHTML  = 'EndHTML:'; 
    CStartFragment = 'StartFragment:'; 
    CEndFragment = 'EndFragment:'; 
    CHTMLIntro  = '<sHtml><head><title>HTML clipboard</title></head><body><!--StartFragment-->'; 
    CHTMLExtro  = '<!--EndFragment--></body></sHtml>'; 
    CNumberLengthAndCR = 10; 
    CDescriptionLength = // Let the compiler determine the description length. 
     Length(CVersion) + Length(CStartHTML) + Length(CEndHTML) + 
     Length(CStartFragment) + Length(CEndFragment) + 4*CNumberLengthAndCR; 
    var 
    description  : string; 
    idxEndFragment : integer; 
    idxEndHtml  : integer; 
    idxStartFragment: integer; 
    idxStartHtml : integer; 
    begin 
    // The sHtml clipboard format is defined by using byte positions in the entire block 
    // where sHtml text and fragments start and end. These positions are written in a 
    // description. Unfortunately the positions depend on the length of the description 
    // but the description may change with varying positions. To solve this dilemma the 
    // offsets are converted into fixed length strings which makes it possible to know 
    // the description length in advance. 
    idxStartHtml := CDescriptionLength;    // position 0 after the description 
    idxStartFragment := idxStartHtml + Length(CHTMLIntro); 
    idxEndFragment := idxStartFragment + Length(sHtml); 
    idxEndHtml := idxEndFragment + Length(CHTMLExtro); 
    description := CVersion + 
     SysUtils.Format('%s%.8d', [CStartHTML, idxStartHtml]) + #13#10 + 
     SysUtils.Format('%s%.8d', [CEndHTML, idxEndHtml]) + #13#10 + 
     SysUtils.Format('%s%.8d', [CStartFragment, idxStartFragment]) + #13#10 + 
     SysUtils.Format('%s%.8d', [CEndFragment, idxEndFragment]) + #13#10; 
    Result := description + CHTMLIntro + sHtml + CHTMLExtro; 
    end; { MakeFragment } 

var 
    clipFormats: array[0..1] of UINT; 
    clipStrings: array[0..1] of string; 
    hClipData : HGLOBAL; 
    iFormats : integer; 
    pClipData : PChar; 

begin { DSiCopyHtmlFormatToClipboard } 
    Win32Check(OpenClipBoard(0)); 
    try 
    //most descriptive first as per api docs 
    clipStrings[0] := MakeFragment(sHtml); 
    if sText = '' then 
     clipStrings[1] := sHtml 
    else 
     clipStrings[1] := sText; 
    clipFormats[0] := GCF_HTML; 
    clipFormats[1] := CF_TEXT; 
    Win32Check(EmptyClipBoard); 
    for iFormats := 0 to High(clipStrings) do begin 
     if clipStrings[iFormats] = '' then 
     continue; 
     hClipData := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(clipStrings[iFormats]) + 1); 
     Win32Check(hClipData <> 0); 
     try 
     pClipData := GlobalLock(hClipData); 
     Win32Check(assigned(pClipData)); 
     try 
      Move(PChar(clipStrings[iFormats])^, pClipData^, Length(clipStrings[iFormats]) + 1); 
     finally GlobalUnlock(hClipData); end; 
     Win32Check(SetClipboardData(clipFormats[iFormats], hClipData) <> 0); 
     hClipData := 0; 
     finally 
     if hClipData <> 0 then 
      GlobalFree(hClipData); 
     end; 
    end; 
    finally Win32Check(CloseClipboard); end; 
end; { DSiCopyHtmlFormatToClipboard } 

initialization 
    GCF_HTML := RegisterClipboardFormat('HTML Format'); 

EDIT: @Edelcom: En Delphi 7, DSiWin32 debe definir

_STARTUPINFOW = record 
    cb: DWORD; 
    lpReserved: PWideChar; 
    lpDesktop: PWideChar; 
    lpTitle: PWideChar; 
    dwX: DWORD; 
    dwY: DWORD; 
    dwXSize: DWORD; 
    dwYSize: DWORD; 
    dwXCountChars: DWORD; 
    dwYCountChars: DWORD; 
    dwFillAttribute: DWORD; 
    dwFlags: DWORD; 
    wShowWindow: Word; 
    cbReserved2: Word; 
    lpReserved2: PByte; 
    hStdInput: THandle; 
    hStdOutput: THandle; 
    hStdError: THandle; 
    end; 
    TStartupInfoW = _STARTUPINFOW; 
    PStartupInfoW = ^TStartupInfoW; 

Voy a poner esto en y suelte nueva versión.

Answer 3

La respuesta aceptada de Wouter fue un buen comienzo, pero no maneja caracteres Unicode. Modifiqué el código de ejemplo para trabajar con unicode (html y datos de texto). También fugas de memoria fija.

function FormatHTMLClipboardHeader(HTMLText: UTF8String): UTF8String; 
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 := UTF8String(StringReplace(string(Result), '°°°°°°', Format('%.6d', [Length(Result)]), [])); 
end; 


//The second parameter is optional and is put into the clipboard as CF_HTML. 
procedure CopyHTMLToClipBoard(const str: String; const htmlStr: String = ''); 
var 
    gMem : HGLOBAL; 
    lp  : Pointer; 
    HString : UTF8String; 
begin 
    {$WARN SYMBOL_PLATFORM OFF} 
    Win32Check(OpenClipBoard(0)); 

    try 
    Win32Check(EmptyClipBoard); 

    if (htmlStr <> '') then 
    begin 
     // convert to utf8 and add header, which windows html clipboard format requires 
     HString := FormatHTMLClipboardHeader(UTF8String(htmlStr)); 

     //an extra "1" for the null terminator 
     gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(HString) + 1); 
     {Succeeded, now read the stream contents into the memory the pointer points at} 
     try 
     Win32Check(gmem <> 0); 
     lp := GlobalLock(gMem); 
     Win32Check(lp <> nil); 
     CopyMemory(lp, Pointer(HString), Length(HString) + 1); 
     Win32Check(gmem <> 0); 
     SetClipboardData(RegisterClipboardFormat('HTML Format'), gMem); 
     Win32Check(gmem <> 0); 
     finally 
     GlobalUnlock(gMem); 
     GlobalFree(gMem); 
     end; 
    end; 

    // Now just place plain unicode text, double buffer size as it's utf16 
    gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, (Length(str) + 1) * 2); 
    {Succeeded, now read the stream contents into the memory the pointer points at} 
    try 
     Win32Check(gmem <> 0); 
     lp := GlobalLock(gMem); 
     Win32Check(lp <> nil); 
     CopyMemory(lp, Pointer(str), (Length(str) + 1) * 2); 
     Win32Check(gmem <> 0); 
     SetClipboardData(CF_UNICODETEXT, gMem); 
     Win32Check(gmem <> 0); 
    finally 
     GlobalUnlock(gMem); 
     GlobalFree(gMem); 
    end; 

    finally 
    Win32Check(CloseClipBoard); 
    end; 
    {$WARN SYMBOL_PLATFORM ON} 
end;