Модератор: Модераторы
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
s:='привет, выпить нет?';
clipboard.SetTextBuf(PChar(s));
end;
uses windows, sysutils;
const
size = 80 * 50;
var
chiBuffer: string;
hStdOut: THandle;
rd: LongWord;
buf: array[0 .. pred(size)] of char;
function GetConsoleWindow: THandle;
var
S: AnsiString;
C: Char;
begin
Result := 0;
Setlength(S, MAX_PATH + 1);
if GetConsoleTitle(PChar(S), MAX_PATH) <> 0 then
begin
C := S[1];
S[1] := '$';
SetConsoleTitle(PChar(S));
Result := FindWindow(nil, PChar(S));
S[1] := C;
SetConsoleTitle(PChar(S));
end;
end;
procedure grabber();
var
Data: THandle;
DataPtr: Pointer;
len: integer;
crd: TCoord;
i: integer;
begin
crd.X := 0;
crd.Y := 0;
hStdout := GetStdHandle(STD_OUTPUT_HANDLE);
ReadConsoleOutputCharacter(hStdout, buf, size, crd, rd);
chiBuffer := '';
for i := 0 to pred(rd) do begin
chiBuffer := chiBuffer + buf[i];
if succ(i) mod 80 = 0 then chiBuffer := chiBuffer + #13#10;
end;
if OpenClipboard(GetConsoleWindow) then
try
{ opening clipboard succeeded... }
len := Length(chiBuffer) + 1;
Data := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, len);
try
DataPtr := GlobalLock(Data);
try
Move(pchar(chiBuffer)^, DataPtr^, len);
EmptyClipboard;
SetClipboardData(CF_TEXT, Data);
finally
GlobalUnlock(Data);
end;
except
GlobalFree(Data);
end;
finally
CloseClipboard;
end;
end;
var
i: integer;
begin
for i := 1 to 10 do
writeln('Wow !!! Wow !!! Wow !!! ', i);
grabber();
end.
EmeraldMan писал(а):Текст в буфер обмена легко (выше уже написали как), а вот картинку проблематично.
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3