source: branches/overos/Os.Window.pas

unit Os.Window;

interface

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

type
  TScreen = class;
  TWindow = class;

  { TCanvasWindow }

  TCanvasWindow = class(TCanvas)
    Window: TWindow;
    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;

  TWindowSide = (wsNone, wsLeft, wsTop, wsRight, wsBottom);

  { TTitleBar }

  TTitleBar = class(TControl)
  private
    FWindow: TWindow;
    procedure SetWindow(AValue: TWindow);
    procedure ButtonCloseClick(Sender: TObject);
    procedure ButtonMaximizeClick(Sender: TObject);
    procedure ButtonMinimizeClick(Sender: TObject);
  protected
    procedure SetRectangle(AValue: TRectangle); override;
  public
  const
    TitleHeight = 32;
  var
    ButtonClose: TButton;
    ButtonMaximize: TButton;
    ButtonMinimize: TButton;
    constructor Create; override;
    destructor Destroy; override;
    property Window: TWindow read FWindow write SetWindow;
  end;

  TMessageWindow = class(TMessage);
  TMessageWindowClose = class(TMessageWindow);
  TMessageWindowMaximize = class(TMessageWindow);

  { TWindow }

  TWindow = class(TControl)
  private
    FScreen: TScreen;
    procedure SetScreen(AValue: TScreen);
  protected
    procedure SetRectangle(AValue: TRectangle); override;
    procedure SetVisible(AValue: Boolean); override;
  public
  const
    BorderGrabWidth = 15;
  var
    TitleBar: TTitleBar;
    Title: string;
    Application: TObject; // TApplication
    procedure HandleMessage(Message: TMessage);
    procedure MouseButtonDown(Pos: TPosition; Button: TMouseButton); override;
    procedure MouseButtonUp(Pos: TPosition; Button: TMouseButton); override;
    procedure Close;
    procedure Maximize;
    procedure Focus;
    procedure Paint; override;
    function Focused: Boolean;
    constructor Create; override;
    destructor Destroy; override;
    property Screen: TScreen read FScreen write SetScreen;
  end;

  { TScreen }

  TScreen = class
  private
    FMouse: TMouse;
    GrabActive: Boolean;
    GrabWindow: TWindow;
    GrabMousePosition: TPosition;
    GrabWindowRectangle: TRectangle;
    GrabWindowSide: TWindowSide;
    procedure MouseButtonDown(Pos: TPosition; Button: TMouseButton);
    procedure MouseButtonUp(Pos: TPosition; Button: TMouseButton);
    procedure MouseMove(Pos: TPosition);
    procedure SetMouse(AValue: TMouse);
  public
    Canvas: TCanvas;
    Windows: TObjectList<TWindow>;
    Size: TSize;
    procedure Paint;
    function CreateWindow(Title: string): TWindow;
    constructor Create;
    destructor Destroy; override;
    property Mouse: TMouse read FMouse write SetMouse;
  end;


implementation

uses
  Os.Application;

{ TTitleBar }

procedure TTitleBar.SetWindow(AValue: TWindow);
begin
  if FWindow = AValue then Exit;
  FreeAndNil(Canvas);
  FWindow := AValue;
  Canvas := TCanvasWindow.Create;
  TCanvasWindow(Canvas).Window := FWindow;
end;

procedure TTitleBar.ButtonCloseClick(Sender: TObject);
begin
  Window.Close;
end;

procedure TTitleBar.ButtonMaximizeClick(Sender: TObject);
begin
  Window.Maximize;
end;

procedure TTitleBar.ButtonMinimizeClick(Sender: TObject);
begin

end;

