Witam! Otóż w moim programie chcę osiągnąć taki efekt jak w programie "RocketDock". Chodzi mi tylko o sposób przewijania paska. Może znacie jakiś komponent ułatwiający stworzenie podobnego efektu. Próbowałem sam takie coś zrobić na komponentach typu "TImage" ale nie zabardzo to wychodzi....
Źródło: http://flash-site.cba.pl/macos.zip.
Kod:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, PngImage1, ExtCtrls, ToolWin, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
TrackBar1: TTrackBar;
Memo3: TMemo;
Image7: TImage;
Panel1: TPanel;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
procedure SetSize(size:integer;what:tcomponent);
function Componentformtag(tag:integer):tcomponent;
function Componentformtag1(tag:integer):tcomponent;
procedure Positions;
{ Public declarations }
end;
var
Form1: TForm1;
credits,creditsh,programm,programmh,ustawienia,ustawieniah,widok,widokh,wtyczki,wtyczkih,kontakty,kontaktyh,dodaj,odejmij:boolean;
standard:integer;
act1,act2,act3:tcomponent;
predkosc:integer;
onthe:boolean;
implementation
{$R *.dfm}
procedure ImagesResize(name1:string;name2:string;name3:string);
var
i:integer;
temp:tcomponent;
begin
for i:=0 to form1.ComponentCount-1 do begin
temp:=form1.Components[i];
if (temp.Name<>name1) and (temp.Name<>name2) and (temp.Name<>name3) then begin
if temp is TImage then begin
form1.SetSize(33,(temp as Timage));
end;
end;
end;
end;
procedure Tform1.Positions;
begin
image2.Left:=image1.Left+image1.Width+1;
panel1.Width:=image6.Left+image6.Width+1;
image3.Left:=image2.Left+image2.Width+1;
panel1.Width:=image6.Left+image6.Width+1;
image4.Left:=image3.Left+image3.Width+1;
panel1.Width:=image6.Left+image6.Width+1;
image5.Left:=image4.Left+image4.Width+1;
panel1.Width:=image6.Left+image6.Width+1;
image6.Left:=image5.Left+image5.Width+1;
panel1.Width:=image6.Left+image6.Width+1;
end;
function Image(name:string):timage;
var
i:integer;
temp:tcomponent;
begin
for i:=0 to form1.ComponentCount-1 do begin
temp:=form1.Components[i];
if temp.Name=name then begin
result:=(temp as Timage);
exit;
end;
end;
result:=nil;
end;
function Tform1.Componentformtag1(tag:integer):tcomponent;
var
i:integer;
temp:tcomponent;
begin
for i:=0 to form1.ComponentCount-1 do begin
temp:=form1.Components[i];
if temp.Tag=tag then begin
if temp is TTimer then begin
result:=temp;
exit;
end;
end;
end;
result:=nil;
end;
function Tform1.Componentformtag(tag:integer):tcomponent;
var
i:integer;
temp:tcomponent;
begin
for i:=0 to form1.ComponentCount-1 do begin
temp:=form1.Components[i];
if temp.Tag=tag then begin
if temp is TImage then begin
result:=temp;
exit;
end;
end;
end;
result:=nil;
end;
procedure Tform1.SetSize(size:integer;what:tcomponent);
var
i,odstep:integer;
czas:ttimer;
begin
if form1.Componentformtag1((what as Timage).Tag)<>nil then exit;
if (what as Timage).Width>size then begin
czas:=TTimer.Create(self);
czas.Name:=(what as Timage).Name+'_size';
czas.OnTimer:=Timer1Timer;
czas.Tag:=(what as Timage).Tag;
czas.Interval:=predkosc;
memo1.Lines[czas.Tag]:=inttostr(size);
memo2.Lines[czas.Tag]:='pomniejsz';
czas.Enabled:=true;
end;
if (what as Timage).Width<size then begin
czas:=TTimer.Create(self);
czas.Name:=(what as Timage).Name+'_size';
czas.OnTimer:=Timer1Timer;
czas.Tag:=(what as Timage).Tag;
czas.Interval:=predkosc;
memo1.Lines[czas.Tag]:=inttostr(size);
memo2.Lines[czas.Tag]:='powieksz';
czas.Enabled:=true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
onthe:=false;
positions;
predkosc:=1;
form1.DoubleBuffered:=true;
dodaj:=false;
odejmij:=false;
standard:=33;
panel1.DoubleBuffered:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i,endsize:integer;
temp:tcomponent;
begin
temp:=form1.Componentformtag((sender as TTimer).Tag);
endsize:=strtoint(memo1.Lines[(sender as TTimer).Tag]);
if memo2.Lines[(sender as TTimer).Tag]='powieksz' then begin
if (temp as Timage).Width>=endsize then begin
memo2.Lines[(sender as TTimer).Tag]:='';
memo1.Lines[(sender as TTimer).Tag]:='';
(temp as Timage).Enabled:=true;
(sender as TTimer).Free;
exit;
end;
(temp as Timage).height:=(temp as Timage).height+1;
(temp as Timage).Width:=(temp as Timage).Width+1;
positions;
exit;
end;
if memo2.Lines[(sender as TTimer).Tag]='pomniejsz' then begin
if (temp as Timage).Width<=endsize then begin
memo2.Lines[(sender as TTimer).Tag]:='';
memo1.Lines[(sender as TTimer).Tag]:='';
(temp as Timage).Enabled:=true;
(sender as TTimer).Free;
exit;
end;
(temp as Timage).Width:=(temp as Timage).Width-1;
(temp as Timage).height:=(temp as Timage).height-1;
positions;
exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
setsize(TrackBar1.Position,image2);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
onthe:=false;
positions;
setsize(33,image1);
setsize(33,image2);
setsize(33,image3);
setsize(33,image4);
setsize(33,image5);
setsize(33,image6);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
i:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (Sender as TImage).Name='Image1' then begin
form1.SetSize(33,image3);
form1.SetSize(33,image4);
form1.SetSize(33,image5);
form1.SetSize(33,image6);
end;
if (Sender as TImage).Name='Image2' then begin
form1.SetSize(33,image4);
form1.SetSize(33,image5);
form1.SetSize(33,image6);
end;
if (Sender as TImage).Name='Image3' then begin
form1.SetSize(33,image1);
form1.SetSize(33,image5);
form1.SetSize(33,image6);
end;
if (Sender as TImage).Name='Image4' then begin
form1.SetSize(33,image1);
form1.SetSize(33,image2);
form1.SetSize(33,image6);
end;
if (Sender as TImage).Name='Image5' then begin
form1.SetSize(33,image1);
form1.SetSize(33,image2);
form1.SetSize(33,image3);
end;
if (Sender as TImage).Name='Image6' then begin
form1.SetSize(33,image1);
form1.SetSize(33,image2);
form1.SetSize(33,image3);
form1.SetSize(33,image4);
end;
if (x>5) and (x<40) then begin
setsize(stala,img);
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
exit;
end;
if (x<5) then begin
if img1<>nil then begin
setsize(45,img1);
positions;
end;
exit;
end;
if (x>40) then begin
if img2<>nil then begin
setsize(45,img2);
positions
end;
exit;
end;
positions;
end;
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (x>5) and (x<40) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
end;
if (x<5) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img1<>nil then begin
img1.Width:=45;
img1.Height:=45;
positions;
end;
end;
if (x>40) then begin
positions;
if img2<>nil then begin
img2.Width:=45;
img2.Height:=45;
positions
end;
end;
positions;
end;
procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (x>5) and (x<40) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
end;
if (x<5) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img1<>nil then begin
img1.Width:=45;
img1.Height:=45;
positions;
end;
end;
if (x>40) then begin
positions;
if img2<>nil then begin
img2.Width:=45;
img2.Height:=45;
positions
end;
end;
positions;
end;
procedure TForm1.Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (x>5) and (x<40) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
end;
if (x<5) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img1<>nil then begin
img1.Width:=45;
img1.Height:=45;
positions;
end;
end;
if (x>40) then begin
positions;
if img2<>nil then begin
img2.Width:=45;
img2.Height:=45;
positions
end;
end;
positions;
end;
procedure TForm1.Image5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (x>5) and (x<40) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
end;
if (x<5) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img1<>nil then begin
img1.Width:=45;
img1.Height:=45;
positions;
end;
end;
if (x>40) then begin
positions;
if img2<>nil then begin
img2.Width:=45;
img2.Height:=45;
positions
end;
end;
positions;
end;
procedure TForm1.Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
img,img1,img2:timage;
stala:integer;
min:integer;
begin
img:=(sender as TImage);
img1:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))-1));
img2:=Image('Image'+inttostr(strtoint(copy((sender as Timage).Name,length((sender as Timage).Name),length((sender as Timage).Name)+2))+1));
stala:=45;
if (x>5) and (x<40) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img2<>nil then begin
img2.Width:=33+(x div 5);
img2.Height:=33+(x div 5);
positions;
end;
if img1<>nil then begin
img1.Width:=41-(x div 5);
img1.Height:=41-(x div 5);
positions;
end;
end;
if (x<5) then begin
img.Width:=stala;
img.Height:=stala;
positions;
if img1<>nil then begin
setsize(45,img1);
positions;
end;
end;
if (x>40) then begin
positions;
if img2<>nil then begin
setsize(45,img2);
positions
end;
end;
positions;
end;
Uzyskany przeze mnie efekt jest za mało płynny, a rozchodzi się o to, aby przynajmniej przypominał "RocketDocka". Z góry THX za pomoc ;-) .
</url>