Changeset 14 for os

Timestamp:

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

Author:

chronos

Message:

• Modified: TForm title bar implemented using controls.

Location:

os/trunk

Files:

• Applications/TestApplication.pas (modified) (2 diffs)
• Applications/UDesktop.pas (modified) (1 diff)
• Drivers/Driver.VideoVCL.pas (modified) (1 diff)
• System/LDOS.Kernel.pas (modified) (7 diffs)
• Xvcl/Xvcl.Classes.pas (modified) (1 diff)
• Xvcl/Xvcl.Controls.pas (modified) (12 diffs)
• Xvcl/Xvcl.Forms.pas (modified) (9 diffs)

os/trunk/Applications/TestApplication.pas

@@ -38 +38 @@
   Form1.Caption := 'Test application';
   Form1.Screen := Screen;
+  Form1.Application := Self;
   Form2 := TForm.Create;
   Form2.Owner := Self;
@@ -44 +45 @@
   Form2.Caption := 'Some form';
   Form2.Screen := Screen;
+  Form2.Application := Self;
   Timer1 := TTimer.Create;
   Timer1.Interval := 1000;

os/trunk/Applications/UDesktop.pas

@@ -83 +83 @@
   MainBar.Caption := 'fdfdfd';
   MainBar.Screen := Screen;
+  MainBar.Application := Self;
   TaskBar := TPanel.Create;
   TaskBar.Parent := MainBar;

os/trunk/Drivers/Driver.VideoVCL.pas

@@ -95 +95 @@
   inherited;
   CanvasVCL.Brush.Color := ColorToVCL(Color);
+  CanvasVCL.Brush.Style := bsSolid;
   CanvasVCL.FillRect(System.Types.Rect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom));
 end;

os/trunk/System/LDOS.Kernel.pas

@@ -63 +63 @@
     Forms: TList<TForm>;
     VideoDevice: TVideoDevice;
+    FormMove: TControlMove;
     procedure HandleResize;
     procedure Paint;
@@ -80 +81 @@
   TMouse = class
     Kernel: TKernel;
-    MovedForm: TForm;
     procedure HandleMove(Position: TPoint);
     procedure HandleDown(Position: TPoint);
@@ -226 +226 @@
   Canvas := TScreenCanvas.Create;
   Canvas.Screen := Self;
+  FormMove := TControlMove.Create;
 end;
 
 destructor TScreen.Destroy;
 begin
+  FormMove.Free;
   Canvas.Destroy;
   Forms.Destroy;
@@ -371 +373 @@
     for Form in Kernel.Screen.Forms do
     if Form.Bounds.Contains(Position) then begin
-      MovedForm := Form;
       if Form.HandleMessage(NewMessage) then begin
         Break;
@@ -389 +390 @@
   NewMessage.Position := Position;
   try
+    with Kernel.Screen.FormMove do
+    if Active then begin
+      TForm(Control).Bounds.TopLeft := StartControlPos + (Position - StartMousePos);
+      Kernel.Screen.Paint;
+    end;
     for Form in Kernel.Screen.Forms do
     if Form.Bounds.Contains(Position) then begin
@@ -410 +416 @@
   NewMessage.Position := Position;
   try
+    Kernel.Screen.FormMove.Active := False;
     for Form in Kernel.Screen.Forms do
     if Form.Bounds.Contains(Position) then begin
@@ -416 +423 @@
       end;
     end;
-    if Assigned(Kernel.Screen.FocusedForm) then
-      Kernel.Screen.FocusedForm.HandleMessage(NewMessage);
+//    if Assigned(Kernel.Screen.FocusedForm) then
+//      Kernel.Screen.FocusedForm.HandleMessage(NewMessage);
   finally
     NewMessage.Destroy;

os/trunk/Xvcl/Xvcl.Classes.pas

@@ -168 +168 @@
 constructor TComponent.Create;
 begin
+  FName := ClassName;
   FComponents := TObjectList<TComponent>.Create;
 end;

os/trunk/Xvcl/Xvcl.Controls.pas

@@ -33 +33 @@
     States: TKeyStateSet;
   end;
+
+  TMouseNotifyEvent = procedure (Sender: TObject; Position: TPoint;
+    Buttons: TMouseButtonSet) of object;
 
   TControlCanvas = class(TCanvas)
