ClientVisuals.pas

File name
C:\Users\Andreas Rejbrand\Documents\Dev\AlgoSim\Client\ClientVisuals.pas
Date exported
Time exported
Formatting processor
TPascalFormattingProcessor
unit ClientVisuals;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, ASVisualization,
  VisCtl2D, MainForm, ASKernelDefs, Generics.Defaults, Generics.Collections,
  Controls, Forms, VisForm, ASObjects, Graphics, Menus, ClientDefs, DoublePoint;

type
  TVisFrm = class(TForm)
  strict private
    FAspect: Double;
  strict protected
    const CMD_SETSIZE = 101;
  protected
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    function CanResize(var NewWidth: Integer; var NewHeight: Integer): Boolean;
      override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;

  TManagedVisCtl2D = class(TVisCtl2D)
  strict private
    FDiagramName: string;
    FmnuDetach: TMenuItem;
    FmnuDock: TMenuItem;
    class var FInstances: TDictionary<string, TManagedVisCtl2D>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
    procedure Detach(Sender: TObject);
    procedure Dock(Sender: TObject); reintroduce;
    procedure ContextPopup(Sender: TObject);
  protected
    procedure SetWindowWidth(AWidth: Integer); override;
    procedure SetWindowHeight(AHeight: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DiagramName: string read FDiagramName;
    class property Instances: TDictionary<string, TManagedVisCtl2D> read FInstances;
  end;

  TVisualization = record
  strict private
    class var FDiagram: string;
    class var FPopups: Boolean;
    class var FPanelCtl: TVisCtl2D;
    class var FDiagramNumber: UInt64;
    class function BarChart(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function PieChart(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Histogram(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function ScatterPlot(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function RegionPlot(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Heatmap(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function VectorField(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Line(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Rectangle(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Circle(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Polygon(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Text(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
    class function Pixmap(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable; static;
  public
    class constructor ClassCreate;
    class procedure Visualize(AVisual: TVisual; ARef: PAlgosimReference = nil); static;
    class procedure RemoveVisual(const AGUID: TGUID); static;
    class procedure ConfigVisual(const AGUID: TGUID; ASettings: TAlgosimStructure); static;
    class procedure ExportVisual(const AGUID: TGUID; const AFileName: TFileName;
      ASettings: TAlgosimStructure); static;
    class property Diagram: string read FDiagram write FDiagram;
    class property Popups: Boolean read FPopups write FPopups;
    class function GetDiagram(out ANewDiagram: Boolean): TVisCtl2D; static;
    class function ShowDiagram(ADiagram: TDiagram): Boolean; overload; static;
    class function ShowDiagram(ADiagram: TVisCtl2D): Boolean; overload; static;
    class function ShowDiagram(const ADiagram: string): Boolean; overload; static;
    class function ShowDiagram(const ADiagram: TGUID): Boolean; overload; static;
  end;

implementation

uses
  ASNum, Gallery, Math, FormFader, WinMgrForm, ImageSizeForm;

{ TVisualization }

class function TVisualization.BarChart(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable;
var
  BarChart: TBarChart absolute Result;
  CatData: TCategoryData;
begin
  BarChart := TBarChart.Create(ACtl, ACtl.View);
  for CatData in AVisual.Data as TCategoryDataList do
    BarChart.AddBar(CatData.Name, CatData.Value);
end;

{$IF SizeOf(ASR) = SizeOf(Double)}
type
  ASRArrayToDoubleArray = TArray<Double>;
  ASR2ArrayToDoublePointArray = TArray<TPointD>;
{$ELSE}
function ASRArrayToDoubleArray(const A: TArray<TASR>): TArray<Double>;
var
  i: Integer;
begin
  SetLength(Result, Length(A));
  for i := 0 to High(A) do
    Result[i] := A[i];
end;

function ASR2ArrayToDoublePointArray(const A: TArray<TASR2>): TArray<TPointD>;
var
  i: Integer;
begin
  SetLength(Result, Length(A));
  for i := 0 to High(A) do
  begin
    Result[i].X := A[i].X;
    Result[i].Y := A[i].Y;
  end;
end;
{$ENDIF}

class function TVisualization.Heatmap(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Heatmap: THeatmap absolute Result;
begin
  Heatmap := THeatmap.Create(ACtl, ACtl.View);
  with AVisual.Data as THeatmapData do
  begin
    var bm := Pixmap.CreateGDIBitmap;
    try
      Heatmap.Bitmap := bm;
    finally
      bm.Free;
    end;
    Heatmap.Rect := TRectD.Create(x0, y1, x1, y0);
  end;
end;

class function TVisualization.Histogram(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable;
var
  Histogram: THistogram absolute Result;
begin
  Histogram := THistogram.Create(ACtl, ACtl.View);
  Histogram.Data := ASRArrayToDoubleArray((AVisual.Data as THistogramData).Numbers);
end;

class function TVisualization.Line(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Line: TLine absolute Result;
begin
  Line := TLine.Create(ACtl, ACtl.View);
  Line.Start := (AVisual.Data as TLineDataR2).a;
  Line.&End := (AVisual.Data as TLineDataR2).b;
end;

class function TVisualization.Circle(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Circle: TCircle absolute Result;
begin
  Circle := TCircle.Create(ACtl, ACtl.View);
  Circle.Center := (AVisual.Data as TCircleData).a;
  Circle.Radius := (AVisual.Data as TCircleData).r;
end;

class constructor TVisualization.ClassCreate;
begin
  FPopups := True;
end;

class procedure TVisualization.ConfigVisual(const AGUID: TGUID;
  ASettings: TAlgosimStructure);
var
  Drawable: TDrawable;
begin
  if TDrawable.TryGetDrawableByGUID(AGUID, Drawable) then
  begin
    Drawable.Control.BeginBackgroundPaint;
    try
      if Assigned(ASettings) then
        Drawable.Configure(ASettings)
      else
        Drawable.ShowOptionsForm(AlgosimMainForm);
    finally
      Drawable.Control.EndBackgroundPaint;
    end;
  end;
end;

class procedure TVisualization.ExportVisual(const AGUID: TGUID;
  const AFileName: TFileName; ASettings: TAlgosimStructure);
var
  Drawable: TDrawable;
begin
  if TDrawable.TryGetDrawableByGUID(AGUID, Drawable) then
  begin
    if string(AFileName).IsEmpty then
      Drawable.Control.SaveAsSVG
    else
    begin
      var LOptions := DefaultSVGExportOptions;
      var LWidth, LHeight: string;
      if ASettings.HasMember('width') then
        LWidth := ASettings['width'].ToString;
      if ASettings.HasMember('height') then
        LHeight := ASettings['height'].ToString;
      LOptions.SetDimensionsFromText(LWidth, LHeight);
      if ASettings.HasMember('stretch') then
        LOptions.Stretch := ASettings['stretch'].ToBoolean;
      if ASettings.HasMember('title') then
        LOptions.Title := ASettings['title'].ToString;
      if ASettings.HasMember('description') then
        LOptions.Description := ASettings['description'].ToString;
      if ASettings.HasMember('language') then
        LOptions.Language := ASettings['language'].ToString;
      Drawable.Control.SaveAsSVG(AFileName, LOptions);
    end;
  end;
end;

class function TVisualization.GetDiagram(out ANewDiagram: Boolean): TVisCtl2D;
var
  ManagedDiagram: TManagedVisCtl2D;
begin

  if FDiagram.IsEmpty then
  begin
    if FPopups then
    begin
      Inc(FDiagramNumber);
      var frm := TVisFrm.CreateNew(AlgosimMainForm);
      frm.Caption := 'Unnamed diagram' + #32 + FDiagramNumber.ToString;
      var ctl := TVisCtl2D.Create(frm);
      ctl.Parent := frm;
      ctl.Align := alClient;
      frm.Show;
      ANewDiagram := True;
      Result := ctl;
    end
    else
    begin
      if TDrawable.ModalLevel > 0 then
        raise Exception.Create('Cannot remove a drawable object when a settings dialog is open.');
      FreeAndNil(FPanelCtl);
      FPanelCtl := TVisCtl2D.Create(AlgosimMainForm);
      FPanelCtl.Parent := AlgosimMainForm.GalleryPanel;
      FPanelCtl.Align := alClient;
      ANewDiagram := True;
      Result := FPanelCtl;
    end;
  end
  else if TManagedVisCtl2D.Instances.TryGetValue(FDiagram, ManagedDiagram) then
  begin
    Result := ManagedDiagram;
    ANewDiagram := False;
  end
  else
  begin
    Result := TManagedVisCtl2D.Create(nil);
    Result.Parent := AlgosimMainForm.GalleryPanel;
    Result.Align := alClient;
    ANewDiagram := True;
  end;

end;

class function TVisualization.PieChart(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable;
var
  PieChart: TPieChart absolute Result;
  CatData: TCategoryData;
begin
  PieChart := TPieChart.Create(ACtl, ACtl.View);
  for CatData in AVisual.Data as TCategoryDataList do
    PieChart.AddSlice(CatData.Name, CatData.Value);
end;

class function TVisualization.Pixmap(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Pixmap: TPixmap absolute Result;
  bm: TBitmap;
begin
  Pixmap := TPixmap.Create(ACtl, ACtl.View);
  Pixmap.Rect := (AVisual.Data as TPixmapData).Rect;
  bm := (AVisual.Data as TPixmapData).Pixmap.CreateGDIBitmap;
  try
    Pixmap.Bitmap := bm
  finally
    bm.Free;
  end;
end;

class function TVisualization.Polygon(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Polygon: TPolygon absolute Result;
begin
  Polygon := TPolygon.Create(ACtl, ACtl.View);
  Polygon.Points := ASR2ArrayToDoublePointArray((AVisual.Data as TPolygonData).Points)
end;

class function TVisualization.Rectangle(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Rectangle: TRectangle absolute Result;
begin
  Rectangle := TRectangle.Create(ACtl, ACtl.View);
  with AVisual.Data as TRectangleData do
    Rectangle.Rect := TRectD.Create(a.X, a.Y - h, a.X + w, a.Y);
end;

class function TVisualization.RegionPlot(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable;
var
  RegionPlot: TRegion absolute Result;
begin
  RegionPlot := TRegion.Create(ACtl, ACtl.View);
  with AVisual.Data as TRegionDataR2 do
  begin
    RegionPlot.SliceData := Slices;
    RegionPlot.Axis := Axis;
    RegionPlot.UnboundedMin := UnboundedMin;
    RegionPlot.UnboundedMax := UnboundedMax;
  end;
  RegionPlot.Points := False;
  RegionPlot.Lines := False;
end;

class procedure TVisualization.RemoveVisual(const AGUID: TGUID);
var
  Drawable: TDrawable;
begin
  if TDrawable.TryGetDrawableByGUID(AGUID, Drawable) then
  begin
    if TDrawable.ModalLevel > 0 then
      raise Exception.Create('Cannot remove a drawable object when a settings dialog is open.');
    if Drawable is TDiagram then
    begin
      if Drawable.Control is TManagedVisCtl2D then
      begin
        if Drawable.Control.Parent is TVisFrm then
          Drawable.Control.Parent.Free
        else
          Drawable.Control.Free;
      end;
    end
    else
    begin
      Drawable.Control.BeginBackgroundPaint;
      try
        Drawable.Control.RemoveObject(Drawable);
      finally
        Drawable.Control.EndBackgroundPaint;
      end;
    end;
  end;
end;

class function TVisualization.ScatterPlot(ACtl: TVisCtl2D; AVisual: TVisual): TDrawable;
var
  ScatterPlot: TXYPlot absolute Result;
begin
  ScatterPlot := TXYPlot.Create(ACtl, ACtl.View);
  ScatterPlot.Data := ASR2ArrayToDoublePointArray((AVisual.Data as TScatterDataR2).Points);
end;

class function TVisualization.ShowDiagram(ADiagram: TVisCtl2D): Boolean;
begin
  Result := ShowDiagram(ADiagram.Diagram);
end;

class function TVisualization.ShowDiagram(ADiagram: TDiagram): Boolean;
var
  Ctl: TVisCtl2D;
begin

  Ctl := ADiagram.Control;
  Result := Assigned(Ctl);
  if Result then
  begin
    if Ctl.Parent = AlgosimMainForm.GalleryPanel then
    begin
      if AlgosimMainForm.GUIMode = guiConsole then
        AlgosimMainForm.GUIMode := guiMixed;
      TGallery.ShowControl(Ctl);
    end
    else
    begin
      var Frm := GetParentForm(Ctl);
      if Assigned(Frm) then
        Frm.Show;
    end;
  end;

end;

class function TVisualization.VectorField(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  VectorField: TVectorField absolute Result;
  VFD: TVectorFieldData;
  i: Integer;
begin
  VFD := AVisual.Data as TVectorFieldData;
  VectorField := TVectorField.Create(ACtl, ACtl.View);
  VectorField.BeginAddVector;
  try
    for i := 0 to High(VFD.Vectors) do
      VectorField.AddVector(VFD.Vectors[i].Key, VFD.Vectors[i].Value);
  finally
    VectorField.EndAddVector;
  end;
end;

class procedure TVisualization.Visualize(AVisual: TVisual;
  ARef: PAlgosimReference);
var
  Ctl: TVisCtl2D;
  Obj: TDrawable;
  NewDiagram: Boolean;
begin

  Ctl := GetDiagram(NewDiagram);

  if Ctl = nil then
    raise Exception.Create('No diagram control.');

  Ctl.BeginBackgroundPaint;
  try

    Obj := nil;

    case AVisual.Kind of
      vkNull: ;
      vkBarChart:
        Obj := BarChart(Ctl, AVisual);
      vkPieChart:
        Obj := PieChart(Ctl, AVisual);
      vkHistogram:
        Obj := Histogram(Ctl, AVisual);
      vkXYPlot:
        Obj := ScatterPlot(Ctl, AVisual);
      vkRegion:
        Obj := RegionPlot(Ctl, AVisual);
      vkHeatmap:
        Obj := Heatmap(Ctl, AVisual);
      vkVectorField:
        Obj := VectorField(Ctl, AVisual);
      vkPixmap:
        Obj := Pixmap(Ctl, AVisual);
      vkText:
        Obj := Text(Ctl, AVisual);
      vkLine:
        Obj := Line(Ctl, AVisual);
      vkRectangle:
        Obj := Rectangle(Ctl, AVisual);
      vkCircle:
        Obj := Circle(Ctl, AVisual);
      vkPolygon:
        Obj := Polygon(Ctl, AVisual);
    end;

    if Assigned(Obj) then
    begin
      Ctl.AddObject(Obj);
      if NewDiagram and Assigned(AVisual.ViewSetupProc) then
        AVisual.ViewSetupProc(Ctl, Obj);
      if Assigned(AVisual.OwnSetupProc) then
        AVisual.OwnSetupProc(Ctl, Obj);
      if Assigned(ARef) then
        ARef^ := Obj.CreateReference;
    end;

  finally
    Ctl.EndBackgroundPaint;
  end;

end;

class function TVisualization.ShowDiagram(const ADiagram: string): Boolean;
var
  Ctl: TManagedVisCtl2D;
begin
  Result := TManagedVisCtl2D.Instances.TryGetValue(ADiagram, Ctl);
  if Result then
    ShowDiagram(Ctl);
end;

class function TVisualization.ShowDiagram(const ADiagram: TGUID): Boolean;
var
  Drawable: TDrawable;
begin
  Result := TDrawable.TryGetDrawableByGUID(ADiagram, Drawable);
  if Result then
    ShowDiagram(Drawable.Control);
end;

class function TVisualization.Text(ACtl: TVisCtl2D;
  AVisual: TVisual): TDrawable;
var
  Text: TText absolute Result;
begin
  Text := TText.Create(ACtl, ACtl.View);
  Text.Position := (AVisual.Data as TTextData).Position;
  Text.Text := (AVisual.Data as TTextData).Text;
end;

{ TManagedVisCtl2D }

class constructor TManagedVisCtl2D.ClassCreate;
begin
  FInstances := TDictionary<string, TManagedVisCtl2D>.Create;
end;

class destructor TManagedVisCtl2D.ClassDestroy;
var
  Ctl: TPair<string, TManagedVisCtl2D>;
begin
  if Assigned(FInstances) then
    for Ctl in FInstances do
      Ctl.Value.Free;
  FreeAndNil(FInstances);
end;

procedure TManagedVisCtl2D.ContextPopup(Sender: TObject);
begin
  FmnuDetach.Visible := Parent = AlgosimMainForm.GalleryPanel;
  FmnuDock.Visible := Parent is TVisFrm;
end;

constructor TManagedVisCtl2D.Create(AOwner: TComponent);
begin
  inherited;
  FDiagramName := TVisualization.Diagram;
  if Assigned(FInstances) then
    FInstances.Add(TVisualization.Diagram, Self);
  FmnuDetach := TMenuItem.Create(Self);
  FmnuDetach.Caption := 'Detach';
  FmnuDetach.Hint := 'Detaches this diagram from the main form.';
  FmnuDetach.Tag := NativeInt(Self);
  FmnuDetach.OnClick := Detach;
  AddMenuItem(FmnuDetach);
  FmnuDock := TMenuItem.Create(Self);
  FmnuDock.Caption := 'Dock';
  FmnuDock.Hint := 'Attaches this diagram in the main form.';
  FmnuDock.Tag := NativeInt(Self);
  FmnuDock.OnClick := Dock;
  AddMenuItem(FmnuDock);
  OnBeforeContextPopup := ContextPopup;
end;

destructor TManagedVisCtl2D.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(FDiagramName);
  inherited;
end;

procedure TManagedVisCtl2D.Detach(Sender: TObject);
var
  frm: TVisFrm;
begin
  if Parent = AlgosimMainForm.GalleryPanel then
  begin
    frm := TVisFrm.CreateNew(AlgosimMainForm);
    frm.Caption := FDiagramName;
    Parent := frm;
    Align := alClient;
    frm.Show;
  end;
end;

procedure TManagedVisCtl2D.Dock(Sender: TObject);
var
  frm: TVisFrm;
begin
  if Parent is TVisFrm then
  begin
    frm := TVisFrm(Parent);
    Parent := AlgosimMainForm.GalleryPanel;
    Align := alClient;
    TGallery.ShowControl(Self);
    frm.Free;
  end;
end;

procedure TManagedVisCtl2D.SetWindowHeight(AHeight: Integer);
begin
  Detach(Self);
  if Parent is TVisFrm then
    TVisFrm(Parent).ClientHeight := AHeight;
end;

procedure TManagedVisCtl2D.SetWindowWidth(AWidth: Integer);
begin
  Detach(Self);
  if Parent is TVisFrm then
    TVisFrm(Parent).ClientWidth := AWidth;
end;

{ TVisFrm }

function TVisFrm.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if FAspect <> 0.0 then
    NewWidth := Max(64, Round(NewHeight * FAspect));
end;

procedure TVisFrm.CMTextChanged(var Message: TMessage);
begin
  inherited;
  TWndMgr.CaptionChanged(Self);
end;

constructor TVisFrm.CreateNew(AOwner: TComponent; Dummy: Integer);
var
  WA, FA: TRect;
  PrefW, PrefH, MinSize: Integer;

type
  TSide = (sNone, sTop, sRight, sBottom, sLeft);

  procedure Init;
  begin
    var MF := AlgosimMainForm;
    FA := MF.BoundsRect;
    var MON := MF.Monitor;
    if Assigned(MON) then
      WA := MON.WorkareaRect
    else
      WA := Screen.WorkAreaRect;
    PrefW := _Scale(800);
    PrefH := _Scale(600);
    MinSize := _Scale(400);
    DefaultMonitor := dmDesktop;
    Position := poDesigned;
  end;

  procedure PlaceToTheRight;
  begin
    Width := Math.Min(PrefW, WA.Right - FA.Right);
    Left := FA.Right;
    Height := Math.Min(PrefH, WA.Height);
    Top := WA.Top + Random(WA.Height - Height);
  end;

  procedure PlaceToTheLeft;
  begin
    Width := Math.Min(PrefW, FA.Left - WA.Left);
    Left := FA.Left - Width;
    Height := Math.Min(PrefH, WA.Height);
    Top := WA.Top + Random(WA.Height - Height);
  end;

  procedure PlaceAbove;
  begin
    Height := Math.Min(PrefH, FA.Top - WA.Top);
    Top := FA.Top - Height;
    Width := Math.Min(PrefW, WA.Width);
    Left := WA.Left + Random(WA.Width - Width);
  end;

  procedure PlaceBelow;
  begin
    Height := Math.Min(PrefH, WA.Bottom - FA.Bottom);
    Top := FA.Bottom;
    Width := Math.Min(PrefW, WA.Width);
    Left := WA.Left + Random(WA.Width - Width);
  end;

  function BestSide: TSide;
  var
    SpaceTop, SpaceRight, SpaceBottom, SpaceLeft: Integer;
    Spaces: TArray<Integer>;
    MaxSpace: Integer;
  begin
    SpaceTop := FA.Top - WA.Top;
    SpaceRight := WA.Right - FA.Right;
    SpaceBottom := WA.Bottom - FA.Bottom;
    SpaceLeft := FA.Left - WA.Left;
    Spaces := [SpaceTop, SpaceRight, SpaceBottom, SpaceLeft];
    MaxSpace := MaxIntValue(Spaces);
    if MaxSpace < MinSize then
      Exit(sNone)
    else
      Result := TSide(IndexInt(MaxSpace, Spaces) + 1);
  end;

  function PlaceNextToForm: Boolean;
  begin
    Result := True;
    case BestSide of
      sTop:
        PlaceAbove;
      sRight:
        PlaceToTheRight;
      sBottom:
        PlaceBelow;
      sLeft:
        PlaceToTheLeft;
    else
      Result := False;
    end;
  end;

  function PlaceOnSecondScreen: Boolean;
  var
    R: TRect;
    i: Integer;
  begin
    Exit(False); // We cannot even know if it is turned on...
    Result := Screen.MonitorCount > 1;
    if Result then
      for i := 0 to Screen.MonitorCount - 1 do
        if Screen.Monitors[i] <> AlgosimMainForm.Monitor then
        begin
          R := Screen.Monitors[i].WorkareaRect;
          Width := Math.Min(PrefW, R.Width);
          Height := Math.Min(PrefH, R.Height);
          Left := EnsureRange(R.Left + Random(R.Width - Width), R.Left, R.Right - Width);
          Top := EnsureRange(R.Top + Random(R.Height - Height), R.Top, R.Bottom - Height);
          Exit;
        end;
    Result := False;
  end;

  function PlaceOnRightSideOfMainForm: Boolean;
  begin
    Width := Math.Min(PrefW, WA.Width);
    Height := Math.Min(PrefH, WA.Height);
    Left := WA.Right - Width;
    Top := WA.Top + Random(WA.Height - Height);
    Result := True;
  end;

begin

  inherited;

  Color := clWhite;

  Init;

  if PlaceNextToForm or PlaceOnSecondScreen or PlaceOnRightSideOfMainForm then
    MakeFullyVisible;

  TFormFader.Create(Self);
  TWindowWatcher.Create(Self);

  var SysMenu := GetSystemMenu(Handle, False);
  if SysMenu = 0 then Exit;
  AppendMenu(SysMenu, MF_SEPARATOR, 0, nil);
  AppendMenu(SysMenu, MF_STRING, CMD_SETSIZE, 'Set size...');

  KeyPreview := True;

end;

procedure TVisFrm.KeyPress(var Key: Char);
begin
  inherited;
  case Key of
    's':
      begin
        Perform(WM_SYSCOMMAND, CMD_SETSIZE, 0);
        Key := #0;
      end;
  end;
end;

procedure TVisFrm.WMSysCommand(var Msg: TWMSysCommand);
begin

  inherited;
  case Msg.CmdType of
    CMD_SETSIZE:
      begin
        var W := ClientWidth;
        var H := ClientHeight;
        var Aspect: Double := FAspect;
        if ImageSizeDialog(Self, W, H, Aspect) then
        begin
          FAspect := 0.0;
          ClientWidth := W;
          ClientHeight := H;
          FAspect := Aspect;
        end;
      end;
  end;

end;

end.