Получить или занести текст в буфер без использования VCL

unit
 Unit1;

 interface


 uses

   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls...;

 type

   TForm1 = class
(TForm)
     Button1: TButton;
     Button2: TButton;
     function
 GetClipBoardText: string
;
     procedure
 SetClipBoardText(const
 Value: string
);
     procedure
 Open;
     procedure
 SetBuffer(Format: Word; var
 Buffer; Size: Integer);
     procedure
 Adding;
     procedure
 Clear;
     constructor
 CreateRes(Ident: Integer);
     procedure
 Button1Click(Sender: TObject);
     procedure
 Button2Click(Sender: TObject);
   private

     FOpenRefCount: Integer;
     FClipboardWindow: HWND;
     FAllocated: Boolean;
     FEmptied: Boolean;
     FMessage: string
;
   public

     { Public declarations }
   end
;

 var

   Form1: TForm1;

 resourcestring
   SCannotOpenClipboard = 'Cannot open clipboard';

 implementation



 {$R *.dfm}

 //Create resource for resourceString 
constructor
 TForm1.CreateRes(Ident: Integer);
 begin

   FMessage := LoadStr(Ident);
 end
;

 //Status: Adding 
procedure
 TForm1.Adding;
 begin

   if
 (FOpenRefCount <> 0) and
 not
 FEmptied then

   begin

     Clear;
     FEmptied := True;
   end
;
 end
;

 //Empty clipboard 
procedure
 TForm1.Clear;
 begin

   Open;
   try

     EmptyClipboard;
   finally

     Close;
   end
;
 end
;

 //Set buffer 
procedure
 TForm1.SetBuffer(Format: Word; var
 Buffer; Size: Integer);
 var

   Data: THandle;
   DataPtr: Pointer;
 begin

   Open;
   try

     Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Size);
     try

       DataPtr := GlobalLock(Data);
       try

         Move(Buffer, DataPtr^, Size);
         Adding;
         SetClipboardData(Format, Data);
       finally

         GlobalUnlock(Data);
       end
;
     except

       GlobalFree(Data);
       raise
;
     end
;
   finally

     Close;
   end
;
 end
;

 //Open the clipboard 
procedure
 TForm1.Open;
 begin

   if
 FOpenRefCount = 0 then

   begin

     FClipboardWindow := Application.Handle;
     if
 FClipboardWindow = 0 then

     begin

       {$IFDEF MSWINDOWS}
       FClipboardWindow := Classes.AllocateHWnd(MainWndProc);
       {$ENDIF}
       {$IFDEF LINUX}
       FClipboardWindow := WinUtils.AllocateHWnd(MainWndProc);
       {$ENDIF}
       FAllocated := True;
     end
;
     if
 not
 OpenClipboard(FClipboardWindow) then

       raise
 Exception.CreateRes(@SCannotOpenClipboard);
     FEmptied := False;
   end
;
   Inc(FOpenRefCount);
 end
;

 //Get the clipboard text 
function
 TForm1.GetClipBoardText: string
;
 var

   Data: THandle;
 begin

   Open;
   Data := GetClipboardData(CF_TEXT);
   try

     if
 Data <> 0 then

       Result := PChar(GlobalLock(Data))
     else

       Result := '';
   finally

     if
 Data <> 0 then
 GlobalUnlock(Data);
     Close;
   end
;
 end
;

 procedure
 TForm1.SetClipBoardText(const
 Value: string
);
 begin

   //Set ClipboardText 
  SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
 end
;

 //Get the clipboard text 
procedure
 TForm1.Button1Click(Sender: TObject);
 begin

   ShowMessage(GetClipboardText);
 end
;

 //Set the clipboard text 
procedure
 TForm1.Button2Click(Sender: TObject);
 begin

   SetClipboardText('-> Big-X <-');
 end
;

 end
.

Другое по теме:

• Форма как графический объект
• Сохранить содержимое буфера обмена или потока как картинку
• Сохранение данных в Clipboard