Delphi 7:如何将非拉丁文本复制到剪贴板? (转换为Unicode?)

时间:2014-02-11 16:14:38

标签: delphi winapi unicode delphi-7

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

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剪贴板复制功能?但是怎么做呢?

2 个答案:

答案 0 :(得分:2)

通过您认为合适的方式将文本转换为Unicode。在Delphi 7中,通常涉及使用WideString

如果您将文本编码为UTF-16,例如在WideString中,则需要使用SetClipboardData剪贴板格式调用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;

答案 1 :(得分:0)

非常感谢,如果你抓住WM_CLIPBOARDUPDATE消息,你可以在剪贴板中转换编码 - 对旧版本的delphi非常有用,例如:俄语。 这是一个完整的工作代码:

(N.B。此缓冲区侦听tecnique仅适用于Windows Vista和更新的操作系统,这就是我使用动态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;