| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Затемнение главного окна пр показе моадльного [XP]

Nil ©   (2008-05-12 12:48:00) 

Сделал затемнение готовым найденным куском кода
Вот он этот кусочек
procedure TMainForm.GrayDesktop;
const
 Color1 = clWhite;
 Color2 = clBlack;{}
 {Color1 = $00AAAAAA;
 Color2 = $00555555;{}
var
 DesktopDC, MemDC: HDC;
 NewBitmap, OldBitmap: HBITMAP;
 I, J: Integer;
begin
 DesktopDC := GetDC(Handle);
 try
   MemDC := CreateCompatibleDC(DesktopDC);
   if MemDC <>0 then
   begin
     NewBitmap := CreateCompatibleBitmap(DesktopDC, 32, 32);
     if NewBitmap <>0 then
     begin
       OldBitmap := SelectObject(MemDC, NewBitmap);
       for I := 0 to 31 do
         for J := 0 to 31 do
           if (I + J) and 1 = 0 then
             SetPixel(MemDC, I, J, Color1)
           else
             SetPixel(MemDC, I, J, Color2);
       { Paint }
       J := 0;
       while J <Screen.Height do
       begin
         I := 0;
         while I <Screen.Width do
         begin
           BitBlt(DesktopDC, I, J, 32, 32, MemDC, 0, 0, SRCAND);
           Inc(I, 32);
         end;
         Inc(J, 32);
       end;
       { Delete objects }
       DeleteObject(NewBitmap);
       SelectObject(MemDC, OldBitmap);
     end;
     DeleteDC(MemDC);
   end;
 finally
   ReleaseDC(Handle, DesktopDC);
 end;
end;

Одна проблема, на форме есть TPageControl, вот всё что вне его затемняется, а TPageControl вместе с его содержимым не затемняется. Подскажите пож в чём проблема?

---

Nil   (2008-05-12 14:32:00) [1]

Работает, спасибо. Я не подумал что у TPageControl свой Canvas и его тоже надо затемнять
Теперь проблема при перемещении окна. Сделал так:

procedure TAboutForm.WMEXITSIZEMOVE(var Message: TMessage);
begin
 MainForm.GrayWControl(MainForm);
end;

но проблема в том, что после перетаскивания, функция не перерисовает ту часть главной формы, где находилось окно до перетаскивания. пробовал ставить в OnPaint главной формы функцию затемнения, но проблема остаётся, ничего не меняется. подскажите пож как обойти грабли..

---

{RASkov}   (2008-05-12 13:48:00) [2]

> [0] Nil   (12.05.08 12:48)

Возможно рекурсивно для всех винконтролов нужно выполнить данный код....
Примерное изменение:
procedure TForm1.GrayWControl(WCtrl: TWinControl);
procedure GrayCtrl;
const
 Color1 = clWhite;
 Color2 = clBlack;{}
 {Color1 = $00AAAAAA;
 Color2 = $00555555;{}
var
 DesktopDC, MemDC: HDC;
 NewBitmap, OldBitmap: HBITMAP;
 I, J: Integer;
begin
 DesktopDC := GetDC(WCtrl.Handle);
 try
   MemDC := CreateCompatibleDC(DesktopDC);
   if MemDC <>0 then
   begin
     NewBitmap := CreateCompatibleBitmap(DesktopDC, 32, 32);
     if NewBitmap <>0 then
     begin
       OldBitmap := SelectObject(MemDC, NewBitmap);
       for I := 0 to 31 do
         for J := 0 to 31 do
           if (I + J) and 1 = 0 then
             SetPixel(MemDC, I, J, Color1)
           else
             SetPixel(MemDC, I, J, Color2);
       { Paint }
       J := 0;
       while J <Screen.Height do
       begin
         I := 0;
         while I <Screen.Width do
         begin
           BitBlt(DesktopDC, I, J, 32, 32, MemDC, 0, 0, SRCAND);
           Inc(I, 32);
         end;
         Inc(J, 32);
       end;
       { Delete objects }
       DeleteObject(NewBitmap);
       SelectObject(MemDC, OldBitmap);
     end;
     DeleteDC(MemDC);
   end;
 finally
   ReleaseDC(Handle, DesktopDC);
 end;
end;
var N: Integer;
begin
 for N:=0 to WCtrl.ControlCount-1 do
  if WCtrl.Controls[N] is TWinControl then begin
   GrayWControl(TWinControl(WCtrl.Controls[N]));
   GrayCtrl;
  end;
 GrayCtrl;
end;

Пример вызова из метода формы: GrayWControl(Self);
ЗЫ: За качество кода в [0], и соответственно кусок его тут, я не ручаюсь...

---

Nil   (2008-05-12 13:01:00) [3]

Прошу прощения за пропущенные буквы, спешил:)

---

Наверх