прозрачность отдельных участков формы

[Ins]

Романнн, это делается с помощью UpdateLayeredWindow, примеры есть в гугле, правда при этом изменяется механизм отрисовки окна - сообщение WM_PAINT окну уже не будет отправляться, придется все контролы отрисовывать самостоятельно. В общем, ВОВАН13 прав.
Альтернативный вариант - здесь:
http://forum.sources.ru/index.php?showtopic=212857

[BOBAH13]

Реальной ссылки на то что я сделал врятли кто найдет а почему ? Ответ прост - максимум что я нашел так это несколько поство обсуждения в дельфи корелевстве... Потом после некоторого времени понял как нужно все построить ) Я движок не делал, я реализовал всеголиш для определенной проги, хотя если повозиться можно и движок сделать, и главное не большого размера

ну собственно все выкладывать конечно же не буду, а описание действий могу дать:

главное нас интерисует следующее... форма:
ловим вот что

procedure WMMOUSEMOVE(var Message: TWMMOUSEMOVE); message WM_MOUSEMOVE;
    procedure WMLBUTTONDOWN(var Message: TWMLBUTTONDOWN); message WM_LBUTTONDOWN;
    procedure WMLBUTTONUP(var Message: TWMLBUTTONUP); message WM_LBUTTONUP;

// к форме в паблике(например) пишем переменные

zsize: TSize;
zpoint: TPoint;
zbf: TBlendFunction;
TopLeft: TPoint;
BMain: TBitMap; // это та картинка которая является Вашим фоном 
BOutMain: TBitMap; // это картинка, та что выводиться на форму, уже с отрисованными картинками ))) контролами

// сама идея реализации всех контролов пришла сама собой - это СТЕК или чтот подобное )

StackCtrls: TList;

// далее сама реализация 

procedure UpdateWnd(Refresh: Boolean); // обновления окна

// тут думаю и так понятно, TAlphaCustomControl - мой описатель классов, в иерархии на 1м месте, от него все остальное пошло...
procedure Push(Control: TAlphaCustomControl);
procedure PopAndDestroy; overload;
procedure PopAndDestroy(Count: Integer); overload;
procedure RefreshCtrls;

// в моем случае пришлось писать эти процедуры, по названию понятно :) 
procedure DoDrawButton(Sender: TObject);
procedure DoDrawCheckBox(Sender: TObject);
procedure DoDrawButtonClose(Sender: TObject);
procedure DoDrawButtonMinimize(Sender: TObject);
procedure DoDrawProgressBar(Sender: TObject);
procedure DoDrawLabel(Sender: TObject);

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

procedure PremultiplyBitmapRect(BMP: TBitmap; const Rect: TRect);
var
  i, j: integer;
  Row: PRGBAArray;
begin
  for i := Rect.Top to Rect.Bottom - 1 do
  begin
    Row := BMP.Scanline[i];
    for j := Rect.Left to Rect.Right - 1 do
    begin
      Row[j].rgbReserved := 255;
      Row[j].rgbBlue := Round(Row[j].rgbBlue * Row[j].rgbReserved / MaxByte);
      Row[j].rgbGreen := Round(Row[j].rgbGreen * Row[j].rgbReserved / MaxByte);
      Row[j].rgbRed := Round(Row[j].rgbRed * Row[j].rgbReserved / MaxByte);
    end;
  end;
end;

// очень похожая на эту функцию другая ))) ниже понадобится 

type
  TRGB = packed record
    R, G, B: Byte;
  end;
  PRGB = ^TRGB;

const
  MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
  MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
  
type
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
  PRGBAArray = ^TRGBAArray;
  TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;

procedure BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap);
var
  x, y: Integer; RowOut: PRGBAArray; RowIn,RowInMask:PRGBArray;
begin
  _B_out.Width:=_B_in.Width;
  _B_out.Height:=_B_in.Height;
  for y:=0 to _B_in.Height-1 do
  begin
     RowOut:= _B_out.ScanLine[y];
     RowIn:= _B_in.ScanLine[y];
     RowInMask:= _B_mask.ScanLine[y];
    for x:=0 to _B_in.Width-1 do
    begin
          RowOut[x].rgbReserved:=trunc((RowInMask[x].rgbtBlue+RowInMask[x].rgbtGreen+RowInMask[x].rgbtRed)/3);
          RowOut[x].rgbBlue:=byte(trunc(RowIn[x].rgbtBlue*RowOut[x].rgbReserved/255));
          RowOut[x].rgbGreen:=byte(trunc(RowIn[x].rgbtGreen*RowOut[x].rgbReserved/255));
          RowOut[x].rgbRed:=byte(trunc(RowIn[x].rgbtRed*RowOut[x].rgbReserved/255));
    end;
  end
