foptions.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

begin
  btnOK.Default := false;
  btnCancel.Cancel := false;
end;

procedure TfrmOptions.btnToolCommandClick(Sender: TObject);
begin
  with OpenDialog1 do begin
    Filter := 'Executable Files (*.exe)|*.exe|All Files (*.*)|*.*';
    if FileExists(txtToolCommand.Text) then
      FileName := txtToolCommand.Text;
    if Execute then begin
      txtToolCommand.Text := FileName;
    end;
  end;
end;

procedure TfrmOptions.lvToolsEdited(Sender: TObject; Item: TListItem;
  var S: String);
begin
  PToolType(Item.Data)^.Name := S;
end;

procedure TfrmOptions.txtToolCommandChange(Sender: TObject);
begin
  if lvTools.Selected <> nil then
    PToolType(lvTools.Selected.Data)^.ExecuteCmd := txtToolCommand.Text;
end;

procedure TfrmOptions.txtToolArgsChange(Sender: TObject);
begin
  if lvTools.Selected <> nil then
    PToolType(lvTools.Selected.Data)^.Arguments := txtToolArgs.Text;
end;

procedure TfrmOptions.lvToolsSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Selected = True then begin
    txtToolCommand.Enabled := True;
    btnToolCommand.Enabled := True;
    txtToolArgs.Enabled := True;
    With PToolType(Item.Data)^ do begin
      txtToolArgs.Text := Arguments;
      txtToolCommand.Text := ExecuteCmd;
    end;
  end
  else begin
    txtToolCommand.Enabled := False;
    btnToolCommand.Enabled := False;
    txtToolArgs.Enabled := False;
  end;
end;

procedure TfrmOptions.chkBraceBadLightClick(Sender: TObject);
begin
  // Bad brace lighting requires brace lighting. But not the other way around;
  if chkBraceBadLight.Checked = True then
    chkMatchBrace.Checked := True;
end;

procedure TfrmOptions.AddAssociation(const AIsPrint: boolean);
var
  MenuText: string;
  Exts: TStringList;
  i, j: integer;
  reg: TMyReg;
  procedure AddThis(Ext: string);
  var
    k: string;
  const
    SKey = '\%s\shell\%s';
    SCommLine = '"%s"';
  begin
    reg.OpenKey(Ext, true);
    Delete(Ext, 1, 1);
    if reg.ValueExists('') then
      k := reg.ReadString('')
    else begin
      k := Ext + 'file';
      reg.WriteReg('', k);
    end;
    reg.CloseKey;
    if AIsPrint then
      reg.OpenKey(Format(SKey, [k, cEditPrintKey]), true)
    else
      reg.OpenKey(Format(SKey, [k, cEditEditKey]), true);
    reg.WriteReg('', MenuText);
    reg.OpenKey('Command', true);
    if AIsPrint then
      reg.WriteReg('', Format(SCommLine, [Application.EXEName]) + ' -p "%1"')
    else
      reg.WriteReg('', Format(SCommLine, [Application.EXEName]) + ' "%1"');
    reg.CloseKey;
  end;
begin
  if AIsPrint then
    MenuText := txtPrintText.Text
  else
    MenuText := txtEditText.Text;
  reg := TMyReg.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    Exts := TStringList.Create;
    try
      for i := 0 to lstFileTypes.Items.Count - 1 do
        if lstFileTypes.Checked[i] then begin
          Exts.Clear;
          GetFileExts(lstFileTypes.Items[i], Exts);
          for j := 0 to Exts.Count - 1 do
            AddThis(Exts[j]);
        end;
    finally
      Exts.Free;
    end;
  finally
    reg.Free;
  end;
end;

procedure TfrmOptions.RemoveAssociation(const AIsPrint: boolean);
var
  Exts: TStringList;
  i, j: integer;
  reg: TRegistry;
  procedure RemoveThis(Ext: string);
  var
    k: string;
  const
    SKey = '\%s\shell\%s';
  begin
    if reg.KeyExists(Ext) then begin
      reg.OpenKey(Ext, false);
      k := reg.ReadString('');
      reg.CloseKey;
      if AIsPrint then begin
        if reg.KeyExists(Format(SKey, [k, cEditPrintKey])) then
          reg.DeleteKey(Format(SKey, [k, cEditPrintKey]));
      end else begin
        if reg.KeyExists(Format(SKey, [k, cEditEditKey])) then
          reg.DeleteKey(Format(SKey, [k, cEditEditKey]));
      end;
    end;
  end;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    Exts := TStringList.Create;
    try
      for i := 0 to lstFileTypes.Items.Count - 1 do
        if lstFileTypes.Checked[i] then begin
          Exts.Clear;
          GetFileExts(lstFileTypes.Items[i], Exts);
          for j := 0 to Exts.Count - 1 do
            RemoveThis(Exts[j]);
        end;
    finally
      Exts.Free;
    end;
  finally
    reg.Free;
  end;
