- Timestamp:
- May 8, 2013, 2:53:22 PM (12 years ago)
- Location:
- branches/Xvcl
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/Xvcl/Applications/TestApplication.pas
r23 r24 33 33 begin 34 34 Form1 := TForm.Create; 35 Form1.Bounds := TRectangle.Create(50, 50, 100, 100);35 Form1.Bounds := TRectangle.Create(50, 80, 200, 120); 36 36 Form1.Name := 'Form1'; 37 37 Form1.Caption := 'Test application'; 38 38 Form1.Screen := Screen; 39 39 Form2 := TForm.Create; 40 Form2.Bounds := TRectangle.Create( 250, 150, 200, 150);41 Form2.Name := 'Form 1';42 Form2.Caption := ' Test application';40 Form2.Bounds := TRectangle.Create(350, 150, 200, 150); 41 Form2.Name := 'Form2'; 42 Form2.Caption := 'Some form'; 43 43 Form2.Screen := Screen; 44 44 Button := TButton.Create; … … 51 51 Label1 := TLabel.Create; 52 52 Label1.Parent := Form1; 53 Label1.Bounds := TRectangle.Create( 50, 70, 60, 24);53 Label1.Bounds := TRectangle.Create(60, 80, 60, 24); 54 54 Label1.Visible := True; 55 55 Label1.Caption := '0'; 56 56 Form1.Controls.Add(Label1); 57 Form2.Controls.Add(Label1);58 57 TScreen(Screen).Forms.Add(Form1); 58 TScreen(Screen).Forms.Add(Form2); 59 59 TScreen(Screen).Paint; 60 60 end; -
branches/Xvcl/Drivers/Driver.VideoVCL.pas
r23 r24 5 5 uses 6 6 Vcl.Forms, Vcl.Graphics, System.Types, UFormMain, Xvcl.Classes, Xvcl.Kernel, 7 Xvcl.Graphics ;7 Xvcl.Graphics, Generics.Collections; 8 8 9 9 type … … 63 63 clSilver: Result := $c0c0c0; 64 64 clGray: Result := $808080; 65 clLightBlue: Result := $ff 8080;66 clLightRed: Result := $ 80ff80;67 clLightGreen: Result := $ 8080ff;65 clLightBlue: Result := $ffb0b0; 66 clLightRed: Result := $b0ffb0; 67 clLightGreen: Result := $b0b0ff; 68 68 clBrown: Result := $a52a2a; 69 69 clMagenta: Result := $ff00ff; -
branches/Xvcl/Xvcl.Controls.pas
r23 r24 125 125 inherited; 126 126 Move := TControlMove.Create; 127 FColor := clWhite; 127 128 end; 128 129 … … 169 170 procedure TControl.Paint; 170 171 begin 172 with Canvas do begin 173 Brush.Color := Color; 174 FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height)); 175 end; 171 176 end; 172 177 … … 206 211 inherited; 207 212 with Canvas do begin 208 Brush.Color := Color;209 FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height));210 213 MoveTo(TPoint.Create(0, 0)); 211 214 LineTo(TPoint.Create(Bounds.Width - 1, 0)); -
branches/Xvcl/Xvcl.Forms.pas
r23 r24 66 66 with TMessageMouseDown(Message) do begin 67 67 TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight); 68 Focused := True; 68 69 if TitleBarBounds.Contains(ScreenToClient(Position)) then begin 69 Focused := True;70 Result := True;71 70 Move.StartControlPos := Bounds.TopLeft; 72 71 Move.StartMousePos := Position; 73 72 Move.Active := True; 73 Result := True; 74 74 end; 75 75 end else … … 90 90 procedure TForm.Paint; 91 91 begin 92 inherited; 92 93 with Canvas do begin 93 Canvas.Brush.Color := clWhite;94 Canvas.FillRect(TRectangle.Create(0, TitleBarHeight, Size.X, Size.Y));95 94 if Focused then Brush.Color := clLightBlue else 96 95 Brush.Color := clSilver; … … 106 105 (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption); 107 106 end; 108 inherited;109 107 end; 110 108 111 109 procedure TForm.SetFocused(const Value: Boolean); 112 110 begin 113 FFocused := Value; 114 Paint; 111 if FFocused <> Value then begin 112 FFocused := Value; 113 if Value then TScreen(Screen).FocusForm(Self); 114 end; 115 115 end; 116 116 -
branches/Xvcl/Xvcl.Generics.pas
r23 r24 2 2 3 3 interface 4 5 uses 6 SysUtils; 4 7 5 8 type … … 24 27 function GetEnumerator: TEnumerator; 25 28 function Add(Item: T): Integer; 26 procedure Remove(Item: T); 29 function Remove(Item: T): Integer; 30 procedure Delete(Index: Integer); 31 procedure Move(FromIndex, ToIndex: Integer); 32 function IndexOf(Item: T): Integer; 33 function Compare(Item1, Item2: T): Integer; 34 procedure Exchange(Index1, Index2: Integer); 27 35 property Count: Integer read FCount write SetCount; 28 36 property Items[Index: Integer]: T read GetItem write SetItem; default; … … 55 63 end; 56 64 65 function TList<T>.Compare(Item1, Item2: T): Integer; 66 begin 67 if CompareMem(Pointer(@Item1), Pointer(@Item2), SizeOf(T)) then Result := 0 68 else Result := -1; 69 end; 70 71 procedure TList<T>.Delete(Index: Integer); 72 var 73 I: Integer; 74 begin 75 if (Index >= 0) and (Index < Count) then 76 for I := Index to Count - 2 do 77 Items[I] := Items[I + 1]; 78 end; 79 80 procedure TList<T>.Exchange(Index1, Index2: Integer); 81 var 82 Temp: T; 83 begin 84 Temp := Items[Index2]; 85 Items[Index2] := Items[Index1]; 86 Items[Index1] := Temp; 87 end; 88 57 89 function TList<T>.GetEnumerator: TEnumerator; 58 90 begin … … 67 99 end; 68 100 69 procedure TList<T>.Remove(Item: T); 101 function TList<T>.IndexOf(Item: T): Integer; 102 var 103 I: Integer; 70 104 begin 105 I := 0; 106 while (I < Count) and (Compare(Items[I], Item) <> 0) do 107 Inc(I); 108 if I < Count then Result := I 109 else Result := -1; 110 end; 71 111 112 procedure TList<T>.Move(FromIndex, ToIndex: Integer); 113 var 114 I: Integer; 115 Temp: T; 116 begin 117 if (FromIndex >= 0) and (FromIndex < Count) and 118 (ToIndex >= 0) and (ToIndex < Count) then begin 119 if FromIndex > ToIndex then begin 120 Temp := Items[ToIndex]; 121 for I := ToIndex to FromIndex - 1 do 122 Items[I] := Items[I + 1]; 123 Items[FromIndex] := Temp; 124 end else 125 if FromIndex < ToIndex then begin 126 Temp := Items[FromIndex]; 127 for I := FromIndex to ToIndex - 1 do 128 Items[I] := Items[I + 1]; 129 Items[ToIndex] := Temp; 130 end; 131 end; 132 end; 133 134 function TList<T>.Remove(Item: T): Integer; 135 begin 136 Result := IndexOf(Item); 137 if Result >= 0 then Delete(Result); 72 138 end; 73 139 -
branches/Xvcl/Xvcl.Graphics.pas
r23 r24 116 116 function TCanvas.GetVideoDevice: TVideoDevice; 117 117 begin 118 Result := FVideoDevice;118 Result := nil; 119 119 end; 120 120 … … 139 139 begin 140 140 if Assigned(VideoDevice) then VideoDevice.SetPixel(Position, Color); 141 end;142 143 procedure TCanvas.SetVideoDevice(const Value: TVideoDevice);144 begin145 FVideoDevice := Value;146 141 end; 147 142 -
branches/Xvcl/Xvcl.Kernel.pas
r23 r24 33 33 34 34 TScreen = class(TComponent) 35 Canvas: T Canvas;35 Canvas: TScreenCanvas; 36 36 Size: TPoint; 37 37 Forms: TList<TForm>; 38 38 VideoDevice: TVideoDevice; 39 39 procedure Paint; 40 procedure FocusForm(Form: TForm); 40 41 constructor Create; override; 41 42 destructor Destroy; override; … … 152 153 Forms := TList<TForm>.Create; 153 154 Canvas := TScreenCanvas.Create; 155 Canvas.Screen := Self; 154 156 end; 155 157 … … 159 161 Forms.Destroy; 160 162 inherited; 163 end; 164 165 procedure TScreen.FocusForm(Form: TForm); 166 var 167 I: Integer; 168 FormIndex: Integer; 169 begin 170 FormIndex := Forms.IndexOf(Form); 171 for I := 0 to Forms.Count - 1 do 172 Forms[I].Focused := I = FormIndex; 173 174 Forms.Move(FormsIndex, Forms.Count - 1); 175 Paint; 161 176 end; 162 177
Note:
See TracChangeset
for help on using the changeset viewer.