AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Leanback

Ein Thema von Peter666 · begonnen am 15. Aug 2019 · letzter Beitrag vom 10. Sep 2019
Antwort Antwort
Seite 2 von 2     12
Peter666

Registriert seit: 11. Aug 2007
357 Beiträge
 
#11

AW: Leanback

  Alt 9. Sep 2019, 13:48
Delphi-Quellcode:
unit FMX.TilesGrid;

interface

uses System.SysUtils, System.Classes, System.Types, System.UITypes,
  FMX.Graphics, FMX.Types, FMX.Controls, FMX.Layouts;

type
    TTileItem = class(TControl)
  protected
    FZoomFactor: Single;
    FBackgroundColor: TAlphaColor;

    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;

    procedure SetZoomFactor(AValue: Single);
    procedure SetBackgroundColor(AValue: TAlphaColor);

    function GetBarPos: Single;
    procedure SetBarPos(const AValue: Single);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BackgroundColor: TAlphaColor read FBackgroundColor
      write SetBackgroundColor;
    property ZoomFactor: Single read FZoomFactor write SetZoomFactor;
    property BarPos: Single read GetBarPos write SetBarPos;
  end;

implementation

uses FMX.Ani, FMX.Stdctrls;

const
  cZoomIn = 0.9;
  cZoomOut = 1.0;
  cZoomTime = 0.2;

type TCustomScrollBoxCracker = class(TCustomScrollBox);

constructor TTileItem.Create(AOwner: TComponent);
begin
  inherited;
  CanFocus := true;
  ZoomFactor := 0;
  FBackgroundColor := TAlphaColors.Gray;
end;

destructor TTileItem.Destroy;
begin
  inherited;
end;

function TTileItem.GetBarPos: Single;
begin
  if Owner is TCustomScrollBox then
   result := TCustomScrollBoxCracker(Owner).HScrollBar.Value else
   result := 0;
end;

procedure TTileItem.SetBarPos(const AValue: Single);
begin
  if Owner is TCustomScrollBox then
    TCustomScrollBoxCracker(Owner).HScrollBar.Value := AValue;
end;

procedure TTileItem.DoEnter;
var
 NewScrollViewPos: single;
 MinWidth, MinHeight: Single;
begin
  BringToFront;
  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomOut, cZoomTime,
    TAnimationType.Out, TInterpolationType.Quadratic);

   NewScrollViewPos := BarPos;
    MinWidth := 0;
    MinHeight := 0;
   if (BoundsRect.Left - NewScrollViewPos < MinWidth) then
    NewScrollViewPos := BoundsRect.Left;

   if (BoundsRect.Left - NewScrollViewPos < MinHeight) then
    NewScrollViewPos := BoundsRect.Right - TCustomScrollBox(Owner).Width;

   if (BoundsRect.Right - NewScrollViewPos > TCustomScrollBox(Owner).Width) then
    NewScrollViewPos := BoundsRect.Right - TCustomScrollBox(Owner).Width;

   TAnimator.AnimateFloat(self, 'BarPos', NewScrollViewPos, cZoomTime,
    TAnimationType.In, TInterpolationType.Linear);
end;

procedure TTileItem.DoExit;
begin
  SendToBack;
  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomIn, cZoomTime,
    TAnimationType.In, TInterpolationType.Linear);
end;

procedure TTileItem.SetBackgroundColor(AValue: TAlphaColor);
begin
  if FBackgroundColor <> AValue then
  begin
    FBackgroundColor := AValue;
    repaint;
  end;
end;

procedure TTileItem.SetZoomFactor(AValue: Single);
begin
  if AValue < cZoomIn then
    AValue := cZoomIn;
  if AValue > cZoomOut then
    AValue := cZoomOut;

  if FZoomFactor <> AValue then
  begin
    FZoomFactor := AValue;
    repaint;
  end;
end;

procedure TTileItem.Paint;
var
  w, h: Single;
  R: TRectF;

begin
  if Locked then
    Exit;

  w := Width * FZoomFactor;
  h := Height * FZoomFactor;
  R := RectF((Width - w) / 2, (Height - h) / 2, w, h);

  Canvas.Fill.Color := FBackgroundColor;
  Canvas.FillRect(R, 5, 5, AllCorners, AbsoluteOpacity);
end;

end.
Ich hab das jetzt wie folgt gemacht. Das DoEnter macht den ganzen "magischen" Kram. So richtig schön finde ich das mit den Scrollen nicht, aber es geht. @Rollo: Vielleicht hast du ja eine bessere Idee.

