اداة ScrollView لعرض مجموعة من النماذج في مكان واحد

[Delphi4Us]

السلام عليكم
لقد كتبت عن هذه الاداة هنا

كود :

http://delphi4arab.net/forum/showthread.php?tid=7671

وهذا كود المكون

كود :

unit ScrollView;

interface

uses
 System.SysUtils,Vcl.Forms,Dialogs, System.Classes, Vcl.Controls, Vcl.ExtCtrls;

  type
TGetMode = (SclUP, SclDown, SclLeft,SclRight);

type
 TScrollView = class(TPanel)


  Timer1: TTimer;
  procedure Timer1Timer(Sender: TObject);
  procedure  ScrollViewResize(Sender: TObject);
 private
  GetSpeed:Integer;
  GetMode: TGetMode;

 protected

 public
  procedure FormShow(Frm:Tform;Bool:Boolean=true);
  constructor Create (AOwner: TComponent); override;
  destructor Destroy; override;
 published

  property Speed: Integer read GetSpeed write GetSpeed;
 // property Form: TForm read FForm write FForm;
  property ScrollType: TGetMode read  GetMode write GetMode;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Samples', [TScrollView]);
end;

{ TScrollView }

constructor TScrollView.Create(AOwner: TComponent);
begin
 inherited;
 Timer1:= TTimer.Create(nil);
 Timer1.Enabled:=false;
 Timer1.Interval:=1;
 Timer1.OnTimer:= Timer1Timer;
 self.OnResize:= ScrollViewResize;
 speed:=50;
 self.Caption:='الاصدارة الاولى مع تحيات Delphi4us ';
 self.BevelOuter :=bvNone;
end;

destructor TScrollView.Destroy;
begin
  Timer1.Free;
  Timer1:=nil;
 inherited;
end;

procedure TScrollView.FormShow(Frm:Tform;Bool:Boolean=true);
begin

   Frm.BorderStyle:=bsNone;
   Frm.Parent:=self;
   Frm.Width:=self.Width;
   frm.Height:=self.Height;

  if Bool=True then begin

   Frm.Show;
   exit;
  end;


  Frm.Show;
  Frm.Hide;

   if ScrollType=sclup then begin
     Frm.Top:=self.Height;
   end;

  if ScrollType=SclDown then begin
     Frm.Top:=0 - frm.Height;
  end;

  if ScrollType=SclLeft then begin
     Frm.Left:=self.Width  ;
  end;

  if ScrollType=SclRight then begin
     Frm.Left:= 0  - frm.Width;
  end;


  Frm.Show;
  // Timer1.OnTimer:= Timer1Timer;
  Timer1.Enabled:=true;

end;

procedure TScrollView.ScrollViewResize(Sender: TObject);
begin
if Self.ControlCount=1 then begin
(Self.Controls[0] as Tform).Width:=self.Width;
 (Self.Controls[0] as Tform).Height:=self.Height;
end;
end;

procedure TScrollView.Timer1Timer(Sender: TObject);
begin

//ShowMessage(Self.ControlCount.ToString());

if Self.ControlCount=1 then begin
(Self.Controls[0] as Tform).Top:=(Self.Controls[0] as Tform).Top -speed;
if (Self.Controls[0] as Tform).Top < 0 then begin
(Self.Controls[0] as Tform).Top:=0;
//(Self.Controls[0] as Tform).close;
Timer1.Enabled:=false;


end;
exit;
end;

if ScrollType=sclup then begin


(Self.Controls[0] as Tform).Top:=(Self.Controls[0] as Tform).Top -speed;

(Self.Controls[1] as Tform).Top:=(Self.Controls[1] as Tform).Top -speed;

if (Self.Controls[1] as Tform).Top < 0 then begin
Timer1.Enabled:=false;
(Self.Controls[0] as Tform).close;
(Self.Controls[1] as Tform).Top:=0;
end;
end;


if ScrollType=SclDown then begin


(Self.Controls[0] as Tform).Top :=(Self.Controls[0] as Tform).Top +speed;

(Self.Controls[1] as Tform).Top:=(Self.Controls[1] as Tform).Top +speed;

if (Self.Controls[1] as Tform).Top > 0 then begin
Timer1.Enabled:=false;
(Self.Controls[0] as Tform).close;
(Self.Controls[1] as Tform).Top:=0;
end;
end;

if ScrollType=SclLeft then begin


(Self.Controls[0] as Tform).Left :=(Self.Controls[0] as Tform).Left -speed;

(Self.Controls[1] as Tform).Left:=(Self.Controls[1] as Tform).Left -speed;

if (Self.Controls[1] as Tform).Left < 0 then begin
Timer1.Enabled:=false;
(Self.Controls[0] as Tform).close;
(Self.Controls[1] as Tform).Left:=0;
end;
end;

if ScrollType=SclRight then begin


(Self.Controls[0] as Tform).Left :=(Self.Controls[0] as Tform).Left +speed;

(Self.Controls[1] as Tform).Left:=(Self.Controls[1] as Tform).Left +speed;

if (Self.Controls[1] as Tform).Left > 0 then begin
Timer1.Enabled:=false;
(Self.Controls[0] as Tform).close;
(Self.Controls[1] as Tform).Left:=0;
end;
end;

end;







end.

---

حتى الكود بحاجة الى تنظيم وتعديل لانه يعتبر مسودة لما قمت به في ساعة من الليل

[Delphi4Us]

المطلوب لمن يريد المشاركة هو اضافة تاثير التلاشي وليس الانزلاق