|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Полупрозрачная форма
Как сделать полупрозрачную форму со всеми ее компонентами?
|
#2
|
|||
|
|||
Код:
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin, XPMan; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; ColorDialog1: TColorDialog; SpinEdit1: TSpinEdit; Label2: TLabel; XPManifest1: TXPManifest; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure SpinEdit1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); private BM:TBitmap; { картинка, в которой хранится изображение экрана } BM2:TBitmap; { картинка, в которой хранится фон окна } Moving:Boolean; { а эта переменная равна True, если окно в данный момент перетаскивается пользователем } procedure WMEraseBkgnd(var Msg:TWMEraseBkgnd);message WM_EraseBkgnd; procedure WMPaint(var Msg:TWMPaint);message WM_Paint; procedure WMMove(var Msg:TMessage);message WM_Move; // Если вместо WM_Move поставить // WM_WindowPosChanged, ничего // не изменится. procedure WMEnterSizeMove(var Msg:TMessage);message WM_EnterSizeMove; procedure WMExitSizeMove(var Msg:TMessage);message WM_ExitSizeMove; public { Public declarations } end; var Form1: TForm1; const Transparency:Integer=40; { Прозрачность в процентах. Должна быть от 0 до 100 } TranspColor:TColor=clBlack; { Цвет окна } DelayTime:Integer=400; { Время задержки в миллисекундах } implementation {$R *.DFM} type PRGBArray=^TRGBArray; TRGBArray=array[0..1000000] of TRGBTriple; { Вместо 1000000 может быть любое число, даже 0, только тогда придётся отключить проверку диапазона. Экземпляры массивов этого типа всё равно не создаются } procedure Delay(DelayTime:Integer); var TicksNow:Integer; begin TicksNow:=GetTickCount; repeat Application.ProcessMessages until GetTickCount-TicksNow>=DelayTime end; { Эта процедура приостанавливает линейное выполнение программы на заданное число миллисекунд, не прерывая, тем не менее, фоновых процессов. } procedure TForm1.WMEraseBkgnd; begin Msg.Result:=1 { В общем-то, мы ничего не сделали в ответ на это сообщение, но зато послали отчёт, что всё сделано в лучшем виде. Если это будут читать маленькие дети, то пусть они помнят, что обманывать всё равно нехорошо, хоть я и показываю плохой пример. } end; procedure TForm1.WMPaint; var DC:HDC; // Контекст устройства. Он нам понадобится целых два раза PS:TPaintStruct; // А сюда будут записаны те самые ЦУ, которые мы проигнорируем. CW,CH,CX,CY:Integer; // размеры клиентской части окна SL:PRGBArray; // Указатель на строку пикселей X,Y:Integer; // Нужно для организации циклов begin CW:=ClientWidth; CH:=ClientHeight; // На всякий случай запоминаем все необходимые размеры. CX:=ClientOrigin.X; // Может быть, после того, как окно будет спрятано, они изменятся. CY:=ClientOrigin.Y; // А может, и нет. Проверьте сами, если не лень if not Moving then // Этот кусок кода не стоит выполнять, когда окно begin // перетаскивается пользователем. ShowWindow(Handle,SW_Hide); // Прячем окно. Кстати, я пробовал не прятать окно, // а использовать SetWindowRgn, чтобы вырезать его // клиентскую часть. Почему-то не сработало. // Что касается этого механизма, то он не будет // работать с окнами типа MDIChild, потому что // такие окна нельзя спрятать. SetActiveWindow(0); // Эта строка заслуживает более подробного комментария. // Когда наше окно прячется, будучи активным, то активным // становится другое окно. Цвет его заголовка меняется, и // в результате не выполнена главная задача: сделать так, // чтобы на экране было всё то же самое, но без нашего окна. // Поэтому делаем все окна неактивными, и получаем нужный // результат. Если же наше окно было неактивным, то эта // строчка никому не мешает (сам не знаю, почему, но факт!) Delay(400); // Ждём и молимся, чтобы все окна успели перерисоваться! DC:=GetDC(0); // Получаем контекст рабочего стола BitBlt(BM.Canvas.Handle,0,0,BM.Width,BM.Height,DC,0,0,SrcCopy); ReleaseDC(0,DC); // Больше этот контекст нам не нужен, о чём мы и сообщаем end; // Начиная с этого места, код выполняется при любом значении Moving BM2.Width:=CW+1; // Ну, это даже не интересно рассказывать... BM2.Height:=CH+1; // Просто готовим картинку к тому, что сейчас будем рисовать BM2.PixelFormat:=pf24bit; BM2.Canvas.Draw(-CX,-CY,BM); for Y:=0 to CH do // А в этих циклах на записанный нами кусок экрана begin // Накладывается светофильтр SL:=BM2.ScanLine[Y]; for X:=0 to CW do begin SL[X].rgbtRed:=(Transparency*SL[X].rgbtRed+(100-Transparency)*GetRValue(TranspColor)) div 100; SL[X].rgbtGreen:=(Transparency*SL[X].rgbtGreen+(100-Transparency)*GetGValue(TranspColor)) div 100; SL[X].rgbtBlue:=(Transparency*SL[X].rgbtBlue+(100-Transparency)*GetBValue(TranspColor)) div 100 { Предыдущие три строчки - реализация алгоритма смешения цветов Pr:=(Pa*Wa+Pb*Wb)/(Wa+Wb), где Pr - результирующий цвет, Pa и Pb - исходные цвета, Wa и Wb - веса этих цветов. У нас в качестве Pa берётся цвет пикселя скопированной с экрана картинки, В качестве Pb - заранее заданный цвет TranspColor, Wa=Transparency, Wb=100-Transparency. Очевидно, что эту операцию необходимо выполнить для каждого из основных цветов в отдельности. Здесь открывается широкое поле для деятельности. Можно, например, сделать Transparency не постоянным, а зависящим от координаты - получится градиентная прозрачность. Или можно в качестве Pb взять не фиксированный цвет, а цвет пикселя другой картинки - получится окно, фоном которого служит полупрозрачная картинка. В конце концов, можно изменить алгоритм смешения цветов, и тогда откроются новые возможности. Кстати, вот пример градиентной прозрачности: SL[X].rgbtRed:=((CH-Y)*SL[X].rgbtRed+Y*GetRValue(TranspColor)) div CH; SL[X].rgbtGreen:=((CH-Y)*SL[X].rgbtGreen+Y*GetGValue(TranspColor)) div CH; SL[X].rgbtBlue:=((CH-Y)*SL[X].rgbtBlue+Y*GetBValue(TranspColor)) div CH; Хочу добавить, что это смотрится нормально только в режимах True Color. High Color для этого недостаточно. А в режимах, худших, чем High Color, полупрозрачные окна выглядят страшнее, чем ядерная война. } end end; ShowWindow(Handle,SW_Show); // Снова показываем окно DC:=BeginPaint(Handle,PS); // Получаем разрешение начать перерисовку вместе с ЦУ. // Кстати, если разобраться с исходниками стандартных // модулей Delphi, то видно, что их авторы тоже // проигнорировали все ЦУ. Наводит на размышления... BitBlt(DC,0,0,BM2.Width,BM2.Height,BM2.Canvas.Handle,0,0,SrcCopy); // Рисуем получившуюся картинку Msg.DC:=DC; // Эти две строчки учитывают особенности обработки WM_Paint в Delphi. inherited; // Windows всегда посылает это сообщение с параметром wParam=0. // Обработчик Delphi сделан так, что он может обрабатывать это // сообщение при wParam<>0. В этом случае этот параметр интерпретируется // как дескриптор контекста, BeginPaint и EndPaint не вызываются. // Это позволяет писать вот такие обработчики. EndPaint(Handle,PS) // Ну, в общем-то и всё... end; procedure TForm1.WMMove; begin Invalidate; // Всё, пора перерисовываться inherited end; procedure TForm1.WMEnterSizeMove; begin Moving:=True; inherited end; procedure TForm1.WMExitSizeMove; begin inherited; Moving:=False end; procedure TForm1.FormCreate(Sender: TObject); begin BM:=TBitmap.Create; BM.Width:=GetSystemMetrics(SM_CXScreen); // Так мы узнаём размеры экрана. В принципе, BM.Height:=GetSystemMetrics(SM_CYScreen); // если TaskBar виден постоянно, то нам, // казалось бы, нужно запоминать несколько // меньшую часть экрана. Но окна, не // имеющие рамки и заголовка, могут занимать // и эту область, а когда они занимают, // то и нормальные окна тоже могут // покушаться на эту территторию. Так что // не будем мелочиться. BM.PixelFormat:=pf24bit; BM2:=TBitmap.Create; Moving:=False end; procedure TForm1.Button1Click(Sender: TObject); begin if ColorDialog1.Execute then begin Invalidate end end; procedure TForm1.SpinEdit1Change(Sender: TObject); begin Invalidate end; procedure TForm1.FormDestroy(Sender: TObject); begin BM.Free; BM2.Free end; end. Работает 100% |
#3
|
||||
|
||||
Если пишешь в Дельфи 6-ххх , то тама есть такая функция:
Form1.AlphaBlend := True; Form1.AlphaBlendValue := 135; Или что-то в этом роде... забыл |
Этот пользователь сказал Спасибо Kaka за это полезное сообщение: | ||
Rusland (26.11.2015)
|