UpdateLayeredWindowを使うには？
解決http://hitokuso.kicks-ass.org/progtips.html
こちらのUpdateLayeredImageをDelphiで書き直してみました。
procedure TForm1.UpdateLayeredImage( _hwnd:HWND; hbmp:HBITMAP; x,y:integer);
var
hdcScreen:HDC;
hdcMemory: HDC;
rect: TRect;
_pos: TPoint;
szWindow: SIZE;
bf: BLENDFUNCTION;
ptSrc: TPoint;
ret: LongBool;
begin
hdcScreen := GetDC( 0 );
hdcMemory := CreateCompatibleDC( hdcScreen );
SelectObject( hdcMemory, hbmp );
GetWindowRect( _hwnd, rect);
_pos := Point(rect. Left, rect.Top);
szWindow.cx := x;
szWindow.cy := y;
ptSrc := Point( 0, 0 );
with bf do begin
BlendOp := AC_SRC_OVER;
BlendFlags := 0;
AlphaFormat := AC_SRC_ALPHA;
SourceConstantAlpha := 255;//$FF;
end;
ret := UpdateLayeredWindow( _hwnd, hdcScreen, @_pos,
@szWindow, hdcMemory,
@ptSrc, 0, bf, ULW_ALPHA );
ShowMessage(SysErrorMessage(GetLastError));
DeleteDC( hdcMemory );
ReleaseDC( 0, hdcScreen );
end;
しかし
UpdateLayeredWindowでエラー「パラメータが間違っています」
https://www.petitmonte.com/bbs/answers?question_id=874
こちらの方と同じ症状です。
・移植に失敗しているのか（上のソースがそもそも間違えているのか）、
・テストに使っているBMPファイルがおかしいのか分かりません。
またそれにともなって同ページのCreateRGBBitmapにも挑戦してみたのですが
HBITMAP hbmp = CreateDIBSection( dc, (BITMAPINFO*)&bh, DIB_RGB_COLORS, (void**)&bitptr, NULL, 0 );
・この一行をどう書き換えれば良いのかも分からない次第です。
以上長くなりましたがよろしくお願いします。
以前も紹介しましたが、
http://forum.nifty.com/fdelphi/samples/01218.html
を参考にしてみてください
参考にさせていただきましたが同じく
ShowMessage(SysErrorMessage(GetLastError));
のところでエラーになります。
画像の一部分を半透明化するには？
https://www.petitmonte.com/bbs/answers?question_id=2696
メラトニンさんの
>32bit BitmapはR,G,B,Alphaの配列でデータが格納されるだけです。
>ScanLineでBitmapデータにアクセスしてください。
がヒントなのでしょうかもう一度出直してきます。
ありがとうございました。
Delphi7以降だったかと思いますが、
TFormのAlphaBlendをTrueにしちゃいけませんよ。
SetLayeredWindowAttributesと衝突すると失敗するからですね。
なかなか苦戦しています。
偽の知性 -malfunctional intellect- - ほげる
http://d.hatena.ne.jp/tsx/20031210
こちらではDelphi自体がWS_EX_LAYEREDを先に設定していると
あるのですが、どうなんでしょうか。
実際にテストしてみました。
Delphi7では動作確認できました。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, LWindow;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
BMP32:TBitmap;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
MakeLayer(Handle, BMP32);
end;
procedure TForm1.FormCreate(Sender: TObject);
var x,y:integer;
P:PByteArray;
begin
BMP32:=TBitmap.Create;
BMP32.PixelFormat:=pf32bit;
BMP32.Height:=ClientHeight;
BMP32.Width :=ClientWidth;
for Y:=0 to BMP32.Height-1 do
begin
P :=BMP32.ScanLine[y];
for X:=0 to BMP32.Width-1 do
begin
p[x*4+0 ]:= 150 ;
p[x*4+1 ]:= 150 ;
p[x*4+2 ]:= 150 ;
p[x*4+3 ]:= 150 ;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BMP32.Free;
end;
end.
//LWindow.pas
unit LWindow;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
function MakeLayer(wHandle:HWND; LayerBmp:TBitmap):boolean;
function MakeLayer2(wHandle:HWND; LayerBmp:TBitmap):boolean;
function UpdateLayeredWindow(_hwnd:HWND; dstHDC:HDC; pptDst:PPoint;
ASize:PSize; srcHDC:HDC; pptSrc:PPoint; crKey:COLORREF;
var bf : BLENDFUNCTION; dwFlag:DWORD):BOOL; stdcall;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
ULW_COLORKEY = 1;
ULW_ALPHA = 2;
ULW_OPAQUE = 4;
AC_SRC_ALPHA = 1;
function UpdateLayeredWindow;
external 'user32.dll' name 'UpdateLayeredWindow';
implementation
function MakeLayer(wHandle:HWND; LayerBmp:TBitmap):boolean;
var
bf : TBlendFunction;
zerop : TPoint;
formsz : TSize;
begin
result:=false;
with bf do begin
BlendOp:=AC_SRC_OVER;
BlendFlags:=0;
SourceConstantAlpha:=255; // 完全にALPHAをBITMAPに依存する場合
AlphaFormat:=AC_SRC_ALPHA;
end;
SetWindowLong(wHandle, GWL_EXSTYLE, GetWindowLong(wHandle, GWL_EXSTYLE) or
WS_EX_LAYERED);
zerop.x:=0; zerop.y:=0;
formsz.cx:=LayerBmp.Width; formsz.cy:=LayerBmp.Height;
if not UpdateLayeredWindow(
wHandle, 0,
nil, // palleteを気にしないならnilでよろし
@formsz, // フォームの大きさの指定 : 必須！
LayerBmp.canvas.handle, // サーフェイスを定義するDC
@zerop, // サーフェイスを定義する画像の開始点
0, bf, ULW_ALPHA) then begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
result:=true;
end;
function MakeLayer2(wHandle:HWND; LayerBmp:TBitmap):boolean;
var
bf : TBlendFunction;
zerop : TPoint;
formsz : TSize;
begin
result:=false;
with bf do begin
BlendOp:=AC_SRC_OVER;
BlendFlags:=0;
SourceConstantAlpha:=255; // 完全にALPHAをBITMAPに依存する場合
AlphaFormat:=AC_SRC_ALPHA;
end;
//SetWindowLong(wHandle, GWL_EXSTYLE, GetWindowLong(wHandle, GWL_EXSTYLE) or
// WS_EX_LAYERED);
zerop.x:=0; zerop.y:=0;
formsz.cx:=LayerBmp.Width; formsz.cy:=LayerBmp.Height;
if not UpdateLayeredWindow(
wHandle, 0,
nil, // palleteを気にしないならnilでよろし
@formsz, // フォームの大きさの指定 : 必須！
LayerBmp.canvas.handle, // サーフェイスを定義するDC
@zerop, // サーフェイスを定義する画像の開始点
0, bf, ULW_ALPHA) then begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
result:=true;
end;
end.
注：コピペです。
わざわざソースをありがとうございます。
再現できました。やはりBitmapの作りがおかしかったようです。
中村さんのグラフィックの本を少し読んでみたのですが、
なかなか難しくて自分はまだまだだと思い知らされました。
あと、MakeLayerとMakeLayer2のWS_EX_LAYEREDの差にも注意ですね。
蛇足ですが
ARGAS.NET
http://www.argas.net/archive/1/2004-11-08
にMikiというUpdateLayeredWindowを用いたMediaPlayerがあります。
再度お礼申し上げます。ありがとうございました。
| ツイート |  |