Changeset 14 for os/trunk/Xvcl/Xvcl.Forms.pas
- Timestamp:
- Feb 29, 2016, 5:23:37 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
os/trunk/Xvcl/Xvcl.Forms.pas
r13 r14 8 8 type 9 9 TBorderStyle = (bsNormal, bsNone); 10 TPanel = class; 11 TForm = class; 12 TApplication = class; 13 14 TFormTitleBar = class 15 private 16 function GetForm: TForm; 17 procedure SetForm(const Value: TForm); 18 procedure DoMaximize(Sender: TObject); 19 procedure DoClose(Sender: TObject); 20 procedure DoMouseDown(Sender: TObject; Position: TPoint; Buttons: TMouseButtonSet); 21 public 22 const 23 TitleBarHeight = 24; 24 var 25 MainLabel: TLabel; 26 Panel: TPanel; 27 MaximizeButton: TButton; 28 MinimizeButton: TButton; 29 CloseButton: TButton; 30 procedure Paint; 31 constructor Create; 32 destructor Destroy; override; 33 property Form: TForm read GetForm write SetForm; 34 end; 10 35 11 36 TForm = class(TWinControl) … … 18 43 function GetVideoDevice: TVideoDevice; override; 19 44 public 20 const21 TitleBarHeight = 24;22 45 var 23 46 Screen: TObject; // TScreen; 47 Application: TApplication; 24 48 Caption: string; 49 TitleBar: TFormTitleBar; 25 50 function HandleMessage(Message: TMessage): Boolean; override; 26 51 procedure Paint; override; 52 procedure Close; 53 constructor Create; override; 54 destructor Destroy; override; 27 55 property Focused: Boolean read FFocused write SetFocused; 28 56 property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; … … 30 58 31 59 TPanel = class(TWinControl) 60 protected 61 function HandleMessage(Message: TMessage): Boolean; override; 62 public 32 63 Caption: string; 33 64 procedure Paint; override; … … 41 72 Forms: TList<TForm>; 42 73 MainForm: TForm; 74 Terminated: Boolean; 43 75 function HandleMessage(Message: TMessage): Boolean; virtual; 44 76 procedure Run; virtual; … … 66 98 procedure TApplication.Terminate; 67 99 begin 68 100 Terminated := True; 69 101 end; 70 102 71 103 { TForm } 104 105 procedure TForm.Close; 106 begin 107 if Application.MainForm = Self then 108 Application.Terminate; 109 end; 110 111 constructor TForm.Create; 112 begin 113 inherited; 114 TitleBar := TFormTitleBar.Create; 115 end; 116 117 destructor TForm.Destroy; 118 begin 119 TitleBar.Free; 120 inherited; 121 end; 72 122 73 123 function TForm.GetVideoDevice: TVideoDevice; … … 78 128 79 129 function TForm.HandleMessage(Message: TMessage): Boolean; 80 var 81 TitleBarBounds: TRectangle; 82 begin 83 Result := False; 84 if Message is TMessageMouseDown then 85 with TMessageMouseDown(Message) do begin 86 TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight); 87 Focused := True; 88 if (BorderStyle = bsNormal) and TitleBarBounds.Contains(ScreenToClient(Position)) then begin 89 Move.StartControlPos := Bounds.TopLeft; 90 Move.StartMousePos := Position; 91 Move.Active := True; 92 Result := True; 93 end; 94 end else 95 if Message is TMessageMouseUp then 96 with TMessageMouseUp(Message) do begin 97 Move.Active := False; 98 end else 99 if Message is TMessageMouseMove then 100 with TMessageMouseUp(Message) do begin 101 if Move.Active then begin 102 Bounds.TopLeft := Move.StartControlPos + (Position - Move.StartMousePos); 103 TScreen(Screen).Paint; 104 end; 105 end; 106 if not Result then inherited; 130 begin 131 inherited; 107 132 end; 108 133 109 134 procedure TForm.Paint; 110 135 begin 136 if BorderStyle = bsNormal then begin 137 TitleBar.Form := Self; 138 TitleBar.Paint; 139 end; 111 140 inherited; 112 141 with Canvas do begin 113 142 if BorderStyle = bsNormal then begin 114 if Focused then Brush.Color := clLightBlue else115 Brush.Color := clSilver;116 FillRect(TRectangle.Create(0, 0, Bounds.Width - 1, TitleBarHeight));117 143 MoveTo(TPoint.Create(0, 0)); 118 144 LineTo(TPoint.Create(Bounds.Width - 1, 0)); … … 120 146 LineTo(TPoint.Create(0, Bounds.Height - 1)); 121 147 LineTo(TPoint.Create(0, 0)); 122 MoveTo(TPoint.Create(0, TitleBarHeight));123 LineTo(TPoint.Create(Bounds.Width - 1, TitleBarHeight));124 TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2,125 (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption);126 148 end; 127 149 end; … … 142 164 143 165 { TPanel } 166 167 function TPanel.HandleMessage(Message: TMessage): Boolean; 168 begin 169 inherited; 170 end; 144 171 145 172 procedure TPanel.Paint; … … 152 179 LineTo(TPoint.Create(0, Bounds.Height - 1)); 153 180 LineTo(TPoint.Create(0, 0)); 154 TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2, 155 (Bounds.Height - GetTextSize(Caption).Y) div 2), Caption); 156 end; 181 if Caption <> '' then 182 TextOut(TPoint.Create((Bounds.Width - GetTextSize(Caption).X) div 2, 183 (Bounds.Height - GetTextSize(Caption).Y) div 2), Caption); 184 end; 185 end; 186 187 { TFormTitleBar } 188 189 constructor TFormTitleBar.Create; 190 begin 191 inherited; 192 Panel := TPanel.Create; 193 Panel.Visible := True; 194 Panel.OnMouseDown := DoMouseDown; 195 196 MainLabel := TLabel.Create; 197 MainLabel.Parent := Panel; 198 MainLabel.Visible := True; 199 200 CloseButton := TButton.Create; 201 CloseButton.Parent := Panel; 202 CloseButton.Caption := 'X'; 203 CloseButton.Visible := True; 204 CloseButton.OnClick := DoClose; 205 206 MaximizeButton := TButton.Create; 207 MaximizeButton.Parent := Panel; 208 MaximizeButton.Caption := 'M'; 209 MaximizeButton.Visible := True; 210 MaximizeButton.OnClick := DoMaximize; 211 212 MinimizeButton := TButton.Create; 213 MinimizeButton.Parent := Panel; 214 MinimizeButton.Caption := 'V'; 215 MinimizeButton.Visible := True; 216 end; 217 218 destructor TFormTitleBar.Destroy; 219 begin 220 MainLabel.Free; 221 MinimizeButton.Free; 222 MaximizeButton.Free; 223 CloseButton.Free; 224 Panel.Free; 225 inherited; 226 end; 227 228 procedure TFormTitleBar.DoClose(Sender: TObject); 229 begin 230 Form.Close; 231 end; 232 233 procedure TFormTitleBar.DoMaximize(Sender: TObject); 234 begin 235 Form.Bounds := TRectangle.Create(0, 0, TScreen(Form.Screen).Size.X, TScreen(Form.Screen).Size.Y); 236 Form.Paint; 237 end; 238 239 procedure TFormTitleBar.DoMouseDown(Sender: TObject; Position: TPoint; Buttons: TMouseButtonSet); 240 begin 241 Form.Focused := True; 242 if (Form.BorderStyle = bsNormal) then begin 243 TScreen(Form.Screen).FormMove.StartControlPos := Form.Bounds.TopLeft; 244 TScreen(Form.Screen).FormMove.StartMousePos := Position; 245 TScreen(Form.Screen).FormMove.Control := Form; 246 TScreen(Form.Screen).FormMove.Active := True; 247 end; 248 end; 249 250 function TFormTitleBar.GetForm: TForm; 251 begin 252 Result := TForm(Panel.Parent); 253 end; 254 255 procedure TFormTitleBar.Paint; 256 begin 257 if Assigned(Form) then begin 258 Panel.Bounds := TRectangle.Create(0, 0, Form.Bounds.Width, TitleBarHeight); 259 CloseButton.Bounds := TRectangle.Create(Panel.Bounds.Width - TitleBarHeight, 260 2, TitleBarHeight - 4, TitleBarHeight - 4); 261 MaximizeButton.Bounds := TRectangle.Create(Panel.Bounds.Width - 2 * TitleBarHeight, 262 2, TitleBarHeight - 4, TitleBarHeight - 4); 263 MinimizeButton.Bounds := TRectangle.Create(Panel.Bounds.Width - 3 * TitleBarHeight, 264 2, TitleBarHeight - 4, TitleBarHeight - 4); 265 if Form.Focused then Panel.Color := clLightBlue else 266 Panel.Color := clSilver; 267 MainLabel.Caption := Form.Caption; 268 MainLabel.Bounds := TRectangle.Create(0, 0, Panel.Bounds.Width, Panel.Bounds.Height); 269 end; 270 end; 271 272 procedure TFormTitleBar.SetForm(const Value: TForm); 273 begin 274 Panel.Parent := Value; 157 275 end; 158 276
Note:
See TracChangeset
for help on using the changeset viewer.