Zauważyłam jeszcze błąd podczas przesuwania innego okna nad aplikacją - czasami się zamazywało.
Cały czas pozostaje jednak drugi błąd - gdy są wstawione 2 TTransparentScrollBoksy tak, że jeden zasłania drugi - odrysowuja się w odwrotnej kolejności - na wierzchu widać ten, który jest pod spodem (chodzi o ramki i paski przewijania).
Włożenie jednego w drugi działa całkiem nieźle.
unit TransparentScrollBox;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TTransparentScrollBox=class(TScrollBox)
private
FNoEraseBackground: boolean;
procedure SetNoEraseBackground(const Value: boolean);
protected
procedure WndProc(var m:TMessage);override;
procedure createParams(var params:TCreateParams);override;
published
// poniższego używaj, gdy wszystkie inne komponenty, poza przezroczystymi
// (włączając w to przezroczyste obrazki) zakrywają całą formę
property NoEraseBackground:boolean read FnoEraseBackground write SetNoEraseBackground;
end;
Procedure Register;
implementation
{ TTransparentScrollBox }
procedure TTransparentScrollBox.createParams(var params: TCreateParams);
begin
inherited createParams(params);
setwindowlong(parent.Handle,-16,getwindowlong(parent.Handle,-16)and not WS_CLIPCHILDREN);
params.exStyle:=params.exStyle or WS_EX_TRANSPARENT;
end;
procedure TTransparentScrollBox.SetNoEraseBackground(const Value: boolean);
begin
FnoEraseBackground := Value;
end;
procedure TTransparentScrollBox.WndProc(var m: TMessage);
var r:TRect;x:integer;m1:TMessage;
begin
if m.msg=133 then
begin
RedrawWindow(parent.Handle,nil,0,RDW_UPDATENOW or RDW_NOCHILDREN);
inherited WndProc(m);
end else
if m.Msg=WM_ERASEBKGND then
begin
// tu nic nie robisz
m.Result:=1;
end else
if visible and((m.Msg=WM_VSCROLL )or(m.Msg=WM_HSCROLL)or(m.Msg=WM_WINDOWPOSCHANGED))then
begin
if (m.msg=wm_hscroll) and (lo(m.wParam)=5)and not(HorzScrollBar.Tracking) then
begin
inherited WndProc(m);
exit;
end;
if (m.msg=wm_vscroll) and (lo(m.wParam)=5)and not(VertScrollBar.Tracking) then
begin
inherited WndProc(m);
exit;
end;
invalidate;
inherited WndProc(m);
if parent<>nil then
begin
r.Left:=0;
r.top:=0;
r.right:=clientwidth;
r.bottom:=clientHeight;
r.TopLeft:=ClientToScreen(r.TopLeft);
r.BottomRight:=ClientToScreen(r.BottomRight);
r.TopLeft:=parent.ScreenToClient(r.TopLeft);
r.BottomRight:=parent.ScreenToClient(r.BottomRight);
if noEraseBackground then
RedrawWindow(parent.handle,@r,0,RDW_INVALIDATE or
RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN)else
RedrawWindow(parent.handle,@r,0,RDW_INVALIDATE or RDW_ERASE or
RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
end else
inherited WndProc(m);
end;
procedure Register;
begin
RegisterComponents('Pantera', [TTransparentScrollBox]);
end;
end.
Uważam to za wersję finalną, ponieważ nie wszystkie systemy operacyjne windows obsługują "TransparentColor" i robieneie tą metodą nie jest dobrym pomysłem, szczególnie gdy ktoś ma Win98/ME.
A przy tym należy pamiętać, że inne kontrolki można wsadzić tylko do TWinControl i nie znam innej metody aby wymusić rysowanie tego co jest za obiektem (tło + inne kontrolki).
Po przekopiowaniu tego pobaw sie trochę rozciąganiem i przenoszeniem okien nad aplikacją - powinno działać OK.