Wszystko sprowadza się do tego, że nie potrafię wykorzystać swojej bitmapy, bo na formie rysowane są jakieś kwadraty, a mi chodzi o to żeby forma była przeźroczysta.
W tym kodzie wykomentowałem część kodu, która tak mi się wydaje, że rysuje te kwadraty.
Ale jak ją usunąłem to nie działa.
Chodzi mi tylko o przerobienie tego bez rysowania kwadratów czarnych i tekstu na formie.
Toom2 napisał(a)
var
Form1: TForm1;
Wnd: TWndClass;
Hnd: THandle;
ComponentForm: TForm;
implementation
{$R *.dfm}
//Funkcja obsługująca zdarzenia półprzezroczystego okna
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(ComponentForm.Handle, 0, Rect.Left, Rect.Top, 0, 0, SWP_NOSIZE);
Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
end;
end;
end;
(*
//Funkcja odmalowująca półprzezroczyste okno z uwzględnieniem regionu
procedure PaintLayeredWindow(Hnd: THandle; Region: HRGN);
var blend: BLENDFUNCTION;
P: TPoint;
S: TSize;
X, Y: integer;
bmpRGB: TBitmap;
Alpha: byte;
Linia24: PRGBTriple;
Linia32: PRGBQuad;
begin
//Tworzenie warstwy RGB
bmpRGB := TBitmap.Create();
try
bmpRGB.Width := 512;
bmpRGB.Height := 512;
bmpRGB.PixelFormat := pf24bit;
with bmpRGB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBlack;
Rectangle(0, 0, bmpRGB.Width-1, bmpRGB.Height-1);
Brush.Style := bsClear;
Font.Style := [fsBold];
Font.Color := clRed;
Font.Size := 32;
TextOut(10, 10, 'TEST');
end;
//Sklejenie RGB oraz wygenerowanego A
with TBitmap.Create() do
begin
try
Width := bmpRGB.Width;
Height := bmpRGB.Height;
PixelFormat := pf32bit;
for Y := 0 to Height-1 do
begin
Linia24 := bmpRGB.ScanLine[Y];
Linia32 := ScanLine[Y];
for X := 0 to Width-1 do
begin
if PtInRegion(Region, X, Y) then
Alpha := 0
else
Alpha := byte(X xor Y);
Linia32.rgbRed := MulDiv(Linia24.rgbtRed, Alpha, 255);
Linia32.rgbGreen := MulDiv(Linia24.rgbtGreen, Alpha, 255);
Linia32.rgbBlue := MulDiv(Linia24.rgbtBlue, Alpha, 255);
Linia32.rgbReserved := Alpha;
inc(Linia32);
inc(Linia24);
end;
end;
//Nakładanie bitmapy
P := Point(0, 0);
S.cx := bmpRGB.Width;
S.cy := bmpRGB.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);
finally
Free;
end;
end;
finally
bmpRGB.Free;
end;
end;
*)
//Tworzenie regionów, wycinanie okna komponentów i tworzenie okna półprzezroczystego
procedure CreateLayered(Form: TForm);
var Region: HRGN;
ComponentRegion: HRGN;
i:Integer;
const LayeredWndClass = 'LayeredWndClass';
begin
ComponentForm := Form;
ComponentForm.BorderStyle := bsNone;
Region := CreateRectRgn(0, 0, 0, 0);
for i := 0 to ComponentForm.ControlCount-1 do
if ComponentForm.Controls[i].Visible then
begin
ComponentRegion := CreateRectRgn(ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Top, ComponentForm.Controls[i].Width+ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Height+ComponentForm.Controls[i].Top);
CombineRgn(Region, Region, ComponentRegion, RGN_OR);
DeleteObject(ComponentRegion);
end;
with Wnd do
begin
lpfnWndProc := @WndNewProc;
hInstance := hInstance;
lpszClassName := LayeredWndClass;
hbrBackground := COLOR_WINDOW;
end;
Windows.RegisterClass(Wnd);
Hnd := CreateWindowEx(WS_EX_LAYERED, LayeredWndClass, PChar(ComponentForm.Caption), WS_VISIBLE, ComponentForm.Left, ComponentForm.Top, ComponentForm.Width, ComponentForm.Height, ComponentForm.Handle, 0, hInstance, NIL);
//PaintLayeredWindow(Hnd, Region);
SetWindowRgn(ComponentForm.Handle, Region, TRUE);
DeleteObject(Region);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateLayered(Form1);
end;