Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.06.27;
Скачать: CL | DM;

Вниз

таблицу в клипборд. программно.   Найти похожие ветки 

 
andruxa   (2004-06-11 01:38) [0]

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


 
andruxa   (2004-06-12 21:24) [1]

Отвечаю на свой вопрос сам.

Итак во-первых
Мутим такую программку

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 . Что-нибудь редактируем.
Вот мы получили содержимое нашего буфера. Теперь рисуем свою прогу, туда процедуру копирования в буфер, и содержимое нашего буфера.

Вот и все.



Страницы: 1 вся ветка

Текущий архив: 2004.06.27;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.024 c
14-1086904004
Aborigen
2004-06-11 01:46
2004.06.27
КПК с GSM/GPRS модулем. Помогите выбрать!?


14-1086868359
GooD
2004-06-10 15:52
2004.06.27
Зацените прогу


1-1087207741
Arestotel
2004-06-14 14:09
2004.06.27
Проблемы с MDI !!!


14-1086943243
Mike
2004-06-11 12:40
2004.06.27
работа с треем


14-1086529803
Алхимик
2004-06-06 17:50
2004.06.27
Кандидатский минимум.