end;


procedure TfrmOptions.btnAddEditClick(Sender: TObject);
begin
  AddAssociation((Sender as TButton).Tag = 1);
end;

procedure TfrmOptions.btnAddPrintClick(Sender: TObject);
begin
  AddAssociation((Sender as TButton).Tag = 1);
end;

procedure TfrmOptions.btnRemovePrintClick(Sender: TObject);
begin
  RemoveAssociation((Sender as TButton).Tag = 1);
end;

procedure TfrmOptions.btnRemoveEditClick(Sender: TObject);
begin
  RemoveAssociation((Sender as TButton).Tag = 1);
end;

procedure TfrmOptions.btnACAddClick(Sender: TObject);
var
  s: String;
begin
  With TfrmProposeSelect.Create(self) do begin
    txtName.Text := '';
    txtDesc.Lines.Text := '';
    if ShowModal = mrOK then begin
      with lvwAutoComplete.Items.Add do begin
        Caption := txtName.Text;
        SubItems.Add(txtDesc.Text);
      end;
      s := lstHighlighters.Items[lstHighlighters.ItemIndex];
      s := AnsiReplaceText(s, '/', '');
      s := AnsiReplaceText(s, '\', '');
      SaveProposal(s);
    end;
  end;
end;

procedure TfrmOptions.LoadProposal(sLangName: String);
var
  lLoadList: TstringList;
  lLoadIns: TstringList;
  i: Integer;
begin
  lLoadList := TStringList.Create;
  lLoadIns := TStringList.Create;

  { If either of the two files required to handle this don't exist then create them
    and then load them :)
  }
  if not FileExists(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst') then
    lLoadList.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst');
  if not FileExists(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins') then
    lLoadIns.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins');
  lLoadList.LoadFromFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst');
  lLoadIns.LoadFromFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins');
  if lLoadList.Count <> lLoadIns.Count then

  { if these files don't match in size then they are corrupted. }
  if MessageDlg('The following file has been corrupted. '+#13+#10+'Do you want it to be deleted and have an'+#13+#10+'empty file put in as a replacement?', mtError, [mbYes,mbNo], 0) in [mrYes] then begin
    DeleteFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst');
    DeleteFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins');
    lLoadList.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst');
    lLoadIns.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins');
  end
  else
    exit;

  { Load it in }
  lvwAutoComplete.Items.Clear;
  for i := 0 to lLoadList.Count - 1 do begin
    With lvwAutoComplete.Items.Add do begin
      Caption := lLoadIns[i];
      SubItems.Add(lLoadList[i]);
    end;
  end;
end;

procedure TfrmOptions.SaveProposal(sLangName: String);
var
  lLoadList: TstringList;
  lLoadIns: TstringList;
  i: Integer;
begin
  lLoadList := TStringList.Create;
  lLoadIns := TStringList.Create;
  for i:=0 to lvwAutoComplete.Items.Count - 1 do
    with lvwAutoComplete.Items[i] do begin
      lLoadIns.Add(Caption);
      lLoadList.Add(SubItems[0]);
    end;
  lLoadList.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.lst');
  lLoadIns.SaveToFile(ExtractFilePath(Application.ExeName) + 'propose\' + sLangName + '.ins');
end;


procedure TfrmOptions.lstHighlightersClick(Sender: TObject);
var
  s: String;
begin
  btnaCadd.Enabled := True;
  lvwAutoComplete.Enabled := True;
  s := lstHighlighters.Items[lstHighlighters.ItemIndex];
  s := AnsiReplaceText(s, '/', '');
  s := AnsiReplaceText(s, '\', '');
//  SaveProposal(s);
  LoadProposal(s);

end;

procedure TfrmOptions.btnACEditClick(Sender: TObject);
var i: integer;
s: string;
begin
  With TfrmProposeSelect.Create(self) do begin
    txtName.Text := lvwAutoComplete.Selected.Caption;
    txtDesc.Lines.Text := lvwAutoComplete.Selected.SubItems[0];
    i := ShowModal; // = mrOK then begin
    if i = mrOK then begin
      with lvwAutoComplete.Selected do begin
        Caption := txtName.Text;
        SubItems[0] := txtDesc.Text;//.Add(txtDesc.Text);
      end;
      s := lstHighlighters.Items[lstHighlighters.ItemIndex];
      s := AnsiReplaceText(s, '/', '');
      s := AnsiReplaceText(s, '\', '');

      SaveProposal(s);
    end;
    destroy;
  end;
end;

procedure TfrmOptions.lvwAutoCompleteSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Selected = True then begin
    btnACEdit.Enabled := True;
    btnCEDelete.Enabled := True;
  end
  else begin
    btnACEdit.Enabled := False;
    btnCEDelete.Enabled := False;
  end;
end;

procedure TfrmOptions.SpeedButton2Click(Sender: TObject);
var
  i: integer;
begin
  with lvTools do
    for i := Items.Count - 1 downto 0 do
      if Items[i].Selected then
        Items.Delete(i);
end;

procedure TfrmOptions.SpeedButton3Click(Sender: TObject);
var
  ii, ni: TListItem;
  lv: TListView;
begin
  // move a tool up
  try
    lv := lvTools;
    with lv do begin
      Items.BeginUpdate;
      ii := Selected;
      if ii.Index > 0 then begin
        ni := Items.Insert(ii.Index - 1);
        ni.Assign(ii);
        Items.Delete(ii.Index);
        ni.Selected := true;
        ni.MakeVisible(false);
      end;
      Items.EndUpdate;
      SetFocus;
//      EnableToolsControls(true);
    end;

  except end;
end;

procedure TfrmOptions.SpeedButton4Click(Sender: TObject);
var
  ii, ni: TListItem;
  lv: TListView;
begin
  // move a tool down
  try
   lv := lvTools;
    with lv do begin
      Items.BeginUpdate;
      ii := Selected;
      if ii.Index < Items.Count - 1 then begin
        ni := Items.Insert(ii.Index + 2);
        ni.Assign(ii);
//        bDisposeLVItemData := false;
        Items.Delete(ii.Index);
//        bDisposeLVItemData := true;
        ni.Selected := true;
        ni.MakeVisible(false);
      end;
      Items.EndUpdate;
      SetFocus;
    end;
  except end;
end;

procedure TfrmOptions.tvOptionsChange(Sender: TObject; Node: TTreeNode);
begin
  if tvOptions.Selected <> nil then begin
    nbOptions.ActivePage := tvOptions.Selected.Text;
    if tvOptions.Selected.Parent = nil then
      pnlCap.Caption := tvOptions.Selected.Text
    else
      pnlCap.Caption := tvOptions.Selected.Parent.Text + ' - (' + tvOptions.Selected.Text + ')';
  end;
end;

procedure TfrmOptions.btnEditDicClick(Sender: TObject);
var
  DicFile: string;
begin
  if (Sender as TButton).Tag = 0 then
    DicFile := txtDictionary.Text
  else
    DicFile := Copy(txtDictionary.Text, 1, Pos('.', txtDictionary.Text) - 1) + '.user.dic';
  ShellExecute(0, 'open', 'notepad.exe', PChar(DicFile), PChar(ExtractFilePath(DicFile)), SW_NORMAL);

end;

procedure TfrmOptions.btnEditUserDicClick(Sender: TObject);
var
  DicFile: string;
begin
  if (Sender as TButton).Tag = 0 then
    DicFile := txtDictionary.Text
  else
    DicFile := Copy(txtDictionary.Text, 1, Pos('.', txtDictionary.Text) - 1) + '.user.dic';
  ShellExecute(0, 'open', 'notepad.exe', PChar(DicFile), PChar(ExtractFilePath(DicFile)), SW_NORMAL);

end;

procedure TfrmOptions.btnDictionaryClick(Sender: TObject);
resourcestring
  SDicFilter = 'Dictionaries (*.dic)|*dic';
begin
  with OpenDialog1 do begin
    Filter := SDicFilter + '|' + SFilterAllFiles;
    if FileExists(txtDictionary.Text) then
      FileName := txtDictionary.Text;
    if Execute then
      txtDictionary.Text := FileName;
  end;
end;


procedure TfrmOptions.txtAutocorrWithChange(Sender: TObject);
begin
  btnAutocorrectAdd.Enabled := (txtAutocorrReplace.Text <> '') and
    (txtAutocorrWith.Text <> '');
  btnAutoCorrReplace.Enabled := (lvwAutocorrect.Selected <> nil) and
    btnAutocorrectAdd.Enabled;
end;

procedure TfrmOptions.btnAutocorrectAddClick(Sender: TObject);
  function AlreadyExists(AVal: string): integer;
  var
    i: integer;
  begin
    Result := -1;
    for i := 0 to lvwAutocorrect.Items.Count - 1 do
      if chkAutoCorrIgnoreCase.Checked then begin
        if SameText(lvwAutocorrect.Items[i].Caption, AVal) then begin
          Result := i;
          Break;
        end;
      end else begin
        if CompareStr(lvwAutocorrect.Items[i].Caption, AVal) = 0 then begin
          Result := i;
          Break;
        end;
      end;
  end;