Timeline Anzeige unter Firemonkey

[Rollo62]

Versucht doch Paint wegzulassen und stattdessen mit Fmx SubContzrols zu arbeiten

Delphi-Quellcode:

unit UMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.ScrollBox, FMX.Objects, FMX.Layouts;

type
  TTimelineButton = class(TRectangle)
  private
    FLabel: TLabel;
    procedure SetTitle(const Value: String);
  protected
    FSelected: TBrush;
    FShadow: TBrush;
    FGrad: TBrush;
    FLightBrush: TBrush;
    FTitle: String;
    FStartTime: TDateTime;
    FEndTime: TDateTime;
    FSelectedRow: Boolean;
    FFocusedBrush: TBrush;

//    procedure Paint; override;
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Title: String read FTitle write SetTitle;
    property StartTime: TDateTime read FStartTime write FStartTime;
    property EndTime: TDateTime read FEndTime write FEndTime;
    property SelectedRow: Boolean read FSelectedRow write FSelectedRow;
  end;

  TForm2 = class(TForm)
    PresentedScrollBox1: TPresentedScrollBox;
    Path1: TPath;
    Path2: TPath;
    Rectangle1: TRectangle;
    Rectangle2: TRectangle;
    ScrollBox1: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

constructor TTimelineButton.Create(AOwner: TComponent);
begin
  inherited;

  FLabel := TLabel.Create( Self );
  FLabel.Parent := Self;
  FLabel.Height := Self.Height / 2;
  FLabel.TextSettings.Font.Size := 20;
  FLabel.TextSettings.FontColor := TAlphaColorRec.Blue;
  FLabel.TextSettings.HorzAlign := TTextAlign.Center;
  FLabel.Align := TAlignLayout.Top;

  FLightBrush := TBrush.Create(TBrushkind.Gradient, 0);
  FLightBrush.Gradient.Color := $22FFFFFF;
  FLightBrush.Gradient.Color1 := $40FFFFFF;
  FLightBrush.Gradient.StartPosition.Point := PointF(0, 0.5);
  FLightBrush.Gradient.StopPosition.Point := PointF(1, 0.5);

  FGrad := TBrush.Create(TBrushkind.Gradient, 0);
  FGrad.Gradient.Color := $40FFFFFF;
  FGrad.Gradient.Color1 := $02FFFFFF;
  FGrad.Gradient.StartPosition.Point := PointF(0, 0);
  FGrad.Gradient.StopPosition.Point := PointF(1, 1);

  FShadow := TBrush.Create(TBrushkind.Gradient, 0);
  FShadow.Gradient.Color1 := $50000000;
  FShadow.Gradient.Color := $00000000;
  FShadow.Gradient.StartPosition.Point := PointF(0, 0.5);
  FShadow.Gradient.StopPosition.Point := PointF(1, 0.5);

  FSelected := TBrush.Create(TBrushkind.Gradient, 0);
  FSelected.Gradient.Color1 := $F0CC0033;
  FSelected.Gradient.Color := $C0CC0033;
  FSelected.Gradient.StartPosition.Point := PointF(1, 0);
  FSelected.Gradient.StopPosition.Point := PointF(0, 0);

  FFocusedBrush := TBrush.Create(TBrushkind.Gradient, 0);
  FFocusedBrush.Gradient.Color1 := $F0FECC09;
  FFocusedBrush.Gradient.Color := $C0FECC09;
  FFocusedBrush.Gradient.StartPosition.Point := PointF(1, 0);
  FFocusedBrush.Gradient.StopPosition.Point := PointF(0, 0);
end;

destructor TTimelineButton.Destroy;
begin
  FLightBrush.Free;
  FGrad.Free;
  FShadow.Free;
  FSelected.Free;
  FFocusedBrush.Free;
  inherited;
end;

procedure TTimelineButton.DoMouseEnter;
begin
  inherited;
  repaint;
end;

procedure TTimelineButton.DoMouseLeave;
begin
  inherited;
  repaint;
end;

