GLScene/Source/GLS.Gui.pas

//
// The graphics engine GLScene https://github.com/glscene
//
unit GLS.Gui;

(* Windows management classes and structures *)

interface

{$I GLScene.Defines.inc}

uses
  Winapi.OpenGL,
  System.Classes,
  System.SysUtils,
  System.Types,

  GLScene.OpenGLTokens,
  GLScene.VectorTypes,
  GLScene.VectorGeometry,

  GLS.Scene,
  GLS.BitmapFont,
  GLS.Material,
  GLS.Context,
  GLScene.PersistentClasses,
  GLScene.Coordinates,
  GLScene.BaseClasses;

type

  TGLBaseGuiObject = class(TGLBaseSceneObject)
  private
    FRecursiveVisible: Boolean;
    FWidth: Single;
    FHeight: Single;
  protected
    // self notification on hide. Also notifies children.
    procedure NotifyHide; virtual;
    // child notification on show. Also notifies children.
    procedure NotifyShow; virtual;
    procedure SetLeft(const Value: TGLFloat);
    function GetLeft: TGLFloat;
    procedure SetTop(const Value: TGLFloat);
    function GetTop: TGLFloat;
    procedure SetWidth(const val: Single);
    procedure SetHeight(const val: Single);
    procedure SetVisible(aValue: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AddChild(AChild: TGLBaseSceneObject); override;
    procedure Insert(aIndex: Integer; AChild: TGLBaseSceneObject); override;
    // GuiComponent Width in 3D world units.
    property Width: Single read FWidth write SetWidth;
    // GuiComponent Height in 3D world units.
    property Height: Single read FHeight write SetHeight;
    // GuiComponent Left in 3D world units.
    property Left: TGLFloat read GetLeft write SetLeft;
    // GuiComponent Top in 3D world units.
    property Top: TGLFloat read GetTop write SetTop;
    property RecursiveVisible: Boolean read FRecursiveVisible;
  end;

  TGUIAlignments = (GLAlTopLeft, GLAlTop, GLAlTopRight, GLAlLeft, GLAlCenter,
    GLAlRight, GLAlBottomLeft, GLAlBottom, GLAlBottomRight, GLAlBorder);

  TGUIRect = record
    X1: TGLFloat;
    Y1: TGLFloat;
    X2: TGLFloat;
    Y2: TGLFloat;
    XTiles: TGLFloat;
    YTiles: TGLFloat;
  end;

  TGUIDrawResult = array [TGUIAlignments] of TGUIRect;

  TGLGuiElementName = string;

  TGLGuiElement = class(TCollectionItem)
  private
    FTopLeft: TgCoordinates2;
    FBottomRight: TgCoordinates2;
    FScale: TgCoordinates2;
    FAlign: TGUIAlignments;
    FName: TGLGuiElementName;
  protected
    function GetDisplayName: string; override;
    procedure SetName(const val: TGLGuiElementName);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AssignTo(Dest: TPersistent); override;
  published
    property TopLeft: TgCoordinates2 read FTopLeft write FTopLeft;
    property BottomRight: TgCoordinates2 read FBottomRight write FBottomRight;
    property Scale: TgCoordinates2 read FScale write FScale;
    property Align: TGUIAlignments read FAlign write FAlign;
    property Name: TGLGuiElementName read FName write SetName;
  end;

  TGLGuiComponent = class;

  TGLGuiElementList = class(TOwnedCollection)
  private
    FGuiComponent: TGLGuiComponent;
  protected
    procedure SetItems(index: Integer; const val: TGLGuiElement);
    function GetItems(index: Integer): TGLGuiElement;
  public
    constructor Create(AOwner: TGLGuiComponent);
    procedure AssignTo(Dest: TPersistent); override;

    function GetOwner: TPersistent; override;
    function IndexOf(const Item: TGLGuiElement): Integer;
    property Items[index: Integer]: TGLGuiElement read GetItems
      write SetItems; default;
  end;

  TGLGuiComponentName = string;
  TGLGuiComponentList = class;

  TGLGuiComponent = class(TCollectionItem)
  private
    FElements: TGLGuiElementList;
    FName: TGLGuiComponentName;
  protected
    function GetDisplayName: string; override;
    procedure SetName(const val: TGLGuiComponentName);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure RenderToArea(X1, Y1, X2, Y2: TGLFloat; var Res: TGUIDrawResult;
      Refresh: Boolean = True; Scale: TGLFloat = 1);
    function GetOwnerList: TGLGuiComponentList;
    property Owner: TGLGuiComponentList read GetOwnerList;
  published
    property Elements: TGLGuiElementList read FElements write FElements;
    property Name: TGLGuiComponentName read FName write SetName;
  end;

  TGLGuiLayout = class;

  TGLGuiComponentList = class(TOwnedCollection)
  private
    FLayout: TGLGuiLayout;
  protected
    procedure SetItems(index: Integer; const val: TGLGuiComponent);
    function GetItems(index: Integer): TGLGuiComponent;
  public
    constructor Create(AOwner: TGLGuiLayout);
    function GetOwner: TPersistent; override;
    function FindItem(name: TGLGuiComponentName): TGLGuiComponent;
    property Items[index: Integer]: TGLGuiComponent read GetItems
      write SetItems; default;
  end;

  TGLGuiLayout = class(TGUpdateAbleComponent)
  private
    FBitmapFont: TGLCustomBitmapFont;
    FMaterial: TGLMaterial;
    FGuiComponents: TGLGuiComponentList;
    FFileName: string;
    FGuiComponentList: TList;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetFileName(newName: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(FN: string);
    procedure Clear;
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(FN: string);
    procedure AddGuiComponent(Component: TGUpdateAbleComponent);
    procedure RemoveGuiComponent(Component: TGUpdateAbleComponent);
    procedure NotifyChange(Sender: TObject); override;
  published
    property BitmapFont: TGLCustomBitmapFont read FBitmapFont write FBitmapFont;
    property Material: TGLMaterial read FMaterial write FMaterial;
    property GuiComponents: TGLGuiComponentList read FGuiComponents
      write FGuiComponents;
    property FileName: string read FFileName write SetFileName;
  end;

const
  GuiNullRect: TGUIRect = (X1: 0.0; Y1: 0.0; X2: 0.0; Y2: 0.0; XTiles: 0.0;
    YTiles: 0.0);

function IsInRect(const R: TGUIRect; X, Y: Single): Boolean; inline;

// ------------------------------------------------------
implementation
// ------------------------------------------------------

function IsInRect(const R: TGUIRect; X, Y: Single): Boolean; inline;

begin
  Result := (R.X1 <= X) and (R.X2 >= X) and (R.Y1 <= Y) and (R.Y2 >= Y);
end;

// ------------------
// ------------------ TGLBaseGuiObject ------------------
// ------------------

constructor TGLBaseGuiObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRecursiveVisible := Visible;
end;

procedure TGLBaseGuiObject.SetLeft(const Value: TGLFloat);
var
  NewPosX: TGLFloat;
  i: Integer;
  Diff: TGLFloat;
begin
  if Assigned(Parent) and (Parent is TGLBaseGuiObject) then
    NewPosX := (Parent as TGLBaseGuiObject).Position.X + Value
  else
    NewPosX := Value;

  if Position.X <> NewPosX then
  begin
    Diff := NewPosX - Position.X;
    Position.X := NewPosX;

    for i := 0 to Count - 1 do
      if Children[i] is TGLBaseGuiObject then
      begin
        (Children[i] as TGLBaseGuiObject).Left :=
          (Children[i] as TGLBaseGuiObject).Left + Diff;
      end;
  end;
end;

function TGLBaseGuiObject.GetLeft: TGLFloat;
begin
  if Assigned(Parent) and (Parent is TGLBaseGuiObject) then
    Result := Position.X - (Parent as TGLBaseGuiObject).Position.X
  else
    Result := Position.X;
end;

procedure TGLBaseGuiObject.SetTop(const Value: TGLFloat);
var
  NewPosY: TGLFloat;
  i: Integer;
  Diff: TGLFloat;
begin
  if Assigned(Parent) and (Parent is TGLBaseGuiObject) then
    NewPosY := (Parent as TGLBaseGuiObject).Position.Y + Value
  else
    NewPosY := Value;

  if Position.Y <> NewPosY then
  begin
    Diff := NewPosY - Position.Y;
    Position.Y := NewPosY;

    for i := 0 to Count - 1 do
      if Children[i] is TGLBaseGuiObject then
      begin
        (Children[i] as TGLBaseGuiObject).Top :=
          (Children[i] as TGLBaseGuiObject).Top + Diff;
      end;
  end;
end;

function TGLBaseGuiObject.GetTop: TGLFloat;
begin
  if Assigned(Parent) and (Parent is TGLBaseGuiObject) then
    Result := Position.Y - (Parent as TGLBaseGuiObject).Position.Y
  else
    Result := Position.Y;
end;

procedure TGLBaseGuiObject.SetWidth(const val: TGLFloat);
begin
  if FWidth <> val then
  begin
    FWidth := val;
    NotifyChange(Self);
  end;
end;

procedure TGLBaseGuiObject.SetHeight(const val: TGLFloat);
begin
  if FHeight <> val then
  begin
    FHeight := val;
    NotifyChange(Self);
  end;
end;

procedure TGLBaseGuiObject.NotifyHide;
var
  child: TGLBaseSceneObject;
  xc: Integer;
begin
  if RecursiveVisible then
  begin
    FRecursiveVisible := False;
    for xc := 0 to Count - 1 do
    begin
      child := Children[xc];
      if child is TGLBaseGuiObject then
        TGLBaseGuiObject(child).NotifyHide;
    end;
  end;
end;

procedure TGLBaseGuiObject.NotifyShow;
var
  child: TGLBaseSceneObject;
  xc: Integer;
begin
  if not RecursiveVisible then
  begin
    FRecursiveVisible := True;
    for xc := 0 to Count - 1 do
    begin
      child := Children[xc];
      if child is TGLBaseGuiObject then
        TGLBaseGuiObject(child).NotifyShow;
    end;
  end;
end;

procedure TGLBaseGuiObject.AddChild(AChild: TGLBaseSceneObject);
begin
  inherited;
  if AChild is TGLBaseGuiObject then
  begin
    if RecursiveVisible then
      TGLBaseGuiObject(AChild).NotifyShow
    else
      TGLBaseGuiObject(AChild).NotifyHide;
  end;
end;

procedure TGLBaseGuiObject.Insert(aIndex: Integer; AChild: TGLBaseSceneObject);
begin
  inherited;
  if AChild is TGLBaseGuiObject then
  begin
    if RecursiveVisible then
      TGLBaseGuiObject(AChild).NotifyShow
    else
      TGLBaseGuiObject(AChild).NotifyHide;
  end;
end;

procedure TGLBaseGuiObject.SetVisible(aValue: Boolean);
begin
  if Visible <> aValue then
  begin
    inherited SetVisible(aValue);
    if aValue then
    begin
      if Parent <> nil then
        if Parent is TGLBaseGuiObject then
        begin
          if TGLBaseGuiObject(Parent).RecursiveVisible then
            NotifyShow;
        end
        else
        begin
          if Parent.Visible then
            NotifyShow;
        end;
    end
    else
    begin
      if RecursiveVisible then
        NotifyHide;
    end;
  end;
end;

constructor TGLGuiLayout.Create(AOwner: TComponent);
begin
  FGuiComponentList := TList.Create;
  inherited;
  FGuiComponents := TGLGuiComponentList.Create(Self);
  FMaterial := TGLMaterial.Create(Self);
end;

destructor TGLGuiLayout.Destroy;
begin
  Clear;
  FMaterial.Free;
  FGuiComponents.Free;
  inherited;
  FGuiComponentList.Free;
end;

procedure TGLGuiLayout.SetFileName(newName: string);
begin
  if newName <> FFileName then
  begin
    FFileName := newName;
    if FileExists(FFileName) then
    begin
      Clear;
      LoadFromFile(FFileName);
    end;
  end;
end;

procedure TGLGuiLayout.LoadFromFile(FN: string);
var
  Stream: TMemoryStream;

begin
  Stream := TMemoryStream.Create;
  try
    Stream.LoadFromFile(FN);
    LoadFromStream(Stream);
    FFileName := FN;
  finally
    Stream.Free;
  end;
end;

procedure TGLGuiLayout.SaveToFile(FN: string);
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    SaveToStream(Stream);
    Stream.SaveToFile(FN);
    FFileName := FN;
  finally
    Stream.Free;
  end;
end;

procedure TGLGuiLayout.AddGuiComponent(Component: TGUpdateAbleComponent);
begin
  if FGuiComponentList.IndexOf(Component) < 0 then
  begin
    FreeNotification(Component);
    FGuiComponentList.Add(Component);
  end;
end;

procedure TGLGuiLayout.RemoveGuiComponent(Component: TGUpdateAbleComponent);
begin
  FGuiComponentList.Remove(Component);
  RemoveFreeNotification(Component);
end;

procedure TGLGuiLayout.Assign(Source: TPersistent);
var
  LLayout: TGLGuiLayout;
  LComponent: TGLGuiComponent;
  i: Integer;
begin
  if Source is TGLGuiLayout then
  begin
    LLayout := TGLGuiLayout(Source);
    FBitmapFont := LLayout.FBitmapFont;
    FMaterial.Assign(LLayout.Material);
    FFileName := LLayout.FFileName;
    Clear;
    for i := 0 to LLayout.FGuiComponents.Count - 1 do
    begin
      LComponent := TGLGuiComponent(FGuiComponents.Add);
      LLayout.FGuiComponents[i].AssignTo(LComponent);
      LComponent.name := LLayout.FGuiComponents[i].name;
    end;
    for i := 0 to FGuiComponentList.Count - 1 do
      TGUpdateAbleComponent(FGuiComponentList[i]).RemoveFreeNotification(Self);
    FGuiComponentList.Assign(LLayout.FGuiComponentList);
    for i := 0 to FGuiComponentList.Count - 1 do
      TGUpdateAbleComponent(FGuiComponentList[i]).FreeNotification(Self);
  end
  else
    inherited; // Assign Error
end;

procedure TGLGuiLayout.Clear;
var
  xc: Integer;

begin
  for xc := FGuiComponents.Count - 1 downto 0 do
  begin
    FGuiComponents.Delete(xc);
  end;
  NotifyChange(Self);
end;

procedure TGLGuiLayout.NotifyChange(Sender: TObject);
var
  xc: Integer;
begin
  inherited;
  for xc := FGuiComponentList.Count - 1 downto 0 do
    TGUpdateAbleComponent(FGuiComponentList[xc]).NotifyChange(Self);
end;

procedure TGLGuiLayout.LoadFromStream(Stream: TStream);

var
  TmpComponent: TGLGuiComponent;
  xc, YC, ZC: Integer;
  TmpElement: TGLGuiElement;
  TmpAlignment: TGUIAlignments;
  Version: Integer;
  Data: TGBinaryReader;

begin
  Data := TGBinaryReader.Create(Stream);
  try

    Version := Data.ReadInteger;
    if Version <> 1 then
      Exit;

    for xc := 0 to Data.ReadInteger - 1 do
    begin
      TmpComponent := FGuiComponents.Add as TGLGuiComponent;
      TmpComponent.FName := Data.ReadString;
      for YC := 0 to Data.ReadInteger - 1 do
      begin
        TmpElement := TmpComponent.FElements.Add as TGLGuiElement;
        TmpElement.FName := Data.ReadString;
        TmpElement.FTopLeft.X := Data.ReadFloat;
        TmpElement.FTopLeft.Y := Data.ReadFloat;
        TmpElement.FTopLeft.Z := Data.ReadFloat;
        TmpElement.FBottomRight.X := Data.ReadFloat;
        TmpElement.FBottomRight.Y := Data.ReadFloat;
        TmpElement.FBottomRight.Z := Data.ReadFloat;
        TmpElement.FScale.X := Data.ReadFloat;
        TmpElement.FScale.Y := Data.ReadFloat;
        TmpElement.FScale.Z := Data.ReadFloat;
        for ZC := 0 to Data.ReadInteger - 1 do
        begin
          TmpAlignment := TGUIAlignments(Data.ReadInteger);
          TmpElement.FAlign := TmpAlignment;
        end;
      end;
    end;
  finally
    Data.Free;
  end;
  NotifyChange(Self);
end;

procedure TGLGuiLayout.SaveToStream(Stream: TStream);
var
  TmpComponent: TGLGuiComponent;
  Alignments, xc, YC: Integer;
  TmpElement: TGLGuiElement;
  TmpAlignment: TGUIAlignments;
  Data: TGBinaryWriter;

begin
  Data := TGBinaryWriter.Create(Stream);
  try
    Data.WriteInteger(1);
    Data.WriteInteger(FGuiComponents.Count);
    for xc := 0 to FGuiComponents.Count - 1 do
    begin
      TmpComponent := FGuiComponents.Items[xc];
      Data.WriteString(TmpComponent.FName);
      Data.WriteInteger(TmpComponent.FElements.Count);

      for YC := 0 to TmpComponent.FElements.Count - 1 do
      begin
        TmpElement := TmpComponent.FElements.Items[YC];

        Data.WriteString(TmpElement.FName);

        Data.WriteFloat(TmpElement.FTopLeft.X);
        Data.WriteFloat(TmpElement.FTopLeft.Y);
        Data.WriteFloat(TmpElement.FTopLeft.Z);

        Data.WriteFloat(TmpElement.FBottomRight.X);
        Data.WriteFloat(TmpElement.FBottomRight.Y);
        Data.WriteFloat(TmpElement.FBottomRight.Z);

        Data.WriteFloat(TmpElement.FScale.X);
        Data.WriteFloat(TmpElement.FScale.Y);
        Data.WriteFloat(TmpElement.FScale.Z);

        Alignments := 0;
        for TmpAlignment := GLAlTopLeft to GLAlBorder do
        begin
          if TmpAlignment = TmpElement.FAlign then
            inc(Alignments);
        end;

        Data.WriteInteger(Alignments);
        for TmpAlignment := GLAlTopLeft to GLAlBorder do
        begin
          if TmpAlignment = TmpElement.FAlign then
            Data.WriteInteger(Integer(TmpAlignment));
        end;
      end;
    end;
  finally
    Data.Free;
  end;
end;

constructor TGLGuiComponentList.Create(AOwner: TGLGuiLayout);
begin
  inherited Create(AOwner, TGLGuiComponent);
  FLayout := AOwner;
end;

function TGLGuiComponentList.GetOwner: TPersistent;
begin
  Result := FLayout;
end;

procedure TGLGuiComponentList.SetItems(index: Integer;
  const val: TGLGuiComponent);
begin
  inherited Items[index] := val;
end;

function TGLGuiComponentList.FindItem(name: TGLGuiComponentName)
  : TGLGuiComponent;
var
  xc: Integer;
  gc: TGLGuiComponent;
begin
  Result := nil;
  if Name = '' then
    Exit;
  for xc := 0 to Count - 1 do
  begin
    gc := Items[xc];
    if gc.FName = Name then
    begin
      Result := gc;
      Break;
    end;
  end;
end;

function TGLGuiComponentList.GetItems(index: Integer): TGLGuiComponent;
begin
  Result := TGLGuiComponent(inherited Items[index]);
end;

procedure TGLGuiComponent.RenderToArea(X1, Y1, X2, Y2: TGLFloat;
  var Res: TGUIDrawResult; Refresh: Boolean = True; Scale: TGLFloat = 1);
var
  xc: Integer;
  ThisElement: TGLGuiElement;
  W, H: TGLFloat;
  Len1, Len2: TGLFloat;
  Layout: TGLGuiLayout;
  LibMaterial: TGLLibMaterial;
  Material: TGLMaterial;
  TexWidth, TexHeight: TGLFloat;
  AlignCount: TGUIAlignments;

  procedure Prepare;
  begin
    Len1 := (ThisElement.FTopLeft.X - ThisElement.FBottomRight.X) *
      ThisElement.Scale.X * Scale;
    Len2 := (ThisElement.FTopLeft.Y - ThisElement.FBottomRight.Y) *
      ThisElement.Scale.Y * Scale;
    if Len1 < 0 then
    begin
      if Len2 < 0 then
      begin
        W := -Len1;
        H := -Len2;
      end
      else
      begin
        W := -Len1;
        H := Len2;
      end;
    end
    else
    begin
      if Len2 < 0 then
      begin
        W := Len1;
        H := -Len2;
      end
      else
      begin
        W := Len1;
        H := Len2;
      end;
    end;
  end;

  procedure RenderIt(var ARect: TGUIRect; AElement: TGLGuiElement);
  var
    xc: TGLFloat;
    YC: TGLFloat;
    XPos, X2Pos: TGLFloat;
    YPos, y2Pos: TGLFloat;
    tx1, ty1, tx2, ty2: TGLFloat;
    XTileSize, YTileSize: TGLFloat;
    tx3, ty3: TGLFloat;
    tx, ty: TGLFloat;

  begin
    if (ARect.XTiles = 1) and (ARect.YTiles = 1) then
    begin
      gl.TexCoord2f(AElement.TopLeft.X / TexWidth, -AElement.TopLeft.Y /
        TexHeight);
      gl.Vertex2f(ARect.X1, -ARect.Y1);

      gl.TexCoord2f(AElement.TopLeft.X / TexWidth, -AElement.BottomRight.Y /
        TexHeight);
      gl.Vertex2f(ARect.X1, -ARect.Y2);

      gl.TexCoord2f(AElement.BottomRight.X / TexWidth, -AElement.BottomRight.Y /
        TexHeight);
      gl.Vertex2f(ARect.X2, -ARect.Y2);

      gl.TexCoord2f(AElement.BottomRight.X / TexWidth,
        -AElement.TopLeft.Y / TexHeight);
      gl.Vertex2f(ARect.X2, -ARect.Y1);
    end
    else
    begin
      XTileSize := (ARect.X2 - ARect.X1) / ARect.XTiles;
      YTileSize := (ARect.Y2 - ARect.Y1) / ARect.YTiles;
      tx1 := AElement.TopLeft.X / TexWidth;
      ty1 := -AElement.TopLeft.Y / TexHeight;
      tx2 := AElement.BottomRight.X / TexWidth;
      ty2 := -AElement.BottomRight.Y / TexHeight;
      tx3 := (AElement.TopLeft.X + (AElement.BottomRight.X - AElement.TopLeft.X)
        * Frac(ARect.XTiles)) / TexWidth;
      ty3 := -(AElement.TopLeft.Y + (AElement.BottomRight.Y -
        AElement.TopLeft.Y) * Frac(ARect.YTiles)) / TexHeight;

      xc := ARect.XTiles;
      XPos := ARect.X1;
      tx := tx2;
      while xc > 0 do
      begin
        YC := ARect.YTiles;
        YPos := ARect.Y1;
        ty := ty2;

        if xc >= 1 then
          X2Pos := XPos + XTileSize
        else
        begin
          X2Pos := ARect.X2;
          tx := tx3;
        end;

        while YC > 0 do
        begin
          if YC >= 1 then
            y2Pos := YPos + YTileSize
          else
          begin
            y2Pos := ARect.Y2;
            ty := ty3;
          end;

          gl.TexCoord2f(tx1, ty1);
          gl.Vertex2f(XPos, -YPos);

          gl.TexCoord2f(tx1, ty);
          gl.Vertex2f(XPos, -y2Pos);

          gl.TexCoord2f(tx, ty);
          gl.Vertex2f(X2Pos, -y2Pos);

          gl.TexCoord2f(tx, ty1);
          gl.Vertex2f(X2Pos, -YPos);
          YC := YC - 1.0;
          YPos := y2Pos;
        end;
        xc := xc - 1.0;
        XPos := X2Pos;
      end;
    end;
  end;

  procedure RenderBorder(AElement: TGLGuiElement);
  var
    TmpElement: TGLGuiElement;

  begin
    TmpElement := TGLGuiElement.Create(nil);
    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X;
    TmpElement.FTopLeft.Y := ThisElement.FTopLeft.Y;
    TmpElement.FBottomRight.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FBottomRight.Y := ThisElement.FTopLeft.Y + ThisElement.Scale.Y;
    TmpElement.Scale.SetPoint2D(1, 1);
    RenderIt(Res[GLAlTopLeft], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FBottomRight.X := ThisElement.FBottomRight.X -
      ThisElement.Scale.X;
    RenderIt(Res[GLAlTop], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FBottomRight.X - ThisElement.Scale.X;
    TmpElement.FBottomRight.X := ThisElement.FBottomRight.X;
    RenderIt(Res[GLAlTopRight], TmpElement);

    TmpElement.FTopLeft.Y := ThisElement.FTopLeft.Y + ThisElement.Scale.Y;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y -
      ThisElement.Scale.Y;
    RenderIt(Res[GLAlRight], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FBottomRight.X - ThisElement.Scale.X;
    TmpElement.FTopLeft.Y := ThisElement.FBottomRight.Y - ThisElement.Scale.Y;
    TmpElement.FBottomRight.X := ThisElement.FBottomRight.X;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y;
    RenderIt(Res[GLAlBottomRight], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FTopLeft.Y := ThisElement.FBottomRight.Y - ThisElement.Scale.Y;
    TmpElement.FBottomRight.X := ThisElement.FBottomRight.X -
      ThisElement.Scale.X;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y;
    RenderIt(Res[GLAlBottom], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X;
    TmpElement.FTopLeft.Y := ThisElement.FBottomRight.Y - ThisElement.Scale.Y;
    TmpElement.FBottomRight.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y;
    RenderIt(Res[GLAlBottomLeft], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X;
    TmpElement.FTopLeft.Y := ThisElement.FTopLeft.Y + ThisElement.Scale.Y;
    TmpElement.FBottomRight.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y -
      ThisElement.Scale.Y;
    RenderIt(Res[GLAlLeft], TmpElement);

    TmpElement.FTopLeft.X := ThisElement.FTopLeft.X + ThisElement.Scale.X;
    TmpElement.FTopLeft.Y := ThisElement.FTopLeft.Y + ThisElement.Scale.Y;
    TmpElement.FBottomRight.X := ThisElement.FBottomRight.X -
      ThisElement.Scale.X;
    TmpElement.FBottomRight.Y := ThisElement.FBottomRight.Y -
      ThisElement.Scale.Y;
    RenderIt(Res[GLAlCenter], TmpElement);
  end;

begin
  Layout := ((GetOwner as TGLGuiComponentList).GetOwner as TGLGuiLayout);
  Material := nil;
  if Assigned(Layout.Material.MaterialLibrary) and
    (Layout.Material.MaterialLibrary is TGLMaterialLibrary) and
    (Layout.Material.LibMaterialName <> '') then
  begin
    LibMaterial := TGLMaterialLibrary(Layout.Material.MaterialLibrary)
      .Materials.GetLibMaterialByName(Layout.Material.LibMaterialName);
    if Assigned(LibMaterial) then
      Material := LibMaterial.Material;
  end;
  if not Assigned(Material) then
  begin
    Material := Layout.Material;
  end;

  if Refresh then
  begin
    Res[GLAlTopLeft].X1 := X1;
    Res[GLAlTopLeft].Y1 := Y1;
    Res[GLAlTopLeft].X2 := X1;
    Res[GLAlTopLeft].Y2 := Y1;

    Res[GLAlTopRight].X1 := X2;
    Res[GLAlTopRight].Y1 := Y1;
    Res[GLAlTopRight].X2 := X2;
    Res[GLAlTopRight].Y2 := Y1;

    Res[GLAlBottomLeft].X1 := X1;
    Res[GLAlBottomLeft].Y1 := Y2;
    Res[GLAlBottomLeft].X2 := X1;
    Res[GLAlBottomLeft].Y2 := Y2;

    Res[GLAlBottomRight].X1 := X2;
    Res[GLAlBottomRight].Y1 := Y2;
    Res[GLAlBottomRight].X2 := X2;
    Res[GLAlBottomRight].Y2 := Y2;

    for xc := 0 to FElements.Count - 1 do
    begin
      ThisElement := FElements[xc];
      if GLAlBorder = ThisElement.Align then
      begin
        Res[GLAlTopLeft].X1 := X1;
        Res[GLAlTopLeft].Y1 := Y1;
        Res[GLAlTopLeft].X2 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlTopLeft].Y2 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;

        Res[GLAlTop].X1 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlTop].Y1 := Y1;
        Res[GLAlTop].X2 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlTop].Y2 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;

        Res[GLAlTopRight].X1 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlTopRight].Y1 := Y1;
        Res[GLAlTopRight].X2 := X2;
        Res[GLAlTopRight].Y2 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;

        Res[GLAlRight].X1 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlRight].Y1 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlRight].X2 := X2;
        Res[GLAlRight].Y2 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;

        Res[GLAlBottomRight].X1 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottomRight].Y1 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottomRight].X2 := X2;
        Res[GLAlBottomRight].Y2 := Y2;

        Res[GLAlBottom].X1 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottom].Y1 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottom].X2 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottom].Y2 := Y2;

        Res[GLAlBottomLeft].X1 := X1;
        Res[GLAlBottomLeft].Y1 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottomLeft].X2 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlBottomLeft].Y2 := Y2;

        Res[GLAlLeft].X1 := X1;
        Res[GLAlLeft].Y1 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlLeft].X2 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlLeft].Y2 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;

        Res[GLAlCenter].X1 := X1 + ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlCenter].Y1 := Y1 + ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
        Res[GLAlCenter].X2 := X2 - ThisElement.Scale.X * Scale *
          ThisElement.Scale.Z;
        Res[GLAlCenter].Y2 := Y2 - ThisElement.Scale.Y * Scale *
          ThisElement.Scale.Z;
      end;

      if GLAlTopLeft = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlTopLeft].X1 := X1;
        Res[GLAlTopLeft].Y1 := Y1;
        Res[GLAlTopLeft].X2 := X1 + W;
        Res[GLAlTopLeft].Y2 := Y1 + H;
      end;
      if GLAlTopRight = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlTopRight].X1 := X2 - W;
        Res[GLAlTopRight].Y1 := Y1;
        Res[GLAlTopRight].X2 := X2;
        Res[GLAlTopRight].Y2 := Y1 + H;
      end;
      if GLAlBottomLeft = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlBottomLeft].X1 := X1;
        Res[GLAlBottomLeft].Y1 := Y2 - H;
        Res[GLAlBottomLeft].X2 := X1 + W;
        Res[GLAlBottomLeft].Y2 := Y2;
      end;
      if GLAlBottomRight = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlBottomRight].X1 := X2 - W;
        Res[GLAlBottomRight].Y1 := Y2 - H;
        Res[GLAlBottomRight].X2 := X2;
        Res[GLAlBottomRight].Y2 := Y2;
      end;
    end;

    Res[GLAlTop].X1 := Res[GLAlTopLeft].X2;
    Res[GLAlTop].Y1 := Res[GLAlTopRight].Y1;
    Res[GLAlTop].X2 := Res[GLAlTopRight].X1;
    Res[GLAlTop].Y2 := Res[GLAlTopLeft].Y2;

    Res[GLAlBottom].X1 := Res[GLAlBottomLeft].X2;
    Res[GLAlBottom].Y1 := Res[GLAlBottomLeft].Y1;
    Res[GLAlBottom].X2 := Res[GLAlBottomRight].X1;
    Res[GLAlBottom].Y2 := Res[GLAlBottomRight].Y2;

    Res[GLAlLeft].X1 := Res[GLAlTopLeft].X1;
    Res[GLAlLeft].Y1 := Res[GLAlTopLeft].Y2;
    Res[GLAlLeft].X2 := Res[GLAlBottomLeft].X2;
    Res[GLAlLeft].Y2 := Res[GLAlBottomLeft].Y1;

    Res[GLAlRight].X1 := Res[GLAlTopRight].X1;
    Res[GLAlRight].Y1 := Res[GLAlTopRight].Y2;
    Res[GLAlRight].X2 := Res[GLAlBottomRight].X2;
    Res[GLAlRight].Y2 := Res[GLAlBottomRight].Y1;

    for xc := 0 to FElements.Count - 1 do
    begin
      ThisElement := FElements[xc];
      if GLAlTop = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlTop].Y1 := Y1;
        Res[GLAlTop].Y2 := Y1 + H;
      end;
      if GLAlBottom = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlBottom].Y1 := Y2 - H;
        Res[GLAlBottom].Y2 := Y2;
      end;
      if GLAlLeft = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlLeft].X1 := X1;
        Res[GLAlLeft].X2 := X1 + W;
      end;
      if GLAlRight = ThisElement.Align then
      begin
        Prepare;
        Res[GLAlRight].X1 := X2 - W;
        Res[GLAlRight].X2 := X2;
      end;
    end;

    Res[GLAlCenter].X1 := Res[GLAlLeft].X2;
    Res[GLAlCenter].Y1 := Res[GLAlTop].Y2;
    Res[GLAlCenter].X2 := Res[GLAlRight].X1;
    Res[GLAlCenter].Y2 := Res[GLAlBottom].Y1;
  end;

  TexWidth := Material.Texture.TexWidth;
  if TexWidth = 0 then
    TexWidth := Material.Texture.Image.Width;

  TexHeight := Material.Texture.TexHeight;
  if TexHeight = 0 then
    TexHeight := Material.Texture.Image.Height;

  gl.Begin_(GL_QUADS);

  for xc := 0 to FElements.Count - 1 do
  begin
    ThisElement := FElements[xc];
    for AlignCount := GLAlTopLeft to GLAlBottomRight do
      if (AlignCount = ThisElement.Align) then
      begin
        if Refresh then
        begin
          Res[AlignCount].XTiles := ((Res[AlignCount].X2 - Res[AlignCount].X1) /
            (ThisElement.FBottomRight.X - ThisElement.FTopLeft.X)) /
            ThisElement.Scale.X;
          Res[AlignCount].YTiles := ((Res[AlignCount].Y2 - Res[AlignCount].Y1) /
            (ThisElement.FBottomRight.Y - ThisElement.FTopLeft.Y)) /
            ThisElement.Scale.Y;
        end;
        RenderIt(Res[AlignCount], ThisElement);
      end;
    if (GLAlBorder = ThisElement.Align) then
    begin
      RenderBorder(ThisElement);
    end;

  end;
  gl.End_;
end;

function TGLGuiComponent.GetOwnerList: TGLGuiComponentList;
begin
  Result := GetOwner as TGLGuiComponentList;
end;

function TGLGuiComponent.GetDisplayName: string;
begin
  Result := FName;
end;

procedure TGLGuiComponent.SetName(const val: TGLGuiComponentName);
begin
  FName := val;
end;

constructor TGLGuiComponent.Create(Collection: TCollection);
begin
  inherited;
  FElements := TGLGuiElementList.Create(Self);
end;

destructor TGLGuiComponent.Destroy;
begin
  FElements.Free;
  inherited;
end;

constructor TGLGuiElementList.Create(AOwner: TGLGuiComponent);
begin
  inherited Create(AOwner, TGLGuiElement);
  FGuiComponent := AOwner;
end;

function TGLGuiElementList.GetOwner: TPersistent;
begin
  Result := FGuiComponent;
end;

procedure TGLGuiElementList.SetItems(index: Integer; const val: TGLGuiElement);
begin
  inherited Items[index] := val;
end;

function TGLGuiElementList.IndexOf(const Item: TGLGuiElement): Integer;
var
  i: Integer;
begin
  Result := -1;
  if Count <> 0 then
    for i := 0 to Count - 1 do
      if GetItems(i) = Item then
      begin
        Result := i;
        Exit;
      end;