procedure TTitleBar.SetRectangle(AValue: TRectangle);
begin
  inherited;
  ButtonClose.Rectangle := TRectangle.Create(TPosition.Create(Size.Width - TitleHeight, 4),
    TSize.Create(TitleHeight - 8, TitleHeight - 8));
  ButtonMaximize.Rectangle := TRectangle.Create(TPosition.Create(Size.Width - 2 * TitleHeight, 4),
    TSize.Create(TitleHeight - 8, TitleHeight - 8));
  ButtonMinimize.Rectangle := TRectangle.Create(TPosition.Create(Size.Width - 3 * TitleHeight, 4),
    TSize.Create(TitleHeight - 8, TitleHeight - 8));
end;

constructor TTitleBar.Create;
begin
  inherited;

  ButtonClose := TButton.Create;
  ButtonClose.Title := 'X';
  ButtonClose.ParentControl := Self;
  ButtonClose.OnClick := ButtonCloseClick;
  ButtonClose.Visible := True;

  ButtonMaximize := TButton.Create;
  ButtonMaximize.Title := '^';
  ButtonMaximize.ParentControl := Self;
  ButtonMaximize.OnClick := ButtonMaximizeClick;
  ButtonMaximize.Visible := True;

  ButtonMinimize := TButton.Create;
  ButtonMinimize.Title := '_';
  ButtonMinimize.ParentControl := Self;
  ButtonMinimize.OnClick := ButtonMinimizeClick;
  ButtonMinimize.Visible := True;
end;

destructor TTitleBar.Destroy;
begin
  FreeAndNil(ButtonClose);
  FreeAndNil(ButtonMaximize);
  FreeAndNil(ButtonMinimize);
  inherited;
end;

{ TCanvasWindow }

procedure TCanvasWindow.DrawLine(P1, P2: TPosition; Color: TColor);
begin
  if Assigned(Window) and Assigned(Window.Screen) then
    Window.Screen.Canvas.DrawLine(P1 + Window.Position, P2 + Window.Position, Color);
end;

procedure TCanvasWindow.DrawArea(Rect: TRectangle; Color: TColor);
begin
  if Assigned(Window) and Assigned(Window.Screen) then
    Window.Screen.Canvas.DrawArea(TRectangle.Create(Rect.Position + Window.Position,
      Rect.Size), Color);
end;

procedure TCanvasWindow.DrawText(P: TPosition; Color: TColor; Text: string);
begin
  if Assigned(Window) and Assigned(Window.Screen) then
    Window.Screen.Canvas.DrawText(P + Window.Position, Color, Text);
end;

function TCanvasWindow.GetTextSize(Text: string): TSize;
begin
  if Assigned(Window) and Assigned(Window.Screen) then
    Result := Window.Screen.Canvas.GetTextSize(Text);
end;

{ TWindow }

procedure TWindow.SetScreen(AValue: TScreen);
begin
  if FScreen = AValue then Exit;
  if Assigned(FScreen) then
    FScreen.Windows.Remove(Self);
  FScreen := AValue;
  if Assigned(FScreen) then
    FScreen.Windows.Add(Self);
end;

procedure TWindow.SetRectangle(AValue: TRectangle);
begin
  inherited;
  TitleBar.Rectangle := TRectangle.Create(Position, TSize.Create(Size.Width, TitleBar.TitleHeight));
end;

procedure TWindow.SetVisible(AValue: Boolean);
begin
  inherited;
  if not Visible and Assigned(Screen) then
    Screen.Paint;
end;

procedure TWindow.HandleMessage(Message: TMessage);
begin
  if Message is TMessageWindowClose then begin
    Free;
  end else
  if Message is TMessageWindowMaximize then begin;
    Rectangle := TRectangle.Create(TPosition.Create(0, 0), Screen.Size);
    Paint;
  end;
end;

procedure TWindow.MouseButtonDown(Pos: TPosition; Button: TMouseButton);
begin
  inherited;
  TitleBar.MouseButtonDown(Pos, Button);
end;

procedure TWindow.MouseButtonUp(Pos: TPosition; Button: TMouseButton);
begin
  inherited;
  TitleBar.MouseButtonUp(Pos, Button);
end;

procedure TWindow.Close;
begin
  TApplication(Application).MessageQueue.PostMessage(Self, TMessageWindowClose.Create);
