⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 utxtfrm.pas

📁 一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
        OprList.DownLoad(Bin,ID,TSpTBXItem(Sender).Tag);
        Bin.SaveToFile(DlgSave.FileName);
      finally
        Bin.Free;
      end;
    end;
  finally
    DlgSave.Free;
  end;
end;

procedure TTxtFrm.SelectAll;
begin
  RichEdit.SelectAll;
  RichEdit.SetFocus;
  RIchEdit.Invalidate;
end;

procedure TTxtFrm.Undo;
begin
  RichEdit.Undo;
end;

procedure TTxtFrm.Redo;
begin
  RichEdit.Redo;
end;

procedure TTxtFrm.DeleteSelection;
begin
  RichEdit.DeleteSelection;
end;

procedure TTxtFrm.InsertBreak;
begin
  RichEdit.InsertBreak(1,rvbsLine,clblack);
end;

procedure TTxtFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if RichEdit.Modified then
  begin
    case MessageBox(Application.Handle,pchar('是否保存对“'+caption+'”的修改？'), '提示', MB_ICONINFORMATION or MB_YESNOCANCEL) of
      IDYes:
      begin
        CanClose:=SaveFile;
      end;
      IDNo:
      begin
        CanClose:=true;
      end;
      IDCancel:
      begin
        CanClose:=false
      end;
    end;
  end;
end;

procedure TTxtFrm.FormActivate(Sender: TObject);
begin
  if OprList<>nil then
    OprList.RefreshwMenu(ID,ID,caption);
end;

procedure TTxtFrm.SpTBXItem12Click(Sender: TObject);
begin
  RichEdit.CopyDef;
end;

procedure TTxtFrm.SpTBXItem11Click(Sender: TObject);
begin
  RichEdit.CutDef; 
end;

procedure TTxtFrm.SpTBXItem10Click(Sender: TObject);
begin
  RichEdit.Paste; 
end;

procedure TTxtFrm.SpTBXItem13Click(Sender: TObject);
begin
  DeleteSelection;
end;

procedure TTxtFrm.SpTBXItem14Click(Sender: TObject);
begin
  SelectAll;
end;

procedure TTxtFrm.SpTBXItem16Click(Sender: TObject);
begin
  Undo; 
end;

procedure TTxtFrm.SpTBXItem15Click(Sender: TObject);
begin
  Redo;
end;

procedure TTxtFrm.InsertFile;
var
  DlgOpen:TOpenDialog;
  r:Boolean;
begin
  DlgOpen:=TOpenDialog.Create(nil);
  try
    DlgOpen.Title := '插入文件';
    DlgOpen.Filter := 'RichView Format Files(*.rvf)|*.rvf|'+
                      'RTF Files(*.rtf)|*.rtf|'+
                      'Text Files - autodetect (*.txt)|*.txt|'+
                      'ANSI Text Files (*.txt)|*.txt|'+
                      'Unicode Text Files (*.txt)|*.txt|'+
                      'OEM Text Files (*.txt)|*.txt';

    if DlgOpen.Execute then
    begin
      Screen.Cursor:=crHourglass;
      case DlgOpen.FilterIndex of
        1:r:=RichEdit.InsertRVFFromFileEd(DlgOpen.FileName);
        2:r:=RichEdit.InsertRTFFromFileEd(DlgOpen.FileName);
        3:
        begin
          if RV_TestFileUnicode(DlgOpen.FileName)=rvutYes then
            r:=RichEdit.InsertTextFromFileW(DlgOpen.FileName)
          else
            r:=RichEdit.InsertTextFromFile(DlgOpen.FileName);
        end;
        4:r:=RichEdit.InsertTextFromFile(DlgOpen.FileName);
        5:r:=RichEdit.InsertTextFromFileW(DlgOpen.FileName);
        6:r:=RichEdit.InsertOEMTextFromFile(DlgOpen.FileName);
        else
          r:=false;
      end;
      Screen.Cursor:=crDefault;
      if not r then
        MessageBox(Application.Handle,'文件读取错误。', '错误', MB_ICONERROR or MB_OK)
    end;
  finally
    DlgOpen.Free;
  end;
end;

procedure TTxtFrm.SpTBXItem18Click(Sender: TObject);
begin
  InsSymbol;
end;

procedure TTxtFrm.Search;
begin
  Fd.Execute; 
end;

procedure TTxtFrm.FdFind(Sender: TObject);
begin
  if not RichEdit.SearchText(Fd.FindText,GetRVESearchOptions(Fd.Options)) then
    MessageBox(Application.Handle,pchar('未找到“'+Fd.FindText+'”，请重新查找。'), '提示', MB_ICONINFORMATION or MB_OK);
end;

