utxtfrm.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

                DateTimeToString(s2, ShortTimeFormat, Time);
                Result := Result+s2;
              end;
          end;
          j := i+1;
        end;
        Field := False;
        end
      else
        Field := s[i]='&';
    if j<Length(s) then
      Result := Result+Copy(s, j, Length(s)-j+1);
  end;

  procedure PrintHF(HF: THFInfo; Header: Boolean);
  var
    s: String;
    ppi, y, h, flag: Integer;
    r: TRect;
  begin
    s := Parse(HF.Text);
    ppi := Canvas.Font.PixelsPerInch;
    Canvas.Font := HF.Font;
    Canvas.Font.PixelsPerInch := ppi;
    h := Canvas.TextHeight(s);
    if Header then
      y := PrintAreaRect.Top-h-ppi div 20
    else
      y := PrintAreaRect.Bottom+ppi div 20;
    r := Rect(PrintAreaRect.Left,y, PrintAreaRect.Right, y+h);
    case HF.Alignment of
      taRightJustify:
        flag := DT_RIGHT;
      taCenter:
        flag := DT_CENTER;
      else
        flag := DT_LEFT;
    end;
    DrawText(Canvas.Handle, PChar(s), Length(s), r,
      DT_SINGLELINE or DT_NOCLIP or DT_NOPREFIX or flag);
  end;
begin
  PrintHF(PageHeader,true);
  PrintHF(PageFooter,false);
end;

{ THFInfo }

constructor THFInfo.Create;
begin
  inherited Create;
  FFont := TFont.Create;
  FFont.Name := 'Arial';
  FFont.Size := 10;
  PrintOnFirstPage := True;
  Alignment := taCenter;
end;

destructor THFInfo.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure THFInfo.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TTxtFrm.ibReadOnlyClick(Sender: TObject);
begin
  ibReadOnly.Checked:=not ibReadOnly.Checked;
  RichEdit.ReadOnly:=not RichEdit.ReadOnly;
end;

procedure TTxtFrm.SetReadOnly;
begin
  RichEdit.ReadOnly:=true;
  ibReadOnly.Checked:=true;
end;

function TTxtFrm.DoSave(AID:integer):Boolean;
var
  RTFFile:TStream;
begin
  if AID<0 then
    if not OprList.ShowSaveDlg then
    begin
      result:=false;
      exit;
    end;
  RTFFile:=TMemoryStream.Create;
  //RichEdit.SaveRTFToStream(RTFFile,false);
  RichEdit.SaveRVFToStream(RTFFile,false);
  lbFileSize.Caption:=format('大小:%.1fK(%d字节)',[RTFFile.Size/1024,RTFFile.Size]);
  OprList.UpdateFile(RTFFile,AID,self);
  RTFFile.Free;
  RichEdit.Modified:=false;
  result:=true;
end;

procedure TTxtFrm.SaveAsFile;
begin
  DoSave(-1);
end;

procedure TTxtFrm.ExportFile;
var
  DlgSave:TSaveDialog;
  rvc: TRVOfficeConverter;
begin
  DlgSave:=TSaveDialog.Create(self);
  DlgSave.Title:='导出文件';
  DlgSave.Filter :='RTF Files (*.rtf)|*.rtf|'+
                   'Text (*.txt)|*.txt|'+
                   'Unicode Text (*.txt)|*.txt|'+
                   'HTML - with CSS (*.htm;*.html)|*.htm;*.html|'+
                   'HTML - Simplified (*.htm;*.html)|*.htm;*.html|'+
                   'Word 6.0/95 (*.doc)|*.doc';
  DlgSave.DefaultExt:='rtf';
  DlgSave.FileName:=Caption;
  DlgSave.Options:=DlgSave.Options+[ofOverwritePrompt];
  if DlgSave.Execute then
  begin
    case DlgSave.FilterIndex of
      1:RichEdit.SaveRTF(DlgSave.FileName, False);
      2:RichEdit.SaveText(DlgSave.FileName, 80);
      3:RichEdit.SaveTextW(DlgSave.FileName, 80);
      4:RichEdit.SaveHTMLEx(DlgSave.FileName, Caption,'img', '',
          '', '', [rvsoImageSizes,rvsoUseCheckpointsNames]);
      5:RichEdit.SaveHTML(DlgSave.FileName, Caption,'img',
          [rvsoImageSizes,rvsoUseCheckpointsNames]);
      6:
      begin
        rvc := TRVOfficeConverter.Create(nil);
        try
          rvc.ExcludeHTMLExportConverter := True;
          rvc.ExtensionsInFilter := True;
          rvc.ExportRV(DlgSave.FileName,richedit,1);
        finally
          rvc.Free;
        end;
      end;
    end;
  end;
