unit Ledlp_8a;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Ledlp, Menus, ledlp_8z;

type
  tColorScheme = record
    color_editorBackGround,
    color_normalWords,
    color_reservedWords,
    color_values,
    color_syntax,
    color_quotedText,
    color_comments: tColorRef;
  end;

  TVBForm = class(TForm)
    WndVB: TLEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Print1: TMenuItem;
    N2: TMenuItem;
    Close1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Clear1: TMenuItem;
    SelectAll1: TMenuItem;
    N3: TMenuItem;
    Options1: TMenuItem;
    SetColors1: TMenuItem;
    Comments1: TMenuItem;
    Keywords1: TMenuItem;
    EditorBackground1: TMenuItem;
    NormalWords1: TMenuItem;
    SyntaxItems1: TMenuItem;
    QuotedText1: TMenuItem;
    NumericValues1: TMenuItem;
    WordWrap1: TMenuItem;
    ColorDialog1: TColorDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WndVBControlHighlight(Sender: TObject; WordType: Word;
      WordValue: Longint; WordStr: String; var ForeClr, BackClr: TColor);
    procedure WndVBFindBrace(Sender: TObject; WordType: Word;
      WordValue: Longint; WordStr: String; var BraceType: TLEBraceStyle);
    procedure WndVBWordClick(Sender: TObject; WordType: Word;
      WordValue: Longint; WordStr: String; var WordHandled: Boolean);
    procedure About1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure WordWrap1Click(Sender: TObject);
    procedure Comments1Click(Sender: TObject);
    procedure Keywords1Click(Sender: TObject);
    procedure EditorBackground1Click(Sender: TObject);
    procedure NormalWords1Click(Sender: TObject);
    procedure SyntaxItems1Click(Sender: TObject);
    procedure QuotedText1Click(Sender: TObject);
    procedure NumericValues1Click(Sender: TObject);
  private
    fReservedWords: tStringList;
    fColors: tColorScheme;
    procedure loadReservedWords;
  public
  end;

const
  VB_LEFT_BRACE = 'begin';
  VB_RIGHT_BRACE= 'end';

var
  VBForm: TVBForm;

implementation

{$R *.DFM}


procedure TVBForm.FormCreate(Sender: TObject);
begin
  { Set up the default colors }
  with fColors do
  begin
    color_editorBackGround  := clWhite;
    color_normalWords       := clBlack;
    color_reservedWords     := clBlue;
    color_syntax            := clNavy;
    color_quotedText        := clGreen;
    color_comments          := clGray;
    color_values            := clRed;
  end;
  WndVB.Color:= fColors.color_editorBackground;
  WndVB.Font.Color:= fColors.color_comments;
  { Create and load the reserved words }
  loadReservedWords;
end;

procedure TVBForm.FormDestroy(Sender: TObject);
begin
  if fReservedWords <> nil then fReservedWords.free;
end;

procedure TVBForm.WndVBControlHighlight(Sender: TObject; WordType: Word;
  WordValue: Longint; WordStr: String; var ForeClr, BackClr: TColor);
var
  MyWord: TWordDesc;
  i: Integer;
begin
  MyWord := WndVB.WordDesc;
  if WordType = WD_SIMPLEWORD then
  begin
    { Set default text color for words }
    ForeClr := fcolors.color_normalWords;
    BackClr := fColors.color_editorBackGround;;

    { Mark the VB keyword }
    for i := 0 to fReservedWords.count -1 do
    begin
      if CompareText(WordStr,fReservedWords[i]) = 0 then
      begin
        ForeClr := fColors.color_reservedWords;
        exit;
      end;
    end;
  end
  else if WordType = WD_SYNTAXITEM then
  begin
    { Set text color for syntax items }
    ForeClr := fColors.color_syntax;
    exit;
  end
  else if (WordType = WD_BADLYQUOTEDTEXT) or
          (WordType = WD_QUOTEDTEXT) then
  begin
    { Set text color for quoted text }
    ForeClr := fColors.color_quotedText;
    exit;
  end
  else
    { Set text color for the rest of words, that is }
    { for numbers                                   }
    ForeClr := fColors.color_values;
end;

procedure TVBForm.WndVBFindBrace(Sender: TObject; WordType: Word;
  WordValue: Longint; WordStr: String; var BraceType: TLEBraceStyle);
var
  SyntaxIndex: Word;
  MyWord: TWordDesc;
begin
  MyWord.wCode := 0;
  MyWord.dwValue := 0;
  StrPCopy(MyWord.caWord, '');
  if WordType = WD_SYNTAXITEM then
  begin
    { Indicate braces for parantheses, brackets etc. }
    SyntaxIndex := HiWord(WordValue);
    if SyntaxIndex > 10 then
    begin
      BraceType := brNone;
    end;
    if (SyntaxIndex mod 2) = 1 then
    begin
      Inc(SyntaxIndex);
      BraceType := brRightBrace;
    end
    else
    begin
      Dec(SyntaxIndex);
      BraceType := brLeftBrace;
    end;
    MyWord.dwValue := MakeLong(0, SyntaxIndex);
  end
  else
  begin
    { Look for starting brace }
    if CompareText(WordStr,VB_LEFT_BRACE) = 0 then
    begin
      StrPCopy(MyWord.caWord, VB_RIGHT_BRACE);
      BraceType := brNoCaseLeftBrace;
    end;

    { Also look for ending brace }
    if CompareText(WordStr,VB_RIGHT_BRACE) = 0 then
    begin
      StrPCopy(MyWord.caWord, VB_LEFT_BRACE);
      BraceType := brNoCaseRightBrace;
    end;
  end;
  WndVB.WordDesc := MyWord;
