utils.pas

IDE开发环境

unit Utils;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, CodeSense_TLB, INIFiles, RTDesign, TBX,
  LangUnit, ProjOptions, Options;

   {Checks if IsParentNode is a parent of IsChildNode}
function IsAParentNode(  IsParentNode,  IsChildNode  : TTreeNode  ) : boolean;
   {Moves Source node to DestNode (as a child!)}
procedure MoveTreeNode(  tv : TTreeView;  SourceNode,  DestNode  : TTreeNode  );
procedure RegisterLanguages(CodeSense : TCodeSense);
procedure SelectAt(idx: Integer);
procedure SetSettings();
function FindString(s: string): Integer;

implementation

uses MainUnit, Unit1;

function IsAParentNode(  IsParentNode,  IsChildNode  : TTreeNode  ) : boolean;
var
   Node : TTreeNode;
begin;
   if(  IsChildNode = nil  ) then
   begin
      Result := false;
      Exit;
   end;

      {Is this node = parent?}
   if(  IsParentNode = IsChildNode  ) then
   begin
      Result := true;
      Exit;
   end;

      {Get parent}
   Node := IsChildNode.Parent;

      {Recursivly test all parents}
   Result := IsAParentNode(  IsParentNode,  Node  );
end;



procedure MoveTreeNode(  tv : TTreeView;  SourceNode,  DestNode  : TTreeNode  );
   procedure MoveTreeNode_internal(  DontMoveSiblings,  SourceNode,  DestNode  : TTreeNode  );
   var
      NewNode : TTreeNode;
   begin
      if(  DestNode = nil  ) then
         Exit;
      if(  SourceNode = nil  ) then
         Exit;

         {Create new child}
      NewNode := tv.Items.AddChild(  DestNode,  SourceNode.Text  );
         {Use same images}
      NewNode.ImageIndex := SourceNode.ImageIndex;
      NewNode.SelectedIndex := SourceNode.SelectedIndex;
      NewNode.Data := SourceNode.Data;


         {If this node has children move them first}
      if(  SourceNode.HasChildren  ) then
         MoveTreeNode_internal(  DontMoveSiblings,  SourceNode.GetFirstChild,  NewNode  );

         {Move all siblings, unless at original level}
      if(  DontMoveSiblings <> SourceNode  ) then
         MoveTreeNode_internal(  DontMoveSiblings,  SourceNode.GetNextSibling,  DestNode  );
    end;
begin
      {Copy node + children}
   MoveTreeNode_internal(  SourceNode,  SourceNode,  DestNode  );
      {Delete original}
   SourceNode.Delete;
end;

procedure RegisterLanguages(CodeSense : TCodeSense);
var
    a             : WideString;
    NewKeywords   : WideString;
    NewOperators  : WideString;
    NewLanguage   : ILanguage;
    NewGlobals    : IGlobals;
    NewFont       : TFont;
