unit Unit_PTCConsole;
interface
uses
Unit_OpenPTC;
var
_format : PTC_FORMAT;
_surface : PTC_SURFACE;
_console : PTC_CONSOLE;
_pixels : pointer;
_width,
_height : integer;
{
wenn TPixel-Klasse funktioniert, dann obige globale Variablen
in Interfaceteil
}
type
TPixels =
class(TObject)
private
function GetPixels(x, y: Integer): Longint;
procedure SetPixels(x, y: Integer;
const Value: Longint);
public
constructor Create;
destructor Destroy;
override;
property pixels[x,y: Longint]: Longint
read GetPixels
write SetPixels;
end;
procedure BeginToPaint;
//nicht BeginPaint / EndPaint, weil letztere in
procedure EndToPaint;
//der VCL existent
var
Pixels: TPixels;
//Instanz meiner Pixels Klasse für bequemere Zuweisung.
implementation
procedure BeginToPaint;
begin
_pixels := ptc_surface_lock(_surface);
// just use normal pointer. dont use dynamic array or bug !
// get surface dimensions
_width := ptc_surface_width(_surface);
_height := ptc_surface_height(_surface);
Pixels := TPixels.Create;
end;
//
// longint(pointer(longint(_pixels) + x*4 + y*_width*4)^) := (r shl 16) + (g shl 8) + b;
//
procedure EndToPaint;
begin
ptc_surface_unlock(_surface);
// copy to console
ptc_surface_copy(_surface,_console);
// update console
ptc_console_update(_console);
Pixels.Free;
end;
{ TPixels }
constructor TPixels.Create;
begin
inherited Create;
end;
destructor TPixels.Destroy;
begin
inherited;
end;
function TPixels.GetPixels(x, y: Integer): Longint;
begin
Result := Longint(_pixels);
end;
procedure TPixels.SetPixels(x, y: Integer;
const Value: Longint);
begin
longint(pointer(longint(_pixels) + x*4 + y*_width*4)^) := Value;
end;
initialization
_console := ptc_console_create();
_format := ptc_format_create_direct(32,$00FF0000,$0000FF00,$000000FF,0);
ptc_console_option( _console, '
windowed output' );
ptc_console_open_format(_console,'
Delphi example',_format,0);
_surface := ptc_surface_create(ptc_console_width(_console),ptc_console_height(_console),_format);
if (ptc_console_key(_console)<>0)
then ;
finalization
ptc_console_close(_console);
ptc_surface_destroy(_surface);
ptc_format_destroy(_format);
ptc_console_destroy(_console);
end.