procedure TTimelineButton.SetTitle(const Value: String);
begin
  FTitle := Value;

  FLabel.Text := Value;
end;

//procedure TTimelineButton.Paint;
//var
//  strDuration: String;
//  Brush: TBrush;
//  Opacity: single;
//begin
//  inherited;
//
//  if assigned(ParentControl) then
//    Opacity := ParentControl.Opacity
//  else
//    exit;
//
//  if Canvas.BeginScene(nil) then
//  begin
//    Brush := nil;
//    if FSelectedRow then
//      Brush := FSelected;
//    if IsMouseOver then
//      Brush := FFocusedBrush;
//
//    //S4:
////    if assigned(Brush) then
////      Self.Fill.Color := Brush.Color;
//
////    if assigned(Brush) then
////      Canvas.FillRect(RectF(0, 0, Width, Height), 0, 0, [], Opacity, Brush);
//
//    Canvas.Font.Size := 25;
//    Canvas.Fill.Color := $FFFEFEFE;
//    Canvas.FillText(RectF(20, 0, Width - 20, Height), Title, false, Opacity, [],
//      TTextAlign.Leading, TTextAlign.Leading);
//
//    // Canvas.DrawPath(ArrowRight,RectangleF(2f, 12f, 20f, 20f), Stretch.UniformToFill, Resource.Colours.Accent1Brush);
////    Canvas.FillRect(RectF(0, Height - 1, Width, Height), 0, 0, [], Opacity,
////      FLightBrush);
////    Canvas.FillRect(RectF(0, 0, Width, 1), 0, 0, [], Opacity, FLightBrush);
////
////    if IsMouseOver then
////      Canvas.FillRect(RectF(0, 0, Width, Height * 0.3), 0, 0, [],
////        Opacity, FGrad);
//
//    if FStartTime <= now then
//      strDuration := FloatToStr(Round(MinsPerDay * (FEndTime - FStartTime))) +
//        ' minutes left'
//    else
//      strDuration := FormatDateTime('hh:nn', FStartTime) + '-' +
//        FormatDateTime('hh:nn', FEndTime);
//    Canvas.Font.Size := 14;
//    Canvas.FillText(RectF(20, Height * 0.6, Width, Height), strDuration, false,
//      Opacity, [], TTextAlign.Leading, TTextAlign.Leading);
//
////    Canvas.FillRect(RectF(Width - 10, 0, Width, Height), 0, 0, [],
////      Opacity, FShadow);
//
//    Canvas.EndScene;
//  end;
//end;

procedure TForm2.FormCreate(Sender: TObject);
var
  x, y: integer;
  t: TDateTime;
  xoffs: single;
  ani: TScrollCalculations;
begin

  ani := TScrollCalculations.Create( ScrollBox1 );

  try
    ani.Animation       := True;
//    ani.ScrollBox       := ScrollBox1;
    ani.AutoShowing     := True;
    ani.BoundsAnimation := True;


    ScrollBox1.AniCalculations.Assign( ani );

  finally
    ani.Free;
    ani := nil;
  end;

  ScrollBox1.BeginUpdate;

  for y := 0 to 50 do
  begin
    t := now;
    xoffs := 0;
    for x := 0 to 100 do
      with TTimelineButton.Create(self) do
      begin
        HitTest := False;
        Parent := ScrollBox1;
        Width := random(400);
        Height := 70;
        Position.Point := PointF(xoffs, y * Height);
        Title := 'Welt der Wunder';
        StartTime := t;
        t := t + (random(120) + 1) / MinsPerDay;
        EndTime := t;
        xoffs := xoffs + Width;
        SelectedRow := y = 1;
      end;
  end;

  ScrollBox1.EndUpdate;

end;

procedure TForm2.FormResize(Sender: TObject);
begin
  with ScrollBox1 do
  begin
    Rectangle1.SetBounds(Position.x + Width - 100, Position.y, 100, Height);
    Rectangle2.SetBounds(Position.x, Position.y, 100, Height);
  end;
end;

end.