dmain.pas

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

      LoadLang(ini);
      ini.Destroy;
    end;
  end;
end;

procedure TDmMain.LoadLang(lang: TiniFile);
var
  tCustLang: TSynAnySyn;
begin
  tCustLang := TSynAnySyn.Create(self);
  TCustLang.LoadHighLighter(lang.Filename);
end;

function TdmMain.SetHighlighter(name: string): TSynCustomHighlighter;
var
  i: integer;
  HasHighlighter: boolean;
begin
  HasHighlighter := False;
  Result := nil;
{  if Name = 'Text' then begin
    Result := nil;
    exit;
  end;}
  for i := 0 to fHighlighters.Count - 1 do begin

    if name = dmMain.fHighlighters[i] then begin

      Result := dmMain.fHighlighters.Objects[i] as TSynCustomHighlighter;
      HasHighlighter := True;
      break;
    end;
  end;

  if HasHighlighter = false then SetHighlighter := nil;
end;


function TdmMain.GetHighlighterForFile(AFileName: string): TSynCustomHighlighter;
begin
  if AFileName <> '' then
    Result := GetHighlighterFromFileExt(fHighlighters, ExtractFileExt(AFileName))
  else
    Result := nil;
end;

procedure TdmMain.SetSelLang(sName: String);
var i: integer;
begin
    if SelDoc = nil then exit;
    if selDoc.sciMain.Highlighter is TSynMultiSyn then
      SelDoc.cmbLang.ItemIndex := SelDoc.cmbLang.Items.IndexOf((SelDoc.sciMain.Highlighter as TSynMultiSyn).DefaultLanguageName)
    else
      SelDoc.cmbLang.ItemIndex := SelDoc.cmbLang.Items.IndexOf(GetLangName(SelDoc.sciMain.Highlighter));

end;

procedure TdmMain.NewDoc(FileName: String; Highlighter: TSynCustomHighlighter = nil);
var
  s: string;
  fNewDoc: TFrmDoc;
  fNewIDoc: TfrmImage;
  FileExt: String;
  i: Integer;
  x: Integer;
begin
  if FileExists(FileName) then begin
//    frmMain.RegMRU.Add(Filename, false, true, 0);
    for i := 0 to frmMain.MDIChildCount - 1 do begin
      if (frmMain.mdiChildren[i] is TfrmDoc) then
        if (frmMain.MDIChildren[i] as TFrmDoc).FileName = Filename then begin
          (frmMain.MDIChildren[i] as TFrmDoc).BringToFront;

          exit;
        end;
      if (frmMain.MdiChildren[i] is TfrmImage) then
        if (frmMain.MDIChildren[i] as TFrmImage).FileName = Filename then begin
          (frmMain.MDIChildren[i] as TFrmImage).BringToFront;

          exit;
        end;
    end;
  end;
  FileExt := LowerCase(ExtractFileExt(FileName));
  if (FileExt = '.bmp') or (FileExt = '.tif') or (FileExt = '.jpg') or (FileExt = '.png') or (FileExt = '.ico') then begin
    if FileExists(FileName) then begin
      fNewIDoc := TfrmImage.Create(frmMain);
      if (bMaximize) then
        fNewIDoc.WindowState := wsMaximized;
      fNewIDoc.imgPic.Picture.LoadFromFile(Filename);
      fNewIDoc.FileName := Filename;
      fNewiDoc.DoUpdateCaption;
      fNewIDoc.Show;
      frmMain.tcFiles.Tabs.InsertObject(frmMain.MDIChildCount-1, ExtractFileName(FileName), fNewIDoc);

      fNewIDoc.FormActivate(nil);
      exit;
    end;
  end
  else
  fNewDoc := TfrmDoc.Create(frmMain); //frmMain);
  fNewDoc.fLineBreak := lbWindows;
  if (bMaximize) then
    fNewDoc.WindowState := wsMaximized;
  if bUseDefault then
    fNewDoc.sciMain.Highlighter := SetHighlighter(sDefaultHighlighter);
  if FileExists(FileName) then begin
    frmMain.MRU.Add(Filename, false, true, 0);

