Changeset 24

Timestamp:

May 8, 2013, 2:53:22 PM (11 years ago)

Author:

chronos

Message:

• Fixed: Make only one form focused at once.
• Modified: Enhanced TList generic class to support more methods.

Location:

branches/Xvcl

Files:

• Applications/TestApplication.pas (modified) (2 diffs)
• Drivers/Driver.VideoVCL.pas (modified) (2 diffs)
• Xvcl.Controls.pas (modified) (3 diffs)
• Xvcl.Forms.pas (modified) (3 diffs)
• Xvcl.Generics.pas (modified) (4 diffs)
• Xvcl.Graphics.pas (modified) (2 diffs)
• Xvcl.Kernel.pas (modified) (3 diffs)

branches/Xvcl/Applications/TestApplication.pas

@@ -33 +33 @@
 begin
   Form1 := TForm.Create;
-  Form1.Bounds := TRectangle.Create(50, 50, 100, 100);
+  Form1.Bounds := TRectangle.Create(50, 80, 200, 120);
   Form1.Name := 'Form1';
   Form1.Caption := 'Test application';
   Form1.Screen := Screen;
   Form2 := TForm.Create;
-  Form2.Bounds := TRectangle.Create(250, 150, 200, 150);
-  Form2.Name := 'Form1';
-  Form2.Caption := 'Test application';
+  Form2.Bounds := TRectangle.Create(350, 150, 200, 150);
+  Form2.Name := 'Form2';
+  Form2.Caption := 'Some form';
   Form2.Screen := Screen;
   Button := TButton.Create;
@@ -51 +51 @@
   Label1 := TLabel.Create;
   Label1.Parent := Form1;
-  Label1.Bounds := TRectangle.Create(50, 70, 60, 24);
+  Label1.Bounds := TRectangle.Create(60, 80, 60, 24);
   Label1.Visible := True;
   Label1.Caption := '0';
   Form1.Controls.Add(Label1);
-  Form2.Controls.Add(Label1);
   TScreen(Screen).Forms.Add(Form1);
+  TScreen(Screen).Forms.Add(Form2);
   TScreen(Screen).Paint;
 end;

branches/Xvcl/Drivers/Driver.VideoVCL.pas

@@ -5 +5 @@
 uses
   Vcl.Forms, Vcl.Graphics, System.Types, UFormMain, Xvcl.Classes, Xvcl.Kernel,
-  Xvcl.Graphics;
+  Xvcl.Graphics, Generics.Collections;
 
 type
@@ -63 +63 @@
     clSilver: Result := $c0c0c0;
     clGray: Result := $808080;
-    clLightBlue: Result := $ff8080;
-    clLightRed: Result := $80ff80;
-    clLightGreen: Result := $8080ff;
+    clLightBlue: Result := $ffb0b0;
+    clLightRed: Result := $b0ffb0;
+    clLightGreen: Result := $b0b0ff;
     clBrown: Result := $a52a2a;
     clMagenta: Result := $ff00ff;

branches/Xvcl/Xvcl.Controls.pas

@@ -125 +125 @@
   inherited;
   Move := TControlMove.Create;
+  FColor := clWhite;
 end;
 
@@ -169 +170 @@
 procedure TControl.Paint;
 begin
+  with Canvas do begin
+    Brush.Color := Color;
+    FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height));
+  end;
 end;
 
@@ -206 +211 @@
   inherited;
   with Canvas do begin
-    Brush.Color := Color;
-    FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height));
     MoveTo(TPoint.Create(0, 0));
     LineTo(TPoint.Create(Bounds.Width - 1, 0));

branches/Xvcl/Xvcl.Forms.pas

@@ -66 +66 @@
   with TMessageMouseDown(Message) do begin
     TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight);
+    Focused := True;
     if TitleBarBounds.Contains(ScreenToClient(Position)) then begin
-      Focused := True;
-      Result := True;
       Move.StartControlPos := Bounds.TopLeft;
       Move.StartMousePos := Position;
       Move.Active := True;
+     Result := True;
     end;
   end else
@@ -90 +90 @@
 procedure TForm.Paint;
 begin
+  inherited;
   with Canvas do begin
-    Canvas.Brush.Color := clWhite;
-    Canvas.FillRect(TRectangle.Create(0, TitleBarHeight, Size.X, Size.Y));
     if Focused then Brush.Color := clLightBlue else
       Brush.Color := clSilver;
@@ -106 +105 @@
       (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption);
   end;
-  inherited;
 end;
 
 procedure TForm.SetFocused(const Value: Boolean);
 begin