Begin
  NewGlobals := coGlobals.Create;
  NewLanguage := coLanguage.Create;
{  NewKeyWords := 'DECLARE' + Char(10) + 'SUB' + Char(10);
  NewKeyWords := NewKeyWords + 'FUNCTION' + Char(10);
  NewKeyWords := NewKeyWords + 'CLASS' + Char(10);
  NewKeyWords := NewKeyWords + 'END' + Char(10);
  NewKeyWords := NewKeyWords + 'PROPERTY' + Char(10);
  NewKeyWords := NewKeyWords + 'IF' + Char(10);
  NewKeyWords := NewKeyWords + 'ELSEIF' + Char(10);
  NewKeyWords := NewKeyWords + 'END' + Char(10);
  NewKeyWords := NewKeyWords + 'SELECT' + Char(10);
  NewKeyWords := NewKeyWords + 'CASE';
  NewKeyWord := NewKeyWords + 'SLEEP';
  NewOperators := '+' + Char(10) + '<' + Char(10);
  NewOperators := NewOperators + '>' + Char(10);
  NewOperators := NewOperators + '=' + Char(10);
  NewOperators := NewOperators + '<>';          }
  a := Char(10);  //NewLine Character - \n
  NewOperators := '^'+a+'-'+a+'*'+a+'/'+a+'\'+a+'SHL'+a+'SHR'+a+'MOD'+a+'INV'+a+'+'+a+'='+a+'<>'+a+'<'+a+'>'+a+'<='+a+'>='+a+'NOT'+a+'AND'+a+'OR'+a+'XOR';
  NewKeyWords := 'FILEEXISTS'+a+'EXECUTE'+a+'CEIL'+a+'FLOOR'+a+'MEMCMP'+a+'CALL'+a+'DIM'+a+'REDIM'+a+'AS'+a+'CREATE'+a+'IF'+a+'THEN'+a+'ELSE'+a+'ELSEIF'+a+'END'+a+'$MACRO'+a+'$OPTION'+a+'$INCLUDE'+a+'$RESOURCE'+a+'$TYPECHECK'+a+'$OPTIMIZE'+a+'$ESCAPECHARS'+a+'$IFDEF'+a+'$IFNDEF'+a+'$ENDIF'+a+'$APPTYPE'+a+'$ELSE'+a+'$DEFINE'+a+'$UNDEF'+a+'EVENT'+a+'INTEGER'+a+'STRING'+a+'SHORT'+a+'LONG'+a+'SINGLE'+a+'DOUBLE'+a+'WORD'+a+'DWORD'+a+'VARIANT'+a+'BYTE'+a+'TYPE'+a+'EXTENDS'+a+'PRINT'+a+'LPRINT'+a+'LFLUSH'+a+'SUB'+a+'MESSAGEBOX'+a+'UNLOADLIBRARY'+a+'LIBRARYINST'+a+'FUNCTION'+a+'SUBI'+a+'FUNCTIONI'+a+'ALIAS'+a+'LIB'+a+'DECLARE'+a+'BIND'+a+'CALLFUNC'+a+'FOR'+a+'TO'+a+'NEXT'+a+'STEP'+a+'DO'+a+'LOOP'+a+'UNTIL'+a+'WHILE'+a+'WEND'+a+'EXIT'+a+'GOTO'+a+'GOSUB'+a+'RETURN'+a+'SELECT'+a+'CASE'+a+'RANDOMIZE'+a+'TIMER'+a+'RND'+a+'VAL'+a+'CHR$'+a+'LEN'+a+'RESTORE'+a+'KILL'+a+'RENAME'+a+'RMDIR';
  NewKeyWords := NewKeyWords + 'INKEY$'+a+'TIME$'+a+'DATE$'+a+'STRING$'+a+'ASC'+a+'SPACE$'+a+'INPUT$'+a+'PLAYWAV'+a+'ATN'+a+'ATAN'+a+'ASIN'+a+'ACOS'+a+'MID$'+a+'LEFT$'+a+'RIGHT$'+a+'INSERT$'+a+'REPLACE$'+a+'DELETE$'+a+'STR$'+a+'RTRIM$'+a+'LTRIM$'+a+'INSTR'+a+'COMMAND$'+a+'COMMANDCOUNT'+a+'PARAMVALCOUNT'+a+'PARAMSTRCOUNT'+a+'PARAMVAL'+a+'PARAMSTR$'+a+'UCASE$'+a+'LCASE$'+a+'SOUND'+a+'EXP'+a+'LOG'+a+'SGN'+a+'STACK.INT'+a+'STACK.STR$'+a+'GET$'+a+'CURDIR$'+a+'HEX$'+a+'READ'+a+'DATA'+a+'AND'+a+'OR'+a+'XOR'+a+'NOT'+a+'MOD'+a+'INV'+a+'SHL'+a+'SHR'+a+'INT'+a+'FIX'+a+'FRAC'+a+'CINT'+a+'CLNG'+a+'ROUND'+a+'SIN'+a+'COS'+a+'TAN'+a+'ABS'+a+'BIN$'+a+'REPLACESUBSTR$'+a+'CHDIR'+a+'CONVBASE$'+a+'DEC'+a+'INC'+a+'DEFINT'+a+'DEFSTR'+a+'DEFDBL'+a+'DEFSNG'+a+'DEFBYTE'+a+'DEFWORD'+a+'DEFDWORD'+a+'DEFLNG'+a+'DEFSHORT'+a+'DIR$'+a+'ENVIRON'+a+'ENVIRON$'+a+'TALLY'+a+'QUICKSORT'+a+'CHDRIVE'+a+'MKDIR'+a+'DIREXISTS';
  NewKeyWords := NewKeyWords + 'DOEVENTS'+a+'UBOUND'+a+'LBOUND'+a+'SWAP'+a+'IIF'+a+'RGB'+a+'SQR'+a+'SHELL'+a+'RUN'+a+'CODEPTR'+a+'CALLBACK'+a+'VARTYPE'+a+'SHOWMESSAGE'+a+'MESSAGEDLG'+a+'FIELD$'+a+'VARPTR'+a+'VARPTR$'+a+'CONST'+a+'SIZEOF'+a+'IS'+a+'WITH'+a+'CONSTRUCTOR'+a+'CLS'+a+'COLOR'+a+'LOCATE'+a+'INPUT'+a+'INP'+a+'OUT'+a+'POKE'+a+'PEEK'+a+'CSRLIN'+a+'POS'+a+'PCOPY'+a+'SETCONSOLETITLE'+a+'SLEEP'+a+'MOUSEX'+a+'MOUSEY'+a+'QFORM'+a+'QBITMAP'+a+'QCANVAS'+a+'QBUTTON'+a+'QCOOLBTN'+a+'QSTRINGGRID'+a+'QSTRINGLIST'+a+'QLISTBOX'+a+'QCOMBOBOX'+a+'QOBJECT'+a+'QGAUGE'+a+'QOVALBTN'+a+'QMENUITEM'+a+'QMAINMENU'+a+'QTIMER'+a+'QFONT'+a+'QIMAGE'+a+'QPANEL'+a+'QLABEL'+a+'QRECT'+a+'QRICHEDIT'+a+'QEDIT'+a+'QSTATUSBAR'+a+'QCHECKBOX'+a+'QPOPUPMENU'+a+'QDIRTREE'+a+'QFILELISTBOX'+a+'QFILESTREAM'+a+'QFONTDIALOG'+a+'QGROUPBOX'+a+'QIMAGELIST'+a+'QSCROLLBOX'+a+'QTABCONTROL'+a+'QLISTVIEW';
  NewKeyWords := NewKeyWords + 'QMEMORYSTREAM'+a+'QNOTIFYICONDATA'+a+'QOPENDIALOG'+a+'QOUTLINE'+a+'QRADIOBUTTON'+a+'QREGISTRY'+a+'QSAVEDIALOG'+a+'QSCROLLBAR'+a+'QSOCKET'+a+'QTRACKBAR'+a+'QGLASSFRAME'+a+'QHEADER'+a+'QSPLITTER'+a+'QMYSQL'+a+'QTREEVIEW'+a+'QOLEOBJECT'+a+'QDXSCREEN'+a+'QDXIMAGELIST'+a+'QDXTIMER'+a+'QD3DFRAME'+a+'QD3DLIGHT'+a+'QD3DMESHBUILDER'+a+'QD3DMESH'+a+'QD3DVISUAL'+a+'QD3DTEXTURE'+a+'QD3DWRAP'+a+'QD3DANIMATION'+a+'QD3DANIMATIONSET'+a+'QD3DFACE'+a+'QD3DVECTOR';

  NewLanguage.Keywords := NewKeywords;
  NewOperators := NewOperators;
  NewLanguage.SingleLineComments := '''' + Char(10) + 'REM';
  NewLanguage.EscapeChar := '\';
//  NewLanguage.MultiLineComments1 := '/*';
//  NewLanguage.MultiLineComments2 := '\*';
  NewLanguage.StringDelims := '"';
  NewLanguage.TerminatorChar := Char(0);
  NewLanguage.CaseSensitive := False;
  NewLanguage.Style := cmLangStyleProcedural;

  NewGlobals.UnregisterAllLanguages;

  NewGlobals.RegisterLanguage('Rapid-Q', NewLanguage);
  {
  NewLanguage.MultiLineComments1 := '/*';
  NewLanguage.MultiLineComments2 := '*/';
  NewLanguage.SingleLineComments := '''' + Char(10) + 'REM' + '//' + Char(10);
  NewLanguage.Keywords := 'DIM' +a+ 'AS'+a+  'INTEGER'+a+  'DOUBLE'+a+  'STRING'+a+ 'PRINT' +a+ 'CLS' +a+ 'SLEEP' +a+ 'INPUT' +a+ 'LONG' +a+ 'MOD' +a;
  NewLanguage.Keywords := NewLanguage.Keywords + 'TYPE' +a+ 'IF' +a+ 'THEN' +a+ 'WHILE' +a+ 'NOT' +a+ 'OR' +a+ 'AND' +a+ 'ELSEIF' +a+ 'ELSE' +a+ 'END' +a+ 'WEND' +a+ 'FUNCTION' +a+ 'SUB' +a;
  NewLanguage.Keywords := NewLanguage.Keywords + '$APPTYPE' +a+ '$INCLUDE' +a+ '$ASM' +a+ '$Optimize' +a+ '$Compress';
  NewLanguage.Operators := '<' +a+ '>' +a+ '=' +a+ '+' +a+ '-' +a+ '*' +a+ '/' +a+ '^';
  NewGlobals.RegisterLanguage('KoolBASIC', NewLanguage);

  NewGlobals.RegisterLanguage('BPP', NewLanguage);

  //Form1.CodeSense1.Language := 'KoolBASIC';
  CodeSense.Language := 'KoolBASIC';}
  CodeSense.Language := 'Rapid-Q'; 
  CodeSense.NormalizeCase := True;
  CodeSense.SetFontStyle(cmStyNumber, cmFontBold);
  NewFont := TFont.Create;
  with NewFont do
  begin
    Name := 'Courier New';
    Style := [];
    Size := 11;
  end;
  CodeSense.Font := NewFont;