//  fNewDoc.FindProperty(FileExt);
    s := FileToString(Filename);
//    fNewDoc.SciMain.Lines.LoadFromFile(FileName);
    fNewDoc.fLineBreak := GetLinebreak(s);
    if fNewDoc.fLineBreak <> lbWindows then
      fNewDoc.sciMain.Lines.Text := AdjustLinebreaks(s)
    else
      fNewDoc.sciMain.Lines.Text := s;
    //if (Pos(fNewDoc.sciMain.Text, Chr(0)) > 0) then tbbHex.Click;
{    if (FileExt = '.htm') or (FileExt = '.html') or (FileExt = '.vbs') or (FileExt = '.js') or (FileExt = '.php') then begin
      fNewDoc.sciMain.Highlighter := dmMain.SynHTML;
    end}
//    else
      fNewDoc.sciMain.Highlighter := GetHighlighterForFile(FileName);
      fNewDoc.Caption := ExtractFileName(Filename);
      fNewDoc.FileName := FileName;
      fNewDoc.DoUpdateCaption;
//      fNewDoc.ListFunctions;

  end

  else begin
    fNewDoc.Caption := Filename;
    if Highlighter <> nil then
      fNewDoc.sciMain.Highlighter := highlighter;
    fNewDoc.FileName := '';
//    fNewDoc.synMain.Highlighter := dmMain.synHTML;
  end;
  fNewDoc.cmbLang.items.Assign(fHighlighters);
  fnewdoc.cmbLang.Items.Insert(0, 'None');
  if fNewdoc.sciMain.Highlighter = nil then
    fnewdoc.cmbLang.ItemIndex := 0
  else
    if fNewDoc.sciMain.Highlighter is TSynMultiSyn then
      fNewDoc.cmbLang.ItemIndex := fNewDoc.cmbLang.Items.IndexOf((fNewDoc.sciMain.Highlighter as TSynMultiSyn).DefaultLanguageName)
    else
      fNewDoc.cmbLang.ItemIndex := fNewDoc.cmbLang.Items.IndexOf(GetLangName(fNewDoc.sciMain.Highlighter));
  frmMain.tcFiles.Tabs.InsertObject(frmMain.MDIChildCount-1, ExtractFileName(FileName), fNewDoc);

  fNewDoc.sciMain.SetFocus;
  fNewDoc.FormActivate(frmMain);

end;


procedure TdmMain.ShowOpt();
var
  i: Integer;
begin
  frmOptions := TfrmOptions.Create(frmMain);
  frmOptions.lstLang.Items.Assign(fHighlighters);
  frmOptions.lstHighlighters.Items.Assign(fHighlighters);
  frmOptions.lstLangs2.Items.Assign(fHighlighters);
  frmOptions.lstLang3.Items.Assign(fHighlighters);
  frmOptions.cmbLangs.Items.Assign(fHighlighters);
  frmOptions.lstFileTypes.Clear;
  for i := dmMain.ComponentCount - 1 downto 0 do begin
    if not (dmMain.Components[i] is TSynCustomHighlighter) then
      continue;
    if (dmMain.Components[i] as TSynCustomHighlighter).DefaultFilter <> '' then
      frmOptions.lstFileTypes.Items.Add((dmMain.Components[i] as TSynCustomHighlighter).DefaultFilter);
  end;
  frmOptions.ShowModal;
end;


procedure TdmMain.s(Sender: TObject);
var
  i: Integer;
  SHFileInfo: TSHFileInfo;
  aItem: TMenuItem;