end;

function TGLGuiElementList.GetItems(index: Integer): TGLGuiElement;
begin
  Result := TGLGuiElement(inherited Items[index]);
end;

function TGLGuiElement.GetDisplayName: string;
begin
  Result := FName;
end;

procedure TGLGuiElement.SetName(const val: TGLGuiElementName);
begin
  FName := val;
end;

constructor TGLGuiElement.Create(Collection: TCollection);
begin
  inherited;
  FTopLeft := TgCoordinates2.CreateInitialized(Self, NullHmgVector, csPoint2D);
  FBottomRight := TgCoordinates2.CreateInitialized(Self, NullHmgVector,
    csPoint2D);
  FScale := TgCoordinates2.CreateInitialized(Self, XYHmgVector, csPoint2D);
end;

destructor TGLGuiElement.Destroy;
begin
  FTopLeft.Free;
  FBottomRight.Free;
  FScale.Free;
  inherited;
end;

procedure TGLGuiLayout.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if Operation = opRemove then
  begin
    if AComponent = FBitmapFont then
      BitmapFont := nil
    else
      FGuiComponentList.Remove(AComponent);
  end;
  NotifyChange(Self); // EG : looks suspicious...
  inherited;
end;

procedure TGLGuiComponent.AssignTo(Dest: TPersistent);
begin
  if Dest is TGLGuiComponent then
  begin
    TGLGuiComponent(Dest).Elements.Assign(Elements);
  end
  else
    inherited;
end;

procedure TGLGuiElementList.AssignTo(Dest: TPersistent);
var
  i: Integer;
begin
  if Dest is TGLGuiElementList then
  begin
    for i := 0 to Count - 1 do
    begin
      TGLGuiElementList(Dest).Add.Assign(Items[i]);
    end;
  end
  else
    inherited;
end;

procedure TGLGuiElement.AssignTo(Dest: TPersistent);
var
  element: TGLGuiElement;
begin
  if Dest is TGLGuiElement then
  begin
    element := TGLGuiElement(Dest);

    element.TopLeft.Assign(TopLeft);
    element.BottomRight.Assign(BottomRight);
    element.Scale.Assign(Scale);
    element.Align := Align;
    element.name := Name;
  end
  else
    inherited;
end;

end.