21-01-2019, Saat: 02:30
Bu aralar geceleri kişisel mobil bir proje ile uğraşıyorum. Masaüstünde kendi çapımda bir altyapım var. Mobildede ufak tefek birşeyler yapmaya başladım. Birilerinin işini görür diyerekte forumda paylaşıyorum. Konumuz kendi ihtiyacım doğrultusunda hazırladığım dinamik bir tabcontrol.
Sample Link
Sample Link
procedure TFrmMain.ItemClick(Sender:TObject);
begin
Button1.Text := TNrTabButton(Sender).Caption;
end;
procedure TFrmMain.Button1Click(Sender: TObject);
Var xTab : TNrTab;
begin
xTab := TNrTab.Create(Self);
xTab.Parent := Self;
xTab.Align := TAlignLayout.Top;
xTab.Height := 60;
xTab.AddItem('SOHBETLER',ItemClick);
xTab.AddItem('DURUM',ItemClick);
xTab.AddItem('ARAMALAR',ItemClick);
xTab.AddItem('İLETİŞİM',ItemClick);
end;
unit NrTab;
{-------------------------------
2019 Salih BAĞCI NrTab.pas
--------------------------------}
interface
uses
FMX.Ani, FMX.Types, System.Types, System.Classes, System.Rtti, FMX.Utils, FMX.Layouts, FMX.Objects, System.UITypes
, FMX.Graphics, FMX.StdCtrls, FMX.Dialogs , SysUtils;
type
TItemClick = procedure(Sender:TObject) of object; // Tab Click'te kullanılır
type
TPointAnimation = class(TCustomPropertyAnimation)
private
FStartFloat: TPointF;
FStartFromCurrent: Boolean;
FStopFloat: TPointF;
protected
procedure FirstFrame; override;
procedure ProcessAnimation; override;
public
constructor Create(AOwner: TComponent); override;
published
property AnimationType default TAnimationType.In;
property AutoReverse default False;
property Delay;
property Duration nodefault;
property Enabled default False;
property Interpolation default TInterpolationType.Linear;
property Inverse default False;
property Loop default False;
property OnFinish;
property OnProcess;
property PropertyName;
property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False;
property StartValue: TPointF read FStartFloat write FStartFloat stored True;
property StopValue: TPointF read FStopFloat write FStopFloat stored True;
property Trigger;
property TriggerInverse;
end;
type
TNrTab = class(TRectangle)
strict private
FBackGroundColor : TAlphaColor;
FSelectedBackGroundColor : TAlphaColor;
FItemColor : TAlphaColor;
FItemNormalTextColor : TAlphaColor;
FItemSelectedTextColor : TAlphaColor;
FLineColor : TAlphaColor;
FItemWidth : Single;
FItemCount : Integer;
procedure setBackGroundColor(const Value: TAlphaColor);
procedure setSelectedBackGroundColor(const Value: TAlphaColor);
procedure setItemColor(const Value: TAlphaColor);
procedure setItemNormalTextColor (const Value: TAlphaColor);
procedure setItemSelectedTextColor(const Value: TAlphaColor);
procedure setLineColor(const Value: TAlphaColor);
procedure setItemWidth(const Value: Single);
private
HorzScroll : THorzScrollBox;
PointAnimation : TPointAnimation;
RecLine : TRectangle;
protected
//
public
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
procedure AddItem(const ACaption:String;AButtonClick:TItemClick);
procedure ItemPred;
published
property BackGroundColor: TAlphaColor read FBackGroundColor write setBackGroundColor;
property SelectedBackGroundColor: TAlphaColor read FSelectedBackGroundColor write setSelectedBackGroundColor;
property ItemColor: TAlphaColor read FItemColor write setItemColor;
property ItemNormalTextColor: TAlphaColor read FItemNormalTextColor write setItemNormalTextColor;
property ItemSelectedTextColor: TAlphaColor read FItemSelectedTextColor write setItemSelectedTextColor;
property LineColor: TAlphaColor read FLineColor write setLineColor;
property ItemWidth: Single read FItemWidth write setItemWidth;
property ItemCount:integer read FItemCount default 0;
end;
type
TNrTabButton = class(TRectangle)
strict private
FCaption: String;
procedure setCaption(const Value: String);
protected
//
public
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
procedure Click; override;
published
property Caption: String read FCaption write setCaption;
end;
implementation
{ TPointAnimation }
constructor TPointAnimation.Create(AOwner: TComponent);
begin
inherited;
Duration := 0.2;
FStartFloat := PointF(0, 0);
FStopFloat := PointF(0, 0);
end;
procedure TPointAnimation.FirstFrame;
var
T : TRttiType;
P : TRttiProperty;
begin
if StartFromCurrent then
begin
T := SharedContext.GetType(FInstance.ClassInfo);
if T <> nil then
begin
P := T.GetProperty(FPath);
if (P <> nil) and (P.PropertyType.TypeKind = tkRecord) then
StartValue := P.GetValue(FInstance).AsType<TPointF>;
end;
end;
end;
procedure TPointAnimation.ProcessAnimation;
var
newPoint : TPointF;
T : TRttiType;
P : TRttiProperty;
begin
if FInstance <> nil then
begin
T := SharedContext.GetType(FInstance.ClassInfo);
if T <> nil then
begin
P := T.GetProperty(FPath);
if(P <> nil) and (P.PropertyType.TypeKind = tkRecord)then
begin
newPoint := PointF(InterpolateSingle(FStartFloat.X, FStopFloat.X, NormalizedTime),InterpolateSingle(FStartFloat.Y, FStopFloat.Y, NormalizedTime));
P.SetValue(FInstance, TValue.From<TPointF>(newPoint));
end;
end;
end;
end;
{ TNrTabItem }
procedure TNrTab.AddItem(const ACaption: String;AButtonClick:TItemClick);
Var xButton : TNrTabButton;
xText : TText;
begin
Self.BeginUpdate;
HorzScroll.BeginUpdate;
FItemCount := Succ(FItemCount);
xButton := TNrTabButton.Create(Self);
xText := TText.Create(Self);
with xButton do
begin
BeginUpdate;
Parent := HorzScroll;
Caption := ACaption;
HitTest := True;
Align := TAlignLayout.Left;
Width := ItemWidth;
Fill.Color := ItemColor;
Stroke.Kind := TBrushKind.None;
OnClick := AButtonClick;
EndUpdate;
end;
with xText do
begin
BeginUpdate;
Parent := xButton;
HitTest := False;
Align := TAlignLayout.Client;
TextSettings.FontColor := FItemNormalTextColor;
Font.Size := FItemWidth / 7;
Font.Style := [TFontStyle.fsBold];
Text := ACaption;
EndUpdate;
end;
HorzScroll.EndUpdate;
Self.EndUpdate;
If FItemCount = 1 then xButton.Click;
end;
constructor TNrTab.Create(AOwner: TComponent);
begin
inherited;
setBackGroundColor(TAlphaColor($FF00695B));
setSelectedBackGroundColor(TAlphaColor($FF00695B));
setItemColor(TAlphaColor($FF00695B));
setItemNormalTextColor(TAlphaColor($FFB0B0B0));
setLineColor(TAlphaColorRec.White);
setItemSelectedTextColor(TAlphaColorRec.White);
setItemWidth(100);
Stroke.Kind := TBrushKind.None;
//HorzScroll Ekle
HorzScroll := THorzScrollBox.Create(Self);
HorzScroll.Parent := Self;
HorzScroll.Align := TAlignLayout.Client;
HorzScroll.ShowScrollBars := False;
//PointAnimation Ekle
PointAnimation := TPointAnimation.Create(AOwner);
with PointAnimation do
begin
PropertyName := 'ViewportPosition';
StartFromCurrent := True;
Duration := 0.3;
HorzScroll.AddObject(PointAnimation);
end;
end;
destructor TNrTab.Destroy;
begin
PointAnimation.Enabled := False;
PointAnimation.Free;
if RecLine <> nil then
RecLine.Free;
HorzScroll.Free;
inherited;
end;
procedure TNrTab.ItemPred;
begin
FItemCount := Pred(ItemCount);
end;
procedure TNrTab.setBackGroundColor(const Value: TAlphaColor);
begin
Fill.Color := Value;
FBackGroundColor := Value;
end;
procedure TNrTab.setItemColor(const Value: TAlphaColor);
begin
FItemColor := Value;
end;
procedure TNrTab.setItemNormalTextColor(const Value: TAlphaColor);
begin
FItemNormalTextColor := Value;
end;
procedure TNrTab.setItemSelectedTextColor(const Value: TAlphaColor);
begin
FItemSelectedTextColor := Value;
end;
procedure TNrTab.setItemWidth(const Value: Single);
begin
FItemWidth := Value;
end;
procedure TNrTab.setLineColor(const Value: TAlphaColor);
begin
FLineColor := Value;
end;
procedure TNrTab.setSelectedBackGroundColor(const Value: TAlphaColor);
begin
FSelectedBackGroundColor := Value;
end;
{ TNrTabItemText }
procedure TNrTabButton.Click;
Var xOwner : TNrTab;
xOwnerButton : TNrTabButton;
Ind,Ind2 : Integer;
begin
xOwner := TNrTab(Owner);
for Ind := 0 to Pred(xOwner.ComponentCount) do
begin
if (xOwner.Components[Ind] <> Self) and (xOwner.Components[Ind] is TNrTabButton) then
begin
xOwnerButton := TNrTabButton(xOwner.Components[Ind]);
xOwnerButton.BeginUpdate;
for Ind2 := 0 to Pred(xOwnerButton.ControlsCount) do
begin
if xOwnerButton.Controls[Ind2] is TText then
begin
TText(xOwnerButton.Controls[Ind2]).BeginUpdate;
TText(xOwnerButton.Controls[Ind2]).TextSettings.FontColor := xOwner.ItemNormalTextColor;
TText(xOwnerButton.Controls[Ind2]).EndUpdate;
end;
end;
xOwnerButton.Fill.Color := xOwner.ItemColor;
xOwnerButton.EndUpdate;
end;
end;
Self.BeginUpdate;
Self.Fill.Color := xOwner.SelectedBackGroundColor;
for Ind2 := 0 to Pred(Self.ControlsCount) do
begin
if Self.Controls[Ind2] is TText then
begin
TText(Self.Controls[Ind2]).BeginUpdate;
TText(Self.Controls[Ind2]).TextSettings.FontColor := xOwner.ItemSelectedTextColor;
TText(Self.Controls[Ind2]).EndUpdate;
end;
end;
Self.EndUpdate;
if xOwner.RecLine = nil then
begin
xOwner.RecLine := TRectangle.Create(xOwner);
with xOwner.RecLine do
begin
Parent := xOwner.HorzScroll;
Align := TAlignLayout.None;
Height := 3;
Width := xOwner.ItemWidth;
Position.Y := xOwner.Height - Height;
Fill.Color := xOwner.LineColor;
Stroke.Kind := TBrushKind.None;
HitTest := False;
end;
end;
if GetParentComponent.ClassType = THorzScrollBox then
begin
xOwner.RecLine.BringToFront;
xOwner.RecLine.AnimateFloat('Position.X',Position.X, 0.3, TAnimationType.InOut, TInterpolationType.Cubic);
xOwner.RecLine.AnimateFloat('Width',Width, 0.3, TAnimationType.InOut, TInterpolationType.Cubic);
end;
xOwner.PointAnimation.StartValue := xOwner.RecLine.Position.Point;
xOwner.PointAnimation.StopValue := Self.Position.Point + TPointF.Create(-100, 0);
xOwner.PointAnimation.Start;
inherited;
end;
constructor TNrTabButton.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TNrTabButton.Destroy;
begin
TNrTab(Owner).ItemPred;
inherited;
end;
procedure TNrTabButton.setCaption(const Value: String);
begin
FCaption := Value;
end;
end.
Yalnızım ama bir kente yürüyen ordu gibiyim, edebiyattan kaçınmalıyım..