end;

// моя реализации почти СТЕКА ))
procedure TfrmMain.Push(Control: TAlphaCustomControl);
begin
  StackCtrls.Add(Control);
end;

procedure TfrmMain.PopAndDestroy;
begin
  if (StackCtrls.Count > 0) then
  begin
    TAlphaCustomControl(StackCtrls.Items[StackCtrls.Count - 1]).Free;
    StackCtrls.Delete(StackCtrls.Count - 1);
  end;
end;

procedure TfrmMain.PopAndDestroy(Count: Integer);
var
  i: Integer;
begin
  i := Count;
  while (i > 0) do
  begin
    PopAndDestroy;
    dec(i);
  end;
end;

procedure TfrmMain.RefreshCtrls;
var
  i: Integer;
begin
  BOutMain.Assign(BMain); // то о чем я и говорил, принимаем сначала фон, а потом уже рисуем все констролы )
  for i:= 0 to StackCtrls.Count - 1 do
    TAlphaCustomControl(StackCtrls.Items[i]).Paint;
end;

[BOBAH13]

// при создании формы придеться сделать подобное 

var
  Main, Mask: TBitMap;
begin
  StackCtrls := TList.Create;

  BMain := TBitMap.Create;
  BMain.PixelFormat := pf32bit;
  BOutMain := TBitMap.Create;
  BOutMain.PixelFormat := pf32bit;

  Main := TBitMap.Create; Mask := TBitMap.Create;
  Main // просто фон ))
  Mask // грузим маску собственно все эффекты в самой маске, чем чернее тем прозрачней
  BuildCopy24to32(Main, Mask, BMain);
  BOutMain.Assign(BMain); 
  Main.Free; Mask.Free;

  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE)
    or WS_EX_LAYERED); // позволим форме поддержку слоев
                          
  // форму под нашу картинку
  Width := BMain.Width; 
  Height := BMain.Height;     

  zsize.cx := BMain.Width;
  zsize.cy := BMain.Height;
  zpoint := Point(0,0);

  with zbf do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    AlphaFormat := AC_SRC_ALPHA;
    SourceConstantAlpha := 255; // 255 - полная не прозрачность формы, сразу говорю что форма появлялась плавно это лучше не юзать, у меня лагает все
  end;

// на разрушение формы делаем подобное

PopAndDestroy(StackCtrls.Count);
StackCtrls.Free;
BOutMain.Free;
BMain.Free;

// ну собственно обновление

TopLeft := BoundsRect.TopLeft;
  UpdateLayeredWindow(Handle, 0, @TopLeft, @zsize, BOutMain.Canvas.Handle,
    @zpoint, 0, @zbf, ULW_ALPHA);

// да и еще когда вызывается отрисовка сделайте чтот типа Painting: Boolean;

и вот когда например какой то контрол отрисовывается, а их очень много в очереди отрисовки, ставите Painting = true, и при вызове обновления слоя, проверка на то что Painting = false иначе выходим и таким образом ускорение отрисовки формы и исчезновение эффекта отрисовки формы :)

ну вот и все ))) кому интересно тут достаточно я выложил

[Ins]

так это несколько поство обсуждения в дельфи корелевстве...

На Королевстве это часто обсуждалось:
http://www.delphikingdom.com/table/s...Eqv=0&Count=10

[BOBAH13]

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

[Романнн]

спасибо всем)
для меня с маской сложновато,конечно.....но будет чем время занять)

[Alar]

Ins, я понимаю, возможно, что-то где-то решалось. Но уже как-то принято Указывать решение, информацию, а только потом ссылку на источник к тому же, я не могу посмотреть тему не зарегестрировавшись. Получается навязчивая реклама.

[BOBAH13]

Нет желающих попробывать вместе написать движок ?

[baadman28]

Very good!!! Support !wow gold wow gold wow gold wow goldwow gold

[BOBAH13]

Вот что уже готово )) На форме всего два компонента, загрузка руками составила маленькие 3 строчки по нажатию на кнопку, и вы увидите то что случится с вашим окон