End;

// Select an item in the active combobox given it's index.
// A bogus index will result in an exception.
procedure SelectAt(idx: Integer);
begin
  MainForm.ComboBox1.ItemIndex := idx;
//  NewSelection;
end;

// Find the index of an item in the combobox given a string.
// If the string does not exist, return -1.
//
function FindString(s: string): Integer;
var
  i: Integer;
begin
  i := 0;
  while (i < MainForm.ComboBox1.Items.Count) and (MainForm.ComboBox1.Items[i] <> s) do
    inc(i);
  Result := i;
end;

procedure SetSettings();
var
  SettingsINI : TINIFile;
  GrabHandle  : Integer;
  MenuStyle   : Integer;
  SnapToGrid  : Boolean;
  GridY, GridX: Integer;
begin
  SettingsINI := TINIFile.Create('BASICIDE.INI');

  GrabHandle := SettingsINI.ReadInteger('Form Designer', 'GrabHandleStyle', 0);

  if GrabHandle = 0 then //delphi
    MainForm.RTDesigner1.GrabHandleKind := gkDelphi
  else if GrabHandle = 1 then //HighContrast
    MainForm.RTDesigner1.GrabHandleKind := gkHighContrast
  else if GrabHandle = 2 then //3D
    MainForm.RTDesigner1.GrabHandleKind := gk3D
  else
    MessageDlg('Warning: Invalid information in BASICIDE.INI. GrabHandleStyle is set to '+IntToStr(GrabHandle)+'. It should be no less than 0 and no greater than 2.'#10'Choose "Options|Default Settings" to fix.', mtWarning, [mbOK], 0);

  MenuStyle := SettingsINI.ReadInteger('Options', 'MenuStyle', 2);
  if MenuStyle = 0 then //normal
    TBXSetTheme('Normal')
  else if MenuStyle = 1 then //stripes
    TBXSetTheme('Stripes')
  else if MenuStyle = 2 then //XP
    TBXSetTheme('OfficeXP')
  else
    MessageDlg('Warning: Invalid information in BASICIDE.INI. MenuStyle is set to '+IntToStr(MenuStyle)+'. It should be no less than 0 and no greater than 2.'#10'Choose "Options|Default Settings" to fix.', mtWarning, [mbOK], 0);

  SnapToGrid := SettingsINI.ReadBool('Form Designer', 'SnapToGrid', True);

   //no else because it wouldn't catch anything. Delphi assumes anything but 0
   //is true.
  if SnapToGrid = true then
    MainForm.RTDesigner1.Options := [rtdSnapToGrid]
  else if SnapToGrid = false then
    MainForm.RTDesigner1.Options := [];

  //code not working (any ideas?)
  GridX := SettingsINI.ReadInteger('Form Designer', 'GridX', 8);

  if GridX < 0 then //if it's a negitive number
  begin
    MessageDlg('Warning: Invalid information in BASICIDE.INI. GridX is set to a negitive number ('+IntToStr(GridX)+'. It should be at least 0. Default of 8 will be used.'#10'Choose Options|Default Settings to fix.', mtWarning, [mbOK], 0);
    GridX := 8;
  end;

  MainForm.RTDesigner1.GridX := GridX;

  GridY := SettingsINI.ReadInteger('Form Designer', 'GridY', 8);

  if GridY < 0 then //if it's a negitive number
  begin
    MessageDlg('Warning: Invalid information in BASICIDE.INI. GridY is set to a negitive number ('+IntToStr(GridY)+'. It should be at least 0. Default of 8 will be used.'#10'Choose Options|Default Settings to fix.', mtWarning, [mbOK], 0);
    GridY := 8;
  end;

  MainForm.RTDesigner1.GridY := GridY;

  //set initial dir settings:
  MainUnit.DefaultPath := SettingsINI.ReadString('Options', 'DefaultPath', ExtractFilePath(Application.ExeName));
  MainForm.SaveProjectDialog.InitialDir := MainUnit.DefaultPath;
  MainForm.SaveFormDialog.InitialDir := MainUnit.DefaultPath;
  MainForm.SaveBASICDialog.InitialDir := MainUnit.DefaultPath;
  MainForm.OpenDialog.InitialDir := MainUnit.DefaultPath;
  ProjOptionsFrm.OpenDialog1.InitialDir := MainUnit.DefaultPath;

  OptionsFrm.LanguageLabel.Caption := SettingsINI.ReadString('Options', 'Language', 'English');

end;

end.