VPF::Рисуем на рабочем столе - Форум программистов

bagos

Дата 3.11.2009, 15:00 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 275
Регистрация: 17.6.2006

Репутация: нет
Всего: 1

Сразу извиняйте если не в том разделе пишу. В программе пользователь должен получить координаты области(mouse down первая координата, mouse up вторая) на экране(не только на самой форме а в любом месте рабочего стола). Для наглядности думаю будет правильно сделать возможным чтобы рисовался прямоугольник когда пользователь задает область. Немног осхоже с выделением на рабочем столе, зажал кнопку мыши получил координату и рисуем прямоугольник, отпустили клавишу мыши, получили вторую координату. Зато все просто и наглядно будет)
Прошу помощи в реализации! smile

Mikel

Дата 9.11.2009, 23:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник Клуба
Сообщений: 882
Регистрация: 30.3.2002
Где: Саратов

Репутация: 1
Всего: 2

Глобальный хук на события мыши, а на столе по GetDC(0) можно рисовать. Но точно нужно именно это? Какова задача? Если что-н типа съемки с экрана, то можно сделать скрин экрана, потом положить его на форму на весь экран и выделяй что хочешь

--------------------

...so remember, it's better to burn out than to fade away

~FoX~

Дата 10.11.2009, 08:01 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 2
Всего: 68

bagos,

Код


unit Unit1;

interface

uses
  Windows, Messages, Classes, Graphics, Forms, StdCtrls, Controls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
    FHookStarted : Boolean;
    procedure JMouseHook(var Msg: tagMSG; var Handled: Boolean);
  end;

  procedure SquareDT(Fx, Fy, Lx, Ly: integer);

var
  Form1: TForm1;
  JHook: THandle;
  Fx, Fy, Lx, Ly: integer;

implementation

{$R *.dfm}


function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
begin
  Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  if Code < 0 then Exit;
  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then begin
    if EventStrut.message = WM_LBUTTONDOWN then begin
      Fx := EventStrut.paramL;
      Fy := EventStrut.paramH;
    end;
    if EventStrut.message = WM_LBUTTONUP then begin
      Lx := EventStrut.paramL;
      Ly := EventStrut.paramH;
      SquareDT(Fx, Fy, Lx, Ly);
    end;
  end;
end;

procedure SquareDT(Fx, Fy, Lx, Ly: integer);
var
  c: TCanvas;
begin
  c := TCanvas.Create;
  c.Brush.Color := clRed;
  c.Pen.Color := clRed;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  c.Ellipse(Rect(Fx, Fy, Lx, Ly));
  c.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FHookStarted then begin
    MessageBox(Application.Handle, PChar('Mouse Hook is already started'), PChar('Error'), MB_OK);
    Exit;
  end;
  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);

  if JHook > 0 then FHookStarted := True
  else MessageBox(Application.Handle, PChar('Can not started'), PChar('Error'), MB_OK);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FHookStarted := False;
  UnhookWindowsHookEx(JHook);
  JHook := 0;
end;

procedure TForm1.JMouseHook(var Msg: tagMSG; var Handled: Boolean);
begin
  Handled := False;
  if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then
    JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FHookStarted then UnhookWindowsHookEx(JHook);
end;

end.

Это сообщение отредактировал(а) ~FoX~ - 10.11.2009, 08:06

--------------------

…множественность никогда не следует полагать без необходимости…

AntonN

Дата 10.11.2009, 09:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 491
Регистрация: 8.8.2006

Репутация: 7
Всего: 18

пум-пурум...
http://delphimaster.ru/cgi-bin/forum.pl?id...7247579&n=7

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »