Witam, jak zrobić aby tło scrollboksa było przezroczyste? Chodzi o to, że pod spodem mam tło z TImage i nie chcę, aby przesuwało się razem z zawartością TScrollBox (piszę przeglądarkę plików graficznych, a zawartość scrollboksa to po prostu obrazek).
Proszę o pomoc [!!!] [!!!] [!!!]
Pomoże mi ktoś? Sprawa jest pilna.
możesz użyć TAdvScrollBox tu masz linka:
http://www.torry.net/quicksearchd.php?String=AdvScrollBox&Title=Yes
Niby zainstalowałem, ale jak zrobić żeby to cholerstwo było przezroczyste?
Proszę, to jest pilne, muszę to dziś skończyć. Wszystko mam już zrobione, tylko ten nieszczęsny scrollbox i jego tło...
unit TransparentScrollBox; { TTransparentScrollBar component. }
interface
uses
Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls;
type
TTransparentScrollBox = class(TScrollBox)
private
{ Private declarations }
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published properties and events }
end; { TTransparentScrollBox }
procedure Register;
implementation
Procedure TTransparentScrollBox.CreateParams( Var params: TCreateParams);
begin
inherited CreateParams( params );
if not ( csDesigning in ComponentState ) then
params.ExStyle := params.ExStyle + WS_EX_TRANSPARENT;
end;
destructor TTransparentScrollBox.Destroy;
begin
inherited Destroy;
end;
constructor TTransparentScrollBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
procedure Register;
begin
RegisterComponents('TransparentScrollBox', [TTransparentScrollBox]);
end;
initialization
finalization
end.
Jak pod takiego scrollboxa wrzucisz Image to po skompilowaniu jest widoczny ale przy przewijaniu zmienia położenie razem z treścią Scrollboxa...
Nie wiem jak to zrobić, wstawiłem Timer, ustawiłem Interval na 50 i w ontimer wpisałem coś takiego:
Image1.left:=100+1; // przy czym 100 zamieniasz na pierwotne położenie obrazka
Image1.top:=100+1;
Image1.left:=100-1;
Image1.top:=100-1;
Ale jest to raczej nie wygodne i nie zbyt przyjazne rozwiązanie (widać przy przewijaniu scrollboxa).
Pzdr.
Dobre chociaż i to... Tak przy okazji, to myślę jak by pokombinować z
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
to by mogło pomóc... Tylko nie wiem dokładnie co (i żeby paski przewijania były widoczne, bo zaraz po uruchomieniu programu nie są).
Edward Gierek napisał(a)
Pomożecie?
Jest tam ktoś? Mi to jest naprawdę potrzebne...
(myślisz "Ależ ten Darkhog jest upierdliwy"? Dobrze myślisz!)
//EDIT: Czy ktoś mi do <autocenzura> pomoże?
10 sekund z google http://www.delphipages.com/tips/thread.cfm?ID=2
<autocenzura> i mam ten sam problem co przy KeySpyXP... F.U.C.K. (Friendly User Certainly Kicked)
Dziedziczysz po TScrollBox i obsługujesz niektóre zdarzenia:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TTransparentScrollBox=class(TScrollBox)
protected
procedure WndProc(var m:TMessage);override;
procedure createParams(var params:TCreateParams);override;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var t:TTransparentScrollBox;
begin
t:=TTransparentScrollBox.Create(self);
with t do
begin
parent:=self;
width:=400;
height:=400;
show;
align:=alClient;
VertScrollBar.Tracking:=true;
HorzScrollBar.Tracking:=true;
end;
button1.Parent:=T;
end;
{ TTransparentScrollBox }
procedure TTransparentScrollBox.createParams(var params: TCreateParams);
begin
inherited createParams(params);
setwindowlong(parent.Handle,-16,getwindowlong(parent.Handle,-16)and not WS_CLIPCHILDREN);
end;
procedure TTransparentScrollBox.WndProc(var m: TMessage);
var r:TRect;
begin
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
defwindowproc(handle,11,0,0);
inherited WndProc(m);
DefWindowProc(handle,11,1,0);
if parent<>nil then
begin
r.Left:=left;
r.top:=top;
r.right:=left+width;
r.bottom:=top+Height;
RedrawWindow(parent.handle,@r,0,$885);
end;
end else
inherited WndProc(m);
end;
end.
Aby zobaczyć jak działa wstaw przycisk button1 gdzieś po prawej stronie formy na dole (zostanie on wrzucony do środka scrollboxa) oraz wstaw jakiś obrazek rozciągnięty na całą szerokość okna (align:alClient) - wtedy $885 możesz zamienić na $881.
Oczywiście formCreate podepnij pod Form1.onCreate
Oczywiście dobrze by było zamknąć to w komponent, aby móc ręcznie wrzucić coś do scrollboxa :)
Dziex. Przetestuję to.
//EDIT: Jest prawie idealnie. Tylko, że pozycje pasków przewijania są aktualizowane dopiero po przeciągnięciu, a nie w czasie przeciągania. A oto ten prawie idealny kod w formie modułu (komponentu) gotowego do instalacji:
unit NScroll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TTransparentScrollBox=class(TScrollBox)
protected
procedure WndProc(var m:TMessage);override;
procedure createParams(var params:TCreateParams);override;
public
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);
end;
procedure TTransparentScrollBox.WndProc(var m: TMessage);
var r:TRect;
begin
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
defwindowproc(handle,11,0,0);
inherited WndProc(m);
DefWindowProc(handle,11,1,0);
if parent<>nil then
begin
r.Left:=left;
r.top:=top;
r.right:=left+width;
r.bottom:=top+Height;
RedrawWindow(parent.handle,@r,0,$885);
end;
end else
inherited WndProc(m);
end;
procedure Register;
begin
RegisterComponents('Standard', [TTransparentScrollBox]);
end;
end.
Po instalacji spróbujcie zamknąć coś bardzo dużego w scrollboksie uruchomcie i poruszajcie paskami (strzałki diałają, chociaż też nie do końca, tzn. strzałki przy scrollbarach, nie na klawiaturze).
Możesz też reagować tylko na zdarzenie WM_ERASEBACKGROUND i zwyczajnie przerywowywać obrazek obrazek jako tło, używając TPicture.bitmap.canvas.
Jednak wtedy nadal na wm_VScroll i wm_HDcroll musisz reagować, lecz wtedy wystarczy wywołać tam refresh()
Reszta wtedy staje sie niepotrzebna (createparams itp). Tyle, że wtedy musisz w komponencie stworzyć sobie właściwość pozwalającą przypisać image, który ma być w tle.
Wtedy paski przewijania będą działały bez zarzutu, no i będzie mniej migotać podczas przewijania z włączonym tracking dla scrollbarów.
PS. Nie zaśmieć sobie zakładki Standard :) Proponuję utworzyć własną (stworzy sie sama podczas próby rejestracji na niej komponentu).
To jest komponent, co prawda nie przezroczysty, ale ... spełniający swoją funkcję - posiada statyczne tło.
unit SkinScrollBox;
interface
uses
windows,SysUtils, messages, Classes, Controls, Forms, ExtCtrls;
type
TSkinScrollBox=class(TScrollBox)
private
Fimage: TImage;
procedure Setimage(const Value: TImage);
public
procedure wndProc(var m:TMessage);override;
published
property image: TImage read Fimage write Setimage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Pantera', [TSkinScrollBox]);
end;
procedure TSkinScrollBox.Setimage(const Value: TImage);
begin
Fimage := Value;
end;
procedure TSkinScrollBox.wndProc(var m: TMessage);
begin
if(m.msg=wm_ERASEBKGND)and(image<>nil)and(image.picture.Bitmap<>nil)then
begin
m.result:=1;
SetStretchBltMode(m.WParam,3);
stretchblt(m.WParam,0,0,clientWidth,clientHeight,image.Picture.Bitmap.Canvas.Handle,0,0,image.Picture.Width,image.Picture.Height,srccopy);
end else
if visible and((m.msg=wm_HScroll)or(m.msg=wm_VScroll)or(m.msg=wm_windowposchanged))then
begin
invalidate;
inherited wndProc(m);
//Refresh;
end else
inherited wndProc(m);
end;
end.
We właściwości image należy wskazać obiekt TImage z załadowanym wcześniej obrazkiem :)
A mógłbyś mi pomóc w modyfikacji tego kodu? Ja na WinAPI się kompletnie nie znam. Aha i sądzę, że jakby zrobić tak, aby paski się przerysowywały podczas przesuwania myszy MouseMove, czy jakoś tak I wciśniętym lewym przycisku, czyli w pseudokodzie:
Jeśli użytkownik RUSZA MYSZĄ i MA WCIŚNIĘTY LEWY PRZYCISK MYSZY nad ScrollBoksem
przerysuj scrollboksa
Niestety nie wiem jak to zakodować. Co do zakładek zaś, to mam ich tak dużo, że nawet przy maksymalnej rozdzielczości mojego monitora (1680x1050) nie mieszczą się na ekranie. Więc chce sobie oszczędzić konieczności przewijania. I nie wszystkie komponenty lądują na Standard.
Darkhog napisał(a)
A mógłbyś mi pomóc w modyfikacji tego kodu.
Czytaj nicki - jestem kobietą - nie wszyscy programiści to faceci.
Daj sobie spokój - patrz przykład wyżej. Na pewno spełni twoje wymagania.
Gdyby obrazek nie miał być rozciągany uiżyj zamiast stretchblt - bitblt.
Gdy ma być z antyaliasingiem, w setstretchmode użyj 4 zamiast 3.
sora, poprawię się. Zadziałało przyzwyczajenie. A sprawa ze scrollboxem jest poważniejsza. Scrollbox będzie w czasie ruchu aplikacji przesuwany, więc tło z Timage nie jest wskazane. Musi być przezroczysty.
Jak tak bardzo przeszkadza Ci, ze proponowane rozwiazania nie spelniaja Twoich oczekiwan, przygotuj sobie obrazki elementow paska przewijania, poczytaj o rysowaniu grafiki z kolorem przezroczystym i, implementujac zamodzielnie obsluge zdarzen, stworz wlasne rozwiazanie.
Swoja droga, watkiem tym zlamales chyba wszystkie podstawowe zasady forumowej netykiety: poczawszy od umieszczania kilkarkotnie wlasnych wypowiedzi pod soba, poprzez aktualizowanie tematu tymi wypowiedziami, by byl na samej gorze dzialu, po pisanie, ze Twoj temat jest pilny (co jest rownoznaczne z powiedzeniem, ze lejesz na tematy innych, bo masz gdzies, ze im tez moze byc potrzebna pomoc) i umieszczanie w stopce rozpaczliwego lamentu o pomoc [o pomyleniu plci innego uzytkownika rozpisywal sie nie bede, bo zdarzyc moze sie kazdemu].
Poniewaz nie ja decyduje o banach, potraktuj to jako ostrzezenie od forumowicza; w innym przypadku dalbym Ci tydzien odpoczynku od 4P na przemyslenie wlasnego zachowania. Postowanie na forum to nie Twoje prawo, ale przywilej. Jak nie bedziesz szanowal innych, ktos moze Ci go odebrac.</span>
Tu masz przerobiony komponent TTransparentScrollBox, tak aby nie miał wad o których pisałeś oraz aby nie obcinał znajdujących się za nim TWinCiontrolów (np. TEditów, TMemo i innych)
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);
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=15 then
begin
defwindowproc(handle,11,0,0);
RedrawWindow(parent.Handle,nil,0,RDW_UPDATENOW or RDW_allCHILDREN or RDW_INTERNALPAINT);
defwindowproc(handle,11,1,0);
inherited WndProc(m);
m1.Msg:=133;
m1.WParam:=1;
m1.LParam:=0;
inherited WndProc(m1);
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_INTERNALPAINT or
RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN)else
RedrawWindow(parent.handle,@r,0,RDW_INVALIDATE or RDW_ERASE or
RDW_INTERNALPAINT or RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
end else
inherited WndProc(m);
end;
procedure Register;
begin
RegisterComponents('Pantera', [TTransparentScrollBox]);
end;
end.
Mam nadzieję, że ten kod Cię zadowala :>.
Oczywiście nie zapomnij odinstalować poprzedniego ;)
Właściwość NoEraseBackground pozwala na zlikwidowanie niepotrzebnego migotania, gdy zakryjesz TImagem całą formę.
Dziękuję. To bardzo miło z Twojej strony, że mi pomogłaś. Jeszcze nie sprawdzałem, ale zaraz to zrobię i napiszę czy działa.
Tamten problem zniknął, ale za to pojawił się nowy. Umieściłem w tym zmodyfikowanym scrollboksie buttona i zmniejszyłem rozmiar, żeby było co przewijać. Niestety po uruchomieniu programu Button stał się... niewidoczny. Wartość Visible buttona jest ustawiona na true, więc to na pewno nie to. Czy mogłabyś coś na to poradzić?
DODATEK: Po kliknięciu niewidocznego przycisku nagle stał się widoczny. To może też Ci pomóc. Gdybym znał lepiej WinApi, sam bym się tym zajął. Niestety nie znam. Co "uniewidaczniania", to oczywiście taka zabawa w kotka i myszkę nie ma większego sensu. Będę wdzięczny za pomoc.
Z głębokim szacunkiem
Darkhog
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.
Dzięki. Działa jak należy.
Darkhog napisał(a)
Perfektion, Mekanik, Aero Dynamik ;)
Czyli wszyscy kochamy Kraftwerka.
Linux is like wigwan. No Windows, No Gates, Apache inside.
Czy nikt mi nie pomoże z tym przezroczystym scrollboksem?
Skoro już otrzymałeś pomoc dotyczącą przezroczystego scrollboksa, to aktualizuj sobie stopkę, ponieważ jest w niej nadal rozpaczliwa prośba o pomoc, która odrywa innych użytkowników od innych problemów.
PS. Darkhog, gdybyś chciał coś przesunąć w środku TTransparentScrollBoksa, to po tej akcji wywołaj parent.refresh() (parent, czyli zapewne twoja główna forma). Tymczasem w wolnej chwili spróbuję to poprawić - widać Windows nie "wie", że jak przesuwane są kontrolki w środku przezroczystego obiektu, powinien odrysowywać też to co jest pod nim.