德尔菲7:如何将非拉丁文本复制到剪贴板上？(转换为Unicode?)

Question

我有这样的代码来复制一些文本到剪贴板。

uses Clipbrd;

var
  text: string;
begin
  text := 'Some non-latin text, for example Russian: Привет!'

  Clipboard.AsText := text;
end;

Win7-8操作系统，在OS区域设置中设置俄罗斯地区(和格式)，Delphi 7.

问题是，只有当我在复制时切换(shift+alt)到俄语键盘布局时，它才能工作。否则，它将被粘贴为"Ïðèâåò!"而不是"Привет!"。

我怎么才能解决呢？

我认为我需要以某种方式将文本转换为Unicode，并从WinAPI调用Unicode剪贴板复制函数？但怎么做呢？

Answer 1

通过任何您认为合适的方式将文本转换为Unicode。在Delphi7中，通常需要使用WideString。

一旦将文本编码为UTF-16，例如在WideString中，就需要使用CF_UNICODETEXT剪贴板格式调用CF_UNICODETEXT。它被Delphi包装为全局SetAsHandle对象的Clipboard方法。

我还没有测试过它，但是这个函数应该会让您在路上：

uses
  Windows, Clipbrd;

procedure SetClipboardText(const Text: WideString);
var
  Count: Integer;
  Handle: HGLOBAL;
  Ptr: Pointer;
begin
  Count := (Length(Text)+1)*SizeOf(WideChar);
  Handle := GlobalAlloc(GMEM_MOVEABLE, Count);
  Try
    Win32Check(Handle<>0);
    Ptr := GlobalLock(Handle);
    Win32Check(Assigned(Ptr));
    Move(PWideChar(Text)^, Ptr^, Count);
    GlobalUnlock(Handle);
    Clipboard.SetAsHandle(CF_UNICODETEXT, Handle);
  Except
    GlobalFree(Handle);
    raise;
  End;
end;

Answer 2

非常感谢您，这意味着您也可以转换在剪贴板中的编码，如果您捕捉到WM_CLIPBOARDUPDATE消息-非常有用的旧版本的德尔菲，例如俄语。下面是一个完整的工作代码：

(注:这种缓冲区监听技术只适用于Windows和较新的操作系统，这就是为什么我使用动态WinAPI链接，参见本文- http://delphidabbler.com/articles?article=9)

type
  TAddOrRemoveClipboardFormatListener = function (hWndNewViewer : HWND) : BOOL; stdcall;

var _isClipboardChangeRequired : boolean;
var _addClipboardFormatListener, _removeClipboardFormatListener : TAddOrRemoveClipboardFormatListener;

procedure TDM.DataModuleCreate(Sender: TObject);
begin
<...>
  _addClipboardFormatListener := GetProcAddress(GetModuleHandle('user32.dll'), 'AddClipboardFormatListener');
  _removeClipboardFormatListener := GetProcAddress(GetModuleHandle('user32.dll'), 'RemoveClipboardFormatListener');

  if (Assigned(_addClipboardFormatListener) AND NOT _addClipboardFormatListener(Application.Handle)) then
    begin
      _isClipboardChangeRequired := false;
      ShowMessage('Не удалось установить перехватчик изменения буфера обмена! Кодировка при вставке в контролы может быть неверной!' +
        sLineBreak + 'Код ошибки (' + IntToStr(GetLastError()) + '): ' + SysErrorMessage(GetLastError()));
    //      WriteLog([ssWarn], ClassName, 'Не удалось установить перехватчик изменения буфера обмена! Кодировка при вставке в контролы может быть неверной!' +
    //      sLineBreak + 'Код ошибки (' + IntToStr(GetLastError()) + '): ' + SysErrorMessage(GetLastError()));
    end
    else
        _isClipboardChangeRequired := true;
<...>
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
    if Assigned(_removeClipboardFormatListener) then
    _removeClipboardFormatListener(Application.Handle);
end;

procedure TDM.ApplicationEvents_ClipboardChangeMessage(var Msg: tagMSG; var Handled: Boolean);
const
    // WM_CLIPBOARDUPDATE is not defined in the Messages unit of all supported
  // versions of Delphi, so we defined it here for safety.
  // (взято отсюда: http://delphidabbler.com/articles?article=9)
  WM_CLIPBOARDUPDATE = $031D;
  MAX_CLIPBOARD_OPEN_ATTEMPTS = 3;
var
    textBuf : array[0..512] of WideChar;
  clipHandle : THandle;
  dataPtr: Pointer;
  dataSize : integer;
  str : string;
  attemptCount : integer;
  isClipboardOpened : boolean;
begin
  // если система не поддерживает слежение за буфером обмена, прекращаем дальнейшие попытки это сделать
    if (NOT Assigned(_addClipboardFormatListener)) then
    begin
        ApplicationEvents_ClipboardChange.OnMessage := nil;
      Exit;
    end;
  if (Msg.message = WM_CLIPBOARDUPDATE) AND (Clipboard.HasFormat(CF_UNICODETEXT)) then
    if NOT _isClipboardChangeRequired then
        begin
            _isClipboardChangeRequired := true;
        Exit;
      end
    else
      begin
        attemptCount := 1;
        isClipboardOpened := false;
        repeat
          try
            Clipboard.Open();
            isClipboardOpened := true;
          except
            if (attemptCount >= MAX_CLIPBOARD_OPEN_ATTEMPTS) then
              begin
                OutputDebugString(PChar('Внимание: Нет доступа к буферу обмена - невозможно изменить его кодировку!'));
                Exit;
              end
            else
              inc(attemptCount);
          end;
        until isClipboardOpened;
        clipHandle := Clipboard.GetAsHandle(CF_UNICODETEXT);
        dataPtr := GlobalLock(clipHandle);
        if (dataPtr <> nil) then
          try
            dataSize := GlobalSize(clipHandle);
            ZeroMemory(@textBuf, sizeof(textBuf));
            CopyMemory(@textBuf, dataPtr, dataSize);
            SetString(str, textBuf, dataSize);
            str := Trim(str);
            Clipboard.AsText := str;
            _isClipboardChangeRequired := false;
            OutputDebugString(PChar('Clipboard encoding converted!'));
          finally
            GlobalUnlock(clipHandle);
          end;
        Clipboard.Close();
      end;
end;