دخول

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 · 31-03-2016, 05:02 PM

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

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة