u_proxriptor_main.pas

Voice Commnucation Components for Delphi

(*
	----------------------------------------------

	  u_proxriptor_main.pas
	  vcScriptor demo application - main form
	  Voice Communicator VCL components 2.5 Pro

	----------------------------------------------
	  This source code cannot be used without
	  proper permission granted to you as a private
	  person or an entity by the Lake of Soft, Ltd

	  Visit http://lakeofsoft.com/ for details.

	  Copyright (c) 2001, 2007 Lake of Soft, Ltd
		     All rights reserved
	----------------------------------------------

	  created by:
		Lake, 26 Jul 2002

	  modified by:
		Lake, Jul 2002
		Lake, May 2003

	----------------------------------------------
*)

{$I unaDef.inc}

unit u_proxriptor_main;

interface

uses
  Windows, unaTypes, unaClasses, Forms, unaVcIDE,
  Classes, Controls, ExtCtrls, StdCtrls, Dialogs, ActnList, ComCtrls, Grids, Menus;

type
  Tf_proxriptor_main = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    ac_main: TActionList;
    a_file_load: TAction;
    a_file_saveAs: TAction;
    a_script_execute: TAction;
    a_help_exit: TAction;
    c_openDialog_load: TOpenDialog;
    c_saveDialog_save: TSaveDialog;
    c_statusBar_main: TStatusBar;
    c_timer_update: TTimer;
    Splitter1: TSplitter;
    a_file_save: TAction;
    c_memo_source: TMemo;
    a_help_scriptRef: TAction;
    Button8: TButton;
    a_file_clear: TAction;
    Panel1: TPanel;
    c_listBox_components: TListBox;
    Splitter2: TSplitter;
    c_sg_properties: TStringGrid;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Load1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Script1: TMenuItem;
    Execute1: TMenuItem;
    Help1: TMenuItem;
    Syntaxref1: TMenuItem;
    Clear1: TMenuItem;
    Button4: TButton;
    Panel3: TPanel;
    c_edit_value: TEdit;
    Button5: TButton;
    a_script_setValue: TAction;
    a_script_newWindow: TAction;
    scriptor: TunavclScriptor;
    //
    procedure formCreate(sender: tObject);
    procedure formDestroy(sender: tObject);
    procedure formCloseQuery(sender: tObject; var canClose: boolean);
    procedure formShow(sender: tObject);
    //
    procedure a_help_exitExecute(Sender: TObject);
    procedure a_script_executeExecute(Sender: TObject);
    procedure a_file_loadExecute(Sender: TObject);
    procedure a_file_saveAsExecute(Sender: TObject);
    procedure c_timer_updateTimer(Sender: TObject);
    procedure a_file_saveExecute(Sender: TObject);
    procedure c_memo_sourceChange(Sender: TObject);
    procedure a_help_scriptRefExecute(Sender: TObject);
    procedure a_file_clearExecute(Sender: TObject);
    procedure c_panel_bannerClick(Sender: TObject);
    procedure c_sg_propertiesClick(Sender: TObject);
    procedure a_script_setValueExecute(Sender: TObject);
    procedure c_listBox_componentsClick(Sender: TObject);
  private
    { Private declarations }
    f_modified: bool;
    f_fileName: string;
    f_validName: bool;
    f_ini: unaIniFile;
    f_c_sg_propertiesClick: bool;
    //
    procedure setModified(value: bool);
    procedure setFileName(const value: string);
    //
    procedure setNewFile(const name: string);
    function checkModified(): bool;
    function saveScript(): bool;
    function saveScriptAs(): bool;
    //
    property modified: bool read f_modified write setModified;
    property fileName: string read f_fileName write setFileName;
    property validName: bool read f_validName write f_validName;
  public
    { Public declarations }
  end;

var
  f_proxriptor_main: Tf_proxriptor_main;


implementation


{$R *.dfm}

uses
  unaUtils, Messages, Math, SysUtils, unaVCLUtils, u_proxriptor_syntax, ShellAPI;

// --  --
procedure Tf_proxriptor_main.formCreate(sender: tObject);
begin
  f_ini := unaIniFile.create();
  //
  c_openDialog_load.initialDir := f_ini.get('initialLoadDir', '');
  c_saveDialog_save.initialDir := f_ini.get('initialSaveDir', '');
  //
  fileName := f_ini.get('lastFileName', '');
  if (validName) then
    setNewFile(fileName);
end;

// --  --
procedure Tf_proxriptor_main.formDestroy(sender: tObject);
begin
  if (validName) then
    f_ini.setValue('lastFileName', fileName);
  //
  freeAndNil(f_ini);
end;