end;

procedure TVBForm.WndVBWordClick(Sender: TObject; WordType: Word;
  WordValue: Longint; WordStr: String; var WordHandled: Boolean);
var
  MsgStr: String;
  SyntaxIndex: Word;
begin
  { Show message about word supplied if it exists }
  MsgStr := WordStr;
  MsgStr := MsgStr + #13 + #10;
  if WordType = WD_SYNTAXITEM then
  begin
    SyntaxIndex := HiWord(WordValue);
    MsgStr := MsgStr + 'Syntax: ' + IntToStr(SyntaxIndex);
  end
  else if (WordType and WDF_INTEGER) > 0 then
    MsgStr := MsgStr + 'Integer: ' + IntToStr(WordValue);

  { Display the Message Dialog }
  MessageDlg(MsgStr, mtInformation, [mbOk], 0);
end;

procedure TVBForm.loadReservedWords;
begin
  fReservedWords:= tStringList.create;
  with fReservedWords do
  begin
    duplicates:= dupIgnore;
    sorted:= true;
    clear;
    { Statements and Types }
    add('And');
    add('AppActivate');
    add('As');
    add('Beep');
    add('BeginTrans');
    add('Begin');
    add('Boolean');
    add('Byte');
    add('Call');
    add('Case');
    add('ChDir');
    add('ChDrive');
    add('Close');
    add('CommitTrans');
    add('CompactDatabase');
    add('Const');
    add('Currency');
    add('Date');
    add('Declare');
    add('DefBool');
    add('DefByte');
    add('DefCur');
    add('DefDate');
    add('DefDbl');
    add('DefInt');
    add('DefLng');
    add('DefObj');
    add('DefSng');
    add('DefStr');
    add('DefVar');
    add('DeleteSetting');
    add('Dim');
    add('Do');
    add('Double');
    add('Each');
    add('Else');
    add('End');
    add('Eqv');
    add('Erase');
    add('Error');
    add('Exit');
    add('FileCopy');
    add('For');
    add('FreeLocks');
    add('Function');
    add('Get');
    add('Global');
    add('GoSub');
    add('GoTo');
    add('If');
    add('Imp');
    add('Input');
    add('Integer');
    add('Is');
    add('Kill');
    add('Let');
    add('Lib');
    add('Like');
    add('Line');
    add('Load');
    add('Lock');
    add('LSet');
    add('Long');
    add('Loop');
    add('Mid');
    add('MkDir');
    add('Mod');
    add('Name');
    add('Next');
    add('Not');
    add('Null');
    add('Object');
    add('On');
    add('Open');
    add('Option');
    add('Or');
    add('Print');
    add('Private');
    add('Property');
    add('Public');
    add('Put');
    add('Randomize');
    add('ReDim');
    add('RegisterDatabase');
    add('Rem');
    add('RepairDatabase');
    add('Reset');
    add('Resume');
    add('Return');
    add('RmDir');
    add('Rollback');
    add('RSet');
    add('SavePicture');
    add('SaveSetting');
    add('Seek');
    add('Select');
    add('SendKeys');
    add('Set');
    add('SetAttr');
    add('SetDataAccessOption');
    add('SetDefaultWorkspace');
    add('Single');
    add('Static');
    add('Stop');
    add('String');
    add('Sub');
    add('Then');
    add('Time');
    add('Type');
    add('Unload');
    add('Unlock');
    add('Variant');
    add('While');
    add('Wend');
    add('Width');
    add('With');
    add('Write');
    add('Xor');

    { Misc }
    add('#');
    add('#If');
    add('#Const');
    add('#Else');
    add('#ElseIf');
    add('#End');
    add('Attribute');

    { Functions }
    add('Abs');
    add('Array');
    add('Asc');
    add('AscB');
    add('Atn');
    add('CBool');
    add('CByte');
    add('CCur');
    add('CDate');
    add('CDbl');
    add('Choose');
    add('Chr');
    add('ChrB');
    add('Clnt');
    add('CLng');
    add('Command');
    add('Cos');
    add('CreateDatabase');
    add('CreateObject');
    add('CSng');
    add('CStr');
    add('CurDir');
    add('CVar');
    add('CVErr');
    add('DateAdd');
    add('DateDiff');
    add('DatePart');
    add('DateSerial');
    add('DateValue');
    add('Day');
    add('DDB');
    add('Dir');
    add('DoEvents');
    add('Environ');
    add('EOF');
    add('Exp');
    add('FileAttr');
    add('FileDateTime');
    add('FileLen');
    add('Fix');
    add('Format');
    add('FreeFile');
    add('FV');
    add('GetAllSettings');
    add('GetAttr');
    add('GetObject');
    add('GetSetting');
    add('Hex');
    add('Hour');
    add('IIf');
    add('IMEStatus');
    add('Input');
    add('InStr');
    add('Int');
    add('IPmt');
    add('IRR');
    add('IsArray');
    add('IsDate');
    add('IsEmpty');
    add('IsError');
    add('IsMissing');
    add('IsNull');
    add('IsNumeric');
    add('IsObject');
    add('LBound');
    add('LCase');
    add('Left');
    add('Len');
    add('LoadPicture');
    add('LoadResData');
    add('LoadResPicture');
    add('LoadResString');
    add('Loc');
    add('LOF');
    add('Log');
    add('LTrim');
    add('Mid');
    add('Minute');
    add('MIRR');
    add('Month');
    add('MsgBox');
    add('Now');
    add('NPer');
    add('NPV');
    add('Oct');
    add('OpenDatabase');
    add('Partition');
    add('Pmt');
    add('PPmt');
    add('PV');
    add('QBColor');
    add('Rate');
    add('ReadProperty');
    add('RGB');
    add('Right');
    add('Rnd');
    add('RTrim');
    add('Second');
    add('Seek');
    add('Sgn');
    add('Shell');
    add('Sin');
    add('SLN');
    add('Space');
    add('Spc');
    add('Sqr');
    add('Str');
    add('StrComp');
    add('StrConv');
    add('String');
    add('Switch');
    add('SYD');
    add('Tab');
    add('Tan');
    add('Timer');
    add('TimeSerial');
    add('TimeValue');
    add('Trim');
    add('TypeName');
    add('UBound');
    add('UCase');
    add('Val');
    add('VarType');
    add('Weekday');
    add('Year');
  end;
