VPF::Сохранение всего содержимого буфера обмена в файл

Vit

Дата 20.5.2002, 15:22 (ссылка)

(нет голосов)

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

Из рассылки "Мастера DELPHI. Новости мира компонент,..."

Код


var   FS:TFileStream;
procedure TForm1.bClearClick(Sender: TObject);
begin
OpenClipBoard(0);
EmptyClipboard;
CloseClipBoard;
end;
procedure TForm1.BSaveClick(Sender: TObject);
var CBF:Cardinal;
CBFList:TList;
i:Integer;
h:THandle;
p:Pointer;
CBBlockLength,Temp:Cardinal;
FS:TFileStream;
begin
if OpenClipBoard(0)then begin
 CBFList:=TList.Create;
 CBF:=0;
 repeat
   CBF:=EnumClipboardFormats(CBF);
   if CBF<>0 then
     CBFList.Add(pointer(CBF));
 until CBF=0;
 edit1.text:=IntToStr(CBFList.Count);
 if CBFList.Count>0 then begin
   FS:=TFileStream.Create('e:\cp.dat',fmCreate);
   Temp:=CBFList.Count;
   FS.Write(Temp,SizeOf(Integer));
   for i:=0 to CBFList.Count-1 do begin
     h:=GetClipboardData(Cardinal(CBFList[i]));
     if h>0 then begin
       CBBlockLength:=GlobalSize(h);
       if h>0 then begin
         p:=GlobalLock(h);
         if p <> nil then begin
           Temp:=Cardinal(CBFList[i]);
           FS.Write(Temp,SizeOf(Cardinal));
           FS.Write(CBBlockLength,SizeOf(Cardinal));
           FS.Write(p^,CBBlockLength);
         end;
         GlobalUnlock(h);
       end;
     end;
   end;
 
 FS.Free;
 end;
 CBFList.Free;
 CloseClipBoard;
end;
end;
procedure TForm1.bLoadClick(Sender: TObject);
var   h:THandle;
p:Pointer;
CBF:Cardin!
al;
CBBlockLength:Cardinal;
i,CBCount:Integer;
FS:TFileStream;
begin
if OpenClipBoard(0)then begin
FS:=TFileStream.Create('e:\cp.dat',fmOpenRead);
if FS.Size=0 then Exit;
FS.Read(CBCount,sizeOf(Integer));
if CBCount=0 then Exit;
for i:=1 to CBCount do begin
 FS.Read(CBF,SizeOf(Cardinal));
 FS.Read(CBBlockLength,SizeOf(Cardinal));
 h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT,CBBlockLength);
 if h>0 then begin
   p:=GlobalLock(h);
   if p=nil then
     GlobalFree(h)
     else begin
       FS.Read(p^,CBBlockLength);
       GlobalUnlock(h);
       SetClipboardData(CBF,h);
   end;
 end;
end;
FS.Free;
CloseClipBoard;
end;
end;

--------------------

With the best wishes, Vit
I have done so much with so little for so long that I am now qualified to do anything with nothing
Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »