Текущий архив: 2008.06.01;
Скачать: CL | DM;

Вниз

Затемнение главного окна пр показе моадльного   Найти похожие ветки 

← →
Nil   (2008-05-12 12:48) [0]

Сделал затемнение готовым найденным куском кода
Вот он этот кусочек
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 13:01) [1]

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

---

← →
{RASkov} ©   (2008-05-12 13:48) [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 14:32) [3]

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

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

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

---

Страницы: 1 вся ветка

Текущий архив: 2008.06.01;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.012 c