end;

procedure TWindow.Maximize;
begin
  TApplication(Application).MessageQueue.PostMessage(Self, TMessageWindowMaximize.Create);
end;

procedure TWindow.Focus;
begin
  if not Focused then begin
    Screen.Windows.Move(Screen.Windows.IndexOf(Self), Screen.Windows.Count - 1);
    Paint;
  end;
end;

procedure TWindow.Paint;
begin
  if Visible then begin
    Canvas.DrawArea(TRectangle.Create(TPosition.Create(0, 0), Size), clGray);
    Canvas.DrawFrame(TRectangle.Create(TPosition.Create(0, 0), Size), clWhite);
    Canvas.DrawLine(TPosition.Create(0, TitleBar.TitleHeight),
      TPosition.Create(Size.Width, TitleBar.TitleHeight), clWhite);
    Canvas.DrawText(TPosition.Create(8, 4), clWhite, Title);
    TitleBar.Paint;
  end;
  inherited;
end;

function TWindow.Focused: Boolean;
begin
  Result := Screen.Windows.IndexOf(Self) = Screen.Windows.Count - 1;
end;

constructor TWindow.Create;
begin
  inherited;
  FreeAndNil(Canvas);
  Canvas := TCanvasWindow.Create;
  TCanvasWindow(Canvas).Window := Self;
  TitleBar := TTitleBar.Create;
  TitleBar.Window := Self;
  TitleBar.Visible := True;
end;

destructor TWindow.Destroy;
begin
  Visible := False;
  FreeAndNil(TitleBar);
  Screen := nil;
  inherited;
end;

{ TScreen }

procedure TScreen.MouseButtonDown(Pos: TPosition; Button: TMouseButton);
var
  I: Integer;
  Window: TWindow;
begin
  for I := Windows.Count - 1 downto 0 do begin
    Window := Windows[I];
    if TRectangle.Create(Window.Position - TPosition.Create(Window.BorderGrabWidth div 2, 0),
    TSize.Create(Window.BorderGrabWidth, Window.Size.Height)).Contains(Pos) then begin
      GrabMousePosition := Pos;
      GrabWindowRectangle := Window.Rectangle;
      GrabWindow := Window;
      GrabWindowSide := wsLeft;
      GrabActive := True;
    end else
    if TRectangle.Create(Window.Position - TPosition.Create(0, Window.BorderGrabWidth div 2),
    TSize.Create(Window.Size.Width, Window.BorderGrabWidth)).Contains(Pos) then begin
      GrabMousePosition := Pos;
      GrabWindowRectangle := Window.Rectangle;
      GrabWindow := Window;
      GrabWindowSide := wsTop;
      GrabActive := True;
    end else
    if TRectangle.Create(Window.Position + TPosition.Create(Window.Size.Width, 0) - TPosition.Create(Window.BorderGrabWidth div 2, 0),
    TSize.Create(Window.BorderGrabWidth, Window.Size.Height)).Contains(Pos) then begin
      GrabMousePosition := Pos;
      GrabWindowRectangle := Window.Rectangle;
      GrabWindow := Window;
      GrabWindowSide := wsRight;
      GrabActive := True;
    end else
    if TRectangle.Create(Window.Position + TPosition.Create(0, Window.Size.Height) - TPosition.Create(0, Window.BorderGrabWidth div 2),
    TSize.Create(Window.Size.Width, Window.BorderGrabWidth)).Contains(Pos) then begin
      GrabMousePosition := Pos;
      GrabWindowRectangle := Window.Rectangle;
      GrabWindow := Window;
      GrabWindowSide := wsBottom;
      GrabActive := True;
    end else
    if TRectangle.Create(Window.Position, TSize.Create(Window.Size.Width, Window.TitleBar.TitleHeight)).Contains(Pos) then begin
      GrabMousePosition := Pos;
      GrabWindowRectangle := Window.Rectangle;
      GrabWindow := Window;
      GrabWindowSide := wsNone;
      GrabActive := True;
    end;
    if Window.Rectangle.Contains(Pos) then begin
      Window.Focus;
      Window.MouseButtonDown(Pos - Window.Position, Button);
      Break;
    end;
  end;