// --  --
procedure Tf_proxriptor_main.formShow(sender: tObject);
begin
  loadControlPosition(self, f_ini);
  //
  if (0 < paramCount) then begin
    setNewFile(paramStr(1));
    validName := true;
  end;
  //
  modified := false;
end;

// --  --
procedure Tf_proxriptor_main.formCloseQuery(sender: tObject; var canClose: boolean);
begin
  canClose := checkModified();
  //
  if (canClose) then
    saveControlPosition(self, f_ini);
end;

// --  --
procedure Tf_proxriptor_main.a_script_executeExecute(Sender: TObject);
var
  result: HRESULT;
begin
  a_script_execute.enabled := false;
  //
  try
    result := scriptor.executeScript(c_memo_source.Text);
    if (windows.succeeded(result)) then
      //MessageBox(handle, 'Script has been executed successfully.', 'Information', MB_OK or MB_ICONINFORMATION)
    else
      MessageBox(handle, pChar('Script error at line #' + int2Str(scriptor.errorLine) + ': ' + scriptor.getErrorCodeString(result) + #13#10'Error code: 0x' + int2Str(unsigned(result), 16)), 'Error', MB_OK or MB_ICONERROR);
  finally
    a_script_execute.enabled := true;
  end;
end;

// --  --
procedure Tf_proxriptor_main.a_file_loadExecute(Sender: TObject);
begin
  if (checkModified()) then
    //
    if (c_openDialog_load.Execute()) then begin
      //
      c_memo_source.lines.loadFromFile(c_openDialog_load.fileName);
      modified := false;
      fileName := c_openDialog_load.FileName;
      //
      f_ini.setValue('initialLoadDir', extractFilePath(fileName));
    end;
end;

// --  --
procedure Tf_proxriptor_main.a_file_saveAsExecute(Sender: TObject);
begin
  saveScriptAs();
end;

// --  --
procedure Tf_proxriptor_main.c_timer_updateTimer(Sender: TObject);
var
  i: unsigned;
  pos: int;
  name: string;
  value: string;
  charIndex: int;
  lineNum: int;
  charNum: int;
  rowNum: unsigned;
begin
  if (not (csDestroying in componentState)) then begin
    //
    c_statusBar_main.panels[0].text := 'Mem: ' + int2Str(ams() shr 10, 10, 3) + ' KB';

    // update component list
    c_listBox_components.items.beginUpdate();
    try
      i := 0;
      while (int(i) < c_listBox_components.items.count) do begin
	// mark for deletion
	c_listBox_components.items.objects[i] := pointer($37);
	inc(i);
      end;

      //
      i := 0;
      while (i < scriptor.componentCount) do begin
	//
	scriptor.getComponentName(i, name);
	pos := c_listBox_components.items.indexOf(name);
	if (0 <= pos) then
	  c_listBox_components.items.objects[pos] := pointer($73)
	else
	  c_listBox_components.items.addObject(name, pointer($73));
	//
	inc(i);
      end;

      //
      i := 0;
      while (int(i) < c_listBox_components.items.count) do begin
	//
	if (pointer($37) = c_listBox_components.items.objects[i]) then
	  c_listBox_components.items.delete(i)
	else
	  inc(i);
      end;

      a_file_clear.enabled := (0 < c_listBox_components.items.count);
      a_script_setValue.enabled := (0 < c_listBox_components.items.count) and (0 <= c_listBox_components.itemIndex);

      //
      charIndex := c_memo_source.selStart;
      lineNum := 1;
      charNum := 1;
      while ((0 < charIndex) and (lineNum <= c_memo_source.lines.count)) do begin
	//
	dec(charIndex, length(c_memo_source.Lines[lineNum - 1]) + 2);
	if (0 < charIndex) then
	  inc(lineNum)
	else begin
	  charNum := length(c_memo_source.Lines[lineNum - 1]) + charIndex + 3;
	  if (0 = charIndex) then begin
	    charNum := 1;
	    inc(lineNum);
	  end;
	  break;
	end;
      end;
      c_statusBar_main.panels[1].text := int2Str(lineNum) + ':' + int2Str(charNum);

      //
      rowNum := 1;
      if ((0 < c_listBox_components.items.count) and (0 <= c_listBox_components.itemIndex)) then begin
	//
	for i := low(unaScriptorKnownProperties) to high(unaScriptorKnownProperties) do begin
	  //
	  if (windows.Succeeded(scriptor.getComponentProperty(c_listBox_components.items[c_listBox_components.itemIndex], unaScriptorKnownProperties[i], value))) then begin
	    //
	    inc(rowNum);
	    if ((2 = c_sg_properties.RowCount) or (c_sg_properties.RowCount < int(rowNum))) then begin
	      if ((c_sg_properties.RowCount < int(rowNum))) then
		c_sg_properties.RowCount := rowNum;
	    end;
	    c_sg_properties.Cells[0, rowNum - 1] := unaScriptorKnownProperties[i];
	    c_sg_properties.Cells[1, rowNum - 1] := value;
	  end;
	end;
      end
      else begin
	//
	c_sg_properties.Cells[0, 1] := '';
	c_sg_properties.Cells[1, 1] := '';
      end;
      //
      c_sg_properties.rowCount := max(2, rowNum);
      //
      if (f_c_sg_propertiesClick) then begin
	c_sg_propertiesClick(nil);
	f_c_sg_propertiesClick := false;
      end;

    finally
      c_listBox_components.items.endUpdate();
    end;
  end;
end;

// --  --
procedure Tf_proxriptor_main.setModified(value: bool);
begin
  f_modified := value;
  a_file_save.enabled := value;
  c_statusBar_main.Panels[2].Text := choice(value, '*', ' ');
end;

// --  --
procedure Tf_proxriptor_main.setFileName(const value: string);
begin
  if ('' = value) then begin
    validName := false;
    f_fileName := 'Untitled';
  end
  else begin
    validName := true;
    f_fileName := value;
  end;
  //
  c_statusBar_main.Panels[3].Text := fileName;
end;

// --  --
procedure Tf_proxriptor_main.setNewFile(const name: string);
begin
  c_memo_source.Lines.LoadFromFile(name);
  fileName := name;
  modified := false;
end;

// --  --
function Tf_proxriptor_main.checkModified(): bool;
var
  res: int;
begin
  if (modified) then begin
    res := MessageBox(handle, 'Script source has been modified since last save.'#13#10'Do you wish to save the changes?', 'Save script', MB_YESNOCANCEL or MB_ICONQUESTION);
    if (IDYES = res) then
      result := saveScript()
    else
      result := (IDNO = res);
  end
  else
    result := true;
end;

// --  --
function Tf_proxriptor_main.saveScript(): bool;
begin
  if (validName) then begin
    c_memo_source.Lines.SaveToFile(fileName);
    modified := false;
    result := true;
  end
  else
    result := saveScriptAs();
end;

// --  --
procedure Tf_proxriptor_main.a_file_saveExecute(Sender: TObject);
begin
  saveScript();
end;

// --  --
function Tf_proxriptor_main.saveScriptAs(): bool;
begin
  if (c_saveDialog_save.Execute()) then begin
    c_memo_source.Lines.SaveToFile(c_saveDialog_save.FileName);
    modified := false;
    fileName := c_saveDialog_save.FileName;
    f_ini.setValue('initialSaveDir', extractFilePath(fileName));
    result := true;
  end
  else
    result := false;
end;

// --  --
procedure Tf_proxriptor_main.c_memo_sourceChange(Sender: TObject);
begin
  modified := true;
end;

// --  --
procedure Tf_proxriptor_main.a_help_scriptRefExecute(Sender: TObject);
begin
  c_form_syntax.show();
end;

// --  --
procedure Tf_proxriptor_main.a_file_clearExecute(Sender: TObject);
begin
  scriptor.executeScript('clear;');	// yep :)
end;

// --  --
procedure Tf_proxriptor_main.c_panel_bannerClick(Sender: TObject);
begin
  ShellExecute(0, 'open', 'http://www.lakeofsoft.com/vc', nil, nil, SW_SHOWNORMAL);
end;

// --  --
procedure Tf_proxriptor_main.c_sg_propertiesClick(Sender: TObject);
begin
  c_edit_value.Text := c_sg_properties.Cells[1, c_sg_properties.row];
end;

// --  --
procedure Tf_proxriptor_main.a_script_setValueExecute(sender: tObject);
var
  res: HRESULT;
begin
  if ((0 < c_listBox_components.items.count) and (0 <= c_listBox_components.itemIndex)) then begin
    //
    res := scriptor.setComponentProperty(c_listBox_components.items[c_listBox_components.itemIndex], c_sg_properties.Cells[0, c_sg_properties.row], c_edit_value.text);
    //
    if (windows.succeeded(res)) then
    else
      MessageBox(handle, pChar(scriptor.getErrorCodeString(res) + #13#10'Error code: 0x' + int2Str(unsigned(res), 16)), 'Error', MB_OK or MB_ICONERROR);
  end;
end;

// --  --
procedure Tf_proxriptor_main.c_listBox_componentsClick(sender: tObject);
begin
  f_c_sg_propertiesClick := true;
end;

// --  --
procedure Tf_proxriptor_main.a_help_exitExecute(sender: tObject);
begin
  close();
end;

end.