dwsdemowin.pas

script language

  if ShellExecute(Application.MainForm.Handle, 'open', PChar(FileName), nil, nil, SW_SHOW) <= 32 then
    ShowMessage('"' + Filename + '" not found');
end;

procedure TFDwsDemo.MIHelpDelphi5Click(Sender: TObject);
begin
  OpenFile(FDocuPath + 'dws210d5.hlp');
end;

procedure TFDwsDemo.MIHelpDelphi6Click(Sender: TObject);
begin
  OpenFile(FDocuPath + 'dws210d6.hlp');
end;

procedure TFDwsDemo.MIHelpHtmlClick(Sender: TObject);
begin
  OpenFile(FDocuPath + 'HtmlHelp\dws210__toc.html');
end;

procedure TFDwsDemo.MIHelpHomepageClick(Sender: TObject);
begin
  OpenFile('http://www.dwscript.com');
end;

procedure TFDwsDemo.MIHelpAboutClick(Sender: TObject);
begin
  ShowMessage('Demonstration program for DelphiWebScript II ' + Script.Version);
end;

procedure TFDwsDemo.OpenScript;
begin
  MIFileNewClick(nil);
  MSource.Lines.LoadFromFile(FScriptPath + sname); // Since we don't want RTF..
  FScriptChanged := True;
  MSource.Modified := False;
  FScrFile := FScriptPath + sname;
  Caption := 'DWS Demo - ' + FScrFile;
end;

procedure TFDwsDemo.MSourceChange(Sender: TObject);
begin
  FScriptChanged := True;
  UpdateSyntax;
end;

procedure TFDwsDemo.UpdateSyntax;
var
  tempMS: TMemoryStream;
  pasCon: TPasConversion;
  pos, top: Integer;
  onChange: TNotifyEvent;
begin
  if (Length(MSource.Text) <= 0) then
    Exit;

  pos := MSource.SelStart;
  top := SendMessage(MSource.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
  onChange := MSource.OnChange;
  tempMS := TMemoryStream.Create;
  try
    MSource.Lines.SaveToStream(TempMS);
    MSource.OnChange := nil;
    pasCon := TPasConversion.Create;
    try
      try
        pasCon.UseDelphiHighlighting(FProgPath + 'DwsDemo.ini');
        pasCon.LoadFromStream(TempMS);
        pasCon.ConvertReadStream;
        MSource.PlainText := False;
        MSource.Lines.BeginUpdate;
        MSource.Lines.LoadFromStream(pasCon);
        SendMessage(MSource.Handle, EM_LINESCROLL, 0, top);
        MSource.Lines.EndUpdate;
      finally
        MSource.PlainText := True;
        PasCon.Free;
      end;
    except
      // Remove highlighting
      tempMS.Position := 0;
      MSource.SelAttributes := MSource.DefAttributes;
      MSource.Lines.LoadFromStream(tempMS);
    end;
  finally
    MSource.SelStart := pos;
    tempMS.Free;
    MSource.OnChange := onChange;
  end;
end;

procedure TFDwsDemo.LBMsgsDblClick(Sender: TObject);
begin
  if LBMsgs.ItemIndex > -1 then
    ShowMsg(Tdws2Msg(LBMsgs.Items.Objects[LBMsgs.ItemIndex]));
end;

procedure TFDwsDemo.ShowMsg(Msg: Tdws2Msg);
var
  b: Boolean;
begin
  MSource.OnChange := nil;
  b := MSource.Modified;

  if (Msg <> FActiveMsg) and (FActiveMsg is TScriptMsg) then
    UpdateSyntax;

  if Assigned(msg) and (msg is TScriptMsg) then
    with msg as TScriptMsg do
    begin
      MSource.SelStart := FPrg.Msgs.GetErrorLineStart(TScriptMsg(Msg).Pos) - 1;
      MSource.SelLength := FPrg.Msgs.GetErrorLineEnd(TScriptMsg(Msg).Pos) - MSource.SelStart;
      MSource.SelAttributes.Style := [fsBold];
      MSource.SelAttributes.Color := clRed;
      MSource.SelStart := TScriptMsg(Msg).Pos.Pos - 1;
      MSource.SelLength := 1;
    end;

  FActiveMsg := Msg;
  MSource.Modified := b;
  MSource.OnChange := MSourceChange;
end;

procedure TFDwsDemo.ShowFirstMsg;
var
  x: Integer;
begin
  for x := 0 to LBMsgs.Items.Count - 1 do
    if Assigned(LBMsgs.Items.Objects[x]) then
    begin
      ShowMsg(Tdws2Msg(LBMsgs.Items.Objects[x]));
      LBLog.ItemIndex := x;
      break;
    end;
  MSource.Repaint;
end;

procedure TFDwsDemo.LBMsgsClick(Sender: TObject);
begin
  LBMsgs.OnDblClick(self);
end;

procedure TFDwsDemo.SimpleDebuggerDoDebug(Prog: TProgram; Expr: TExpr);
begin
  MSource.SelStart := Expr.Pos.Pos - 1;
  MSource.SelLength := 2;
  while not FNextStep do
    Application.ProcessMessages;
  FNextStep := False;
end;

procedure TFDwsDemo.dws2UnitFunctionsInputEval(Info: TProgramInfo);
begin
  Info['Result'] := InputBox(Info['Title'], Info['Prompt'], '');
end;

procedure TFDwsDemo.dws2UnitVariablesscriptCodeInstantiate(
  var ExtObject: TObject);
begin
  ExtObject := MSource.Lines;
end;

procedure TFDwsDemo.dws2UnitVariablestestReadVar(var Value: Variant);
begin
  Value := Caption;
end;

procedure TFDwsDemo.dws2UnitVariablestestWriteVar(Value: Variant);
begin
  Caption := Value;
end;

procedure TFDwsDemo.dws2UnitFunctionsTestEval(Info: TProgramInfo);
begin
  Info.Vars['r'].Member['p'].Member['x'].Value := 12;
end;

procedure TFDwsDemo.dws2UnitFunctionsShowGlobalEval(Info: TProgramInfo);
begin
  ShowMessage(Info['Global']);
  Info['Global'] := 'Hello World';
end;

procedure TFDwsDemo.dws2UnitClassesTFieldMethodsAsIntegerEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TField(ExtObject).AsInteger;
end;

procedure TFDwsDemo.dws2UnitClassesTFieldMethodsAsStringEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TField(ExtObject).AsString;
end;

procedure TFDwsDemo.dws2UnitClassesTFieldsConstructorsCreateEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  x: Integer;
  fieldsLookup: TFieldsLookup;
  dwsField: IUnknown;
begin
  fieldsLookup := (ExtObject as TFieldsLookup);

  // Create a DWS-TField object for every Delphi-TField
  for x := 0 to fieldsLookup.Fields.Count - 1 do
  begin
    dwsField := Info.Vars['TField'].GetConstructor('Create',
      fieldsLookup.Fields[x]).Call.Value;
    fieldsLookup.DwsFields.Add(dwsField);
  end;
end;

procedure TFDwsDemo.dws2UnitClassesTFieldsMethodsDestroyEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  ExtObject.Free;
end;

procedure TFDwsDemo.dws2UnitClassesTFieldsMethodsGetFieldEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  fieldsLookup: TFieldsLookup;
  fieldIndex: Integer;
begin
  fieldsLookup := (ExtObject as TFieldsLookup);
  fieldIndex := fieldsLookup.Fields.FieldByName(Info['FieldName']).Index;
  Info['Result'] := fieldsLookup.DwsFields[fieldIndex];
end;

procedure TFDwsDemo.dws2UnitClassesTQueryConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TQuery.Create(nil);
end;

procedure TFDwsDemo.dws2UnitClassesTQueryConstructorsCreateEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  q: TQuery;
  fieldsLookup: TFieldsLookup;
begin
  q := TQuery(ExtObject);
  try
    q.DatabaseName := Info['db'];
    q.SQL.Text := Info['query'];
    q.Prepare;
    q.Open;

    fieldsLookup := TFieldsLookup.Create(q.Fields);
    Info['FFields'] := Info.Vars['TFields'].GetConstructor('Create', fieldsLookup).Call.Value;
  except
    q.Free;
    raise;
  end;
end;

procedure TFDwsDemo.dws2UnitClassesTQueryDestroyEval(Info: TProgramInfo; ExtObject: TObject);
begin
  ExtObject.Free;
end;

procedure TFDwsDemo.dws2UnitClassesTQueryFirstEval(Info: TProgramInfo; ExtObject: TObject);
begin
  TQuery(ExtObject).First;
end;

procedure TFDwsDemo.dws2UnitClassesTQueryNextEval(Info: TProgramInfo; ExtObject: TObject);
begin
  TQuery(ExtObject).Next;
end;

procedure TFDwsDemo.dws2UnitClassesTQueryEofEval(Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TQuery(ExtObject).Eof;
end;

procedure TFDwsDemo.dws2UnitClassesTQueryFieldByNameEval(Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    Info.Vars['FFields'].Method['GetField'].Call([Info['FieldName']]).Value;
end;

procedure TFDwsDemo.dws2UnitClassesTStringsConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TStringList.Create;
end;

procedure TFDwsDemo.dws2UnitClassesTStringsMethodsDestroyEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  ExtObject.Free;
end;

procedure TFDwsDemo.dws2UnitClassesTStringsAddEval(Info: TProgramInfo; ExtObject: TObject);
begin
  TStrings(ExtObject).Add(Info['s']);
end;

procedure TFDwsDemo.dws2UnitClassesTStringsMethodsGetStringEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info.Result := TStrings(ExtObject)[Info['x']];
end;

procedure TFDwsDemo.dws2UnitClassesTWindowConstructorsCreateAssignExternalObject(Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TFTest.Create(nil);
end;

procedure TFDwsDemo.dws2UnitClassesTWindowConstructorsCreateEval(Info: TProgramInfo; ExtObject: TObject);
var
  frm: TForm;
begin
  frm := TForm(ExtObject);

  // Use default
  Info['Width'] := frm.Width;
  Info['Height'] := frm.Height;

  // Calls method SetPosition
  Info.Vars['Self'].Method['SetPosition'].Call([Info['Left'], Info['Top']]);

  // Another way to call a method
  Info.Func['SetCaption'].Call([Info['Caption']]);

  frm.Show;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsSetCaptionEval(Info: TProgramInfo; ExtObject: TObject);
begin
  TFTest(ExtObject).Caption := Info['s'];
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsSetPositionEval(Info: TProgramInfo; ExtObject: TObject);
begin
  Info.Vars['Self'].Member['Left'].Value := Info['Left'];
  Info.Vars['Self'].Member['Top'].Value := Info['Top'];
  Info.Func['Update'].Call;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsSetSizeEval(Info: TProgramInfo; ExtObject: TObject);
begin
  Info.Vars['Self'].Member['Height'].Value := Info['Height'];
  Info.Vars['Self'].Member['Width'].Value := Info['Width'];
  Info.Func['Update'].Call;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsUpdateEval(Info: TProgramInfo; ExtObject: TObject);
begin
  TFTest(ExtObject).Left := Info['Left'];
  TFTest(ExtObject).Top := Info['Top'];
  TFTest(ExtObject).Width := Info['Width'];
  TFTest(ExtObject).Height := Info['Height'];
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsSetParamsEval(Info: TProgramInfo; ExtObject: TObject);
var
  params: IInfo;
begin
  Info['Left'] := Info.Vars['params'].Member['Left'].Value;
  Info['Top'] := Info.Vars['params'].Member['Top'].Value;
  Info['Width'] := Info.Vars['params'].Member['Width'].Value;
  Info['Height'] := Info.Vars['params'].Member['Height'].Value;
  Info['Caption'] := Info.Vars['params'].Member['Caption'].Value;

  // The same thing but optimized
  params := Info.Vars['params'];
  Info['Left'] := params.Member['Left'].Value;
  Info['Top'] := params.Member['Top'].Value;
  Info['Width'] := params.Member['Width'].Value;
  Info['Height'] := params.Member['Height'].Value;
  Info['Caption'] := params.Member['Caption'].Value;

  Info.Func['Update'].Call;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsVarParamTestEval(Info: TProgramInfo; ExtObject: TObject);
begin
  // Assign value to the var parameters
  Info['a'] := 12;
  Info['b'] := 21;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsUseVarParamTestEval(Info: TProgramInfo; ExtObject: TObject);
var
  meth: IInfo;
  s: string;
begin
  // Get the function
  meth := Info.Func['VarParamTest'];
  // Call the function
  meth.Call;
  // Display the output value of the var parameters
  s := Format('Var params: a = %s, b = %s', [meth.Parameter['a'].Value, meth.Parameter['b'].Value]);
  Info.Func['SetCaption'].Call([s]);

  // Another way to call a function with parameters
  // This is the prefered way if the method has arguments with complex types
  meth := Info.Func['SetSize'];
  meth.Parameter['Width'].Value := 300;
  meth.Parameter['Height'].Value := 50;
  meth.Call;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowMethodsNewInstanceEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := Info.Vars['TWindow'].Method['Create'].Call([50, 50, 'Hello']).Value;
end;

procedure TFDwsDemo.dws2UnitClassesTWindowCleanUp(obj: TScriptObj;
  ExternalObject: TObject);
begin
  ShowMessage('TWindow.OnCleanUp');
end;

procedure TFDwsDemo.dws2UnitClassesTListConstructorsCreateAssignExternalObject(
  Info: TProgramInfo; var ExtObject: TObject);
begin
  ExtObject := TList.Create;
end;

procedure TFDwsDemo.dws2UnitClassesTListMethodsDestroyEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  ExtObject.Free;
end;

procedure TFDwsDemo.dws2UnitClassesTListMethodsAddEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TList(ExtObject).Add(Pointer(Integer(Info['Obj'])));
end;

procedure TFDwsDemo.dws2UnitClassesTListMethodsGetEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := Integer(TList(ExtObject).Items[Info['Index']]);
end;

procedure TFDwsDemo.dws2UnitClassesTListMethodsClearEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  TList(ExtObject).Clear;
end;

procedure TFDwsDemo.dws2UnitClassesTListMethodsGetCountEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := TList(ExtObject).Count;
end;

{ TFieldsLookup }

constructor TFieldsLookup.Create(Fields: TFields);
begin
  FFields := Fields;
  FDwsFields := TInterfaceList.Create;
end;

destructor TFieldsLookup.Destroy;
begin
  FDwsFields.Free;
  inherited;
end;

end.