-  FFocused := Value;
-  Paint;
+  if FFocused <> Value then begin
+    FFocused := Value;
+    if Value then TScreen(Screen).FocusForm(Self);
+  end;
 end;
 

branches/Xvcl/Xvcl.Generics.pas

@@ -2 +2 @@
 
 interface
+
+uses
+  SysUtils;
 
 type
@@ -24 +27 @@
     function GetEnumerator: TEnumerator;
     function Add(Item: T): Integer;
-    procedure Remove(Item: T);
+    function Remove(Item: T): Integer;
+    procedure Delete(Index: Integer);
+    procedure Move(FromIndex, ToIndex: Integer);
+    function IndexOf(Item: T): Integer;
+    function Compare(Item1, Item2: T): Integer;
+    procedure Exchange(Index1, Index2: Integer);
     property Count: Integer read FCount write SetCount;
     property Items[Index: Integer]: T read GetItem write SetItem; default;
@@ -55 +63 @@
 end;
 
+function TList<T>.Compare(Item1, Item2: T): Integer;
+begin
+  if CompareMem(Pointer(@Item1), Pointer(@Item2), SizeOf(T)) then Result := 0
+    else Result := -1;
+end;
+
+procedure TList<T>.Delete(Index: Integer);
+var
+  I: Integer;
+begin
+  if (Index >= 0) and (Index < Count) then
+  for I := Index to Count - 2 do
+    Items[I] := Items[I + 1];
+end;
+
+procedure TList<T>.Exchange(Index1, Index2: Integer);
+var
+  Temp: T;
+begin
+  Temp := Items[Index2];
+  Items[Index2] := Items[Index1];
+  Items[Index1] := Temp;
+end;
+
 function TList<T>.GetEnumerator: TEnumerator;
 begin
@@ -67 +99 @@
 end;
 
-procedure TList<T>.Remove(Item: T);
+function TList<T>.IndexOf(Item: T): Integer;
+var
+  I: Integer;
 begin
+  I := 0;
+  while (I < Count) and (Compare(Items[I], Item) <> 0) do
+    Inc(I);
+  if I < Count then Result := I
+    else Result := -1;
+end;
 
+procedure TList<T>.Move(FromIndex, ToIndex: Integer);
+var
+  I: Integer;
+  Temp: T;
+begin
+  if (FromIndex >= 0) and (FromIndex < Count) and
+  (ToIndex >= 0) and (ToIndex < Count) then begin
+    if FromIndex > ToIndex then begin
+      Temp := Items[ToIndex];
+      for I := ToIndex to FromIndex - 1 do
+        Items[I] := Items[I + 1];
+      Items[FromIndex] := Temp;
+    end else
+    if FromIndex < ToIndex then begin
+      Temp := Items[FromIndex];
+      for I := FromIndex to ToIndex - 1 do
+        Items[I] := Items[I + 1];
+      Items[ToIndex] := Temp;
+    end;
+  end;
+end;
+
+function TList<T>.Remove(Item: T): Integer;
+begin
+  Result := IndexOf(Item);
+  if Result >= 0 then Delete(Result);
 end;
 

branches/Xvcl/Xvcl.Graphics.pas

@@ -116 +116 @@
 function TCanvas.GetVideoDevice: TVideoDevice;
 begin
-  Result := FVideoDevice;
+  Result := nil;
 end;
 
@@ -139 +139 @@
 begin
   if Assigned(VideoDevice) then VideoDevice.SetPixel(Position, Color);
-end;
-
-procedure TCanvas.SetVideoDevice(const Value: TVideoDevice);
-begin
-  FVideoDevice := Value;
 end;
 

branches/Xvcl/Xvcl.Kernel.pas

@@ -33 +33 @@
 
   TScreen = class(TComponent)
-    Canvas: TCanvas;
+    Canvas: TScreenCanvas;
     Size: TPoint;
     Forms: TList<TForm>;
     VideoDevice: TVideoDevice;
     procedure Paint;
+    procedure FocusForm(Form: TForm);
     constructor Create; override;
     destructor Destroy; override;
@@ -152 +153 @@
   Forms := TList<TForm>.Create;
   Canvas := TScreenCanvas.Create;
+  Canvas.Screen := Self;
 end;
 
@@ -159 +161 @@
   Forms.Destroy;
   inherited;
+end;
+
+procedure TScreen.FocusForm(Form: TForm);
+var
+  I: Integer;
+  FormIndex: Integer;
+begin
+  FormIndex := Forms.IndexOf(Form);
+  for I := 0 to Forms.Count - 1 do
+    Forms[I].Focused := I = FormIndex;
+
+  Forms.Move(FormsIndex, Forms.Count - 1);
+  Paint;
 end;