Peter
  Mit Zitat antworten Zitat
CHackbart

Registriert seit: 22. Okt 2012
260 Beiträge
 
#12

AW: Leanback

  Alt 9. Sep 2019, 20:55
Das ist ja ne coole Idee. Ich war so frei und hab das mal etwas weitergesponnen.

Delphi-Quellcode:
unit UTilesGrid;

interface

uses System.SysUtils, System.Classes, System.Types, System.UITypes,
  FMX.Graphics, FMX.Types, FMX.Controls, FMX.Layouts, FMX.StdCtrls,
  System.Generics.Collections;

type
  TTileItem = class(TControl)
  protected
    FZoomFactor: Single;
    FBackgroundColor: TAlphaColor;
    FOnPaint: TNotifyEvent;

    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;

    procedure SetZoomFactor(AValue: Single);
    procedure SetBackgroundColor(AValue: TAlphaColor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BackgroundColor: TAlphaColor read FBackgroundColor
      write SetBackgroundColor;
    property ZoomFactor: Single read FZoomFactor write SetZoomFactor;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  end;

  TTileRow = class(TControl)
  protected
    FTiles: TObjectList<TTileItem>;
    FItemIndex: Integer;
    FScrollBox: THorzScrollBox;
    FTitle: TLabel;
    FSelected: TTileItem;

    function GetCount: Integer;
    function GetItem(AIndex: Integer): TTileItem;

    procedure SetItemIndex(AIndex: Integer);

    function GetScrollPos: Single;
    procedure SetScrollPos(const AValue: Single);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function Add: TTileItem;
    procedure Delete(const AIndex: Integer);

    procedure ScrollIntoView(const AItem: TTileItem);

    property Items[index: Integer]: TTileItem read GetItem; default;
    property Count: Integer read GetCount;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;

  published
    property ScrollPos: Single read GetScrollPos write SetScrollPos;
    property Title: TLabel read FTitle;
    property Scale;
  end;

  TTileGrid = class(TControl)
  protected
    FRows: TObjectList<TTileRow>;
    FItemIndex: Integer;

    FScrollBox: TVertScrollBox;
    function GetItem(AIndex: Integer): TTileRow;
    function GetCount: Integer;
    procedure SetItemIndex(AIndex: Integer);

    function GetScrollPos: Single;
    procedure SetScrollPos(const AValue: Single);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ScrollIntoView(const AItem: TTileRow);

    function Add: TTileRow;
    procedure Delete(const AIndex: Integer);

    property Items[index: Integer]: TTileRow read GetItem; default;
    property Count: Integer read GetCount;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
  published
    property ScrollPos: Single read GetScrollPos write SetScrollPos;
    property Scale;
  end;

implementation

uses FMX.Ani;

const
  cZoomIn = 0.9;
  cZoomOut = 1.0;
  cZoomTime = 0.2;

type
  TCustomScrollBoxCracker = class(TCustomScrollBox);

function IfThen(const AState: Boolean; const ATrue, AFalse: Integer)
  : Integer; inline;
begin
  if AState then
    result := ATrue
  else
    result := AFalse;
end;

{ TTileItem }
constructor TTileItem.Create(AOwner: TComponent);
begin
  inherited;
  CanFocus := true;
  ZoomFactor := 0;
  FBackgroundColor := TAlphaColors.Gray;
end;

destructor TTileItem.Destroy;
begin
  inherited;
end;

procedure TTileItem.DoEnter;
begin
  BringToFront;
  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomOut, cZoomTime,
    TAnimationType.Out, TInterpolationType.Quadratic);

  if Owner is TTileRow then
    TTileRow(Owner).ScrollIntoView(self);
end;

procedure TTileItem.DoExit;
begin
  SendToBack;
  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomIn, cZoomTime, TAnimationType.
    In, TInterpolationType.Linear);
end;

procedure TTileItem.SetBackgroundColor(AValue: TAlphaColor);
begin
  if FBackgroundColor <> AValue then
  begin
    FBackgroundColor := AValue;
    repaint;
  end;
end;

procedure TTileItem.SetZoomFactor(AValue: Single);
begin
  if AValue < cZoomIn then
    AValue := cZoomIn;
  if AValue > cZoomOut then
    AValue := cZoomOut;

  if FZoomFactor <> AValue then
  begin
    FZoomFactor := AValue;
    repaint;
  end;
end;

