unit1.pas

Ritchedit Syntax Editor with color (Pascal, C++, Java, Jajascript,...)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FireColorSynth;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    RichEdit1: TRichEdit;
    ButtonFont: TButton;
    FontDialog1: TFontDialog;
    Edit1: TEdit;
    Label2: TLabel;
    ButtonMemo: TButton;
    GroupBox3: TGroupBox;
    FireColorSynth1: TFireColorSynth;
    ButtonSuppr: TButton;
    ButtonSauver: TButton;
    SaveDialog1: TSaveDialog;
    ButtonCharger: TButton;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    ButtonDefaultFont: TButton;
    CheckBoxComment: TCheckBox;
    Button2: TButton;
    procedure ListBox1Click(Sender: TObject);
    procedure ButtonFontClick(Sender: TObject);
    procedure ButtonMemoClick(Sender: TObject);
    procedure ButtonSupprClick(Sender: TObject);
    procedure ButtonSauverClick(Sender: TObject);
    procedure ButtonChargerClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ButtonDefaultFontClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { D閏larations priv閑s }
  public
    { D閏larations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1Click(Sender: TObject);
var
    CSI : TColorSyntItem;
    i : Integer;
begin
    ButtonSuppr.Enabled := ListBox1.ItemIndex <> -1;
    
    if ListBox1.ItemIndex <> -1 then
    begin
          CSI := FireColorSynth1.GetItemByName(ListBox1.Items[ListBox1.ItemIndex]);
          Edit1.Text := csi.Name;
          RichEdit1.Clear;
          RichEdit1.Font.Assign(csi.ColorList.Font);
          For i := 0 to csi.ColorList.List.Count - 1 do
          begin
              RichEdit1.Lines.Add(csi.ColorList.List.Strings[i]);
          end;

          RichEdit1.Font.Assign(csi.ColorList.Font);
          FontDialog1.Font.Assign(csi.ColorList.Font);

          CheckBoxComment.Checked := CSI.ColorList.ListType = TYPE_COMMENT;
    end;
end;

procedure TForm1.ButtonFontClick(Sender: TObject);
begin
      if FontDialog1.Execute then RichEdit1.Font.Assign(FontDialog1.Font);
end;

procedure TForm1.ButtonMemoClick(Sender: TObject);
var
    N : String;
    i, j : integer;
    CSI : TColorSyntItem;
begin
      ListBox1.ItemIndex := -1;
      ButtonSuppr.Enabled := false;

      with FireColorSynth1 do
      begin
            N := Edit1.Text;
            if (Edit1.Text = '') Or (ListBox1.Items.IndexOf(N) = -1) then
            begin
                  items.Add;
                  CSI := items[items.Count - 1];
                  if N = '' then
                  begin
                        N := 'Item' + InttoStr(items.Count-1);
                        j := 0;
                        While ListBox1.Items.IndexOf(N) <> -1 Do
                        begin
                              N := 'Item' + IntToStr(j) + '_' + InttoStr(items.Count);
                              Inc(j);
                        end;
                  end;

                  CSI.Name := N;
                  ListBox1.Items.Add(N);
            end
            else
            begin
                i := 0;
                CSI := nil;
                While (i < items.Count) And (CSI = nil) Do
                begin
                    if UpperCase(items[i].Name) = UpperCase(N) then CSI := items[i];
                    Inc(i);
                end;
            end;

            CSI.ColorList.List.Clear;
            CSI.ColorList.LoadWordListFromText(RichEdit1.Text);
            CSI.ColorList.Font.Assign(RichEdit1.Font);
            if CheckBoxComment.Checked then
              CSI.ColorList.ListType := TYPE_COMMENT
            else
              CSI.ColorList.ListType := TYPE_WORD;
      end;
      Edit1.Text := '';
      Edit1.SetFocus;
      RichEdit1.Clear;
end;

procedure TForm1.ButtonSupprClick(Sender: TObject);
var
    i : Integer;
begin
    if ListBox1.ItemIndex <> -1 then
    begin
          i := fireColorSynth1.GetIndexItemNamed(ListBox1.Items[ListBox1.ItemIndex]);
          FireColorSynth1.items.Delete(i);

          ListBox1.Items.Delete(ListBox1.ItemIndex);
          ListBox1.ItemIndex := -1;
    end;
end;

procedure TForm1.ButtonSauverClick(Sender: TObject);
var
    Path : String;
begin
    if SaveDialog1.Execute then
    begin
        Path := SaveDialog1.FileName;
        if UpperCase(ExtractFileExt(Path)) <> '.INI' then Path := Path + '.ini';
        FireColorSynth1.SaveColorToIniFile(Path);
    end;
end;

procedure TForm1.ButtonChargerClick(Sender: TObject);
var
      i, j, k : Integer;
      N : String;
begin
      if OpenDialog1.Execute then
      begin
          ListBox1.Clear;
          FireColorSynth1.items.Clear;
          FireColorSynth1.LoadColorFromIniFile(OpenDialog1.FileName);
          for i := 0 to FireColorSynth1.items.Count-1 do
          begin
                N := FireColorSynth1.items[i].Name;
                if N = '' then
                begin
                      N := 'Item' + InttoStr(i+1);
                      repeat
                            j := 0;
                            While ListBox1.Items.IndexOf(N) <> -1 Do
                            begin
                                  N := 'Item' + IntToStr(j) + '_' + InttoStr(i+1);
                                  Inc(j);
                            end;

                            k := i + 1;
                            while (k < FireColorSynth1.items.Count) And (UpperCase(FireColorSynth1.items[k].Name) <> Uppercase(N)) do Inc(k);

                      until k = FireColorSynth1.items.Count;
                end;
                ListBox1.Items.Add(N);
                FireColorSynth1.items[i].Name := N;
          end;
      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      FireColorSynth1.items.Clear;
      ListBox1.Clear;
end;

procedure TForm1.ButtonDefaultFontClick(Sender: TObject);
begin
    FontDialog1.Font.Assign(FireColorSynth1.Font);
    if FontDialog1.Execute then FireColorSynth1.Font.Assign(FontDialog1.Font);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RichEdit1.Clear;
end;

end.