end;

procedure TScreen.MouseButtonUp(Pos: TPosition; Button: TMouseButton);
var
  I: Integer;
  Window: TWindow;
begin
  if GrabActive then begin
    GrabActive := False;
    GrabWindow := nil;
  end;
  for I := Windows.Count - 1 downto 0 do begin
    Window := Windows[I];
    if Window.Rectangle.Contains(Pos) then begin
      Window.MouseButtonUp(Pos - Window.Position, Button);
      Break;
    end;
  end;
end;

procedure TScreen.MouseMove(Pos: TPosition);
var
  I: Integer;
begin
  if GrabActive then begin
    if GrabWindowSide = wsNone then
      GrabWindow.Position := GrabWindowRectangle.Position + (Pos - GrabMousePosition)
    else if GrabWindowSide = wsLeft then
      GrabWindow.Rectangle := TRectangle.Create(GrabWindowRectangle.Position + TPosition.Create(Pos.Left - GrabMousePosition.Left, 0),
        GrabWindowRectangle.Size - TSize.Create(Pos.Left - GrabMousePosition.Left, 0))
    else if GrabWindowSide = wsTop then
      GrabWindow.Rectangle := TRectangle.Create(GrabWindowRectangle.Position + TPosition.Create(0, Pos.Top - GrabMousePosition.Top),
        GrabWindowRectangle.Size - TSize.Create(0, Pos.Top - GrabMousePosition.Top))
    else if GrabWindowSide = wsRight then
      GrabWindow.Rectangle := TRectangle.Create(GrabWindowRectangle.Position,
        GrabWindowRectangle.Size + TSize.Create(Pos.Left - GrabMousePosition.Left, 0))
    else if GrabWindowSide = wsBottom then
      GrabWindow.Rectangle := TRectangle.Create(GrabWindowRectangle.Position,
        GrabWindowRectangle.Size + TSize.Create(0, Pos.Top - GrabMousePosition.Top));
    Paint;
  end;
  for I := Windows.Count - 1 downto 0 do begin
    if Windows[I].Rectangle.Contains(Pos) then begin
      Windows[I].MouseMove(Pos - Windows[I].Position);
      Break;
    end;
  end;
end;

procedure TScreen.SetMouse(AValue: TMouse);
begin
  if FMouse = AValue then Exit;
  if Assigned(AValue) then begin
    AValue.OnButtonDown := nil;
    AValue.OnButtonUp := nil;
    AValue.OnMove := nil;
  end;
  FMouse := AValue;
  if Assigned(AValue) then begin
    AValue.OnButtonDown := MouseButtonDown;
    AValue.OnButtonUp := MouseButtonUp;
    AValue.OnMove := MouseMove;
  end;
end;

procedure TScreen.Paint;
var
  I: Integer;
begin
  Canvas.DrawArea(TRectangle.Create(TPosition.Create(0, 0), Size), clBlack);
  for I := 0 to Windows.Count - 1 do
    Windows[I].Paint;
end;

function TScreen.CreateWindow(Title: string): TWindow;
begin
  Result := TWindow.Create;
  Result.Screen := Self;
  Result.Title := Title;
  Result.Rectangle := TRectangle.Create(TPosition.Create(10, 10), TSize.Create(400, 300));
  Result.Visible := True;
end;

constructor TScreen.Create;
begin
  Windows := TObjectList<TWindow>.Create;
  Windows.OwnsObjects := False;
  Canvas := TCanvas.Create;
end;

destructor TScreen.Destroy;
var
  I: Integer;
begin
  for I := Windows.Count - 1 downto 0 do
    Windows[I].Free;
  FreeAndNil(Windows);
  FreeAndNil(Canvas);
  inherited;
end;

end.