Changeset 14 for os/trunk/Xvcl/Xvcl.Forms.pas

Timestamp:

Feb 29, 2016, 5:23:37 PM (8 years ago)

Author:

chronos

Message:

• Modified: TForm title bar implemented using controls.

File:

• os/trunk/Xvcl/Xvcl.Forms.pas (modified) (9 diffs)

os/trunk/Xvcl/Xvcl.Forms.pas

@@ -8 +8 @@
 type
   TBorderStyle = (bsNormal, bsNone);
+  TPanel = class;
+  TForm = class;
+  TApplication = class;
+
+  TFormTitleBar = class
+  private
+    function GetForm: TForm;
+    procedure SetForm(const Value: TForm);
+    procedure DoMaximize(Sender: TObject);
+    procedure DoClose(Sender: TObject);
+    procedure DoMouseDown(Sender: TObject; Position: TPoint; Buttons: TMouseButtonSet);
+  public
+  const
+    TitleBarHeight = 24;
+  var
+    MainLabel: TLabel;
+    Panel: TPanel;
+    MaximizeButton: TButton;
+    MinimizeButton: TButton;
+    CloseButton: TButton;
+    procedure Paint;
+    constructor Create;
+    destructor Destroy; override;
+    property Form: TForm read GetForm write SetForm;
+  end;
 
   TForm = class(TWinControl)
@@ -18 +43 @@
     function GetVideoDevice: TVideoDevice; override;
   public
-  const
-    TitleBarHeight = 24;
   var
     Screen: TObject; // TScreen;
+    Application: TApplication;
     Caption: string;
+    TitleBar: TFormTitleBar;
     function HandleMessage(Message: TMessage): Boolean; override;
     procedure Paint; override;
+    procedure Close;
+    constructor Create; override;
+    destructor Destroy; override;
     property Focused: Boolean read FFocused write SetFocused;
     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
@@ -30 +58 @@
 
   TPanel = class(TWinControl)
+  protected
+    function HandleMessage(Message: TMessage): Boolean; override;
+  public
     Caption: string;
     procedure Paint; override;
@@ -41 +72 @@
     Forms: TList<TForm>;
     MainForm: TForm;
+    Terminated: Boolean;
     function HandleMessage(Message: TMessage): Boolean; virtual;
     procedure Run; virtual;
@@ -66 +98 @@
 procedure TApplication.Terminate;
 begin
-
+  Terminated := True;
 end;
 
 { TForm }
+
+procedure TForm.Close;
+begin
+  if Application.MainForm = Self then
+    Application.Terminate;
+end;
+
+constructor TForm.Create;
+begin
+  inherited;
+  TitleBar := TFormTitleBar.Create;
+end;
+
+destructor TForm.Destroy;
+begin
+  TitleBar.Free;
+  inherited;
+end;
 
 function TForm.GetVideoDevice: TVideoDevice;
@@ -78 +128 @@
 
 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 (BorderStyle = bsNormal) and 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;
+begin
+  inherited;
 end;
 
 procedure TForm.Paint;
 begin
+  if BorderStyle = bsNormal then begin
+    TitleBar.Form := Self;
+    TitleBar.Paint;
+  end;
   inherited;
   with Canvas do begin
     if BorderStyle = bsNormal then 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));
@@ -120 +146 @@
       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;
@@ -142 +164 @@
 
 { TPanel }
+
+function TPanel.HandleMessage(Message: TMessage): Boolean;
+begin
+  inherited;
+end;
 
 procedure TPanel.Paint;
@@ -152 +179 @@
     LineTo(TPoint.Create(0, Bounds.Height - 1));
     LineTo(TPoint.Create(0, 0));
-    TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2,
-      (Bounds.Height - GetTextSize(Caption).Y) div 2), Caption);
-  end;
+    if Caption <> '' then
+      TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2,
+        (Bounds.Height - GetTextSize(Caption).Y) div 2), Caption);
+  end;
+end;
+
+{ TFormTitleBar }
+
+constructor TFormTitleBar.Create;
+begin
+  inherited;
+  Panel := TPanel.Create;
+  Panel.Visible := True;
+  Panel.OnMouseDown := DoMouseDown;
+
+  MainLabel := TLabel.Create;
+  MainLabel.Parent := Panel;
+  MainLabel.Visible := True;
+
+  CloseButton := TButton.Create;
+  CloseButton.Parent := Panel;
+  CloseButton.Caption := 'X';
+  CloseButton.Visible := True;
+  CloseButton.OnClick := DoClose;
+
+  MaximizeButton := TButton.Create;
+  MaximizeButton.Parent := Panel;
+  MaximizeButton.Caption := 'M';
+  MaximizeButton.Visible := True;
+  MaximizeButton.OnClick := DoMaximize;
+
+  MinimizeButton := TButton.Create;
+  MinimizeButton.Parent := Panel;
+  MinimizeButton.Caption := 'V';
+  MinimizeButton.Visible := True;
+end;
+
+destructor TFormTitleBar.Destroy;
+begin
+  MainLabel.Free;
+  MinimizeButton.Free;
+  MaximizeButton.Free;
+  CloseButton.Free;
+  Panel.Free;
+  inherited;
+end;
+
+procedure TFormTitleBar.DoClose(Sender: TObject);
+begin
+  Form.Close;
+end;
+
+procedure TFormTitleBar.DoMaximize(Sender: TObject);
+begin
+  Form.Bounds := TRectangle.Create(0, 0, TScreen(Form.Screen).Size.X, TScreen(Form.Screen).Size.Y);
+  Form.Paint;
+end;
+
+procedure TFormTitleBar.DoMouseDown(Sender: TObject; Position: TPoint; Buttons: TMouseButtonSet);
+begin
+  Form.Focused := True;
+  if (Form.BorderStyle = bsNormal) then begin
+    TScreen(Form.Screen).FormMove.StartControlPos := Form.Bounds.TopLeft;
+    TScreen(Form.Screen).FormMove.StartMousePos := Position;
+    TScreen(Form.Screen).FormMove.Control := Form;
+    TScreen(Form.Screen).FormMove.Active := True;
+  end;
+end;
+
+function TFormTitleBar.GetForm: TForm;
+begin
+  Result := TForm(Panel.Parent);
+end;
+
+procedure TFormTitleBar.Paint;
+begin
+  if Assigned(Form) then begin
+    Panel.Bounds := TRectangle.Create(0, 0, Form.Bounds.Width, TitleBarHeight);
+    CloseButton.Bounds := TRectangle.Create(Panel.Bounds.Width - TitleBarHeight,
+      2, TitleBarHeight - 4, TitleBarHeight - 4);
+    MaximizeButton.Bounds := TRectangle.Create(Panel.Bounds.Width - 2 * TitleBarHeight,
+      2, TitleBarHeight - 4, TitleBarHeight - 4);
+    MinimizeButton.Bounds := TRectangle.Create(Panel.Bounds.Width - 3 * TitleBarHeight,
+      2, TitleBarHeight - 4, TitleBarHeight - 4);
+   if Form.Focused then Panel.Color := clLightBlue else
+      Panel.Color := clSilver;
+    MainLabel.Caption := Form.Caption;
+    MainLabel.Bounds := TRectangle.Create(0, 0, Panel.Bounds.Width, Panel.Bounds.Height);
+  end;
+end;
+
+procedure TFormTitleBar.SetForm(const Value: TForm);
+begin
+  Panel.Parent := Value;
 end;