30-03-2016, 06:25 PM
السلام عليكم
لقد كتبت عن هذه الاداة هنا
وهذا كود المكون
حتى الكود بحاجة الى تنظيم وتعديل لانه يعتبر مسودة لما قمت به في ساعة من الليل
لقد كتبت عن هذه الاداة هنا
كود :
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.حتى الكود بحاجة الى تنظيم وتعديل لانه يعتبر مسودة لما قمت به في ساعة من الليل