source: branches/Xvcl/lddesktop.pas

unit lddesktop;

interface

uses
  Generics.Collections;

type
  TPoint = record
    X: Integer;
    Y: Integer;
    constructor Create(X, Y: Integer);
  end;

  TBounds = record
  private
    function GetBottom: Integer;
    function GetPosition: TPoint;
    function GetRight: Integer;
    function GetSize: TPoint;
    function GetBottomLeft: TPoint;
    function GetBottomRight: TPoint;
    function GetLeftTop: TPoint;
    function GetRightTop: TPoint;
  public
    Left: Integer;
    Top: Integer;
    Width: Integer;
    Height: Integer;
    property Right: Integer read GetRight;
    property Bottom: Integer read GetBottom;
    property Size: TPoint read GetSize;
    property Position: TPoint read GetPosition;
    property LeftTop: TPoint read GetLeftTop;
    property BottomRight: TPoint read GetBottomRight;
    property RightTop: TPoint read GetRightTop;
    property BottomLeft: TPoint read GetBottomLeft;
    constructor Create(Left, Top, Width, Height: Integer);
  end;

  TComponent = class
  private
    FOwner: TComponent;
    FName: string;
  public
    constructor Create; virtual;
    property Owner: TComponent read FOwner write FOwner;
    property Name: string read FName write FName;
  end;

  TColor = (clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed);

  TPen = class
    Pos: TPoint;
    Color: TColor;
    procedure MoveTo(Pos: TPoint);
    procedure LineTo(Pos: TPoint);
  end;

  TBrush = class
    Color: TColor;
  end;

  TFont = class

  end;

  TCanvas = class
  private
    FPen: TPen;
    FBrush: TBrush;
    FFont: TFont;
  public
    procedure MoveTo(Position: TPoint);
    procedure LineTo(Position: TPoint);
    constructor Create;
    destructor Destroy; override;
    property Pen: TPen read FPen;
    property Brush: TBrush read FBrush;
    property Font: TFont read FFont;
  end;

  TControl = class;

  TControlCanvas = class(TCanvas)
    Control: TControl;
  end;

  TControl = class(TComponent)
  private
    FVisible: Boolean;
    FBounds: TBounds;
    FCanvas: TControlCanvas;
    function GetCanvas: TCanvas;
  public
    Controls: TList<TControl>;
  public
    procedure Paint; virtual;
    property Bounds: TBounds read FBounds write FBounds;
    property Visible: Boolean read FVisible write FVisible;
    property Canvas: TCanvas read GetCanvas;
    constructor Create; override;
    destructor Destroy; override;
  end;

  TButton = class(TControl)
  private
    FCaption: string;
  public
    procedure Paint; override;
    property Caption: string read FCaption write FCaption;
  end;

  TForm = class(TControl)
  end;

  TBitmap = class
  private
    function GetPixel(X, Y: Integer): TColor;
    procedure SetPixel(X, Y: Integer; const Value: TColor);
  public
    property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
  end;

  TGraphicDriver = class
    procedure DrawBitmap(Bitmap: TBitmap);
  end;

  TScreen = class(TComponent)
    Size: TPoint;
    Forms: TList<TForm>;
    GraphicDriver: TGraphicDriver;
    procedure Paint;
    constructor Create; override;
    destructor Destroy; override;
  end;


  implementation

{ TBounds }

constructor TBounds.Create(Left, Top, Width, Height: Integer);
begin
  Self.Left := Left;
  Self.Top := Top;
  Self.Width := Width;
  Self.Height := Height;
end;

function TBounds.GetBottom: Integer;
begin
  Result := Top + Height;
end;

function TBounds.GetBottomLeft: TPoint;
begin
  Result := TPoint.Create(Left, Bottom);
end;

function TBounds.GetBottomRight: TPoint;
begin
  Result := TPoint.Create(Right, Bottom);
end;

function TBounds.GetLeftTop: TPoint;
begin
  Result := TPoint.Create(Left, Top);
end;

function TBounds.GetPosition: TPoint;
begin
  Result := TPoint.Create(Left, Top);
end;

function TBounds.GetRight: Integer;
begin
  Result := Left + Width;
end;

function TBounds.GetRightTop: TPoint;
begin
  Result := TPoint.Create(Right, Top);
end;

function TBounds.GetSize: TPoint;
begin
  Result := TPoint.Create(Width, Height);
end;

{ TForm }


{ TComponent }

constructor TComponent.Create;
begin
end;

{ TScreen }

constructor TScreen.Create;
begin
  inherited;
  Forms := TList<TForm>.Create;
end;

destructor TScreen.Destroy;
begin
  Forms.Destroy;
  inherited;
end;

procedure TScreen.Paint;
var
  Form: TForm;
begin
  for Form in Forms do Form.Paint;
end;

{ TControl }

constructor TControl.Create;
begin
  inherited;
  Controls := TList<TControl>.Create;
end;

destructor TControl.Destroy;
begin
  Controls.Destroy;
  if Assigned(FCanvas) then FCanvas.Destroy;
  inherited;
end;

function TControl.GetCanvas: TCanvas;
begin
  if not Assigned(FCanvas) then begin
    FCanvas := TControlCanvas.Create;
    FCanvas.Control := Self;
  end;
  Result := FCanvas;
end;

procedure TControl.Paint;
var
  C: TControl;
begin
  for C in Controls do C.Paint;
end;

{ TButton }

procedure TButton.Paint;
begin
  inherited;
  with Canvas do begin
    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));
  end;
end;

{ TPoint }

constructor TPoint.Create(X, Y: Integer);
begin
  Self.X := X;
  Self.Y := Y;
end;

{ TPen }

procedure TPen.LineTo(Pos: TPoint);
begin
  Self.Pos := Pos;
end;

procedure TPen.MoveTo(Pos: TPoint);
begin

end;

{ TCanvas }

constructor TCanvas.Create;
begin
  FPen := TPen.Create;
  FBrush := TBrush.Create;
  FFont := TFont.Create;
end;

destructor TCanvas.Destroy;
begin
  FFont.Destroy;
  FBrush.Destroy;
  FPen.Destroy;
  inherited;
end;

procedure TCanvas.LineTo(Position: TPoint);
begin
  Pen.LineTo(Position);
end;

procedure TCanvas.MoveTo(Position: TPoint);
begin
  Pen.MoveTo(Position);
end;

{ TGraphicDriver }

procedure TGraphicDriver.DrawBitmap(Bitmap: TBitmap);
begin

end;

{ TBitmap }

function TBitmap.GetPixel(X, Y: Integer): TColor;
begin

end;

procedure TBitmap.SetPixel(X, Y: Integer; const Value: TColor);
begin

end;

end.