procedure TTileItem.Paint;
var
  w, h: Single;
  R: TRectF;

begin
  if Locked then
    Exit;

  w := Width * FZoomFactor;
  h := Height * FZoomFactor;
  R := RectF((Width - w) / 2, (Height - h) / 2, w, h);

  Canvas.Fill.Color := FBackgroundColor;
  Canvas.FillRect(R, 5, 5, AllCorners, AbsoluteOpacity);
  if assigned(FOnPaint) then
    FOnPaint(self);
end;

{ TTileRow }
constructor TTileRow.Create(AOwner: TComponent);
begin
  inherited;
  Height := 300;

  FTiles := TObjectList<TTileItem>.Create(true);
  FItemIndex := -1;
  FTitle := TLabel.Create(self);
  FTitle.Parent := self;
  FTitle.Align := TAlignLayout.Top;
  FTitle.Text := 'RowTitle';

  FScrollBox := THorzScrollBox.Create(self);
  FScrollBox.Parent := self;
  FScrollBox.Align := TAlignLayout.Client;
  FScrollBox.ShowScrollBars := false;
  HitTest := true;
end;

destructor TTileRow.Destroy;
begin
  FTiles.Free;
  FScrollBox.Free;
  inherited;
end;

function TTileRow.GetCount: Integer;
begin
  result := FTiles.Count;
end;

function TTileRow.Add: TTileItem;
begin
  result := TTileItem.Create(self);
  result.Parent := FScrollBox;
  FTiles.Add(result);
end;

function TTileRow.GetScrollPos: Single;
begin
  if assigned(TCustomScrollBoxCracker(FScrollBox).HScrollBar) then
    result := TCustomScrollBoxCracker(FScrollBox).HScrollBar.Value;
end;

procedure TTileRow.SetScrollPos(const AValue: Single);
begin
  if assigned(TCustomScrollBoxCracker(FScrollBox).HScrollBar) then
    TCustomScrollBoxCracker(FScrollBox).HScrollBar.Value := AValue;
end;

procedure TTileRow.ScrollIntoView(const AItem: TTileItem);
var
  NewScrollViewPos: Single;
  MinWidth, MinHeight: Single;
begin
  if FSelected <> AItem then
  begin
    NewScrollViewPos := ScrollPos;
    MinWidth := 0;
    MinHeight := 0;

    if (AItem.BoundsRect.Left - NewScrollViewPos < MinWidth) then
      NewScrollViewPos := AItem.BoundsRect.Left;

    if (AItem.BoundsRect.Right - NewScrollViewPos > FScrollBox.Width) then
      NewScrollViewPos := AItem.BoundsRect.Right - FScrollBox.Width;

    TAnimator.AnimateFloat(self, 'ScrollPos', NewScrollViewPos, cZoomTime,
      TAnimationType.In, TInterpolationType.Linear);

    FItemIndex := FTiles.IndexOf(AItem);

    FSelected := AItem;
  end;

  if Owner is TTileGrid then
    TTileGrid(Owner).ScrollIntoView(self);

end;

procedure TTileRow.Delete(const AIndex: Integer);
begin
  FTiles.Delete(AIndex);
end;

function TTileRow.GetItem(AIndex: Integer): TTileItem;
begin
  if (AIndex >= 0) and (AIndex < FTiles.Count) then
    result := FTiles[AIndex]
  else
    result := nil;
end;

procedure TTileRow.SetItemIndex(AIndex: Integer);
begin
  if AIndex < 0 then
    AIndex := Count - 1
  else if AIndex >= Count then
    AIndex := 0;

  FTiles[AIndex].SetFocus;
end;

{ TTileGrid }

constructor TTileGrid.Create(AOwner: TComponent);
begin
  inherited;
  FRows := TObjectList<TTileRow>.Create;
  FItemIndex := -1;
  FScrollBox := TVertScrollBox.Create(self);
  FScrollBox.Parent := self;
  FScrollBox.Align := TAlignLayout.Client;
  FScrollBox.ShowScrollBars := false;
  HitTest := true;
end;

destructor TTileGrid.Destroy;
begin
  FRows.Free;
  FScrollBox.Free;
  inherited;
end;

function TTileGrid.GetItem(AIndex: Integer): TTileRow;
begin
  result := FRows[AIndex];
end;

function TTileGrid.GetCount: Integer;
begin
  result := FRows.Count;
end;

function TTileGrid.Add: TTileRow;
begin
  result := TTileRow.Create(self);
  FRows.Add(result);

  result.Parent := FScrollBox;
  result.Align := TAlignLayout.Top;