end;

procedure TTxtFrm.TBXSubmenuItem1Click(Sender: TObject);
begin
  RichEdit.ApplyStyleConversion(2);
end;

procedure TTxtFrm.TBXSubmenuItem2Click(Sender: TObject);
begin
  Richedit.ApplyParaStyleConversion(3);
end;

procedure TTxtFrm.CreatePlugBtn(ASecPlug: ISecPlug);
begin
  CreateToolBarBtn(SpTBXDock1,0,100,PlugToolbar,ASecPlug,DoPlugExecute);
  PlugToolbar.DockMode:=dmCannotFloat;
  CreateToolPopupMenuItem(TBXPopupMenu1,ASecPlug,DoPlugAction,DoPlugDrawMenuItem);
end;

procedure TTxtFrm.DeletePlugBtn(AName: widestring);
begin
  DeleteToolBarBtn(PlugToolBar,AName);
  DeleteToolPopupMenuItem(TBXPopupMenu1,AName);
end;

procedure TTxtFrm.DoPlugExecute(sender: TObject);
var
  i:integer;
begin
  if PlugList<>nil then
  begin
    for i:=0 to PlugList.Count-1 do
    begin
      if TSpTBXItem(sender).Name=ISecPlug(PlugList[i]).Name then
      begin
        ISecPlug(PlugList[i]).HostForm:=self;
        ISecPlug(PlugList[i]).HostID:=ID;
        ISecPlug(PlugList[i]).Execute;
        break;
      end;
    end;
  end;
end;

procedure TTxtFrm.SpTBXItem19Click(Sender: TObject);
begin
  InsAccessories;
end;

procedure TTxtFrm.DoOnItemDelete(sender: TObject);
var
  s:string;
  i:integer;
begin
  s:='是否要删除“'+TSpTBXItem(Sender).Hint+'”附件？';
  if MessageBox(Handle,Pchar(s), '提示', MB_ICONASTERISK or MB_OKCANCEL)=IDOk then
  begin
    for i:=0 to mAcc.Count-1 do
    begin
      if mAcc.Items[i].Tag=TSpTBXItem(Sender).Tag then
      begin
        mAcc.Items[i].Clear;
        mAcc.Delete(i);
        break;
      end;
    end;
    OprList.DelAccessories(ID,TSpTBXItem(Sender).Tag);
    mAcc.Tag:=mAcc.Tag-1;
    mAcc.Caption:='共有'+inttostr(mAcc.Tag)+'个附件';
  end;
end;

procedure TTxtFrm.DelAccessories;
begin
//
end;

procedure TTxtFrm.InsertTable;
var
  frm:TInsertTabfrm;
  tbl: TRVTableItemInfo;
begin
  if RichEdit.TopLevelEditor.RVData.PartialSelectedItem<>nil then
    exit;

  frm:=TInsertTabfrm.Create(self);
  if frm.ShowModal=mrOk then
  begin
    tbl := TRVTableItemInfo.CreateEx(frm.Rows,frm.Cols,RichEdit.RVData);
    InitTable(tbl,frm.BestWidth);
    RichEdit.InsertItem('',tbl);
  end;
  frm.Free;
end;

procedure TTxtFrm.TBXToolPalette2DrawCellImage(
  Sender: TTBXCustomToolPalette; Canvas: TCanvas; ARect: TRect; ACol,
  ARow: Integer; Selected, Hot, Enabled: Boolean);
begin
  if (ACol<=FSelectTableCol) and (ARow<=FSelectTableRow) then
  begin
    Canvas.Brush.Color:=clHighlight;
    Canvas.FillRect(ARect);
    Canvas.Pen.Color:=clGray;
    Canvas.Pen.Width:=2;
    Canvas.Rectangle(ARect);
  end;

  if (ACol>FSelectTableCol) or (ARow>FSelectTableRow) then
  begin
    Canvas.Brush.Color:=clWhite;
    Canvas.FillRect(ARect);
    Canvas.Pen.Color:=clGray;
    Canvas.Pen.Width:=2;
    Canvas.Rectangle(ARect);
  end;
end;

procedure TTxtFrm.TBXToolPalette2GetCellHint(Sender: TTBXCustomToolPalette;
  ACol, ARow: Integer; var HintText: String);
begin
  HintText:=inttostr(ARow+1)+'x'+inttostr(ACol+1);
end;

procedure TTxtFrm.SpTBXSubmenuItem1Popup(Sender: TTBCustomItem;
  FromLink: Boolean);
begin
  FSelectTableCol:=0;
  FSelectTableRow:=0;
end;

procedure TTxtFrm.TBXToolPalette2CellChange(Sender: TTBXCustomToolPalette;
  var ACol, ARow: Integer);
begin
  FSelectTableCol:=ACol;
  FSelectTableRow:=ARow;
  TBXToolPalette2.ViewBeginUpdate;
  TBXToolPalette2.Invalidate;
  TBXToolPalette2.ViewEndUpdate;
end;

procedure TTxtFrm.InitTable(Table: TRVTableItemInfo;BestWidth:integer);
  procedure SetTableCellsWidth(table: TRVTableItemInfo; Width: Integer);
  var
    r,c: Integer;
  begin
    if table.BestWidth<>0 then
      exit;
    dec(Width, ((table.BorderWidth+table.BorderHSpacing)*2+(table.CellHSpacing*(table.Rows[0].Count-1)))+
              table.Rows[0].Count*table.CellBorderWidth*2);
    Width := Width div table.Rows[0].Count;
    for r := 0 to table.Rows.Count-1 do
      for c := 0 to table.Rows[r].Count-1 do
        table.Cells[r,c].BestWidth := Width;
  end;
begin
  table.Options:=RVTABLEDEFAULTOPTIONS;
  table.PrintOptions:=RVTABLEDEFAULTPRINTOPTIONS;
  table.Color:=clNone;
  table.BestWidth:=BestWidth;
  table.BorderWidth:=1;
  table.BorderVSpacing:=-1;
  table.BorderHSpacing:=-1;
  table.BorderStyle:=rvtbColor;
  table.CellBorderWidth:=1;
  table.CellVSpacing:=-1;
  table.CellHSpacing:=-1;
  table.CellBorderStyle:=rvtbColor;
  table.CellPadding:=1;
  SetTableCellsWidth(table, RichEdit.TopLevelEditor.RVData.TextWidth-10);
end;

procedure TTxtFrm.TBXToolPalette2CellClick(Sender: TTBXCustomToolPalette;
  var ACol, ARow: Integer; var AllowChange: Boolean);
var
  tbl: TRVTableItemInfo;
begin
  tbl := TRVTableItemInfo.CreateEx(ARow+1,ACol+1,RichEdit.RVData);
  InitTable(tbl,0);
  RichEdit.InsertItem('',tbl);
end;

procedure TTxtFrm.SpTBXSubmenuItem1Click(Sender: TObject);
var
  tbl: TRVTableItemInfo;
begin
  tbl := TRVTableItemInfo.CreateEx(1,1,RichEdit.RVData);
  InitTable(tbl,0);
  RichEdit.InsertItem('',tbl);
end;

procedure TTxtFrm.MergeTable;
var
  Data: Integer;
  item: TCustomRVItemInfo;
  ItemNo: Integer;
  table: TRVTableItemInfo;
  rve: TCustomRichViewEdit;
  r,c,cs,rs: Integer;
  sel:Boolean;
begin
  if not RichEdit.CanChange or
     not RichEdit.GetCurrentItemEx(TRVTableItemInfo,rve,Item) then
    exit;
  table := TRVTableItemInfo(item);
  ItemNo := table.GetMyItemNo;
  rve.BeginItemModify(ItemNo, Data);

  rve.BeginUndoGroup(rvutModifyItem);
  rve.SetUndoGroupMode(True);
  try
    sel:=table.GetNormalizedSelectionBounds(True,r,c,cs,rs);
    table.MergeSelectedCells(True);
    table.DeleteEmptyRows;
    table.DeleteEmptyCols;
    if sel then
      table.Select(r,c,0,0);
  finally
    rve.SetUndoGroupMode(False);
  end;

  rve.EndItemModify(ItemNo, Data);
  rve.Change;
end;

procedure TTxtFrm.SpTBXItem1Click(Sender: TObject);
begin
  MergeTable;
end;

procedure TTxtFrm.SpTBXItem20Click(Sender: TObject);
begin
  SplitTable;
end;

procedure TTxtFrm.SplitTable;
var
  frm: TfrmRVSplit;
  Data: Integer;
  item: TCustomRVItemInfo;
  ItemNo: Integer;
  table: TRVTableItemInfo;
  rve: TCustomRichViewEdit;
  function CanUnmergeRows(table: TRVTableItemInfo): Boolean;
  var fr,fc,r,c,cs,rs,mr,mc: Integer;
  begin
    Result := table.GetNormalizedSelectionBounds(True, fr, fc, cs, rs);
    if Result then begin
      for r := fr to fr+rs-1 do
        for c := fc to fc+cs-1 do
          if table.Rows.GetMainCell(r,c,mr,mc).RowSpan>1 then
            exit;
      Result := False;
    end;
  end;

  function CanUnmergeCols(table: TRVTableItemInfo): Boolean;
  var fr,fc,r,c,cs,rs,mr,mc: Integer;
  begin
    Result := table.GetNormalizedSelectionBounds(True, fr, fc, cs, rs);
    if Result then begin
      for r := fr to fr+rs-1 do
        for c := fc to fc+cs-1 do
          if table.Rows.GetMainCell(r,c,mr,mc).ColSpan>1 then
            exit;
      Result := False;
    end;
  end;
begin
  if not RichEdit.CanChange or
     not RichEdit.GetCurrentItemEx(TRVTableItemInfo,rve,Item) then
    exit;
  table := TRVTableItemInfo(item);
  ItemNo := table.GetMyItemNo;
  rve.BeginItemModify(ItemNo, Data);

  frm := TfrmRVSplit.Create(self);
  try
    frm.cbUnmergeRows.Enabled:=CanUnmergeRows(table);
    frm.cbUnmergeCols.Enabled:=CanUnmergeCols(table);
    frm.cbUnmergeRows.Checked:=frm.cbUnmergeRows.Enabled;
    frm.cbUnmergeCols.Checked:=frm.cbUnmergeCols.Enabled;
    frm.rbUnmerge.Enabled:=frm.cbUnmergeRows.Checked or frm.cbUnmergeCols.Checked;
    frm.cbMerge.Enabled:=table.CanMergeSelectedCells(True);  
    if frm.ShowModal=mrOk then
    begin
      if frm.rbSplit.Checked then
      begin
        rve.BeginUndoGroup(rvutModifyItem);
        rve.SetUndoGroupMode(True);
        try