Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > AlphaBlend только в тех местах где нет компонентов


Автор: Delphist 7.6.2007, 14:17
У формы есть такое свойство как AlphaBlendValue, которое делает форму прозрачной. Скажите, пожалуйста, как сделать так, чтобы прозрачность не проявлялась на компоненты, которые расположены на этой форме.  Т.е. если я размещаю на форме панельку, то AlphaBlendValue делает прозрачной не только форму, но и панель, а мне нужно чтобы только панель.

Автор: Delphist 7.6.2007, 16:33
Или хотя бы для определенного цвета. На форме есть Label белого цвета, и я говорю, что на белый цвет прозрачность не применять, и получится что метка не будет прозрачной.

Автор: Alexeis 7.6.2007, 20:17
Как вариант сделать 2 формы, одну под другой. Форма с контролами будет непрозрачной, только в местах где контролы, а нижняя уже по вкусу smile .

Автор: MetalFan 7.6.2007, 22:02
а с регионами ничего нельзя тут прикрутить?

Автор: Sunvas 8.6.2007, 10:45
Может аттач натолкнет на какие-то мысли..

Автор: Alexeis 8.6.2007, 11:09
MetalFan, А что с ними можно сделать кроме дырки? А нужно как раз антипод дырки. 

Sunvas, мдя этот пример не для слабых видюх. У меня большая задержка на перерисовку. Быстрое решение возможно если использовать UpdateLayeredWindow , но при этом прийдеться все контролы рисовать руками. 

Автор: Sunvas 8.6.2007, 11:19
Alexeis, А что, если форму сделать прозрачной, а у элементов прозрачность убрать? Или прозрачность наследуется?

Автор: Alexeis 8.6.2007, 11:38
Прозрачность не устанавливается для детей.

Автор: Delphist 8.6.2007, 12:19
Цитата(Sunvas @  8.6.2007,  12:19 Найти цитируемый пост)
а у элементов прозрачность убрать

Как её убрать?

Добавлено через 1 минуту и 4 секунды
Цитата(Alexeis @  8.6.2007,  12:38 Найти цитируемый пост)
Прозрачность не устанавливается для детей. 

Не правда! Все контролы лежщие на форме также делаются прозрачными, если формы прозрачна,  а надо бы запретить.

Добавлено через 9 минут и 3 секунды
Нужно подобие примера Sunvas'a только чтобы отрисовка выполнялась без тормозов.

Автор: Alexeis 8.6.2007, 13:59
Цитата(Delphist @  8.6.2007,  12:19 Найти цитируемый пост)
Не правда! Все контролы лежщие на форме также делаются прозрачными, если формы прозрачна,  а надо бы запретить.

Цитата(MSDN)

WS_EX_LAYERED
    Windows 2000/XP: Creates a layered window. Note that this cannot be used for child windows.


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

Автор: Delphist 8.6.2007, 16:21
Цитата(Alexeis @  8.6.2007,  14:59 Найти цитируемый пост)
 А кто говорил что они не могут быть прозрачными? Я сказал что устанавливать прозрачность нельзя. Их прозрачность определяется прозрачностью парента, потому они не имеют своей прозрачности. 

Ну так как решить мой вопрос?

Автор: misha_mike 8.6.2007, 16:46
Можно подумать на тему OnPaint. При помощи PaintTo рисовать контролы прямо на DC рабочего стола. Только со стиранием прийдется повозиться, но думаю реально.

Автор: Mephisto 8.6.2007, 17:00
Вот как дельфина делает альфабленд:
Код

procedure TCustomForm.SetLayeredAttribs;
const
  cUseAlpha: array [Boolean] of Integer = (0, LWA_ALPHA);
  cUseColorKey: array [Boolean] of Integer = (0, LWA_COLORKEY);
var
  AStyle: Integer;
begin
  if not (csDesigning in ComponentState) and
    (Assigned(SetLayeredWindowAttributes)) and HandleAllocated then
  begin
    AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
    if FAlphaBlend or FTransparentColor then
    begin
      if (AStyle and WS_EX_LAYERED) = 0 then
        SetWindowLong(Handle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
      SetLayeredWindowAttributes(Handle, FTransparentColorValue, FAlphaBlendValue,
        cUseAlpha[FAlphaBlend] or cUseColorKey[FTransparentColor]);
    end
    else
    begin
      SetWindowLong(Handle, GWL_EXSTYLE, AStyle and not WS_EX_LAYERED);
      RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
    end;
  end;
end;


Что вам мешает проделать то же с каждым из компонентов? Каждому сказать что он не альфаблендится? Попробуй по крайней мере! 

Автор: bems 8.6.2007, 17:10
Mephisto, SetLayeredWindowAttributes работает только с top-level окнами

Автор: Alexeis 8.6.2007, 17:36
Цитата(misha_mike @  8.6.2007,  16:46 Найти цитируемый пост)
Можно подумать на тему OnPaint. При помощи PaintTo рисовать контролы прямо на DC рабочего стола. Только со стиранием прийдется повозиться, но думаю реально.

  Пробовал. :( Рисует криво (Без XP стиля). 

Автор: Delphist 8.6.2007, 18:07
Цитата(Mephisto @  8.6.2007,  18:00 Найти цитируемый пост)
Вот как дельфина делает альфабленд:

Ну покажи, хотя бы напримере 2-х компонентов

Автор: Sunvas 8.6.2007, 21:31
Общем долго-долго я над этим игрался. Использовал всю мощь сего форума - никак не получается для контролов на форме сделать. Как-то видно винда определяет что не форма это.
Мой приговор - невозможно.

Автор: misha_mike 9.6.2007, 00:56
Ну почему сразу невозможно? Тут уже предлагали: делаем два одинаковых по размеру окна, одно с альфа-каналом без контролов, а над ним второе с контролами и WS_EX_TRANSPARENT. Остается синхронизировать все операции над ними и обеспечить всегда правильный взаимный z-order. Изврат, но если заказчик так хочет изврат -- пусть его и получает, кто ж ему лекарь?

Автор: Delphist 9.6.2007, 10:44
Цитата(Sunvas @  8.6.2007,  22:31 Найти цитируемый пост)
Мой приговор - невозможно. 

Ну а как же заставка AutoCad 2006

Автор: Alexeis 9.6.2007, 10:55
  Я даже попробовал его. Трудновато 
Цитата(misha_mike @  9.6.2007,  00:56 Найти цитируемый пост)
обеспечить всегда правильный взаимный z-order

 А так выглядит очень даже ничего.

Автор: sw04 9.6.2007, 19:25
Чем Вам не угодил пример из статьи прозрачности форм? 
получается ровно так как надо - все компоненты изображены нормально, а сама форма прозрачная.
Есть минус в перерисовке при любом движении окна, но другого решения пока не видел.

Автор: Alexeis 9.6.2007, 19:44
Цитата(Delphist @  9.6.2007,  10:44 Найти цитируемый пост)
Ну а как же заставка AutoCad 2006 

  Так она наверное без конролов совсем.

Автор: Yanis 9.6.2007, 22:17
Вот какой изврат я нарисовал smile

Прежде чем качать можете глянуть http://yanis.front.ru/images/screen.jpg.
Основной принцип заключается в создании второй прозрачной формы, которая всегда располагается под основной формой. Дырки в основной форме я добился с помощью её свойсвта Transparent и TransparentColor. Скачивайте, смотрите.

Автор: Alexeis 9.6.2007, 22:40
Yanis, Ну ты бы хоть рассказал вкратце, что главная форма у тебя полностью прозрачная и на ней все компоненты, а нижняя форма полупрозрачная и пустая с убранным заголовком. Вот только есть один ньюанс, когда по форме кликаешь, то она чуток подмигивает, но обработчик быстро поднимает на верх нужную форму. Теперь можно нижнюю сделать вообще с изменяющейся прозрачностью. Работает быстро и почти безупречно. Зачет.

Автор: Yanis 9.6.2007, 22:43
Alexeis
Всё таки лучше один раз потрогать, чем сто раз прочитать smile
Я думаю, что с не VCL-евскими окошками вообще летать будет.

Автор: Yanis 9.6.2007, 23:55
Alexeis
Твои слова 
Цитата(Alexeis @  9.6.2007,  23:40 Найти цитируемый пост)
Вот только есть один ньюанс, когда по форме кликаешь, то она чуток подмигивает, но обработчик быстро поднимает на верх нужную форму.
 дали мне стимул добиться, что бы окно не мигало smile
Достаточно заменить:
Код
procedure WMActivate(var M: TWMActivate); message WM_ACTIVATE;
procedure TForm2.WMActivate(var M: TWMActivate);
begin
  if M.Active <> WA_INACTIVE then
    begin
      Form1.Show;
      Form1.SetSamePos(Form1, Self);
    end;
end;

на
Код
procedure WMMouseActivate(var M: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure TForm2.WMMouseActivate(var M: TWMMouseActivate);
begin
  M.Result := MA_NOACTIVATEANDEAT;
end;


Исправленный исходник прилагается. В этот раз только код.

Автор: ivan219 10.6.2007, 10:56
Eсли можно раскажите суть метода а то я так и непонял smile 

Автор: Yanis 10.6.2007, 11:24
Цитата(ivan219 @  10.6.2007,  11:56 Найти цитируемый пост)
Eсли можно раскажите суть метода а то я так и непонял

А ты скачай. Там же всё просто.
Попробуй такой код на пустой форме:
Код
  TransparentColor := True;
  TransparentColorValue := clPurple;


Все контролы с цветом clPurple, расположенные теперь на этой форме будут дырявить форму.
Если дописать:
Код
Color := clPurple;
, то форма будет без клиентской области вместо этого будет дырка smile
Что бы нельзя было кликнуть «под формой», я располагаю форму с прозрачностью 1 под главной формой.

Автор: Alexeis 10.6.2007, 12:41
Цитата(Yanis @  10.6.2007,  11:24 Найти цитируемый пост)
Что бы нельзя было кликнуть «под формой», я располагаю форму с прозрачностью 1 под главной формой.

  Более того нижнюю форму можно сделать с градиентной прозрачностью, т.е. плавно растворяющуюся к  краям. Это делается при помощи UpdateLayeredWindow. В ней можно задать прозрачность каждого пиксела. Как я понял эта функция была введена для создания стартовых окошек, потому на ней не видны контролы. Но она очень даже подошла бы как фон к примеру Яниса.

Автор: Alexeis 10.6.2007, 14:00
  Вот гибрид на основе примеров Яниса и Гирдера. Теперь в качестве фона у нас круговой градиент похожий на стекло бутылки.

Код

procedure TForm1.FormActivate(Sender: TObject);
begin
  if bLoaded then
    Exit;
  with Form2 do
    begin
     { AlphaBlend := True;  //убрана равномерная прозрачность
      AlphaBlendValue := 1; }
      BorderStyle := bsNone;
      SetSamePos(Self, Form2);
      Show;
      SetWindowPos(Handle, Form1.Handle, 0, 0, 0, 0,
                   SWP_NOMOVE or SWP_NOSIZE);
      Form1.Show;
    end;
  bLoaded := True;
end;


Код

procedure TForm2.FormResize(Sender: TObject);
type
  TRGBAarray = array[0..32000] of RGBQUAD;
  PRGBAarray = ^TRGBAarray;
var
  Bmp  : TBitmap;
  BF   : TBlendFunction;
  PA   : PRGBAarray;
  i, j : integer;
  cx, cy : integer;
  LA, L : integer;
  Alpha : integer;
  b : boolean;
  FBmpSize    : TSize;
  FBmpTopLeft :TPoint;
begin
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32Bit;
  Bmp.Width  := Width;
  Bmp.Height := Height;
  Bmp.Canvas.Brush.Color := RGB(0, 40, 0);
  Bmp.Canvas.FillRect(Rect(0, 0, Width, Height));

  SetWindowLong(Handle, GWL_EXSTYLE,
                GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
  BF.BlendOp             := AC_SRC_OVER;
  BF.BlendFlags          := 0;
  BF.SourceConstantAlpha := 255;
  BF.AlphaFormat         := AC_SRC_ALPHA;

  LA := round(sqrt(sqr(Bmp.Width) + sqr(Bmp.Height)) / 2);
  cx := Bmp.Width div 2;
  cy := Bmp.Height div 2;

  for i := 0 to Bmp.Height-1
  do
    begin
      PA := Bmp.ScanLine[i];
      for j := 0 to Bmp.Width - 1
      do
        begin
          L     := round(sqrt(sqr(cx - j) + sqr(cy - i)));
          Alpha := 255 - ((L * 255) div LA);
          PA[j].rgbReserved := Alpha;
        end;
    end;

  FBmpSize.cx := Width;
  FBmpSize.cy := Height;
  FBmpTopLeft := Point(0, 0);

  UpdateLayeredWindow(Handle, 0, nil,
                      @FBmpSize, Bmp.Canvas.Handle, @FBmpTopLeft,
                      clNone, @BF, ULW_ALPHA);
  Bmp.Free;

end;




Автор: Yanis 10.6.2007, 15:08
Alexeis
smile

Цитата(Alexeis @  10.6.2007,  15:00 Найти цитируемый пост)
Вот гибрид на основе примеров Яниса и Гирдера.

А где Girder такой пример давал?

Автор: aktuba 10.6.2007, 15:20
Alexeis, жестоко глючит пример!!!
user posted image

Автор: ivan219 10.6.2007, 15:23
Симпатично smile 

Автор: Alexeis 10.6.2007, 19:59
Цитата(Yanis @  10.6.2007,  15:08 Найти цитируемый пост)
А где Girder такой пример давал?

http://forum.vingrad.ru/index.php?show_type=forum&showtopic=100336

Цитата(aktuba @  10.6.2007,  15:20 Найти цитируемый пост)
Alexeis, жестоко глючит пример!!!

Раскрой секрет как это удалось сделать? Явно формы разделились.  smile . Хотя тут полная синхронизация по перемещению  smile 


Автор: Yanis 10.6.2007, 20:06
Цитата(Alexeis @  10.6.2007,  20:59 Найти цитируемый пост)
Раскрой секрет как это удалось сделать?

Это может быть у кого угодно. Главное что бы побольше прог было запущено и комп тормозил smile

Автор: Alexeis 10.6.2007, 20:32
Цитата(Yanis @  10.6.2007,  20:06 Найти цитируемый пост)
Главное что бы побольше прог было запущено и комп тормозил

  Не это не влияет. Я запустил 2 экземпляра проги 
Код

While true do;

И раскидал по обоим процам. (добился 100% загрузки). И начал гонять эту прогу. Она тормозила жутко на перемещении, но такого поймать мне не удалось smile . ДУмю здесь что-то другое.

Автор: aktuba 10.6.2007, 21:52
Цитата

Раскрой секрет как это удалось сделать?


Скачал и запустил из архива. Никакого секрета, никакой загрузки компа...

Автор: Alexeis 10.6.2007, 22:56
Винда XP? 

Автор: aktuba 10.6.2007, 23:13
Цитата

Винда XP?


Да.

Автор: Delphist 13.6.2007, 09:32
Yanis, спасибо за пример, есть один недостаток - не работает OnClick панели, и формы. Помоги это исправить.

Автор: Alexeis 13.6.2007, 09:56
Цитата(Delphist @  13.6.2007,  09:32 Найти цитируемый пост)
Yanis, спасибо за пример, есть один недостаток - не работает OnClick панели, и формы. Помоги это исправить. 


Все нормально, только не нужно создавать лишних обработчиков, ведь клики формы уже обрабатываются тут. Дописать свой код вместо showmessage('Form_click'); и все.

Код

procedure TForm2.WMMouseActivate(var M: TWMMouseActivate);
begin
  showmessage('Form_click');
  M.Result := MA_NOACTIVATEANDEAT;
end;

Автор: GELEAF 1.11.2007, 22:47
Я поставил полупрозрачную png картинку на форму при запуску она небыла полупрозрачна...почему?
И вообше мне кажется надо не дырку в форме сделать а полу прозрачную форму с полностью непрозрачными контролами

Автор: Alexeis 1.11.2007, 22:56
Цитата(GELEAF @  1.11.2007,  22:47 Найти цитируемый пост)
Я поставил полупрозрачную png картинку на форму при запуску она небыла полупрозрачна...почему?

  Потому что такого механизма нет. Нужно pngшку превратить в bmpшку 32 бита на цвет и задать ее в UpdateWindowLayer, как это делается в примере.

Автор: MetalFan 10.2.2008, 18:26
поковырял тут на тему решения сабжа с пом. UpdateLayeredWindow.
вот, что получилось:
user posted image
замеченные баги:
не отрисовывается курсор в edit. не отображается ItemIndex в ListBox... и пр.


Автор: windbear 17.4.2008, 00:09
MetalFan, пример хорош, но тормозит ужасно... по крайней мере полной отрисовки не происходит.. при фокусе на едите, каретка не отображается

Автор: MetalFan 17.4.2008, 08:32
Цитата(windbear @  17.4.2008,  00:09 Найти цитируемый пост)
тормозит ужасно... по крайней мере полной отрисовки не происходит

странное у тебя понятие "тормозов"

Цитата(windbear @  17.4.2008,  00:09 Найти цитируемый пост)
при фокусе на едите, каретка не отображается 


Цитата(MetalFan @  10.2.2008,  18:26 Найти цитируемый пост)
не отрисовывается курсор в edit

это мы и так знаем

Автор: kr3v3tkus 9.3.2009, 12:08
народ сори, я смотрю тема относительно старая, мб появились новые, более простые решения? или также только подстановка форм и самостоятельная перерисовка?

Автор: Delphist 10.3.2009, 13:30
Цитата(kr3v3tkus @  9.3.2009,  13:08 Найти цитируемый пост)
народ сори, я смотрю тема относительно старая, мб появились новые, более простые решения? или также только подстановка форм и самостоятельная перерисовка? 

а с чего они вдруг появяться?

Автор: kr3v3tkus 11.3.2009, 02:53
ну я не слишком секуsmile вдруг в новых дельфях изменили наследование альфабленда =]

Автор: Delphist 11.3.2009, 11:37
Цитата(kr3v3tkus @  11.3.2009,  03:53 Найти цитируемый пост)
ну я не слишком секу вдруг в новых дельфях изменили наследование альфабленда =] 

Ага smile  дождешься

Автор: Alexeis 11.3.2009, 12:41
Цитата(kr3v3tkus @  11.3.2009,  01:53 Найти цитируемый пост)
вдруг в новых дельфях изменили наследование альфабленда =]

  Все это делается средствами ОС. Если можно было бы такое сделать, то ввели бы.

Автор: Teleport 15.3.2009, 06:45
выкладываю давно найденный мною пример - может кому интересен будет. Компонет + demo пример. На 2007 делфи поставился без проблем. Правда перерисовка тормозит при перетаскивании окна. Не ругайте если не понравится  smile 

Автор: Teleport 15.3.2009, 06:49
+ часть 2

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)