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

Советы » Буфер обмена » Получить или занести текст в буфер без использования 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

.

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

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com