source: branches/Independent/Forms/FormScreen.pas

unit FormScreen;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Os;

type

  { TFormScreen }

  TFormScreen = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure PaintBox1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    DrawPending: Boolean;
  public
    System: TSystem;
    procedure Redraw(Sender: TObject);
  end;

implementation

{$R *.lfm}

{ TFormScreen }

procedure TFormScreen.PaintBox1Paint(Sender: TObject);
var
  I: Integer;
const
  TitleHeight = 40;
begin
  PaintBox1.Canvas.Brush.Color := clBlack;
  PaintBox1.Canvas.Brush.Style := bsSolid;

  for I := 0 to System.Windows.Count - 1 do
  with System.Windows[I] do begin
    if Visible then begin
      PaintBox1.Canvas.Brush.Color := clGray;
      PaintBox1.Canvas.Brush.Style := bsSolid;
      PaintBox1.Canvas.Pen.Color := clWhite;
      PaintBox1.Canvas.Pen.Style := psSolid;
      PaintBox1.Canvas.Pen.Width := 5;
      PaintBox1.Canvas.Rectangle(Rect);
      PaintBox1.Canvas.TextOut(Rect.Left + 20, Rect.Top + 5, Name);
      PaintBox1.Canvas.Line(Rect.Left, Rect.Top + TitleHeight, Rect.Right, Rect.Top + TitleHeight);
    end;
  end;
end;

procedure TFormScreen.Timer1Timer(Sender: TObject);
begin
  if DrawPending then begin
    DrawPending := False;
    PaintBox1.Repaint;
  end;
end;

procedure TFormScreen.Redraw(Sender: TObject);
begin
  DrawPending := True;
end;

end.