Changeset 23


Ignore:
Timestamp:
May 8, 2013, 1:52:33 PM (12 years ago)
Author:
chronos
Message:
  • Added: Support for mouse move handling. Now forms can be moved by dragging title bar.
  • Fixed: Clearing background during painting in screen and forms.
Location:
branches/Xvcl
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • branches/Xvcl/Applications

    • Property svn:ignore set to
      __history
  • branches/Xvcl/Applications/TestApplication.pas

    r19 r23  
    88type
    99  TTestApplication = class(TApplication)
    10     Form: TForm;
     10    Form1: TForm;
     11    Form2: TForm;
    1112    Button: TButton;
    1213    Label1: TLabel;
     
    3132procedure TTestApplication.Run;
    3233begin
    33   Form := TForm.Create;
    34   Form.Bounds := TRectangle.Create(50, 50, 100, 100);
    35   Form.Name := 'Form1';
    36   Form.Caption := 'Test application';
    37   Form.Screen := Screen;
     34  Form1 := TForm.Create;
     35  Form1.Bounds := TRectangle.Create(50, 50, 100, 100);
     36  Form1.Name := 'Form1';
     37  Form1.Caption := 'Test application';
     38  Form1.Screen := Screen;
     39  Form2 := TForm.Create;
     40  Form2.Bounds := TRectangle.Create(250, 150, 200, 150);
     41  Form2.Name := 'Form1';
     42  Form2.Caption := 'Test application';
     43  Form2.Screen := Screen;
    3844  Button := TButton.Create;
    39   Button.Parent := Form;
     45  Button.Parent := Form1;
    4046  Button.Bounds := TRectangle.Create(50, 50, 60, 24);
    4147  Button.Visible := True;
    4248  Button.Caption := 'Start';
    4349  Button.OnClick := ButtonClick;
    44   Form.Controls.Add(Button);
     50  Form1.Controls.Add(Button);
    4551  Label1 := TLabel.Create;
    46   Label1.Parent := Form;
     52  Label1.Parent := Form1;
    4753  Label1.Bounds := TRectangle.Create(50, 70, 60, 24);
    4854  Label1.Visible := True;
    4955  Label1.Caption := '0';
    50   Form.Controls.Add(Label1);
    51   TScreen(Screen).Forms.Add(Form);
     56  Form1.Controls.Add(Label1);
     57  Form2.Controls.Add(Label1);
     58  TScreen(Screen).Forms.Add(Form1);
    5259  TScreen(Screen).Paint;
    5360end;
  • branches/Xvcl/Drivers/Driver.MouseVCL.pas

    r20 r23  
    1313    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
    1414      Shift: TShiftState; X, Y: Integer);
     15    procedure DoMouseMove(Sender: TObject; Shift: TShiftState;
     16      X, Y: Integer);
    1517  public
    1618    Form: Vcl.Forms.TForm;
     
    2527begin
    2628  Kernel.Mouse.HandleDown(TPoint.Create(X, Y));
     29end;
     30
     31procedure TDriverMouseVCL.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
     32  Y: Integer);
     33begin
     34  Kernel.Mouse.HandleMouseMove(TPoint.Create(X, Y));
    2735end;
    2836
     
    4553  TForm1(Form).Image1.OnMouseDown := DoMouseDown;
    4654  TForm1(Form).Image1.OnMouseUp := DoMouseUp;
     55  TForm1(Form).Image1.OnMouseMove := DoMouseMove;
    4756end;
    4857
  • branches/Xvcl/Drivers/Driver.VideoVCL.pas

    r22 r23  
    5656begin
    5757  case Color of
    58     clBlack: Result := Vcl.Graphics.clBlack;
    59     clWhite: Result := Vcl.Graphics.clWhite;
    60     clBlue: Result := Vcl.Graphics.clBlue;
    61     clGreen: Result := Vcl.Graphics.clGreen;
    62     clRed: Result := Vcl.Graphics.clRed;
    63     clSilver: Result := Vcl.Graphics.clSilver;
    64     clGray: Result := Vcl.Graphics.clGray;
    65     else Result := Vcl.Graphics.clBlack;
     58    clBlack: Result := $000000;
     59    clWhite: Result := $ffffff;
     60    clBlue: Result := $ff0000;
     61    clGreen: Result := $00ff00;
     62    clRed: Result := $0000ff;
     63    clSilver: Result := $c0c0c0;
     64    clGray: Result := $808080;
     65    clLightBlue: Result := $ff8080;
     66    clLightRed: Result := $80ff80;
     67    clLightGreen: Result := $8080ff;
     68    clBrown: Result := $a52a2a;
     69    clMagenta: Result := $ff00ff;
     70    clCyan: Result := $00ffff;
     71    clYellow: Result := $ffff00;
     72    else Result := $000000;
    6673  end;
    6774end;
  • branches/Xvcl/Xvcl.Classes.pas

    r20 r23  
    1111    function Substract(Point: TPoint): TPoint;
    1212    function IsZero: Boolean;
     13    class operator Add(A, B: TPoint): TPoint;
     14    class operator Subtract(A, B: TPoint): TPoint;
    1315  end;
    1416
     
    5759  TNotifyEvent = procedure (Sender: TObject) of object;
    5860
     61  TUpdateLock = class
     62  private
     63    FOnUpdate: TNotifyEvent;
     64  published
     65    Counter: Integer;
     66    procedure Start;
     67    procedure Stop;
     68    procedure Update;
     69    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
     70  end;
     71
    5972
    6073implementation
     
    157170end;
    158171
     172class operator TPoint.Add(A, B: TPoint): TPoint;
     173begin
     174  Result.X := A.X + B.X;
     175  Result.Y := A.Y + B.Y;
     176end;
     177
    159178constructor TPoint.Create(X, Y: Integer);
    160179begin
     
    169188end;
    170189
     190class operator TPoint.Subtract(A, B: TPoint): TPoint;
     191begin
     192  Result.X := A.X - B.X;
     193  Result.Y := A.Y - B.Y;
     194end;
     195
    171196function TPoint.Substract(Point: TPoint): TPoint;
    172197begin
     
    174199end;
    175200
     201{ TUpdateLock }
     202
     203procedure TUpdateLock.Start;
     204begin
     205  Inc(Counter);
     206end;
     207
     208procedure TUpdateLock.Stop;
     209begin
     210  if Counter > 0 then begin
     211    Dec(Counter);
     212    Update;
     213  end;
     214end;
     215
     216procedure TUpdateLock.Update;
     217begin
     218  if (Counter = 0) and Assigned(FOnUpdate) then
     219    FOnUpdate(Self);
     220end;
     221
    176222end.
  • branches/Xvcl/Xvcl.Controls.pas

    r21 r23  
    2323  TMessageMouseDown = class(TMessageMouse);
    2424  TMessageMouseUp = class(TMessageMouse);
     25  TMessageMouseMove = class(TMessageMouse);
    2526
    2627  TKeyState = (ksShift, ksAlt, ksOS);
     
    3738    Control: TControl;
    3839    function AdjustPos(Position: TPoint): TPoint; override;
     40  end;
     41
     42  TControlMove = class
     43    Control: TControl;
     44    StartControlPos: TPoint;
     45    StartMousePos: TPoint;
     46    Active: Boolean;
    3947  end;
    4048
     
    5462  protected
    5563    function GetVideoDevice: TVideoDevice; virtual;
    56   public
    57     Controls: TList<TControl>;
    5864    function HandleMessage(Message: TMessage): Boolean; virtual;
     65  public
     66    Move: TControlMove;
    5967    function ClientToScreen(Position: TPoint): TPoint; virtual;
    6068    function ScreenToClient(Position: TPoint): TPoint; virtual;
     
    7583  TWinControl = class(TControl)
    7684  protected
     85    function HandleMessage(Message: TMessage): Boolean; override;
    7786  public
    7887    Controls: TList<TControl>;
    79     function HandleMessage(Message: TMessage): Boolean; override;
     88    procedure Paint; override;
    8089    constructor Create; override;
    8190    destructor Destroy; override;
     
    115124begin
    116125  inherited;
    117   Controls := TList<TControl>.Create;
     126  Move := TControlMove.Create;
    118127end;
    119128
    120129destructor TControl.Destroy;
    121130begin
    122   Controls.Destroy;
     131  Move.Destroy;
    123132  if Assigned(FCanvas) then FCanvas.Destroy;
    124133  inherited;
     
    159168
    160169procedure TControl.Paint;
    161 var
    162   C: TControl;
    163 begin
    164   for C in Controls do C.Paint;
     170begin
    165171end;
    166172
     
    267273end;
    268274
     275procedure TWinControl.Paint;
     276var
     277  C: TControl;
     278begin
     279  inherited;
     280  for C in Controls do C.Paint;
     281end;
     282
    269283{ TLabel }
    270284
  • branches/Xvcl/Xvcl.Forms.pas

    r22 r23  
    88type
    99  TForm = class(TWinControl)
     10  private
     11    FFocused: Boolean;
     12    procedure SetFocused(const Value: Boolean);
    1013  protected
    1114    function GetVideoDevice: TVideoDevice; override;
    1215  public
     16  const
     17    TitleBarHeight = 24;
     18  var
    1319    Screen: TObject; // TScreen;
    1420    Caption: string;
     21    function HandleMessage(Message: TMessage): Boolean; override;
    1522    procedure Paint; override;
     23    property Focused: Boolean read FFocused write SetFocused;
    1624  end;
    1725
     
    5058end;
    5159
     60function TForm.HandleMessage(Message: TMessage): Boolean;
     61var
     62  TitleBarBounds: TRectangle;
     63begin
     64  Result := False;
     65  if Message is TMessageMouseDown then
     66  with TMessageMouseDown(Message) do begin
     67    TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight);
     68    if TitleBarBounds.Contains(ScreenToClient(Position)) then begin
     69      Focused := True;
     70      Result := True;
     71      Move.StartControlPos := Bounds.TopLeft;
     72      Move.StartMousePos := Position;
     73      Move.Active := True;
     74    end;
     75  end else
     76  if Message is TMessageMouseUp then
     77  with TMessageMouseUp(Message) do begin
     78    Move.Active := False;
     79  end else
     80  if Message is TMessageMouseMove then
     81  with TMessageMouseUp(Message) do begin
     82    if Move.Active then begin
     83      Bounds.TopLeft := Move.StartControlPos + (Position - Move.StartMousePos);
     84      TScreen(Screen).Paint;
     85    end;
     86  end;
     87  if not Result then inherited;
     88end;
     89
    5290procedure TForm.Paint;
    53 const
    54   TitleBarHeight = 24;
    5591begin
    56   inherited;
    5792  with Canvas do begin
     93    Canvas.Brush.Color := clWhite;
     94    Canvas.FillRect(TRectangle.Create(0, TitleBarHeight, Size.X, Size.Y));
     95    if Focused then Brush.Color := clLightBlue else
     96      Brush.Color := clSilver;
     97    FillRect(TRectangle.Create(0, 0, Bounds.Width - 1, TitleBarHeight));
    5898    MoveTo(TPoint.Create(0, 0));
    5999    LineTo(TPoint.Create(Bounds.Width - 1, 0));
     
    66106      (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption);
    67107  end;
     108  inherited;
     109end;
     110
     111procedure TForm.SetFocused(const Value: Boolean);
     112begin
     113  FFocused := Value;
     114  Paint;
    68115end;
    69116
  • branches/Xvcl/Xvcl.Generics.pas

    r22 r23  
    44
    55type
    6   TList<T> = class;
    7 
    8 
    9 
    106  TList<T> = class
    117  private
     
    3531implementation
    3632
    37 { TListEnumerator<T> }
     33{ TList<T>.TEnumerator }
    3834
    3935function TList<T>.TEnumerator.GetCurrent: T;
  • branches/Xvcl/Xvcl.Graphics.pas

    r20 r23  
    88type
    99
    10   TColor = (clNone, clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed);
     10  TColor = (clNone, clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed,
     11    clLightBlue, clLightRed, clLightGreen, clBrown, clYellow, clMagenta, clCyan);
    1112
    1213  TPen = class
     
    115116function TCanvas.GetVideoDevice: TVideoDevice;
    116117begin
    117   Result := nil;
     118  Result := FVideoDevice;
    118119end;
    119120
     
    138139begin
    139140  if Assigned(VideoDevice) then VideoDevice.SetPixel(Position, Color);
     141end;
     142
     143procedure TCanvas.SetVideoDevice(const Value: TVideoDevice);
     144begin
     145  FVideoDevice := Value;
    140146end;
    141147
  • branches/Xvcl/Xvcl.Kernel.pas

    r21 r23  
    88type
    99  TKernel = class;
     10  TScreen = class;
    1011
    1112  TProcessState = (psReady, psRunning, psWaiting, psFinished);
     
    2425    procedure Initialize; virtual;
    2526    procedure Finalize; virtual;
     27  end;
     28
     29  TScreenCanvas = class(TCanvas)
     30    Screen: TScreen;
     31    function GetVideoDevice: TVideoDevice; override;
    2632  end;
    2733
     
    4551  TMouse = class
    4652    Kernel: TKernel;
     53    procedure HandleMove(Position: TPoint);
    4754    procedure HandleDown(Position: TPoint);
    4855    procedure HandleUp(Position: TPoint);
     
    144151  inherited;
    145152  Forms := TList<TForm>.Create;
    146   Canvas := TCanvas.Create;
     153  Canvas := TScreenCanvas.Create;
    147154end;
    148155
     
    158165  Form: TForm;
    159166begin
     167  Canvas.Brush.Color := clWhite;
     168  Canvas.FillRect(TRectangle.Create(0, 0, Size.X, Size.Y));
    160169  for Form in Forms do Form.Paint;
    161170end;
     
    203212var
    204213  Form: TForm;
    205   NewMessage: TMessageMouse;
     214  NewMessage: TMessageMouseDown;
    206215begin
    207216  NewMessage := TMessageMouseDown.Create;
    208217  NewMessage.Position := Position;
    209218  try
    210     for Form in Kernel.Screen.Forms do begin
     219    for Form in Kernel.Screen.Forms do
     220    if Form.Bounds.Contains(Position) then begin
    211221      if Form.HandleMessage(NewMessage) then begin
    212222        Break;
     
    218228end;
    219229
    220 procedure TMouse.HandleUp(Position: TPoint);
    221 var
    222   Form: TForm;
    223   NewMessage: TMessageMouse;
    224 begin
    225   NewMessage := TMessageMouseUp.Create;
     230procedure TMouse.HandleMove(Position: TPoint);
     231var
     232  Form: TForm;
     233  NewMessage: TMessageMouseMove;
     234begin
     235  NewMessage := TMessageMouseMove.Create;
    226236  NewMessage.Position := Position;
    227237  try
    228     for Form in Kernel.Screen.Forms do begin
     238    for Form in Kernel.Screen.Forms do
     239    if Form.Bounds.Contains(Position) then begin
    229240      if Form.HandleMessage(NewMessage) then begin
    230241        Break;
     
    236247end;
    237248
     249procedure TMouse.HandleUp(Position: TPoint);
     250var
     251  Form: TForm;
     252  NewMessage: TMessageMouseUp;
     253begin
     254  NewMessage := TMessageMouseUp.Create;
     255  NewMessage.Position := Position;
     256  try
     257    for Form in Kernel.Screen.Forms do
     258    if Form.Bounds.Contains(Position) then begin
     259      if Form.HandleMessage(NewMessage) then begin
     260        Break;
     261      end;
     262    end;
     263  finally
     264    NewMessage.Destroy;
     265  end;
     266end;
     267
     268{ TScrenCanvas }
     269
     270function TScreenCanvas.GetVideoDevice: TVideoDevice;
     271begin
     272  if Assigned(Screen) then Result := Screen.VideoDevice
     273    else Result := nil;
     274end;
     275
    238276end.
Note: See TracChangeset for help on using the changeset viewer.