mainunit.~pas

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

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, StdCtrls,X_StdLib_TLB, ExtCtrls,
  OleCtrls, MSScriptControl_TLB, openGL,ActiveX, glut, UserMsg;


type
  TMainFomr = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    StatusBar1: TStatusBar;
    page: TPageControl;
    N7: TMenuItem;
    Splitter1: TSplitter;
    Memo1: TMemo;
    ScriptControl1: TScriptControl;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    procedure N7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    AppPath:string;
    RenderSceneFuncName,ReshapeFuncName:string;
    Procedure glFormPaint(var msg:TMessage);message WM_GLFORMPAINT;
    Procedure glFormChangeSize(var msg:TMessage);message WM_GLFORMCHANGESIZE;
    procedure glGetCallBackFuncName(var t: TWmCopyData); message WM_COPYDATA;

    procedure AppModeFortext();
    procedure appModeForGraphic();
    function CallFunction(const FunctionName: string;const Params: oleVariant):OleVariant;
    procedure AddCodeFile(code:string);

  public
    { Public declarations }
  end;



var
  MainFomr: TMainFomr;
  ScriptApp:IX_System;
  aass:IX_GL;



implementation

{$R *.dfm}

procedure TMainFomr.N7Click(Sender: TObject);
var tabsheet:TTabSheet;
        memo:TMemo;
begin
    tabsheet:=Ttabsheet.Create(page);
    tabsheet.PageControl:=page;
    tabsheet.Caption:='newFile'+inttostr(page.PageCount);
    memo:=Tmemo.create(tabsheet);
    memo.parent:=tabsheet;
    memo.Align:=alClient;
    memo.WantTabs:=true;
    memo.ScrollBars:=ssBoth;
    memo.Font.Name:='宋体';
    memo.font.size:=9;

end;

procedure TMainFomr.FormCreate(Sender: TObject);
begin
        ScriptApp:=IX_System(CoX_System.Create);
        ScriptApp.AppInit(Pointer(Memo1));
        aass:=IX_GL(coX_GL.Create);
end;

function TMainFomr.CallFunction(const FunctionName: string;
  const Params: oleVariant): OleVariant;
var
Sarray: PSafeArray;
begin
// 转化为安全数组
Sarray := PSafeArray(TVarData(Params).VArray);
// 调用函数
Result := ScriptControl1.Run(FunctionName, Sarray);
end;

procedure TMainFomr.appModeForGraphic;
var     i:integer;
        aa:HResult;    a: OleVariant;
        str:tstringlist;
begin
    //  ScriptApp.LaunchApp(aa);
       aass._InitGraphicApp(self.Handle);    //传入句柄
  try  try
      str:=tstringList.Create;
      str.LoadFromFile('Source\Graphic.js');
      ScriptControl1.Language:='JavaScript';
      ScriptControl1.Reset;
      ScriptControl1.Timeout:=-1;
      ScriptControl1.AddCode(str.Text);
      for i:=0 to page.PageCount-1 do
      begin
          ScriptControl1.AddCode(Tmemo(page.Pages[i].Controls[0]).text);
      end;
      a := VarArrayCreate([0, 0], varVariant);
      a[0] := '';
      MainFomr.CallFunction('initialization',a);     //初始化默认的
////////////////////////////////////////////////////////////
    //  if not assigned(GraphicForm) then
    //      GraphicForm:=TGraphicForm.Create(nil);

      CallFunction('main',a);
////////////////////////////////////////////////////////////
  except
      on E: Exception do
                memo1.Lines.add(e.Message);
      end;
  finally
      ScriptApp.TerminateApp;
      str.free;
  end;
end;

procedure TMainFomr.AppModeFortext;
var     i:integer;
        aa:HResult;
        a: OleVariant;
        str:tstringlist;
begin
      ScriptApp.LaunchApp(aa);
       if aa<0 then exit;
  try  try
      str:=tstringList.Create;
      str.LoadFromFile('Source\System.js');
      ScriptControl1.Language:='JavaScript';
      ScriptControl1.Reset;
      ScriptControl1.Timeout:=-1;

      AddCodeFile(str.Text);
      for i:=0 to page.PageCount-1 do
      begin
         // ScriptControl1.AddCode(Tmemo(page.Pages[i].Controls[0]).text);
          AddCodeFile(Tmemo(page.Pages[i].Controls[0]).text);
      end;
      a := VarArrayCreate([0, 0], varVariant);
      a[0] := '';
      CallFunction('initialization',a);
      CallFunction('main',a);
      except
        on E: Exception do
                memo1.Lines.add(e.Message);
      end;
  finally
      ScriptApp.TerminateApp;
      str.free;
  end;
end;

procedure TMainFomr.N6Click(Sender: TObject);
begin
        if n10.Checked then begin ScriptApp._SetAppMode(0); AppModeFortext; end
        else if n11.Checked then
        begin
            scriptApp._SetAppMode(1);
            appModeForGraphic;
        end;

end;



procedure TMainFomr.glFormPaint(var msg: TMessage);
var a: OleVariant;
begin
      if  RenderSceneFuncName='' then exit;
      a := VarArrayCreate([0, 0], varVariant);
      a[0] := '';
      MainFomr.CallFunction(RenderSceneFuncName,a);
end;

procedure TMainFomr.glGetCallBackFuncName(var t: TWmCopyData);
var s:string;
begin
       s:=pchar(t.CopyDataStruct.lpData);

       case t.CopyDataStruct.dwData of
       0:begin       //重画
             RenderSceneFuncName:=s;
         end;
       1:begin      //改变大小
             ReshapeFuncName:=s;
         end;
       end;

     //  showmessage(RenderSceneFuncName);
end;

procedure TMainFomr.Button1Click(Sender: TObject);
begin
  //    aass._InitGraphicApp(self.Handle);
  //    aass._xglutDisplayFunc('asdfasdfsf');
end;

procedure TMainFomr.glFormChangeSize(var msg: TMessage);
var a: OleVariant;
begin
      if  ReshapeFuncName='' then exit;
      a := VarArrayCreate([0, 1], varVariant);
      a[0] := inttostr(msg.WParam);
      a[1]:= inttostr(msg.LParam);
      MainFomr.CallFunction(ReshapeFuncName,a);
end;

procedure TMainFomr.AddCodeFile(code: string);
begin
      
      ScriptControl1.AddCode(code);
end;

procedure TMainFomr.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
      SHOWMESSAGE(INTTOSTR(KEY));
end;

end.