end;

procedure TTileGrid.Delete(const AIndex: Integer);
begin
  FRows.Delete(AIndex);
end;

procedure TTileGrid.SetItemIndex(AIndex: Integer);
begin
  if AIndex < 0 then
    AIndex := Count - 1
  else if AIndex >= Count then
    AIndex := 0;

  with FRows[AIndex] do
    ItemIndex := IfThen(ItemIndex = -1, 0, ItemIndex);
end;

function TTileGrid.GetScrollPos: Single;
begin
  if assigned(TCustomScrollBoxCracker(FScrollBox).VScrollBar) then
    result := TCustomScrollBoxCracker(FScrollBox).VScrollBar.Value;
end;

procedure TTileGrid.SetScrollPos(const AValue: Single);
begin
  if assigned(TCustomScrollBoxCracker(FScrollBox).VScrollBar) then
    TCustomScrollBoxCracker(FScrollBox).VScrollBar.Value := AValue;
end;

procedure TTileGrid.ScrollIntoView(const AItem: TTileRow);
var
  NewScrollViewPos: Single;
  MinWidth, MinHeight: Single;
  i: Integer;
begin
  NewScrollViewPos := ScrollPos;
  MinWidth := 0;
  MinHeight := 0;

  if (AItem.BoundsRect.Top - NewScrollViewPos < MinHeight) then
    NewScrollViewPos := AItem.BoundsRect.Top;

  if (AItem.BoundsRect.Bottom - NewScrollViewPos > FScrollBox.Height) then
    NewScrollViewPos := AItem.BoundsRect.Bottom - FScrollBox.Height;

  TAnimator.AnimateFloat(self, 'ScrollPos', NewScrollViewPos, cZoomTime,
    TAnimationType.In, TInterpolationType.Linear);

  AItem.SetFocus;
  FItemIndex := FRows.IndexOf(AItem);
end;

end.
Die Tiles zeichne ich bei dem OnPaint Notify und lade das selbe Bild als Hintergrund von dem TTileGrid. Man könnte die aktive Reihe noch mittels Scale Property vergrößern, aber so schaut es auch schon schick aus. Danke für den Ansatz.

Christian
PS: Das ganze geht auch noch einfacher und sauberer, aber ich dachte probiere ich einfach mal 100 Reihen mit jeweils 100 Einträgen. Die Idee war abzuschätzen, ob sich das wirklich lohnt so umzusetzen und es geht erstaunlich gut. Beim vertikalen Scrollen auf einem Touchpad ist das ganze jedoch etwas unschön. Da bleibt das Scrollen gerne hängen, wenn sich ein Icon in der Reihe in den Focus bewegt.
Miniaturansicht angehängter Grafiken
screenshot_2019-09-09-20-50-15-085_com.hackbart.launcher.jpg  

Geändert von CHackbart ( 9. Sep 2019 um 21:05 Uhr) Grund: Rechtschreibfehler
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.336 Beiträge
 
Delphi 11 Alexandria
 
#13

AW: Leanback

  Alt 10. Sep 2019, 10:15
Kann man da mal etwas kurzes bewegtes sehen?
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
CHackbart

Registriert seit: 22. Okt 2012
260 Beiträge
 
#14

AW: Leanback

  Alt 10. Sep 2019, 10:25
Klar, gerne.

Das ist jetzt ohne Grafiken. Es ist denke ich das was Peter bewerkstelligen wollte. Die Tiles mit Bildern und Texten zu versehen ist ja denke ich nur Fleißarbeit. Ich bin eigentlich nicht der Mensch der Labels und sonstige Komponenten in eine Komponente hämmert, aber ich glaube bei Firemonkey ist das in Ordnung.

Christian
Angehängte Dateien
Dateityp: zip tilesgrid.zip (3,6 KB, 14x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.336 Beiträge
 
Delphi 11 Alexandria
 
#15

AW: Leanback

  Alt 10. Sep 2019, 10:34
Habe jetzt kein Delphi. Schaue ich mir heute Abend unbedingt an.
GUI-Ideen finde ich immer spannend.
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
CHackbart

Registriert seit: 22. Okt 2012
260 Beiträge
 
#16

AW: Leanback

  Alt 10. Sep 2019, 11:01
Das ist jetzt kein hübsches Beispiel, aber sowas ist das Leanback: https://www.youtube.com/watch?v=j8R7FEg8rzw
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:53 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz