source: branches/Xvcl/Xvcl.Forms.pas

unit Xvcl.Forms;

interface

uses
  Xvcl.Classes, Xvcl.Controls, Xvcl.Graphics, Xvcl.Generics;

type
  TForm = class(TWinControl)
  private
    FFocused: Boolean;
    procedure SetFocused(const Value: Boolean);
  protected
    function GetVideoDevice: TVideoDevice; override;
  public
  const
    TitleBarHeight = 24;
  var
    Screen: TObject; // TScreen;
    Caption: string;
    function HandleMessage(Message: TMessage): Boolean; override;
    procedure Paint; override;
    property Focused: Boolean read FFocused write SetFocused;
  end;

  TApplication = class(TComponent)
    Screen: TObject; // TScreen;
    Forms: TList<TForm>;
    MainForm: TForm;
    procedure Run; virtual;
    procedure Terminate; virtual;
  end;


implementation

uses
  Xvcl.Kernel;

{ TApplication }

procedure TApplication.Run;
begin

end;

procedure TApplication.Terminate;
begin

end;

{ TForm }

function TForm.GetVideoDevice: TVideoDevice;
begin
  if Assigned(Screen) then Result := TScreen(Screen).VideoDevice
    else Result := nil;
end;

function TForm.HandleMessage(Message: TMessage): Boolean;
var
  TitleBarBounds: TRectangle;
begin
  Result := False;
  if Message is TMessageMouseDown then
  with TMessageMouseDown(Message) do begin
    TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight);
    Focused := True;
    if TitleBarBounds.Contains(ScreenToClient(Position)) then begin
      Move.StartControlPos := Bounds.TopLeft;
      Move.StartMousePos := Position;
      Move.Active := True;
     Result := True;
    end;
  end else
  if Message is TMessageMouseUp then
  with TMessageMouseUp(Message) do begin
    Move.Active := False;
  end else
  if Message is TMessageMouseMove then
  with TMessageMouseUp(Message) do begin
    if Move.Active then begin
      Bounds.TopLeft := Move.StartControlPos + (Position - Move.StartMousePos);
      TScreen(Screen).Paint;
    end;
  end;
  if not Result then inherited;
end;

procedure TForm.Paint;
begin
  inherited;
  with Canvas do begin
    if Focused then Brush.Color := clLightBlue else
      Brush.Color := clSilver;
    FillRect(TRectangle.Create(0, 0, Bounds.Width - 1, TitleBarHeight));
    MoveTo(TPoint.Create(0, 0));
    LineTo(TPoint.Create(Bounds.Width - 1, 0));
    LineTo(TPoint.Create(Bounds.Width - 1, Bounds.Height - 1));
    LineTo(TPoint.Create(0, Bounds.Height - 1));
    LineTo(TPoint.Create(0, 0));
    MoveTo(TPoint.Create(0, TitleBarHeight));
    LineTo(TPoint.Create(Bounds.Width - 1, TitleBarHeight));
    TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2,
      (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption);
  end;
end;

procedure TForm.SetFocused(const Value: Boolean);
begin
  if FFocused <> Value then begin
    FFocused := Value;
    if Value then TScreen(Screen).FocusForm(Self);
  end;
end;

end.