procedure TTxtFrm.SearchNext;
begin
  if Fd.FindText<>'' then
  begin
    if not RichEdit.SearchText(Fd.FindText,GetRVESearchOptions(Fd.Options)) then
      MessageBox(Application.Handle,pchar('未找到“'+Fd.FindText+'”，请重新查找。'), '提示', MB_ICONINFORMATION or MB_OK);
  end;
end;

procedure TTxtFrm.RdFind(Sender: TObject);
begin
  Fd.FindText:=Rd.FindText;
  Fd.Options:=Rd.Options;
  if not RichEdit.SearchText(Rd.FindText,GetRVESearchOptions(Rd.Options)) then
    MessageBox(Application.Handle,pchar('未找到“'+Rd.FindText+'”，请重新查找。'), '提示', MB_ICONINFORMATION or MB_OK);
end;

procedure TTxtFrm.RdReplace(Sender: TObject);
var
  c:Integer;
begin
  if frReplace in Rd.Options then
  begin
    if AnsiLowerCase(RichEdit.GetSelText)=AnsiLowerCase(Rd.FindText) then
    begin
      RichEdit.InsertText(Rd.ReplaceText, not (frDown in Rd.Options));
    end;
    if not RichEdit.SearchText(Rd.FindText,GetRVESearchOptions(Rd.Options)) then
      MessageBox(Application.Handle,pchar('未找到“'+Rd.FindText+'”，请重新查找。'), '提示', MB_ICONINFORMATION or MB_OK);
  end
  else if frReplaceAll in Rd.Options then
  begin
    c:=0;
    if AnsiLowerCase(RichEdit.GetSelText)=AnsiLowerCase(Rd.FindText) then
    begin
      RichEdit.InsertText(Rd.ReplaceText, not (frDown in Rd.Options));
      inc(c);
    end;
    while RichEdit.SearchText(Rd.FindText, GetRVESearchOptions(Rd.Options)) do
    begin
      RichEdit.InsertText(Rd.ReplaceText, not (frDown in Rd.Options));
      inc(c);
    end;
    MessageBox(Application.Handle,pchar('已完成'+inttostr(c)+'处替换。'), '提示', MB_ICONINFORMATION or MB_OK);
  end;
end;

procedure TTxtFrm.Replace;
begin
  rd.Execute;
end;

procedure TTxtFrm.Preview;
var
  frm:TPreviewfrm;
begin
  frm:=TPreviewfrm.Create(self);
  LockWindowUpdate(frm.Handle);
  try
    RVPrint1.AssignSource(RichEdit);
    RVPrint1.FormatPages(rvdoALL);
    frm.Pv.RVPrint:=RVPrint1;
    frm.SpTBXItem1.Click;
  finally
    LockWindowUpdate(0);
  end;
  frm.ShowModal;
  frm.Free;
end;

procedure TTxtFrm.RichEditCaretMove(Sender: TObject);
var
  LineNum:longint;
  CharsBeforeLine:longint;
  rve: TCustomRichViewEdit;
  item: TCustomRVItemInfo;
  table: TRVTableItemInfo;
  ItemNo: Integer;

  StartNo, EndNo, a,b,i: Integer;
  Checked1,Checked2: Boolean;
  CorrectListNo, ListNo, ListLevel, StartFrom: Integer;
  UseStartFrom: Boolean;

  function IsApplicable(rve: TCustomRichViewEdit;
    table: TRVTableItemInfo; ItemNo: Integer): Boolean;
  var
    r,c,cs,rs: Integer;
  begin
    Result := table.GetNormalizedSelectionBounds(True,r,c,cs,rs);
    if Result then begin
      table.Rows.GetMainCell(r,c,r,c);
      Result := (cs = table.Cells[r,c].ColSpan) and
                (rs = table.Cells[r,c].RowSpan);
      Result := Result or table.CanMergeSelectedCells(True);
    end;
  end;