end;

procedure TVBForm.About1Click(Sender: TObject);
begin
  LEExAboutBox.ShowModal;
end;

procedure TVBForm.Close1Click(Sender: TObject);
begin
  Close;
end;

procedure TVBForm.New1Click(Sender: TObject);
begin
  WndVB.NewFile;
end;

procedure TVBForm.Open1Click(Sender: TObject);
begin
  WndVB.OpenFile;
end;

procedure TVBForm.Save1Click(Sender: TObject);
begin
  WndVB.SaveFile;
end;

procedure TVBForm.SaveAs1Click(Sender: TObject);
begin
  WndVB.SaveFileAs;
end;

procedure TVBForm.Print1Click(Sender: TObject);
begin
  WndVB.Print;
end;

procedure TVBForm.Cut1Click(Sender: TObject);
begin
  WndVB.CutToClipboard;
end;

procedure TVBForm.Copy1Click(Sender: TObject);
begin
  WndVB.CopyToClipboard;
end;

procedure TVBForm.Paste1Click(Sender: TObject);
begin
  WndVB.PasteFromClipboard;
end;

procedure TVBForm.Clear1Click(Sender: TObject);
begin
  WndVB.Clear;
end;

procedure TVBForm.SelectAll1Click(Sender: TObject);
begin
  WndVB.SelectAll;
end;

procedure TVBForm.WordWrap1Click(Sender: TObject);
begin
  WndVB.WordWrap := not WndVB.WordWrap;
  WordWrap1.Checked := WndVB.WordWrap;
end;

procedure TVBForm.Comments1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_comments;
  if ColorDialog1.Execute then
  begin
    fColors.color_comments := ColorDialog1.Color;
    WndVB.Font.Color := fColors.color_comments;
    WndVB.refresh;
  end;
end;

procedure TVBForm.Keywords1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_reservedWords;
  if ColorDialog1.Execute then
  begin
    fColors.color_reservedWords := ColorDialog1.Color;
    WndVB.refresh;
  end;
end;

procedure TVBForm.EditorBackground1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_editorBackGround;
  if ColorDialog1.Execute then
  begin
    fColors.color_editorBackGround := ColorDialog1.Color;
    WndVB.Color := fColors.color_editorBackGround;
    WndVB.refresh;
  end;
end;

procedure TVBForm.NormalWords1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_normalWords;
  if ColorDialog1.Execute then
  begin
    fColors.color_normalWords := ColorDialog1.Color;
    WndVB.refresh;
  end;
end;

procedure TVBForm.SyntaxItems1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_syntax;
  if ColorDialog1.Execute then
  begin
    fColors.color_syntax := ColorDialog1.Color;
    WndVB.refresh;
  end;
end;

procedure TVBForm.QuotedText1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_quotedText;
  if ColorDialog1.Execute then
  begin
    fColors.color_quotedText := ColorDialog1.Color;
    WndVB.refresh;
  end;
end;

procedure TVBForm.NumericValues1Click(Sender: TObject);
begin
  ColorDialog1.Color := fColors.color_values;
  if ColorDialog1.Execute then
  begin
    fColors.color_values := ColorDialog1.Color;
    WndVB.refresh;
  end;
end;

end.
