Валерий Борисок - Delphi. Трюки и эффекты

Листинг 11.3.

Обработчик клиентских запросов

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);

var

strText: string;

width, height, i: Integer;

dc: HDC;

begin

//Принимаем от клиента строку

strText := AThread.Connection.ReadLn;

//Определяем, что нужно выполнить

if (strText = \'get_screen_height\') then

//Возвратим высоту экрана

Athread.Connection.WriteInteger(Screen.Height)

else if (strText = \'get_screen_width\') then

//Возвратим ширину экрана

Athread.Connection.WriteInteger(Screen.Width)

else if (strText = \'get_screen_colors\') then

begin

//Возвратим количество бит на точку

dc := GetDC(0);

Athread.Connection.WriteInteger(GetDeviceCaps(dc,

BITSPIXEL));

ReleaseDC(0, dc);

end

else if (strText = \'get_screen\') then

//Возвратим полноразмерную копию экрана

SendScreen(Screen.Width, Screen.Height, AThread.Connection)

else begin //строка вида \'get_screen:x,y\'

//Определим значения высоты и ширины,

//переданные пользователем

strText := Copy(strText, 12,Length(strText)-11);

i := Pos(\',\', strText); //Положение запятой

width := StrToInt(Copy(strText, 1, i-1));

height := StrToInt(Copy(strText, i+1, Length(strText)-i));

//Возвратим копию экрана

SendScreen(width, height, AThread.Connection);

end;

end;

Листинг 11.4.

Снятие копии экрана

//Процедура снимает копию экрана, приводит полученное

//изображение к заданному размеру и отправляет

//преобразованное изображение клиентской программе

procedure SendScreen(width: Integer; height: Integer;

Connection: TIdTCPServerConnection);

var

ScreenCopy: TCanvas;

gr: TBitmap;

stream: TMemoryStream;

rcDest, rcSource: TRect;

begin

rcDest := Rect(0, 0, width, height); //Конечный размер

//изображения

rcSource := Screen.DesktopRect; //Исходный размер

//изображения

//Создаем канву и присоединяем ее к контексту Рабочего стола

ScreenCopy := TCanvas.Create;

ScreenCopy.Handle := GetDC(0);

//Создаем объект для хранения копии экрана

//и копируем изображение

gr := TBitmap.Create;

gr.Height := height;

gr.Width := width;

gr.Canvas.CopyRect(rcDest, ScreenCopy,rcSource);

ReleaseDC(0, ScreenCopy.Handle);

//Сохраняем изображение в поток данных

stream := TMemoryStream.Create;

gr.SaveToStream(stream);

//Отправляем изображение клиенту

Connection.WriteStream(stream,True,True);

stream.Clear;

stream.Free;

gr.Free;

end;

Листинг 11.5. Соединение с сервером

procedure TForm1.cmbConnectClick(Sender: TObject);

begin

if (cmbConnect.Caption = \'Подключиться\') then

begin

if (txtServer.Text = \'\') then

//Не введено имя сервера

MessageDlg(\'Введите имя машины-сервера в текстовое поле\',

mtInformation, [mbOK], 0)

else begin

//Подключаемся к серверу