VPF::Рисовать на часах Windows - Форум программистов

ДенисБелов

Дата 19.9.2006, 20:32 (ссылка)

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

Загрузка ...

Подмастерье

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

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

Проблему поднимал уже, думал решу её сам, но разобраться так и не смог.

Прошу пример, как
1). Нарисовать вместо часов, например, картинку из файла.
2). Узнать размер области рисования, ширину и высоту.
3). Сделать обработчик событий на щелчки мыши, например, на левую возращает обычный вид часов, на правую показывает контекстное меню.

НЕ надо мне говорить про то, что бы я почитал книгу по WINAPI, мне нужен пример именно этого, нигде в книгах такого примера я не видел.

Желательно даже, чтобы это была ссылка на работающие исходники.

Если кто сможет помочь, заранее благодарен. smile

M
Girder

Зачем дубли плодить http://forum.vingrad.ru/index.php?showtopic=111635
Тема закрыта!

~FoX~

Дата 20.9.2006, 11:34 (ссылка)

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

Загрузка ...

НЕ рыжий!!!

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

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

Нарисует небольшой кружочек на часиках.

Код


var
 Wnd: THandle; 
 c: TCanvas;
begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayClockWClass', nil);
 c := TCanvas.Create;
 c.Handle := GetDC(wnd);
 c.Ellipse(1,1,10,10);

end;

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

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

Sunvas

Дата 20.9.2006, 20:38 (ссылка)

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

Загрузка ...

Соль и сахар

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

Репутация: 28
Всего: 89

Цитата(ДенисБелов @ 19.9.2006, 20:32

)

Прошу пример, как
1). Нарисовать вместо часов, например, картинку из файла.
2). Узнать размер области рисования, ширину и высоту.
3). Сделать обработчик событий на щелчки мыши, например, на левую возращает обычный вид часов, на правую показывает контекстное меню.

Если ты это пишешь для Win XP или 2000, то думаю тут будет проще использовать прозрачную форму и замостить ее поверх часов. С этой формой тебе не будет трудности всунуть туда и рисунок и еще чего-либо.
Вот, кое-что набрасал:
Код в Формы1 (основной). При нажатии на кнопку на часы моститься форма 2.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Wnd: THandle;
implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 r:trect;
 p0,p1:tpoint;
begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayClockWClass', nil);
 form2.BorderStyle:=bsnone;
 form2.AlphaBlend:=true;
 form2.AlphaBlendValue:=150;
 getwindowrect(wnd,r);
 p0:=r.TopLeft;
 p1:=r.BottomRight;
 p1.X:=p1.X-p0.X;
 p1.y:=p1.y-p0.y;
 form2.Width:=p1.X;
 form2.Height:=p1.Y;
 form2.Left:=p0.X;
 form2.Top:=p0.Y;
 form2.Show;
end;

procedure TForm1.Timer1Timer(Sender: TObject); //постоянно подталкиваем окно формы2 наверх, чтобы оно было всегда поверх панели задач
begin
SetWindowPos(form2.Handle, HWND_TOPMOST, 0, 0, 0, 0,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

end.

Вот код Формы2, которая показывается поверх стандартных часов:

Код


unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls;

type
  TForm2 = class(TForm)
    Image1: TImage;
    procedure FormClick(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormClick(Sender: TObject);
begin
case form2.AlphaBlendValue of
150: form2.AlphaBlendValue:=10;
10: form2.AlphaBlendValue:=150;
end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer); //Как ты и просил - показываем меню от часов.
begin
if button=mbright then
sendmessage(unit1.Wnd,WM_RBUTTONUP,0,0);
end;

end.

ЗЫ. Дорабатывать было лень.

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ДенисБелов

Дата 20.9.2006, 20:43 (ссылка)

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

Загрузка ...

Спасибо за ответ, сейчас посмотрю что к чему.

Это сообщение отредактировал(а) ДенисБелов - 20.9.2006, 20:52

Alexeis

Дата 20.9.2006, 20:54 (ссылка)

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

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата(ДенисБелов @ 20.9.2006, 20:43

)

Первый вариант не устраивает и тем, что при обновлении стола он рисунок пропадает.

По другому и не получится это же чужое окно! Придется перехватывать OnPaint.

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

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

ДенисБелов

Дата 20.9.2006, 21:11 (ссылка)

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

Загрузка ...

Во-первых спасибо за ответы, хорошая пища для размышлений.
посмотрел оба варианта и оба меня полностью не устраивают.

Алгоритм предложенный в первом ответе мне предлагался, он не устроил меня тем, что при обновлении все исчезает. Перехватить OnPaint? Как? И как поймать нажатие мыши?

Второй вариант тоже интересен. Однако, окно появляется не сразу, при нажатии на кнопку открытия\скрытия значков трея пропадает на время таймера. Да и при банальном свернуть всё сворачмивается со всеми окнами, оно и понятно. Может можно "приклеить" его так чтобы оно было уже всегда наверху, несмотря ни на что.

Вобщем, тема остается открытой, помогите доработать эти варианты или предложите новые.
И как уже говорил smile

Romikgy

Дата 20.9.2006, 21:44 (ссылка)

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

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

А не проще ли будет создать свое окно , да и поставить его выше часов, а там рисовать все что хочется , ну и вставлять время?

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

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

ДенисБелов

Дата 20.9.2006, 23:48 (ссылка)

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

Загрузка ...

Sunvas это и предлагал, однако как решить проблемку чтобы окно было всегда выше всех, даже если нажать на кнопку "свернуть всё".

Alexeis

Дата 21.9.2006, 01:20 (ссылка)

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

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата(ДенисБелов @ 20.9.2006, 23:48

)

Это уже хоть и каряво, но решили (см. поиск по форуму). Для перехвата сообщений служат несколько метов. Простейший, он же худший - это вешать хук. Еще можно внедрять свой код, менять точки входа в системные библиотеки и пр. Все это неоднократно обсуждалось в разделе "Delphi: WinAPI и системное программирование". Туда прямая дорога.

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

~FoX~

Дата 21.9.2006, 07:39 (ссылка)

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

Загрузка ...

НЕ рыжий!!!

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

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

Цитата(ДенисБелов @ 20.9.2006, 22:11

)

Перехватить OnPaint? Как?

Примерно так:

Код


procedure WMPAINT(var Message: TMessage); message WM_PAINT; 
....................
procedure TForm1.WMPAINT(var Message: TMessage);
var
 Wnd: THandle;
 c: TCanvas;
begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayClockWClass', nil);
 c := TCanvas.Create;
 c.Handle := GetDC(wnd);
 c.Ellipse(1,1,10,10);
end;

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

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

Alexeis

Дата 21.9.2006, 09:15 (ссылка)

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

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

~FoX~, это WM_PAINT своего окна, а нужно чужого, свой то зачем?

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

Romikgy

Дата 21.9.2006, 09:32 (ссылка)

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

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Цитата(ДенисБелов @ 20.9.2006, 22:48

)

аже если нажать на кнопку "свернуть всё".

ну так полюбому идет команда окну "свернутся" , а что если поставить свой обработчик на это сообщение , да игнорировать его

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

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Sunvas

Дата 21.9.2006, 16:49 (ссылка)

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

Загрузка ...

Соль и сахар

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

Репутация: 28
Всего: 89

Ну.. Можно еще скрыть окно часов, а на его место всунуть свое окно, путем изменения родителя с Application на TrayNotifyWnd при помощи windows.setparent

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

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