Menu a'la RocketDock

0

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>

0

Czy mozesz wstawic to skompilowane i ze zrodlami?

//dodane
Podales, ale on nie dziala

0

Przecież podałem link do źródła

http://flash-site.cba.pl/macos.zip

1 użytkowników online, w tym zalogowanych: 0, gości: 1