123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116 |
- {
- Ported to FPC by Nikolay Nikolov ([email protected])
- }
- {
- Keyboard example for OpenPTC 1.0 C++ Implementation
- Copyright (c) Glenn Fiedler ([email protected])
- This source code is in the public domain
- }
- Program KeyboardExample;
- {$MODE objfpc}
- Uses
- ptc;
- Var
- console : TPTCConsole;
- surface : TPTCSurface;
- format : TPTCFormat;
- color : TPTCColor;
- key : TPTCKey;
- area : TPTCArea;
- x, y : Integer;
- size : Integer;
- delta : Integer;
- Begin
- key := Nil;
- color := Nil;
- format := Nil;
- surface := Nil;
- console := Nil;
- Try
- Try
- { create key }
- key := TPTCKey.Create;
-
- { create console }
- console := TPTCConsole.Create;
- { create format }
- format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
- { open the console }
- console.open('Keyboard example', format);
- { create surface matching console dimensions }
- surface := TPTCSurface.Create(console.width, console.height, format);
- { setup cursor data }
- x := surface.width Div 2;
- y := surface.height Div 2;
- size := surface.width Div 10;
- color := TPTCColor.Create(1, 1, 1);
- { main loop }
- Repeat
- { check for key press }
- If console.KeyPressed Then
- Begin
- { read console key press }
- console.ReadKey(key);
-
- { shift modifier }
- If key.shift Then
- { move fast }
- delta := 10
- Else
- { move slow }
- delta := 1;
- { handle cursor keys }
- Case key.code Of
- PTCKEY_LEFT : Dec(x, delta);
- PTCKEY_RIGHT : Inc(x, delta);
- PTCKEY_UP : Dec(y, delta);
- PTCKEY_DOWN : Inc(y, delta);
- { exit when escape is pressed }
- PTCKEY_ESCAPE : Break;
- End;
- End;
- { clear surface }
- surface.clear;
- { setup cursor area }
- area := TPTCArea.Create(x - size, y - size, x + size, y + size);
- Try
- { draw cursor as a quad }
- surface.clear(color, area);
- Finally
- area.Free;
- End;
- { copy to console }
- surface.copy(console);
- { update console }
- console.update;
- Until False;
- Finally
- color.Free;
- console.close;
- console.Free;
- surface.Free;
- key.Free;
- format.Free;
- End;
- Except
- On error : TPTCError Do
- { report error }
- error.report;
- End;
- End.
|