Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить или занести текст в буфер без использования VCL

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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.
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.