![]() |
|
اداة ScrollView لعرض مجموعة من النماذج في مكان واحد - نسخة قابلة للطباعة +- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum) +-- قسم : منتديات دلفي الأخرى (https://delphi4arab.net/forum/forumdisplay.php?fid=4) +--- قسم : مشاريع دلفي الجماعية (https://delphi4arab.net/forum/forumdisplay.php?fid=24) +--- الموضوع : اداة ScrollView لعرض مجموعة من النماذج في مكان واحد (/showthread.php?tid=7673) |
اداة ScrollView لعرض مجموعة من النماذج في مكان واحد - Delphi4Us - 30-03-2016 السلام عليكم لقد كتبت عن هذه الاداة هنا كود : 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.حتى الكود بحاجة الى تنظيم وتعديل لانه يعتبر مسودة لما قمت به في ساعة من الليل RE: اداة ScrollView لعرض مجموعة من النماذج في مكان واحد - Delphi4Us - 31-03-2016 المطلوب لمن يريد المشاركة هو اضافة تاثير التلاشي وليس الانزلاق |