Stwórz aplikację z Form1 i kilkoma komponentami (ja testowałem z przyciskiem - Application.Terminate w jego akcji - oraz z ListView) dodatkowo dorzuć Image1 (Visible=False), do którego wczytaj 32 bitową bitmapę.
Całość działań jest obsługiwana takim kodem:
unit Unit1;
interface
uses Windows, Forms, MEssages, Graphics, Controls, ExtCtrls, StdCtrls, Classes, ComCtrls;
type
TForm1 = class(TForm)
ListView1: TListView;
Button1: TButton;
Image1: TImage;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ ***** Do obsługi okna przezroczystego ***** }
Wnd: TWndClass;
Hnd: THandle;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TLinia32 = array[WORD] of TRGBQuad;
PLinia32 = ^TLinia32;
TLinia24 = array[WORD] of TRGBTriple;
PLinia24 = ^TLinia24;
TLinia8 = array[WORD] of byte;
PLinia8 = ^TLinia8;
{ ***** Narysowanie obrazu okna przezroczystego z Image1, uwzględniając w bitmapie rejon z zaznaczonymi komponentami ***** }
procedure PaintLayeredWindow(Image1:TImage; Hnd:THandle; Region:HRGN);
var blend:BLENDFUNCTION;
P:TPoint;
S:TSize;
i,j:integer;
bmpRGB, bmpA:TBitmap;
Linia8:PLinia8;
Linia24:PLinia24;
Linia32:PLinia32;
begin
//Tworzenie warstw RGB oraz A
bmpRGB:=TBitmap.Create();
bmpRGB.Width:=Image1.Width;
bmpRGB.Height:=Image1.Height;
bmpRGB.PixelFormat:=pf24bit;
bmpA:=TBitmap.Create();
bmpA.Width:=Image1.Width;
bmpA.Height:=Image1.Height;
bmpA.PixelFormat:=pf8bit;
//Rozdzielenie Image1.Picture.Bitmap RGBA na RGB oraz A
for j:=0 to Image1.Height-1 do
begin
Linia8:=bmpA.ScanLine[j];
Linia24:=bmpRGB.ScanLine[j];
Linia32:=Image1.Picture.Bitmap.ScanLine[j];
for i:=0 to Image1.Width-1 do
begin
if PtInRegion(Region, i, j) then
Linia8[i]:=0
else
Linia8[i]:=Linia32[i].rgbReserved;
Linia24[i].rgbtBlue:=Linia32[i].rgbBlue;
Linia24[i].rgbtGreen:=Linia32[i].rgbGreen;
Linia24[i].rgbtRed:=Linia32[i].rgbRed;
end;
end;
//Rysowanie po warstwie RGB lub A
bmpRGB.Canvas.Font.Style:=[fsBold];
bmpRGB.Canvas.Brush.Style:=bsClear;
bmpRGB.Canvas.TextOut(10,10,'TEST');
//Sklejenie RGB oraz A
with TBitmap.Create() do
begin
Width:=Image1.Width;
Height:=Image1.Height;
PixelFormat:=pf32bit;
for j:=0 to Height-1 do
begin
Linia8:=bmpA.ScanLine[j];
Linia24:=bmpRGB.ScanLine[j];
Linia32:=ScanLine[j];
for i:=0 to Width-1 do
begin
Linia32[i].rgbRed := MulDiv(Linia24[i].rgbtRed, Linia8[i], 255);
Linia32[i].rgbGreen := MulDiv(Linia24[i].rgbtGreen, Linia8[i], 255);
Linia32[i].rgbBlue := MulDiv(Linia24[i].rgbtBlue, Linia8[i], 255);
Linia32[i].rgbReserved := Linia8[i];
end;
end;
P := Point(0, 0);
S.cx := Image1.Width;
S.cy := Image1.Height;
blend.BlendOp := AC_SRC_OVER;
blend.BlendFlags := 0;
blend.AlphaFormat := AC_SRC_ALPHA;
blend.SourceConstantAlpha := 255;
UpdateLayeredWindow(Hnd, GetDC(0), nil, @S, Canvas.Handle, @P, 0, @blend, ULW_ALPHA);
Free;
end;
bmpA.Free;
bmpRGB.Free;
end;
{ ***** Obsługa komunikatów okna przezroczystego, z przeciąganiem po kliknięciu włącznie ***** }
function WndNewProc(Wnd: HWND; uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var Rect:TRect;
begin
Result := 0;
case uMsg of
WM_DESTROY: PostQuitMessage(0);
WM_LBUTTONDOWN: SendMessage(Wnd, WM_SYSCOMMAND, SC_MOVE+2, 0);
else
begin
if ((uMsg=WM_MOVING) or (uMsg=WM_MOVE)) and GetWindowRect(Wnd, Rect) then
SetWindowPos(Form1.Handle, 0, Rect.Left, Rect.Top, 0, 0, SWP_NOSIZE);
Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
end;
end;
end;
{ ***** Utworzenie okna przezroczystego i wycięcie wg. komponentów okna nieprzezroczystego ***** }
procedure TForm1.FormShow(Sender: TObject);
var Region:HRGN;
ComponentRegion:HRGN;
i:Integer;
begin
Region:=CreateRectRgn(0, 0, 0, 0);
for i:=0 to ControlCount-1 do
if Controls[i].Visible then
begin
ComponentRegion:=CreateRectRgn(Controls[i].Left, Controls[i].Top, Controls[i].Width+Controls[i].Left, Controls[i].Height+Controls[i].Top);
CombineRgn(Region, Region, ComponentRegion, RGN_OR);
DeleteObject(ComponentRegion);
end;
with Wnd do
begin
lpfnWndProc := @WndNewProc;
hInstance := hInstance;
lpszClassName := 'My1stApp';
hbrBackground := COLOR_WINDOW;
end;
Windows.RegisterClass(Wnd);
Hnd:=CreateWindowEx(WS_EX_LAYERED, 'My1stApp', PChar(Form1.Caption), WS_VISIBLE, Form1.Left, Form1.Top, Form1.Width, Form1.Height, Form1.Handle, 0, hInstance, NIL);
PaintLayeredWindow(Image1, Hnd, Region);
SetWindowRgn(Handle, Region, TRUE);
DeleteObject(Region);
end;
{ ***** Zamknięcie aplikacji ***** }
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.Terminate;
end;
end.
Jeśli kontrolki mogą dynamicznie zmieniać miejsce lub rozmiar, albo częściowo pokazują tło pod spodem (tak jak TLabel), należy trochę więcej nakombinować (Label można wypisać na obrazku).
Z tego tematu postaram się napisać wskazówkę do FAQ albo nawet całego arta, tylko najpierw chętnie poznam wasze zdanie i opinie na ten temat.