ftags.pas

来自「Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器」· PAS 代码 · 共 156 行

unit fTags;

interface

uses
  Windows, Messages, Dialogs, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ComCtrls, DockPanel, strutils, fDoc, ElTree, StdCtrls, ElXPThemedControl;

type
  TfrmTags = class(TDockableForm)
    tvTags: TElTree;
    cmbTagList: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure tvTagsDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure cmbTagListChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    tagList: TStringList;
    { Private declarations }
    procedure LoadTags(strFile: String);
    procedure LoadItems;
  public
    { Public declarations }
  end;

var
  frmTags: TfrmTags;

implementation

uses fMain, dMain;

{$R *.dfm}

procedure TfrmTags.LoadTags(strFile: String);
var
  strList: TStringList;
  tNode: TElTreeItem;
  tmpStr: String;
  i: Integer;
begin
  strList := TStringList.Create;

  strList.LoadFromFile(ExtractFilePath(Application.ExeName) + 'tags\' + strFile);
  tvTags.Items.Clear;
  TagList.Clear;
  tmpStr := '';
  lockWindowUpdate(tvTags.Handle);
  for i := 0 to strList.Count-1 do begin
    if (LeftStr(strList[i], 2) = '#T') or (i = strList.Count-1) then begin
      if (i <> strList.Count-1) then begin
        tNode := tvTags.Items.AddItem(nil);
        tNode.Text := MIdStr(strList[i], 4, Length(strList[i]));
      end;
      TagList.Add(tmpStr);
      tmpStr := '';
    end
    else begin
      if tmpStr <> '' then
        tmpStr := tmpStr + Chr(10) + strList[i]
      else
        tmpStr := strList[i];
      //TagList.Add(tmpStr);
    end;
  end;
  //MessageBox(0, PChar(TagList.Text), 'test', mB_OK);
  LockWindowUpdate(0);
end;

procedure TfrmTags.LoadItems;
var
  SRec : TSearchRec;
  b: Boolean;
begin
  cmbTagList.Items.Clear;
  b:=(FindFirst(ExtractFilePath(Application.ExeName) + 'tags\*.tag',faAnyFile, SRec)=0);
  while b do begin
    cmbTagList.Items.Add(SRec.Name);
    b:=(FindNext(sRec)=0);
  end;
end;

procedure TfrmTags.FormCreate(Sender: TObject);
var i: Integer;
begin
  TagList := TStringList.Create;
  LoadTags('HTML.tag');
  cmbTagList.Text := 'HTML.tag';
  LoadItems;
  for i:=0 to cmbTagList.Items.Count do
    if cmbTagList.Items[i] = 'HTML.tag' then begin
      cmbTagList.ItemIndex := i;
      exit;
    end;
end;

procedure TfrmTags.tvTagsDblClick(Sender: TObject);
var
  TmpStr,tmpChk, tmpInput: String;
  pos1, pos3, pos2, i, cnt, curPos: Integer;
begin
  if dmMain.SelDoc <> nil then begin
    tmpStr := tagList[tvTags.Selected.Index+1];
    tmpChk := tmpStr;
    pos1:= Pos('^#', tmpChk);
    pos2:= Pos('#^', tmpChk);
    While ((pos1) <> 0) and ((pos2) <> 0) do begin
      tmpInput := InputBox('Input', MidStr(tmpChk, pos1+2,pos2-pos1-2),'');
      tmpStr := AnsiReplaceStr(tmpStr,MidStr(tmpChk, pos1,(pos2+2)-pos1), tmpInput);
      tmpChk:=MidStr(tmpChk, pos2+2, Length(tmpChk));
      pos1:= Pos('^#', tmpChk);
      pos2:= Pos('#^', tmpChk);
    end;
    pos3:=Pos('^!', tmpStr);
    cnt := 0;
    for i:=0 to pos3 do begin
      if tmpStr[i] = Chr(10) then
        cnt := cnt + 1;
    end;
    tmpStr := AnsiReplaceStr(tmpStr, '^!', '');
    curPos := dmMain.SelDoc.sciMain.SelStart;
    dmMain.SelDoc.sciMain.SelText := tmpStr;
    dmMain.SelDoc.sciMain.SelStart := curPos + (pos3-1) + cnt;
    Windows.SetFocus(dmMain.SelDoc.sciMain.Handle)
  end;

end;

procedure TfrmTags.FormResize(Sender: TObject);
begin
  with cmbTagList do begin
    Left := 0;
    Top := 0;
    Width := self.ClientWidth;
  end;
  With tvTags Do begin
    Left := 0;
    Top := cmbTagList.Height + 2;
    Width := Self.ClientWidth;
    Height := Self.ClientHeight - cmbTagList.Height - 4;
  end;
end;

procedure TfrmTags.cmbTagListChange(Sender: TObject);
begin
  LoadTags(cmbTagList.Text);
end;

procedure TfrmTags.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  frmMain.QuickTags1.Checked := False;
end;

end.