begin
  RichEdit.GetCurrentLineCol(LineNum,CharsBeforeLine);
  lbPosition.Caption:=Format('行:%d 列:%d',[LineNum,CharsBeforeLine]);

  if not RichEdit.GetCurrentItemEx(TRVTableItemInfo, rve, item) then
  begin
    SpTBXItem1.Enabled:=false;
    SpTBXItem20.Enabled:=false;
  end
  else
  begin
    table := TRVTableItemInfo(item);
    SpTBXItem1.Enabled:=table.CanMergeSelectedCells(True);

    SpTBXSubmenuItem1.Enabled:=rve.TopLevelEditor.RVData.PartialSelectedItem=nil;
    ItemNo := table.GetMyItemNo;
    SpTBXItem20.Enabled:=IsApplicable(rve, table, ItemNo);
  end;

  RichEdit.TopLevelEditor.GetSelectionBounds(StartNo, a, EndNo, b, True);
  if StartNo<0 then
  begin
    StartNo := RichEdit.TopLevelEditor.CurItemNo;
    EndNo   := StartNo;
  end;
  RichEdit.TopLevelEditor.RVData.ExpandToPara(StartNo, EndNo, StartNo, EndNo);
  Checked1 := True;
  Checked2 := True;
  CorrectListNo := -1;
  for i := StartNo to EndNo do
    if RichEdit.TopLevelEditor.IsParaStart(i) then
    begin
      if (RichEdit.TopLevelEditor.GetListMarkerInfo(i, ListNo, ListLevel, StartFrom, UseStartFrom)<0) or (ListNo<0) then
      begin
        Checked1 := False;
        //Checked2 := False;
        break;
      end;
      if (i=StartNo) then
      begin
        if RichEdit.TopLevelEditor.Style.ListStyles[ListNo].Levels.IsSimpleEqual(RVStyle1.ListStyles[0].Levels) then
          CorrectListNo := ListNo
        else
        begin
          Checked1 := False;
          break;
        end;
        {if RichEdit.TopLevelEditor.Style.ListStyles[ListNo].Levels.IsSimpleEqual(RVStyle1.ListStyles[1].Levels) then
          CorrectListNo := ListNo
        else
        begin
          Checked2 := False;
          break;
        end;}
      end
      else if ListNo<>CorrectListNo then
      begin
        Checked1 := False;
        //Checked2 := False;
        break;
      end;
    end;
  SpTBXItem22.Checked := Checked1;

  RichEdit.TopLevelEditor.RVData.ExpandToPara(StartNo, EndNo, StartNo, EndNo);
  CorrectListNo := -1;
  for i := StartNo to EndNo do
    if RichEdit.TopLevelEditor.IsParaStart(i) then
    begin
      if (RichEdit.TopLevelEditor.GetListMarkerInfo(i, ListNo, ListLevel, StartFrom, UseStartFrom)<0) or (ListNo<0) then
      begin
        //Checked1 := False;
        Checked2 := False;
        break;
      end;
      if (i=StartNo) then
      begin
        {if RichEdit.TopLevelEditor.Style.ListStyles[ListNo].Levels.IsSimpleEqual(RVStyle1.ListStyles[0].Levels) then
          CorrectListNo := ListNo
        else
        begin
          Checked1 := False;
          break;
        end;}
        if RichEdit.TopLevelEditor.Style.ListStyles[ListNo].Levels.IsSimpleEqual(RVStyle1.ListStyles[1].Levels) then
          CorrectListNo := ListNo
        else
        begin
          Checked2 := False;
          break;
        end;
      end
      else if ListNo<>CorrectListNo then
      begin
        //Checked1 := False;
        Checked2 := False;
        break;
      end;
    end;
  SpTBXItem21.Checked := Checked2;
end;

procedure TTxtFrm.Print;
begin
  RVPrint1.AssignSource(RichEdit);
  RVPrint1.FormatPages(rvdoALL);
  Pd.Options:=Pd.Options+[poPageNums];
  Pd.MinPage:=1;
  Pd.MaxPage:=RVPrint1.PagesCount;
  Pd.FromPage:=1;
  Pd.ToPage:=RVPrint1.PagesCount;
  if RVPrint1.PagesCount>0 then
  begin
    if Pd.Execute then
    begin
      Screen.Cursor := crHourGlass;
      try
        if Pd.PrintRange = prAllPages then
          RVPrint1.Print(Caption,pd.Copies,pd.Collate)
        else if Pd.PrintRange = prPageNums then
          RVPrint1.PrintPages(Pd.FromPage,Pd.ToPage,Caption,pd.Copies,pd.Collate);
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  end;
end;

procedure TTxtFrm.PrintDefault;
begin
  RVPrint1.AssignSource(RichEdit);
  RVPrint1.FormatPages(rvdoALL);
  Screen.Cursor := crHourGlass;
  try
    RVPrint1.Print(Caption,1,false);
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TTxtFrm.PageSetup;
var
  frm:TfrmRVPageSetup;
begin
  frm:=TfrmRVPageSetup.Create(self);
  frm.init;
  if frm.ShowModal=mrok then
  begin

  end;
  frm.Free;
end;

procedure TTxtFrm.RVPrint1PagePrepaint(Sender: TRVPrint; PageNo: Integer;
  Canvas: TCanvas; Preview: Boolean; PageRect, PrintAreaRect: TRect);

  function Parse(const s: String): String;
  var
    i,j: Integer;
    Field: Boolean;
    s2: String;
  begin
    Result := '';
    Field := False;
    j := 1;
    for i := 1 to Length(s) do
      if Field then begin
        if s[i] in ['&', 'p', 'P', 'd', 't'] then begin
          Result := Result+Copy(s, j, i-j-1);
          case s[i] of
            '&':
              Result := Result+'&';
            'p':
              Result := Result+IntToStr(PageNo+StartPage-1);
            'P':
              Result := Result+IntToStr(Sender.PagesCount);
            'd':
              Result := Result+DateToStr(Date);
            't':
              begin
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -