source: branches/overos/Os.Controls.pas

unit Os.Controls;

interface

uses
  Classes, SysUtils, Os.Types, Os.Graphics, Generics.Collections, Os.Mouse;

type

  { TControl }

  TControl = class
  private
    FOnClick: TNotifyEvent;
    FParentControl: TControl;
    FRectangle: TRectangle;
    FVisible: Boolean;
    function GetPosition: TPosition;
    function GetSize: TSize;
    procedure SetParentControl(AValue: TControl);
    procedure SetPosition(AValue: TPosition);
    procedure SetSize(AValue: TSize);
  protected
    procedure SetRectangle(AValue: TRectangle); virtual;
    procedure SetVisible(AValue: Boolean); virtual;
  public
    Canvas: TCanvas;
    Controls: TObjectList<TControl>;
    procedure MouseButtonDown(Pos: TPosition; Button: TMouseButton); virtual;
    procedure MouseButtonUp(Pos: TPosition; Button: TMouseButton); virtual;
    procedure MouseMove(Pos: TPosition); virtual;
    procedure Paint; virtual;
    constructor Create; virtual;
    destructor Destroy; override;
    property ParentControl: TControl read FParentControl write SetParentControl;
    property Visible: Boolean read FVisible write SetVisible;
    property Position: TPosition read GetPosition write SetPosition;
    property Size: TSize read GetSize write SetSize;
    property Rectangle: TRectangle read FRectangle write SetRectangle;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

  { TCanvasControl }

  TCanvasControl = class(TCanvas)
    Control: TControl;
    procedure DrawLine(P1, P2: TPosition; Color: TColor); override;
    procedure DrawArea(Rect: TRectangle; Color: TColor); override;
    procedure DrawText(P: TPosition; Color: TColor; Text: string); override;
    function GetTextSize(Text: string): TSize; override;
  end;

  { TButton }

  TButton = class(TControl)
  private
    FClicked: Boolean;
    FTitle: string;
    procedure SetClicked(AValue: Boolean);
    procedure SetTitle(AValue: string);
  public
    procedure MouseButtonDown(Pos: TPosition; Button: TMouseButton); override;
    procedure MouseButtonUp(Pos: TPosition; Button: TMouseButton); override;
    procedure Paint; override;
    property Clicked: Boolean read FClicked write SetClicked;
    property Title: string read FTitle write SetTitle;
  end;

  { TLabel }

  TLabel = class(TControl)
  private
    FTitle: string;
    procedure SetTitle(AValue: string);
  public
    procedure Paint; override;
    property Title: string read FTitle write SetTitle;
  end;

  { TEdit }

  TEdit = class(TControl)
  private
    FText: string;
    procedure SetText(AValue: string);
  public
    procedure Paint; override;
    property Text: string read FText write SetText;
  end;


implementation

{ TCanvasControl }

procedure TCanvasControl.DrawLine(P1, P2: TPosition; Color: TColor);
begin
  if Assigned(Control) and Assigned(Control.ParentControl) then
    Control.ParentControl.Canvas.DrawLine(P1 + Control.Rectangle.Position, P2 + Control.Rectangle.Position, Color);
end;

procedure TCanvasControl.DrawArea(Rect: TRectangle; Color: TColor);
begin
  if Assigned(Control) and Assigned(Control.ParentControl) then
    Control.ParentControl.Canvas.DrawArea(TRectangle.Create(Rect.Position + Control.Rectangle.Position,
      Rect.Size), Color);
end;

procedure TCanvasControl.DrawText(P: TPosition; Color: TColor; Text: string);
begin
  if Assigned(Control) and Assigned(Control.ParentControl) then
    Control.ParentControl.Canvas.DrawText(P + Control.Rectangle.Position, Color, Text);
end;

function TCanvasControl.GetTextSize(Text: string): TSize;
begin
  if Assigned(Control) and Assigned(Control.ParentControl) then
    Result := Control.ParentControl.Canvas.GetTextSize(Text);
end;

{ TControl }

procedure TControl.SetVisible(AValue: Boolean);
begin
  if FVisible = AValue then Exit;
  FVisible := AValue;
  if not FVisible then begin
    if Assigned(ParentControl) then ParentControl.Paint;
  end else Paint;
end;

procedure TControl.MouseButtonDown(Pos: TPosition; Button: TMouseButton);
var
  I: Integer;
begin
  for I := Controls.Count - 1 downto 0 do
    if Controls[I].Rectangle.Contains(Pos) then begin
      Controls[I].MouseButtonDown(Pos - Controls[I].Rectangle.Position, Button);
      Break;
    end;
end;

