x_system.~pas

你想用javaScript来开发windows程序吗？你想用javaScript来开发OpenGl程序吗？你还在为你的游戏使用什么脚本语言而烦恼吗？那就来看看javaScript开发平台。把javaS

unit X_System;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, x_GraphiMode,X_StdLib_TLB, Dialogs,StdVcl, StdCtrls,Windows,SystemVar;

type
  TX_System = class(TAutoObject, IX_System)
  protected
    procedure _WriteLn(const str: WideString); safecall;
    procedure AppInit(DebugMemo: PChar); safecall;
    procedure _MessageBox(const str: WideString); safecall;
    procedure _DebugOut(const str: WideString); safecall;
    procedure LaunchApp(out Inited: HResult); safecall;
    procedure TerminateApp; safecall;
    function _ReadLn: WideString; safecall;
    procedure TEST; safecall;
    procedure _Format(const str: WideString); safecall;
    function _Read: WideString; safecall;
    procedure _Write(const str: WideString); safecall;
    procedure _SetAppMode(mode: Integer); safecall;
    procedure _SetupRcCallBack(FuncPT: PChar); safecall;
    procedure _ChangeSceneSizeCallBack(FuncPT: PChar); safecall;
    procedure _RenderSceneCallBack(FuncPT: SCODE); safecall;
    { Protected declarations }
  end;

  
implementation

uses ComServ;

procedure TX_System._WriteLn(const str: WideString);
begin
     writeln(str);
end;

procedure TX_System.AppInit(DebugMemo: PChar);
begin
    DebugOutForm:=Tmemo(DebugMemo);
    AppMode:=mode_text;
end;

procedure TX_System._MessageBox(const str: WideString);
begin
    showmessage(str);
end;

procedure TX_System._DebugOut(const str: WideString);
begin
    DebugOutForm.Lines.Add(str);
end;

procedure TX_System.LaunchApp(out Inited: HResult);
begin
     case AppMode of
     mode_text:
               begin
                  if not AllocConsole then begin Inited:=-1; exit;end;
                   SetConsoleMode(ENABLE_PROCESSED_INPUT,ENABLE_WRAP_AT_EOL_OUTPUT);
                   SetConsoleTitle(pchar('正在运行...'));
                   inited:=0;
                   CurrentSatus:=app_Run;
               end;
     mode_graphic:
               begin
                   GraphicMode:=TGraphicMode.Create(nil);
                   graphicmode.Show;
                   inited:=0;
                   CurrentSatus:=app_Run;
               end;
     mode_window:begin

               end;
     end;
end;

procedure TX_System.TerminateApp;
var ss:string;
begin
     CurrentSatus:=app_Terminate;
     case AppMode of
     mode_text:
              begin
                SetConsoleTitle(pchar('已完成，请按任意键关闭'));
                writeln('');
                writeln('>>>>>>>>>>>>>>>>>>>>>>>>已完成，请按任意键关闭>>>>>>>>>>>>>>>>>>>>>>>>');
                readln(ss);
                FreeConsole;               //关闭控制台
              end;
     mode_graphic:
               begin
                  // graphicmode.Close;
               end;
     mode_window:begin

               end;
     end;
end;

function TX_System._ReadLn: WideString;
var str:string;
begin
    readln(str);
    result:=str;
end;

procedure TX_System.TEST;
begin
     showmessage('OK');
end;

procedure TX_System._Format(const str: WideString);
begin

end;

function TX_System._Read: WideString;
var str:string;
begin
     read(str);
     result:=str;
end;

procedure TX_System._Write(const str: WideString);
begin
     write(str);
end;

procedure TX_System._SetAppMode(mode: Integer);
begin
        case mode of
        0:AppMode:=mode_text;
        1:AppMode:=mode_graphic;
        2:AppMode:=mode_window;
        end;
end;

procedure TX_System._SetupRcCallBack(FuncPT: PChar);
begin
     SetupRCCallBack:=PSetupRCCallBack(FuncPT);
end;

procedure TX_System._ChangeSceneSizeCallBack(FuncPT: PChar);
begin
    ChangeSceneSizeCallback:=pChangeSceneSizeCallback(FuncPT);
end;

procedure TX_System._RenderSceneCallBack(FuncPT: SCODE);
begin
     RenderSceneCallback:=pRenderSceneCallback(FuncPT);
end;


initialization
  TAutoObjectFactory.Create(ComServer, TX_System, Class_X_System,
    ciMultiInstance, tmApartment);
end.