 ::  |
| Autor |
Poruka |
Doktor
~Sanjicino*slculence~
 |
Godine: 38
Datum registracije: 17 Nov 2005
Poruke: 4264
Mesto: Novi Sad
|
|
Ovde vam je predstavljen kompletan program koji sadrži rutine za rad sa Clipboardom. Ono što je važno je da program ne koristi VCL objekte pa je samim tim izvršni oblik aplikacije znatno smanjen. VCL (Visual Component Library) služi za povezivanje elemenata interfejsa sa aplikacijom i značajno povećava samu veličinu EXE fajla. Kako se ovaj modul koristi u iteraciji sa nekim drugim modulima ovaj primer ne koristi VCL kako ne bi došlo do dvostrukog prevodjenja istih rutina i vizualnih elemenata što u zavisnosti od veličine programa smanjuje EXE fajl i za nekoliko megabajta.
Ovaj primer prikazuje kako se neki tekst šalje odnosno prima iz Clipboarda. Takodje kod sadrži i rutinu za brisanje celokupnog sadržaja vaše “beležnice” (procedura TForm1.Clear).
| Code: |
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}
//kreiranje resursa za neki string (ResourceString)
constructor TForm1.CreateRes(Ident: Integer);
begin
FMessage := LoadStr(Ident);
end;
//status dodavanja nekog teksta u Clipboard
procedure TForm1.Adding;
begin
if (FOpenRefCount <> 0) and not FEmptied then
begin
Clear;
FEmptied := True;
end;
end;
//pražnjenje Clipboarda
procedure TForm1.Clear;
begin
Open;
try
EmptyClipboard;
finally
Close;
end;
end;
//Postavljanje bafera
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;
//otvaranje Clipboarda
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;
//preuzimanje teksta snimljenog u Clipboard
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
//slanje nekog teksta u Clipboard
SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
end;
//preuzimanje nekog teksta iz Clipboarda pritiskom na dugme (simulacija Ctrl+V)
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetClipboardText);
end;
//postavljanje vašeg teksta u Clipboard pritiskom na dugme (simulacija Ctrl+C)
procedure TForm1.Button2Click(Sender: TObject);
begin
SetClipboardText('Primer upisivanja teksta u Clipboard');
end;
end.
|
|
_________________
~*~Vojim svoje srculence najvise na svetu ~*~ :322:
 |
|
| |
|
 |
|
|
Vi ne možete otvarati nove teme u ovom forumu
Vi ne možete odgovarati na teme u ovom forumu
Vi ne možete menjati Vaše poruke u ovom forumu
Vi ne možete brisati Vaše poruke u ovom forumu
Vi ne možete glasati u anketama u ovom forumu
Vi ne možete postavljati fajlove u ovom forumu
Vi ne možete preuzeti fajlove sa ovog foruma
|
|
