- Timestamp:
- Jun 2, 2013, 10:46:40 PM (11 years ago)
- Location:
- os/trunk
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
os/trunk/Applications/TestApplication.pas
r7 r8 12 12 Button: TButton; 13 13 Label1: TLabel; 14 Edit1: TEdit; 14 15 Timer1: TTimer; 15 16 procedure Run; override; … … 54 55 Button.Caption := 'Start'; 55 56 Button.OnClick := ButtonClick; 56 Form1.Controls.Add(Button);57 57 Label1 := TLabel.Create; 58 58 Label1.Parent := Form1; … … 61 61 Label1.Visible := True; 62 62 Label1.Caption := '0'; 63 Form1.Controls.Add(Label1); 63 Edit1 := TEdit.Create; 64 Edit1.Parent := Form2; 65 Edit1.Owner := Form2; 66 Edit1.Bounds := TRectangle.Create(60, 80, 60, 24); 67 Edit1.Visible := True; 68 Edit1.Text := 'Text'; 64 69 MainForm := Form1; 65 70 TScreen(Screen).Forms.Add(Form1); -
os/trunk/Applications/UDesktop.pas
r7 r8 90 90 TaskBar.Visible := True; 91 91 TaskBar.Caption := 'dds'; 92 MainBar.Controls.Add(TaskBar);93 92 MenuButton := TButton.Create; 94 MenuButton.Parent := TaskBar;95 MenuButton.Owner := TaskBar;93 MenuButton.Parent := MainBar; 94 MenuButton.Owner := MainBar; 96 95 MenuButton.Bounds := TRectangle.Create(0, 0, 50, 24); 97 96 MenuButton.Visible := True; 98 97 MenuButton.Caption := 'Menu'; 99 98 MenuButton.OnClick := ButtonClick; 100 MainBar.Controls.Add(MenuButton);101 99 TScreen(Screen).Forms.Add(MainBar); 102 100 MainForm := MainBar; -
os/trunk/Drivers/Driver.KeyboardVCL.pas
r5 r8 34 34 begin 35 35 Kernel.Keyboard.KeysState[Key] := False; 36 Kernel.Keyboard.HandleKeyPress(Key); 36 37 end; 37 38 -
os/trunk/System/LDOS.Kernel.pas
r7 r8 73 73 function ReadKey: Char; 74 74 function KeyPressed: Boolean; 75 procedure HandleKeyPress(Key: Word); 75 76 end; 76 77 … … 303 304 { TKeyboard } 304 305 306 procedure TKeyboard.HandleKeyPress(Key: Word); 307 var 308 Form: TForm; 309 NewMessage: TMessageKeyPress; 310 begin 311 NewMessage := TMessageKeyPress.Create; 312 NewMessage.KeyCode := Key; 313 try 314 for Form in Kernel.Screen.Forms do 315 if Form.HandleMessage(NewMessage) then begin 316 Break; 317 end; 318 finally 319 NewMessage.Destroy; 320 end; 321 end; 322 305 323 function TKeyboard.KeyPressed: Boolean; 306 324 begin -
os/trunk/Xvcl/Xvcl.Controls.pas
r5 r8 29 29 TKeyState = (ksShift, ksAlt, ksOS); 30 30 TKeyStateSet = set of TKeyState; 31 TMessageKey board= class(TMessage)31 TMessageKeyPress = class(TMessage) 32 32 KeyCode: Integer; 33 33 States: TKeyStateSet; … … 59 59 FOnMouseDown: TNotifyEvent; 60 60 FOnMouseUp: TNotifyEvent; 61 FOnKeyPress: TNotifyEvent; 61 62 function GetCanvas: TCanvas; 62 63 procedure SetParent(const Value: TWinControl); virtual; … … 81 82 property OnMouseDown: TNotifyEvent read FOnMouseDown write FOnMouseDown; 82 83 property OnMouseUp: TNotifyEvent read FOnMouseUp write FOnMouseUp; 84 property OnKeyPress: TNotifyEvent read FOnKeyPress write FOnKeyPress; 83 85 end; 84 86 … … 97 99 FCaption: string; 98 100 procedure SetCaption(const Value: string); 101 protected 102 function HandleMessage(Message: TMessage): Boolean; override; 99 103 public 100 104 procedure Paint; override; … … 112 116 end; 113 117 118 TEdit = class(TControl) 119 private 120 FText: string; 121 procedure SetText(const Value: string); 122 protected 123 function HandleMessage(Message: TMessage): Boolean; override; 124 public 125 procedure Paint; override; 126 constructor Create; override; 127 property Text: string read FText write SetText; 128 end; 129 114 130 115 131 implementation … … 153 169 154 170 function TControl.HandleMessage(Message: TMessage): Boolean; 171 begin 172 Result := False; 173 end; 174 175 procedure TControl.Paint; 176 begin 177 with Canvas do begin 178 Brush.Color := Color; 179 FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height)); 180 end; 181 end; 182 183 function TControl.ScreenToClient(Position: TPoint): TPoint; 184 begin 185 Result := Position.Substract(Bounds.TopLeft); 186 if Assigned(Parent) then Result := Parent.ClientToScreen(Result); 187 end; 188 189 procedure TControl.SetColor(const Value: TColor); 190 begin 191 if FColor <> Value then begin 192 FColor := Value; 193 if Visible then Paint; 194 end; 195 end; 196 197 procedure TControl.SetParent(const Value: TWinControl); 198 begin 199 if FParent <> Value then begin 200 if Assigned(FParent) then Parent.Controls.Remove(Self); 201 FParent := Value; 202 if Assigned(FParent) then Parent.Controls.Add(Self); 203 end; 204 end; 205 206 { TButton } 207 208 function TButton.HandleMessage(Message: TMessage): Boolean; 155 209 begin 156 210 Result := False; … … 170 224 end; 171 225 172 procedure TControl.Paint;173 begin174 with Canvas do begin175 Brush.Color := Color;176 FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height));177 end;178 end;179 180 function TControl.ScreenToClient(Position: TPoint): TPoint;181 begin182 Result := Position.Substract(Bounds.TopLeft);183 if Assigned(Parent) then Result := Parent.ClientToScreen(Result);184 end;185 186 procedure TControl.SetColor(const Value: TColor);187 begin188 if FColor <> Value then begin189 FColor := Value;190 if Visible then Paint;191 end;192 end;193 194 procedure TControl.SetParent(const Value: TWinControl);195 begin196 if FParent <> Value then begin197 if Assigned(FParent) then Parent.Controls.Remove(Self);198 FParent := Value;199 if Assigned(FParent) then Parent.Controls.Add(Self);200 end;201 end;202 203 { TButton }204 205 226 constructor TButton.Create; 206 227 begin … … 268 289 if Message is TMessageMouse then 269 290 with TMessageMouse(Message) do begin 270 if Control.Bounds.Contains(ScreenToClient(Position)) then begin 291 if Control.Bounds.Contains(ScreenToClient(Position)) then begin 292 if TWinControl(Control).HandleMessage(Message) then begin 293 Result := True; 294 Break; 295 end; 296 end; 297 end else 298 if Message is TMessageKeyPress then 271 299 if TWinControl(Control).HandleMessage(Message) then begin 272 300 Result := True; 273 301 Break; 274 302 end; 275 end;276 end;277 303 end; 278 304 end; … … 305 331 end; 306 332 333 { TEdit } 334 335 constructor TEdit.Create; 336 begin 337 inherited; 338 FColor := clWhite; 339 end; 340 341 function TEdit.HandleMessage(Message: TMessage): Boolean; 342 begin 343 Result := False; 344 if Message is TMessageKeyPress then 345 with TMessageKeyPress(Message) do begin 346 if Assigned(FOnKeyPress) then FOnKeyPress(Self); 347 if KeyCode = 8 then Text := Copy(Text, 1, Length(Text) - 1) 348 else Text := Text + Chr(TMessageKeyPress(Message).KeyCode); 349 Paint; 350 Result := True; 351 end else 352 end; 353 354 procedure TEdit.Paint; 355 var 356 TextShort: string; 357 begin 358 inherited; 359 with Canvas do begin 360 MoveTo(TPoint.Create(0, 0)); 361 LineTo(TPoint.Create(Bounds.Width - 1, 0)); 362 LineTo(TPoint.Create(Bounds.Width - 1, Bounds.Height - 1)); 363 LineTo(TPoint.Create(0, Bounds.Height - 1)); 364 LineTo(TPoint.Create(0, 0)); 365 TextShort := Text; 366 while (GetTextSize(TextShort).X > Bounds.Width) and 367 (Length(TextShort) > 0) do 368 Delete(TextShort, 1, 1); 369 370 TextOut(TPoint.Create(3, 371 (Bounds.Height - GetTextSize(TextShort).Y) div 2), TextShort); 372 end; 373 end; 374 375 procedure TEdit.SetText(const Value: string); 376 begin 377 if FText <> Value then begin 378 FText := Value; 379 if Visible then Paint; 380 end; 381 end; 382 307 383 end.
Note:
See TracChangeset
for help on using the changeset viewer.