Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Таблицу в clipboard

Delphi , Компоненты и Классы , TMemo и TRichEdit

У меня есть 2 memo. как мне сделать так, чтобы в клипборд посылалосьтабличка из двух ячеек с содержимым их мемо. точнее как загнать табличку в клипборд программно.

Я смотрел, что когда копируешь из wordа табличку, то в клипе лежит текст и картинка (вот с эти я больше всего не понял). Не понятно!!

Итак во-первых

Мутим такую программку

Code:

unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Clipbrd, ComCtrls;
 
type
TForm1 = class(TForm)
   memformats: TMemo;
   memexample: TMemo;
   Label1: TLabel;
   BtnShowFormats: TButton;
   btngetrtf: TButton;
   btnsetrtf: TButton;
   RichEdit1: TRichEdit;
   procedure FormCreate(Sender: TObject);
   procedure BtnShowFormatsClick(Sender: TObject);
   procedure btngetrtfClick(Sender: TObject);
   procedure btnsetrtfClick(Sender: TObject);
private
   { Private declarations }
public
   CF_RTF: Word;
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
// register clipboard format rtf 
CF_RTF := RegisterClipboardFormat('Rich Text Format'); 
if CF_RTF = 0 then
begin
   ShowMessage('Unable to register the Rich Text clipboard format!'); 
   Application.Terminate; 
end;
BtnShowFormats.Click;
end;
 
procedure TForm1.BtnShowFormatsClick(Sender: TObject);
var
buf: array [0..60] of Char; 
n: Integer; 
fmt: Word; 
Name: string[30]; 
begin
MemFormats.Clear; 
for n := 0 to Clipboard.FormatCount - 1 do
begin
   fmt := Clipboard.Formats[n];
   if GetClipboardFormatName(fmt, buf, Pred(SizeOf(buf))) <> 0 then
     MemFormats.Lines.Add(StrPas(buf)) 
   else
   begin
     case fmt of
       1: Name := 'CF_TEXT'; 
       2: Name := 'CF_BITMAP'; 
       3: Name := 'CF_METAFILEPICT'; 
       4: Name := 'CF_SYLK'; 
       5: Name := 'CF_DIF'; 
       6: Name := 'CF_TIFF'; 
       7: Name := 'CF_OEMTEXT'; 
       8: Name := 'CF_DIB'; 
       9: Name := 'CF_PALETTE'; 
       10: Name := 'CF_PENDATA'; 
       11: Name := 'CF_RIFF'; 
       12: Name := 'CF_WAVE'; 
       13: Name := 'CF_UNICODETEXT'; 
       14: Name := 'CF_ENHMETAFILE'; 
       15: Name := 'CF_HDROP (Win 95)'; 
       16: Name := 'CF_LOCALE (Win 95)'; 
       17: Name := 'CF_MAX (Win 95)'; 
       $0080: Name := 'CF_OWNERDISPLAY'; 
       $0081: Name := 'CF_DSPTEXT'; 
       $0082: Name := 'CF_DSPBITMAP'; 
       $0083: Name := 'CF_DSPMETAFILEPICT'; 
       $008E: Name := 'CF_DSPENHMETAFILE'; 
       $0200..$02FF: Name := 'private format'; 
       $0300..$03FF: Name := 'GDI object'; 
       else
         Name := 'unknown format'; 
     end; 
     MemFormats.Lines.Add(Name); 
   end;
end; 
end;
 
procedure TForm1.btngetrtfClick(Sender: TObject);
var
MemHandle: THandle; 
begin
with Clipboard do
begin
   Open; 
   try
     if HasFormat(CF_RTF) then
     begin
       MemHandle := GetAsHandle(CF_RTF);
       MemExample.SetTextBuf(GlobalLock(MemHandle));
       GlobalUnlock(MemHandle); 
     end
     else
       MessageDlg('The clipboard contains no RTF text!', 
         mtError, [mbOK], 0); 
   finally
     Close; 
   end;
end; 
end;
 
procedure TForm1.btnsetrtfClick(Sender: TObject);
const
testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}'; 
testtext2: PChar = '{\rtf1\ansi' + 
   '\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman Cyr;}}' + 
   '\pard\plain 12{\ul апопьт4}}';
var
MemHandle: THandle;
rtfstring: PChar;
begin
 
with Clipboard do
begin
   rtfstring :=memexample.Lines.GetText;