procedure TControl.MouseButtonUp(Pos: TPosition; Button: TMouseButton);
var
  I: Integer;
begin
  for I := Controls.Count - 1 downto 0 do
    if Controls[I].Rectangle.Contains(Pos) then begin
      Controls[I].MouseButtonUp(Pos - Controls[I].Rectangle.Position, Button);
      Break;
    end;
  if Assigned(FOnClick) then
    FOnClick(Self);
end;

procedure TControl.MouseMove(Pos: TPosition);
var
  I: Integer;
begin
  for I := Controls.Count - 1 downto 0 do
    if Controls[I].Rectangle.Contains(Pos) then begin
      Controls[I].MouseMove(Pos - Controls[I].Rectangle.Position);
      Break;
    end;
end;

procedure TControl.SetParentControl(AValue: TControl);
begin
  if FParentControl = AValue then Exit;
  if Assigned(FParentControl) then
    FParentControl.Controls.Remove(Self);
  FParentControl := AValue;
  if Assigned(FParentControl) then
    FParentControl.Controls.Add(Self);
end;

function TControl.GetPosition: TPosition;
begin
  Result := FRectangle.Position;
end;

function TControl.GetSize: TSize;
begin
  Result := FRectangle.Size;
end;

procedure TControl.SetPosition(AValue: TPosition);
begin
  Rectangle := TRectangle.Create(AValue, FRectangle.Size);
end;

procedure TControl.SetSize(AValue: TSize);
begin
  Rectangle := TRectangle.Create(FRectangle.Position, AValue);
end;

procedure TControl.SetRectangle(AValue: TRectangle);
begin
  if FRectangle = AValue then Exit;
  FRectangle := AValue;
end;

procedure TControl.Paint;
var
  I: Integer;
begin
  if FVisible then begin
    for I := 0 to Controls.Count - 1 do
      Controls[I].Paint;
  end;
end;

constructor TControl.Create;
begin
  Controls := TObjectList<TControl>.Create;
  Controls.OwnsObjects := False;
  Canvas := TCanvasControl.Create;
  TCanvasControl(Canvas).Control := Self;
end;

destructor TControl.Destroy;
var
  I: Integer;
begin
  for I := 0 to Controls.Count - 1 do
    Controls[I].Free;
  ParentControl := nil;
  FreeAndNil(Canvas);
  FreeAndNil(Controls);
  inherited;
end;

{ TEdit }

procedure TEdit.SetText(AValue: string);
begin
  if FText = AValue then Exit;
  FText := AValue;
  Paint;
end;

procedure TEdit.Paint;
begin
  if FVisible then begin
    Canvas.DrawArea(TRectangle.Create(TPosition.Create(0, 0), Rectangle.Size), clBlack);
    Canvas.DrawFrame(TRectangle.Create(TPosition.Create(0, 0), Rectangle.Size), clWhite);
    Canvas.DrawText(TPosition.Create(4, 4), clWhite, FText);
  end;
  inherited;
end;

{ TLabel }

procedure TLabel.SetTitle(AValue: string);
begin
  if FTitle = AValue then Exit;
  FTitle := AValue;
  Paint;
end;

procedure TLabel.Paint;
begin
  if FVisible then begin
    Canvas.DrawText(TPosition.Create(0, 0), clWhite, FTitle);
  end;
  inherited;
end;

{ TButton }

procedure TButton.SetTitle(AValue: string);
begin
  if FTitle = AValue then Exit;
  FTitle := AValue;
  Paint;
end;

procedure TButton.MouseButtonDown(Pos: TPosition; Button: TMouseButton);
begin
  inherited;
  Clicked := True;
end;

procedure TButton.MouseButtonUp(Pos: TPosition; Button: TMouseButton);
begin
  inherited;
  Clicked := False;
end;

procedure TButton.SetClicked(AValue: Boolean);
begin
  if FClicked = AValue then Exit;
  FClicked := AValue;
  Paint;
end;

procedure TButton.Paint;
var
  Color: TColor;
  TextSize: TSize;
begin
  if FVisible then begin
    if Clicked then Color := clBlack
      else Color := clGray;
    Canvas.DrawArea(TRectangle.Create(TPosition.Create(0, 0), Rectangle.Size), Color);
    Canvas.DrawFrame(TRectangle.Create(TPosition.Create(0, 0), Rectangle.Size), clWhite);
    TextSize := Canvas.GetTextSize(FTitle);
    Canvas.DrawText(TPosition.Create((Size.Width - TextSize.Width) div 2,
      (Size.Height - TextSize.Height) div 2), clWhite, FTitle);
  end;
  inherited;
end;

end.