delphi - ClipboardAsString 的 Unicode 版本

Question

多年来，我一直在使用 Peter Above 的 APIClipboard 单元，但它不再在 Unicode Delphi 下工作。

ClipboardAsString 返回 gobbledegook:

Procedure DataFromClipboard( fmt: DWORD; S: TStream );
  Var
    hMem: THandle;
    pMem: Pointer;
    datasize: DWORD;
  Begin { DataFromClipboard }
    Assert( Assigned( S ));
    hMem := GetClipboardData( fmt );
    If hMem <> 0 Then Begin
      datasize := GlobalSize( hMem );
      If datasize > 0 Then Begin
        pMem := GlobalLock( hMem );
        If pMem = Nil Then
          raise EclipboardError.Create( eLockFailed );
        try
          S.WriteBuffer( pMem^, datasize );
        finally
          GlobalUnlock( hMem );
        end;
      End;
    End;
  End;



Procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
  Begin { CopyDataFromClipboard }
    Assert( Assigned( S ));
    If OpenClipboard( 0 ) Then
      try
        DataFromClipboard( fmt , S );
      finally
        CloseClipboard;
      end
    Else
      raise EclipboardError.Create( eCannotOpenClipboard );
  End; 


Function ClipboardAsString: String;
  Const
    nullchar: Char = #0;
  Var
    ms: TMemoryStream;
  Begin { ClipboardAsString }
    If not IsClipboardFormatAvailable( CF_TEXT ) Then
      Result := EmptyStr
    Else Begin
      ms:= TMemoryStream.Create;
      try
        CopyDataFromClipboard( CF_TEXT , ms );
        ms.Seek( 0, soFromEnd );
        ms.WriteBuffer( nullChar, Sizeof( nullchar ));
        Result := Pchar( ms.Memory );
      finally
        ms.Free;
      end;
    End;
  End; 

而 StringToClipboard 只复制第一个字符:

Procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin { DataToClipboard }
    If datasize <= 0 Then Exit;
    hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT ,
                         datasize );
    If hmem = 0 Then
      raise EclipboardError.Create( eSystemOutOfMemory );

    pMem := GlobalLock( hMem );
    If pMem = Nil Then Begin
      GlobalFree( hMem );
      raise EclipboardError.Create( eLockFailed );
    End;

    Move( data, pMem^, datasize );
    GlobalUnlock( hMem );
    If SetClipboardData( fmt, hMem ) = 0 Then
      raise EClipboarderror( eSetDataFailed );
  End; { DataToClipboard }

Procedure CopyDataToClipboard( fmt: DWORD; Const data; datasize: 
Integer;
                               emptyClipboardFirst: Boolean = true );
  Begin { CopyDataToClipboard }
    If OpenClipboard( 0 ) Then
      try
        If emptyClipboardFirst Then
          EmptyClipboard;
        DataToClipboard( fmt, data, datasize );
      finally
        CloseClipboard;
      end
    Else
      raise EclipboardError.Create( eCannotOpenClipboard );
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    If Length(S) > 0 Then
      CopyDataToClipboard( CF_TEXT, S[1], Length(S)+1);
  End;

我已搜索但找不到该单元的更新版本。有没有对 Unicode 字符串有更多经验的人知道解决这个问题的最佳方法？

谢谢

Answer 1

CF_TEXT是安西，CF_UNICODETEXT是 Unicode。需要根据 string 是否更新代码以使用适当的格式。是 Ansi 或 Unicode，例如:

Const
  CFTextFmt = {$IFDEF UNICODE}CF_UNICODETEXT{$ELSE}CF_TEXT{$ENDIF};

Function ClipboardAsString: String;
  Var
    ms: TMemoryStream;
  Begin { ClipboardAsString }
    If not IsClipboardFormatAvailable( CFTextFmt ) Then
      Result := EmptyStr
    Else Begin
      ms := TMemoryStream.Create;
      try
        CopyDataFromClipboard( CFTextFmt, ms );
        SetString(Result, PChar(ms.Memory), ms.Size);
      finally
        ms.Free;
      end;
    End;
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    CopyDataToClipboard( CFTextFmt, PChar(S)^, (Length(S) + 1) * SizeOf(Char));
  End;

或者，您可以只使用 VCL 自己的 TClipboard.AsText相反，它会为您处理这些详细信息:

uses
  Clipbrd;

Function ClipboardAsString: String;
  Begin
    Result := Clipboard.AsText;
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    Clipboard.AsText := S;
  End;

话虽如此，在旁注中， DataToClipboard()有一些错误。它应该允许 datasize为 0 并且不要忽略它，否则无法存储空白数据(这是可取的)。不需要使用 GMEM_ZEROINIT (不是错误，而是浪费了开销)。它需要释放 HGLOBAL如果 SetClipboardData()失败:

Procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin { DataToClipboard }
    If datasize < 0 Then datasize := 0;
    hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, datasize );
    If hMem = 0 Then
      raise EclipboardError.Create( eSystemOutOfMemory );
    Try
      If datasize > 0 Then 
      Begin
        pMem := GlobalLock( hMem );
        If pMem = Nil Then
          raise EclipboardError.Create( eLockFailed );
        Try
          Move( data, pMem^, datasize );
        Finally
          GlobalUnlock( hMem );
        End;
      End;
      If SetClipboardData( fmt, hMem ) = 0 Then
        raise EClipboarderror( eSetDataFailed );
    Except
      GlobalFree( hMem );
      raise;
    End;
  End; { DataToClipboard }

CopyDataToClipboard() 中还有一个错误。当 emptyClipboardFirst是真的:

If an application calls OpenClipboard with hwnd set to NULL, EmptyClipboard sets the clipboard owner to NULL; this causes SetClipboardData to fail.

因此，您必须传递一个有效的非零 HWND至 OpenClipboard()清空剪贴板然后将新数据放在上面时。