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

Вниз

Гугл хром браузер и bmp   Найти похожие ветки 

← →
alexdn ©   (2013-05-28 12:21) [40]

> antonn ©   (28.05.13 12:09) [39]
в 2010 выходит что так. Кстати, как оговорить альфа канал для bmp? что то нигде не могу найти..

---

← →
Дмитрий СС   (2013-05-28 13:39) [41]

С помощью ScanLine

---

← →
Дмитрий СС   (2013-05-29 14:07) [42]

Вот пример:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Math;

type
 TForm1 = class(TForm)
   procedure FormShow(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   procedure HitTest(var M: TWMNCHitTest); message WM_NCHITTEST;
 protected
 public
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.HitTest(var M: TWMNCHitTest);
begin
 M.Result := HTCAPTION;
end;

procedure AlphaPremultiBmp(Bmp: HBITMAP);
var
 BmpInfo:Windows.TBitmap;
 Point: PRGBQuad;
 I:Integer;
begin
 GetObject(Bmp, SizeOf(BmpInfo), @BmpInfo);
 Point := BmpInfo.bmBits;
 for i:=0 to pred(BmpInfo.bmWidth * BmpInfo.bmHeight) do
 begin
   Point^.rgbBlue := MulDiv(Point^.rgbBlue, Point^.rgbReserved, 255);
   Point^.rgbGreen := MulDiv(Point^.rgbGreen, Point^.rgbReserved, 255);
   Point^.rgbRed := MulDiv(Point^.rgbRed, Point^.rgbReserved, 255);
   inc(Point);
 end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
 Bmp: TBitmap;
 SignBmp: TBitmap;
 BmpC, SignC: PRGBQuad;
 X, Y: Integer;
 Pt: TPoint;
 Sz: TSize;
 F: TBlendFunction;
 ScreenDC, BmpDC, SavedDC: HDC;
begin
 SetWindowLong(Handle,
   GWL_EXSTYLE,
   GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);

 Bmp := TBitmap.Create;
 try
   Bmp.PixelFormat := pf32bit;
   Bmp.Width := ClientWidth;
   Bmp.Height := ClientHeight;

   SignBmp := TBitmap.Create;
   try
     SignBmp.PixelFormat := pf32bit;
     SignBmp.Width := ClientWidth;
     SignBmp.Height := ClientHeight;

     SignBmp.Canvas.Brush.Color := clBlack;
     SignBmp.Canvas.Brush.Style := bsSolid;
     SignBmp.Canvas.FillRect(Rect(0,0, SignBmp.Width, SignBmp.Height));
     SignBmp.Canvas.Font.Name := "Times";
     SignBmp.Canvas.Font.Size := 72;
     SignBmp.Canvas.Font.Color := clWhite;
     SignBmp.Canvas.TextOut(10, 10, "Hello, Kitty!");

     for Y := 0 to Pred(Bmp.Height) do
     begin
       BmpC := Bmp.ScanLine[Y];
       SignC := SignBmp.ScanLine[Y];
       for X := 0 to Pred(Bmp.Width) do
       begin
         ZeroMemory(BmpC, SizeOf(BmpC^));
         BmpC^.rgbRed := Y * 255 div Bmp.Height;
         BmpC^.rgbBlue := (255 - Y * 255 div Bmp.Height) div 4;
         BmpC^.rgbGreen := SignC^.rgbGreen;
         BmpC^.rgbReserved := 255 - X * 255 div Bmp.Width; // random alpha
         Inc(BmpC);
         Inc(SignC);
       end;
     end;
   finally
     SignBmp.Free;
   end;

   ZeroMemory(@Pt, SizeOf(Pt));

   Sz.cx := ClientWidth;
   Sz.cy := ClientHeight;

   ZeroMemory(@F, SizeOf(F));
   F.BlendOp := AC_SRC_OVER;
   F.AlphaFormat := AC_SRC_ALPHA;
   F.SourceConstantAlpha := 255;

   AlphaPremultiBmp(Bmp.Handle);

   ScreenDC := GetDC(0);
   try
     BmpDC := CreateCompatibleDC(ScreenDC);
     try
       SavedDC := SelectObject(BmpDC, Bmp.Handle);
       try
         UpdateLayeredWindow(Handle, ScreenDC, nil, @Sz, BmpDC, @Pt, 0, @F, ULW_ALPHA);
       finally
         SelectObject(SavedDC, Bmp.Handle);
       end;
     finally
       DeleteDC(BmpDC);
     end;
   finally
     ReleaseDC(0, ScreenDC);
   end;
 finally
   Bmp.Free;
 end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 BorderStyle := bsNone;
 FormStyle := fsStayOnTop;
end;

end.



---

← →
Rouse_ ©   (2013-05-29 22:21) [43]

> Дмитрий СС   (29.05.13 14:07) [42]

ScreenDC и BmpDC := CreateCompatibleDC(ScreenDC); лишние, а так-же SelectObject лишнее.
Вместо первого достаточно нуля, вместо второго хэндла канваса битмапа с альфаканалом.

---

← →
Rouse_ ©   (2013-05-29 22:30) [44]

Удалено модератором
Примечание: промахнулся...

---

← →
Rouse_ ©   (2013-05-29 22:30) [45]

Блин... вот так:

  UpdateLayeredWindow(Handle, 0, nil, @Sz, Bmp.Canvas.Handle, @Pt, 0, @F, ULW_ALPHA);

  {ScreenDC := GetDC(0);
  try
    BmpDC := CreateCompatibleDC(ScreenDC);
    try
      SavedDC := SelectObject(BmpDC, Bmp.Handle);
      try
        UpdateLayeredWindow(Handle, ScreenDC, nil, @Sz, BmpDC, @Pt, 0, @F, ULW_ALPHA);
      finally
        SelectObject(SavedDC, Bmp.Handle);
      end;
    finally
      DeleteDC(BmpDC);
    end;
  finally
    ReleaseDC(0, ScreenDC);
  end;  }

---

← →
Rouse_ ©   (2013-05-29 22:31) [46]

зы и AlphaPremultiBmp тоже избыточен.

---

← →
Дмитрий С ©   (2013-05-29 23:40) [47]

> зы и AlphaPremultiBmp тоже избыточен.

Вот тут пишут что нужен для BLENDFUNCTION:
http://msdn.microsoft.com/en-us/library/windows/desktop/dd183393(v=vs.85).aspx

Да и разница есть:
http://yadi.sk/d/vEv7wVJO5JDdm
Слева без AlphaPremultiBmp, справа с ним.


> Rouse_ ©   (29.05.13 22:30) [45]

Действительно работает. Тем более в моем примере, который я еще в 2008 году написал, примерно так и написано. А в этом примере, пока я его писал, почему-то не работало, поэтому я сделал так. Видимо пока делал, исправил что-то.

---

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

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

Наверх

Память: 0.55 MB
Время: 0.007 c