//    rtfstring :=testtext;
   MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1); 
   if MemHandle <> 0 then
   begin
     StrCopy(GlobalLock(MemHandle), rtfstring);
     GlobalUnlock(MemHandle);
     Open; 
     try
      // AsText := '1244444';
       SetAsHandle(CF_RTF, MemHandle);
     finally
       Close; 
     end; 
   end
   else
     MessageDlg('Global Alloc failed!',
       mtError, [mbOK], 0); 
end;
end;
end.

прога представляет из себя просмоторщик rtf-текста в буфере. Из вёрда допустим, копируем табличку, нажимает на кнопочку(btngetrtf) в проге и в memo высветится наш клипборд

Точнее из этой проги, в основном нам нужна процедура копирования в буфер, благополучно ее и забираем, а также то, что получается в буфере.

во-вторых, рисуем таблицу в вёрде, копируем в клипбоАрд. Запускаем нашу прогу и нажимаем на нопочку (btngetrtf) и нам, О чудо!!!, высвечивается буфер. То, что вы там увидите, будет очень громоздко по размерам и переполнено тегами. Для своего случая, мне нужна была небольшая табличка 4х2, я сначала копировал из вёдра, потом копировал в wordpad, и сохранял на диск. Там реально в чем-то разобраться, нежели чем из вёрда. Такой фокус прокатит только с объединенными ячейками по горизонтали, по вертикали не судьба.

В-третьих, чтобы мало по малу отредактировать наш rtf или понять что и где находится изучаем его спецификацию http://ftp.bspu.unibel.by/pub/Programming/Specifications/rtf/gc0165.exe . Что-нибудь редактируем. Вот мы получили содержимое нашего буфера. Теперь рисуем свою прогу, туда процедуру копирования в буфер, и содержимое нашего буфера.

Автор: andruxin

Взято из http://forum.sources.ru

Я помогу вам скопировать таблицу из двух полей мемо в буфер обмена и затем отобразить ее в другой приложении.

Сначала создадим новый процедуру, которая будет копировать содержимое двух полей мемо в буфер обмена в формате RTF (Rich Text Format). Мы будем использовать процедуру btnsetrtfClick как стартовую точку.

Вот обновленный код:

procedure TForm1.btnsetrtfClick(Sender: TObject);
const
  testtext1, testtext2: PChar;
begin
  testtext1 := MemFormats.Lines.Text + #13;
  testtext2 := MemExample.Lines.Text + #13;

  rtfstring := testtext1 + testtext2;

  MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1);
  if MemHandle <> 0 then
  begin
    StrCopy(GlobalLock(MemHandle), rtfstring);
    GlobalUnlock(MemHandle);

    Open;
    try
      SetAsHandle(CF_RTF, MemHandle);
    finally
      Close;
    end;
  end
  else
    MessageDlg('Global Alloc failed!', mtError, [mbOK], 0);
end;

В этом коде мы конкатенируем содержимое полей мемо MemFormats и MemExample в одиночную строку с помощью синтаксиса + #13, чтобы добавить символ новой строки в конце каждой строки. Затем мы выделяем память для строки RTF с помощью GlobalAlloc, копируем строку в выделенную память с помощью StrCopy, и наконец, устанавливаем формат буфера обмена на RTF с помощью SetAsHandle.

Теперь создадим новый кнопку, которая будет вызывать эту процедуру:

procedure TForm1.btnCopyToClipboardClick(Sender: TObject);
begin
  btnsetrtfClick(Sender);
end;

Добавьте новую кнопку в вашу форму и установите свойство Caption на "Copy to Clipboard". Затем в событии OnClick этой кнопки вызовите процедуру btnsetrtfClick.

Запустите ваше приложение, выберите текст в обоих полях мемо, нажмите кнопку "Copy to Clipboard", а затем откройте процессор текста или другое приложение, поддерживающее формат RTF. Вы должны увидеть содержимое двух полей мемо скопировано в буфер обмена в виде таблицы RTF.

Чтобы отобразить содержимое буфера обмена в другом приложении, вы можете использовать процедуру GetAsHandle, чтобы получить содержимое буфера обмена в формате RTF, а затем отобразить его с помощью Rich Edit-контрола или другого контрола, поддерживающего формат RTF.

Надеюсь, это поможет! Пожалуйста, дайте мне знать, если у вас есть какие-либо дальнейшие вопросы.

Программа создает просмотрщик RTF-текста в буфере обмена, позволяя копировать таблицы из Word и получать содержимое буфера.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: TMemo и TRichEdit ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-06-16 18:11:21/0.0039360523223877/0