@@ -57 +60 @@
     FOnClick: TNotifyEvent;
     FColor: TColor;
-    FOnMouseDown: TNotifyEvent;
-    FOnMouseUp: TNotifyEvent;
+    FOnMouseDown: TMouseNotifyEvent;
+    FOnMouseUp: TMouseNotifyEvent;
+    FOnMouseMove: TMouseNotifyEvent;
     FOnKeyPress: TNotifyEvent;
     FFocused: Boolean;
@@ -69 +73 @@
     function HandleMessage(Message: TMessage): Boolean; virtual;
   public
-    Move: TControlMove;
     function ClientToScreen(Position: TPoint): TPoint; virtual;
     function ScreenToClient(Position: TPoint): TPoint; virtual;
@@ -83 +86 @@
     property Focused: Boolean read FFocused write SetFocused;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
-    property OnMouseDown: TNotifyEvent read FOnMouseDown write FOnMouseDown;
-    property OnMouseUp: TNotifyEvent read FOnMouseUp write FOnMouseUp;
+    property OnMouseDown: TMouseNotifyEvent read FOnMouseDown write FOnMouseDown;
+    property OnMouseUp: TMouseNotifyEvent read FOnMouseUp write FOnMouseUp;
+    property OnMouseMove: TMouseNotifyEvent read FOnMouseMove write FOnMouseMove;
     property OnKeyPress: TNotifyEvent read FOnKeyPress write FOnKeyPress;
   end;
@@ -119 +123 @@
     procedure Paint; override;
     property Caption: string read FCaption write SetCaption;
+    constructor Create; override;
   end;
 
@@ -147 +152 @@
 begin
   inherited;
-  Move := TControlMove.Create;
   FColor := clWhite;
 end;
@@ -153 +157 @@
 destructor TControl.Destroy;
 begin
-  Move.Destroy;
   if Assigned(FCanvas) then FCanvas.Destroy;
   inherited;
@@ -176 +179 @@
 begin
   Result := False;
+  if Message is TMessageMouseDown then
+  with TMessageMouseDown(Message) do begin
+    if Assigned(FOnMouseDown) then begin
+      FOnMouseDown(Self, Position, Buttons);
+      Result := True;
+    end;
+  end else
+  if Message is TMessageMouseUp then
+  with TMessageMouseUp(Message) do begin
+    if Assigned(FOnMouseUp) then begin
+      FOnMouseUp(Self, Position, Buttons);
+      Result := True;
+    end;
+  end else
+  if Message is TMessageMouseMove then
+  with TMessageMouseMove(Message) do begin
+    if Assigned(FOnMouseMove) then begin
+      FOnMouseMove(Self, Position, Buttons);
+      Result := True;
+    end;
+  end;
 end;
 
 procedure TControl.Paint;
 begin
+  if Color <> clNone then
   with Canvas do begin
     Brush.Color := Color;
@@ -189 +214 @@
 begin
   Result := Position.Substract(Bounds.TopLeft);
-  if Assigned(Parent) then Result := Parent.ClientToScreen(Result);
+  if Assigned(Parent) then Result := Parent.ScreenToClient(Result);
 end;
 
@@ -220 +245 @@
 begin
   Result := False;
-  if Message is TMessageMouseDown then begin
-    if Assigned(FOnMouseDown) then FOnMouseDown(Self);
+  if Message is TMessageMouseDown then
+  with TMessageMouseDown(Message) do begin
+    if Assigned(FOnMouseDown) then FOnMouseDown(Self, Position, Buttons);
     Color := clGray;
     Paint;
     Result := True;
   end else
-  if Message is TMessageMouseUp then begin
-    if Assigned(FOnMouseUp) then FOnMouseUp(Self);
+  if Message is TMessageMouseUp then
+  with TMessageMouseUp(Message) do begin
+    if Assigned(FOnMouseUp) then FOnMouseUp(Self, Position, Buttons);
     Color := clSilver;
     Paint;
@@ -321 +348 @@
       end;
   end;
+  if not Result then inherited;
 end;
 
@@ -332 +360 @@
 
 { TLabel }
+
+constructor TLabel.Create;
+begin
+  inherited;
+  Color := clNone;
+end;
 
 procedure TLabel.Paint;

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;