begin
  LoadLangs;
  ExportXHTML := TSynExporterXHTML.Create(dmmain);
  fHighlighters := TStringList.Create;
  GetHighlighters(Self, fHighlighters, FALSE);
  imlShellIcon.Handle := SHGetFileInfo('', 0, SHFileInfo, SizeOf(SHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  imlShellLarge.Handle := SHGetFileInfo('', 0, SHFileInfo, SizeOf(SHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
  Propose.ShortCut := ShortCut(VK_SPACE, [ssCtrl]);
  ReadFunctions;
//  aItem.RethinkHotkeys;
  dlgFileOpen.Filter :=  SFilterAllFiles + GetHighlightersFilter(fHighlighters);
end;

procedure TdmMain.SaveHighlighters();
var
  i: integer;
  s: String;
  Highlighter: TSynCustomHighlighter;
  Filter: String;
  reg: TMyReg;
begin
  for i := dmMain.ComponentCount - 1 downto 0 do begin
    if not (dmMain.Components[i] is TSynCustomHighlighter) then
      continue;
    Highlighter := dmMain.Components[i] as TSynCustomHighlighter;
    Filter := Highlighter.DefaultFilter;
    Highlighter.SaveToRegistry(HKEY_CURRENT_USER, 'Software\cEdit\Highlighters\' + GetLangName(Highlighter));
    s := GetLangName(Highlighter);
    s := ansireplacetext(s, '\', '');
    s := ansireplacetext(s, '/', '');
    Highlighter.SaveComment(ExtractFilePath(Application.ExeName) + 'comments\' + s + 'cmt');
    reg := TMyReg.Create;
    reg.OpenKey('Software\cEdit\Highlighters\' + GetLangName(Highlighter) + '\', true);
    reg.WriteReg('Filter', Filter);
  end;
end;


procedure TdmMain.LoadHighlighters();
var
  i: integer;
  Highlighter: TSynCustomHighlighter;
  reg: TMyReg;
  s: string;
begin
  for i := dmMain.ComponentCount - 1 downto 0 do begin
    if not (dmMain.Components[i] is TSynCustomHighlighter) then
      continue;

    Highlighter := dmMain.Components[i] as TSynCustomHighlighter;
    Highlighter.LoadFromRegistry(HKEY_CURRENT_USER, 'Software\cEdit\Highlighters\' + GetLangName(Highlighter));

    s := GetLangName(Highlighter);
    s := ansireplacetext(s, '\', '');
    s := ansireplacetext(s, '/', '');
    Highlighter.LoadComment(ExtractFilePath(Application.ExeName) + 'comments\' + s + 'cmt');
    reg := TMyReg.Create;
    reg.OpenKey('Software\cEdit\Highlighters\' +  GetLangName(Highlighter) + '\', True);
    Highlighter.DefaultFilter := reg.ReadReg('Filter', Highlighter.DefaultFilter);
  end;
end;

procedure TdmMain.DataModuleDestroy(Sender: TObject);
begin
  imlShellIcon.Handle := 0;
  fHighlighters.Free;
end;

procedure TdmMain.actFileNewExecute(Sender: TObject);
begin
  NewDoc('Untitled' + IntToStr(frmMain.MDIChildCount));
end;

function TdmMain.CloseAll(TDoc: TfrmDoc = nil): TmodalResult;
var
  i: Integer;
  strStore: TStringList;
  mrResult: Integer;
begin
    Result := mrNo;
    strStore := TStringList.Create;
    bCloseAll := False;
    if tDoc <> nil then begin
      strStore.AddObject(tDoc.Caption, tDoc);
    end
    else begin
      bCloseAll := True;
      for i:=0 to frmMain.MDIChildCount - 1 do
        if (frmMain.MDIChildren[i] <> nil) {and (frmMain.MDIChildren[i] is TfrmDoc)} then begin
          if (frmMain.MDIChildren[i] is TfrmDoc) and (((frmMain.MDIChildren[i] as TfrmDoc).sciMain.Modified = True) or ((frmMain.MDIChildren[i] as TfrmDoc).hxMain.Modified = True)) then begin
            strStore.AddObject((frmMain.MDIChildren[i] as TfrmDoc).Caption, frmMain.MDIChildren[i]);
          end;
        end;
    end;

    if strStore.Count > 0 then With TfrmSaveDlg.Create(self) do begin
      lstFiles.Items.Assign(strStore);
      for i:=0 to lstFiles.Count-1 do
        lstFiles.Selected[i] := True;
      mrResult := ShowModal;
      Result := mrResult;
      if mrResult = mrYes then begin
        for i := 0 to lstFiles.Count - 1 do begin
          if lstFiles.Selected[i] then begin
            SaveDoc(lstFiles.Items.Objects[i] as TfrmDoc);
          end;
        end;
      end
      else if mrResult = mrAll then begin
        for i := 0 to lstFiles.Count - 1 do begin
          SaveDoc(lstFiles.Items.Objects[i] as TfrmDoc);
        end;

      end else if mrResult = mrCancel then begin
        bCloseAll := False;
        exit;
      end
    end;
    if (tDoc <> nil) then begin
      bCloseAll := True;
      tDoc.Close;
      bCloseAll := False;
    end
    else begin
      bCloseAll := True;
      for i:=0 to frmMain.MDIChildCount - 1 do begin
        //if (frmMain.MDIChildren[i] <> nil) then
          frmMain.MDIChildren[i].Close
      end;
    end;

end;
procedure StringToFile(const FileName, AText: string);
var
  F: File;
  SaveFileMode: integer;
begin
  SaveFileMode := FileMode;
  try
    FileMode := fmOpenWrite;
    AssignFile(F, FileName);
    Rewrite(F, 1);
  finally
    FileMode := SaveFileMode;
  end;
  try
    BlockWrite(F, PChar(AText)^, Length(AText));
  finally
    CloseFile(F);
  end;
end;

procedure TdmMain.SaveDoc(TDoc: TfrmDoc);
var
 frmUpload: TfrmUpload;
 s: String;
begin

  if TDoc <> nil then begin
   // If it's got the ftp flag then we need to handle it accordingly.
   if TDoc.isFTP = True then begin
     // First off save the temp file
     if TDoc.bHexMode = false then
       if TDoc.fLineBreak <> lbWindows then begin
         s := Tdoc.sciMain.Lines.Text;
         ConvLineBreak(s, tDoc.fLineBreak);
         StringToFile(tDoc.Filename, s);
       end
       else
         TDoc.sciMain.Lines.SaveToFile(tDoc.FileName)
     else
       TDoc.hxMain.SaveToFile(tDoc.FileName);
     // Now Setup the FTP Upload
     frmUpload := TfrmUPload.Create(self);
     frmUPload.LocalFile := TDoc.FileName;
     frmUPload.FileName := TDoc.FTPName;
     frmUpload.cboAccount.Text := TDoc.FTPName;
     frmUpload.FTPDir := TDoc.FTPDir;
     if frmUpload.ShowModal <> mrCancel then begin
       TDoc.sciMain.Modified := False;
       TDoc.hxMain.Modified := False;
     end;
     exit;
   end;

   if TDoc.FileName <> '' then begin
     if TDoc.bHexMode = false then begin
       if TDoc.fLineBreak <> lbWindows then begin
         s := Tdoc.sciMain.Lines.Text;
         ConvLineBreak(s, tDoc.fLineBreak);
         StringToFile(tDoc.Filename, s);
       end
       else
         TDoc.sciMain.Lines.SaveToFile(tDoc.FileName);
       TDoc.sciMain.Modified := False;
       TDoc.hxMain.Modified := False;
     end
     else begin
       tDoc.hxMain.SaveToFile(SelDoc.FileName);
       TDoc.sciMain.Modified := False;
       TDoc.hxMain.Modified := False;
     end;
   end
   else BEGIN
     SaveDocAs(TDoc);
   end;
  end;

end;

procedure TdmMain.SaveDocAs(TDoc: TfrmDoc);
var
  idx: Integer;
  s: String;
  msgResponse: Word;
label Start;
begin
  if TDoc = nil then exit;
  With dlgFileSave do begin
    Filter := SFilterAllFiles + GetHighlightersFilter(fHighlighters);
Start:
    if Execute then begin
      if FileExists(FileName) then begin
        msgResponse:=MessageDlg('The file '''+Filename+''''+#13+#10+'already exists. Do you wish to overwrite?', mtWarning, [mbYes,mbNo,mbCancel], 0);
        if (msgResponse=mrNo) then
          Goto Start
        else if (msgResponse=mrCancel) then
          exit;
      end;
      if TDoc.bHexMode = false then begin
       if TDoc.fLineBreak <> lbWindows then begin
          s := Tdoc.sciMain.Lines.Text;