utxtfrm.pas

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

unit uTxtfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Jpeg,
  Dialogs, StdCtrls, TB2Dock, TB2Toolbar, TBX, SpTBXItem, TB2Item, TBXAluminumTheme,
  uIHintInf,uDllfrmList, ImgList, RichView, RVEdit, RVScroll, ExtDlgs, RVStyle,
  TBXToolPals, TB2ExtItems, TBXExtItems, TBXThemes, TBXUtils, Buttons, DBClient,
  Menus,RVUni,RVMisc,uSecDialogs, TBXStatusBars, PtblRV, ExtCtrls, TB2ToolWindow,
  RVOfficeCnv, uFunction, uSecPlugInf, uInsertTable, RvTable, TBXDkPanels, RVItem,
  uSplitTable, uInsHyperlink, CRVFData, ShellAPI, CRVData;

type
  THFInfo = class
  private
    FFont: TFont;
    procedure SetFont(const Value: TFont);
  public
    Text: String;
    Alignment: TAlignment;
    PrintOnFirstPage: Boolean;
    constructor Create;
    destructor Destroy; override;
    property Font: TFont read FFont write SetFont;
  end;

  TTxtFrm = class(TDllFrm)
    SpTBXDock1: TSpTBXDock;
    TBXToolbar1: TTBXToolbar;
    ImageList1: TImageList;
    RichEdit: TRichViewEdit;
    SpTBXSubmenuItem2: TSpTBXSubmenuItem;
    TBXToolPalette1: TTBXToolPalette;
    ImageList2: TImageList;
    RVStyle1: TRVStyle;
    TBXSeparatorItem1: TTBXSeparatorItem;
    cbFontSize: TTBXComboBoxItem;
    cbFontItem: TTBXComboBoxItem;
    TBXSubmenuItem1: TTBXSubmenuItem;
    TBXColorPalette1: TTBXColorPalette;
    TBXSeparatorItem2: TTBXSeparatorItem;
    SpTBXItem2: TSpTBXItem;
    Cd: TColorDialog;
    TBXColorItem1: TTBXColorItem;
    TBXSeparatorItem3: TTBXSeparatorItem;
    SpTBXItem3: TSpTBXItem;
    SpTBXItem4: TSpTBXItem;
    SpTBXItem5: TSpTBXItem;
    TBXSeparatorItem4: TTBXSeparatorItem;
    SpTBXItem6: TSpTBXItem;
    SpTBXItem7: TSpTBXItem;
    SpTBXItem8: TSpTBXItem;
    TBXSubmenuItem2: TTBXSubmenuItem;
    TBXColorItem2: TTBXColorItem;
    TBXColorPalette2: TTBXColorPalette;
    TBXSeparatorItem5: TTBXSeparatorItem;
    SpTBXItem9: TSpTBXItem;
    TBXPopupMenu1: TTBXPopupMenu;
    SpTBXItem10: TSpTBXItem;
    SpTBXItem11: TSpTBXItem;
    SpTBXItem12: TSpTBXItem;
    SpTBXSeparatorItem1: TSpTBXSeparatorItem;
    SpTBXItem13: TSpTBXItem;
    SpTBXItem14: TSpTBXItem;
    SpTBXSeparatorItem2: TSpTBXSeparatorItem;
    SpTBXItem15: TSpTBXItem;
    SpTBXItem16: TSpTBXItem;
    SpTBXSeparatorItem3: TSpTBXSeparatorItem;
    SpTBXItem17: TSpTBXItem;
    SpTBXItem18: TSpTBXItem;
    Fd: TSecFindDialog;
    Rd: TSecReplaceDialog;
    RVPrint1: TRVPrint;
    SBar: TSpTBXStatusBar;
    TBSeparatorItem2: TTBSeparatorItem;
    TBSeparatorItem3: TTBSeparatorItem;
    Pd: TPrintDialog;
    SpTBXSeparatorItem4: TSpTBXSeparatorItem;
    ibReadOnly: TSpTBXItem;
    lbFileSize: TSpTBXLabelItem;
    lbPosition: TSpTBXLabelItem;
    mAcc: TSpTBXSubmenuItem;
    SpTBXItem19: TSpTBXItem;
    TBXSeparatorItem7: TTBXSeparatorItem;
    SpTBXSubmenuItem1: TSpTBXSubmenuItem;
    TBXToolPalette2: TTBXToolPalette;
    TBXSeparatorItem6: TTBXSeparatorItem;
    SpTBXItem1: TSpTBXItem;
    SpTBXItem20: TSpTBXItem;
    SpTBXSeparatorItem5: TSpTBXSeparatorItem;
    TBXSeparatorItem8: TTBXSeparatorItem;
    SpTBXItem21: TSpTBXItem;
    SpTBXItem22: TSpTBXItem;
    SpTBXSeparatorItem6: TSpTBXSeparatorItem;
    SpTBXItem23: TSpTBXItem;
    SpTBXItem24: TSpTBXItem;
    SpTBXItem25: TSpTBXItem;
    SpTBXItem26: TSpTBXItem;
    SpTBXItem27: TSpTBXItem;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TBXToolPalette1CellClick(Sender: TTBXCustomToolPalette;
      var ACol, ARow: Integer; var AllowChange: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure cbFontItemAcceptText(Sender: TObject; var NewText: String;
      var Accept: Boolean);
    procedure cbFontItemItemClick(Sender: TObject);
    procedure RichEditStyleConversion(Sender: TCustomRichViewEdit; StyleNo,
      UserData: Integer; AppliedToText: Boolean; var NewStyleNo: Integer);
    procedure RichEditCurTextStyleChanged(Sender: TObject);
    procedure TBXSubmenuItem1DrawImage(Item: TTBCustomItem;
      Viewer: TTBItemViewer; Canvas: TCanvas; ImageRect: TRect;
      ImageOffset: TPoint; StateFlags: Integer);
    procedure TBXColorPalette1Change(Sender: TObject);
    procedure RichEditParaStyleConversion(Sender: TCustomRichViewEdit;
      StyleNo, UserData: Integer; AppliedToText: Boolean;
      var NewStyleNo: Integer);
    procedure RichEditCurParaStyleChanged(Sender: TObject);
    procedure SpTBXItem2Click(Sender: TObject);
    procedure TBXColorItem1Click(Sender: TObject);
    procedure SpTBXItem8Click(Sender: TObject);
    procedure SpTBXItem7Click(Sender: TObject);
    procedure SpTBXItem6Click(Sender: TObject);
    procedure SpTBXItem5Click(Sender: TObject);
    procedure SpTBXItem4Click(Sender: TObject);
    procedure SpTBXItem3Click(Sender: TObject);
    procedure TBXColorPalette2Change(Sender: TObject);
    procedure TBXColorItem2Click(Sender: TObject);
    procedure SpTBXItem9Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure SpTBXItem12Click(Sender: TObject);
    procedure SpTBXItem11Click(Sender: TObject);
    procedure SpTBXItem10Click(Sender: TObject);
    procedure SpTBXItem13Click(Sender: TObject);
    procedure SpTBXItem14Click(Sender: TObject);
    procedure SpTBXItem16Click(Sender: TObject);
    procedure SpTBXItem15Click(Sender: TObject);
    procedure SpTBXItem18Click(Sender: TObject);
    procedure FdFind(Sender: TObject);
    procedure RdFind(Sender: TObject);
    procedure RdReplace(Sender: TObject);
    procedure RichEditCaretMove(Sender: TObject);
    procedure RVPrint1PagePrepaint(Sender: TRVPrint; PageNo: Integer;
      Canvas: TCanvas; Preview: Boolean; PageRect, PrintAreaRect: TRect);
    procedure ibReadOnlyClick(Sender: TObject);
    procedure TBXSubmenuItem1Click(Sender: TObject);
    procedure TBXSubmenuItem2Click(Sender: TObject);
    procedure SpTBXItem19Click(Sender: TObject);
    procedure TBXToolPalette2DrawCellImage(Sender: TTBXCustomToolPalette;
      Canvas: TCanvas; ARect: TRect; ACol, ARow: Integer; Selected, Hot,
      Enabled: Boolean);
    procedure TBXToolPalette2GetCellHint(Sender: TTBXCustomToolPalette;
      ACol, ARow: Integer; var HintText: String);
    procedure SpTBXSubmenuItem1Popup(Sender: TTBCustomItem;
      FromLink: Boolean);
    procedure TBXToolPalette2CellChange(Sender: TTBXCustomToolPalette;
      var ACol, ARow: Integer);
    procedure TBXToolPalette2CellClick(Sender: TTBXCustomToolPalette;
      var ACol, ARow: Integer; var AllowChange: Boolean);
    procedure SpTBXSubmenuItem1Click(Sender: TObject);
    procedure SpTBXItem1Click(Sender: TObject);
    procedure SpTBXItem20Click(Sender: TObject);
    procedure TBXSubmenuItem2DrawImage(Item: TTBCustomItem;
      Viewer: TTBItemViewer; Canvas: TCanvas; ImageRect: TRect;
      ImageOffset: TPoint; StateFlags: Integer);
    procedure SpTBXItem17Click(Sender: TObject);
    procedure RichEditJump(Sender: TObject; id: Integer);
    procedure RichEditReadHyperlink(Sender: TCustomRichView; const Target,
      Extras: String; DocFormat: TRVLoadFormat; var StyleNo,
      ItemTag: Integer; var ItemName: String);
    procedure RichEditWriteHyperlink(Sender: TCustomRichView; id: Integer;
      RVData: TCustomRVData; ItemNo: Integer; SaveFormat: TRVSaveFormat;
      var Target, Extras: String);
    procedure SpTBXItem22Click(Sender: TObject);
    procedure SpTBXItem21Click(Sender: TObject);
    procedure TBXPopupMenu1Popup(Sender: TObject);
    procedure SpTBXItem23Click(Sender: TObject);
    procedure SpTBXItem24Click(Sender: TObject);
    procedure SpTBXItem25Click(Sender: TObject);
    procedure SpTBXItem26Click(Sender: TObject);
    procedure SpTBXItem27Click(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams);override;
  private
    { Private declarations }
    Fcds: TClientDataSet;
    PlugToolBar:TTBXToolbar;
    PlugList:TInterfaceList;
    FSelectTableCol:integer;
    FSelectTableRow:integer;

    procedure SetParaStyle(style:integer);
    procedure Setcds(const Value: TClientDataSet);
    procedure CreateItem(Acaption:string;Atag:integer);
    procedure DoOnItemClick(sender:TObject);
    procedure DoOnItemDelete(sender:TObject);
    function DoSave(AID:integer):Boolean;
    procedure SetURLToSelection(const URL: String);
    procedure NewOnStyleConversion(Sender: TCustomRichViewEdit;
      StyleNo, UserData: Integer; AppliedToText: Boolean; var NewStyleNo: Integer);
    function HasItems(rve: TCustomRichViewEdit; var Target: String): Boolean;
    function GetHyperlinkStyleNo(rve: TCustomRichViewEdit; StyleNo: Integer=-1): Integer;
    function EncodeTarget(const Target: String): String;
  protected

  public
    { Public declarations }
    StartPage:integer;
    PageHeader: THFInfo;
    PageFooter: THFInfo;
    OprList:IOprList;
    FontName:string;
    FontSize:integer;
    TheColor,TheBackColor,TheGridColor:TColor;
    FindDialog: TSecFindDialog;
    procedure InitData;override;
    procedure AfterInitData;override;
    function SaveFile:Boolean;
    procedure SaveAsFile;
    procedure InsPic;
    procedure InsSymbol;
    procedure InsAccessories;
    procedure DelAccessories;
    procedure SetAlignmentLeft;
    procedure SetAlignmentCenter;
    procedure SetAlignmentRight;
    procedure SelectAll;
    procedure Undo;
    procedure Redo;
    procedure DeleteSelection;
    procedure InsertBreak;
    procedure InsertFile;
    procedure Search;
    procedure SearchNext;
    procedure Replace;
    procedure Preview;
    procedure Print;
    procedure PrintDefault;
    procedure PageSetup;
    procedure SetReadOnly;
    procedure ExportFile;
    procedure InsertTable;
    procedure MergeTable;
    procedure SplitTable;
    procedure InsHyperlink;
    procedure ExportDBFile;
    procedure ImportDBFile;

    procedure CreatePlugBtn(ASecPlug:ISecPlug);
    procedure DeletePlugBtn(AName:widestring);
    procedure DoPlugExecute(sender:TObject);
    procedure DoPlugAction(sender:TObject);
    procedure DoPlugDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; ItemInfo: TTBXItemInfo;
      const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
    procedure InitTable(Table: TRVTableItemInfo;BestWidth:integer);

    destructor Destroy; override;
    property cds:TClientDataSet read Fcds write Setcds;
  end;

implementation

uses InsSymbolRVFrm, uPrviewfrm, PageSetupRVFrm;

{$R *.dfm}

procedure TTxtFrm.FormShow(Sender: TObject);
begin
  TBXSetTheme('Aluminum');
end;

procedure TTxtFrm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i:integer;
begin
  i:=DllfrmList.DllTxt.IndexOf(self);
  if i<>-1 then
    DllfrmList.DllTxt.Delete(i);

  if RichEdit<>nil then
  begin
    for i:=RichEdit.ControlCount-1 downto 0 do
      RichEdit.Controls[i].Free;
  end;
  Action:=cafree;
end;

destructor TTxtFrm.Destroy;
var
  AID:integer;
begin
  AID:=ID;
  cds.Free;
  inherited Destroy;
  PostMessage(Application.MainForm.Handle,WM_FreeTxtDll,longint(AID),0);
end;

procedure TTxtFrm.InitData;
var
  Texts:TStream;
  i:integer;
begin
  inherited;
  caption:=OprList.Caption;

  PageHeader:=THFInfo.Create;
  PageHeader.Text:='- &p -';
  PageFooter:=THFInfo.Create;
  StartPage:=1;

  Texts:=TMemoryStream.Create;
  try
    OprList.ReadFile(Texts,ID);
    RichEdit.ReadOnly:=OprList.GetFileReadOnly(ID);
    ibReadOnly.Checked:=RichEdit.ReadOnly;
    lbFileSize.Caption:=format('大小:%.1fK(%d字节)',[Texts.Size/1024,Texts.Size]);
    Texts.Position:=0;
    try
      RichEdit.Clear;
      //RichEdit.LoadRTFFromStream(Texts);
      RichEdit.LoadRVFFromStream(Texts);
      RichEdit.Format;
    except
    end;
  finally
    Texts.Free;
  end;

  PlugList:=OprList.GetSecPlugList;
  for i:=0 to PlugList.Count-1 do
  begin
    if ISecPlug(PlugList[i]).PlugType=ptText then
    begin
      CreatePlugBtn(ISecPlug(PlugList[i]));
    end;
  end;

  if FormStyle=fsMDIChild then
    OprList.CreatewMenu(ID,caption);

  cds.Close;
  cds.Data:=OprList.ReadAccessoryList(ID);
  cds.Open;
  try
    while not cds.Eof do
    begin
      CreateItem(cds.Fields[1].AsString,cds.Fields[0].AsInteger);
      cds.Next;
    end;
  finally
    mAcc.Tag:=cds.RecordCount;
    mAcc.Caption:='共有'+inttostr(mAcc.Tag)+'个附件';
    cds.Close;
  end;
end;

function TTxtFrm.SaveFile:Boolean;
begin
  if OprList.GetFileReadOnly(ID) then
  begin
    MessageBox(Application.Handle,'该文件只读，不能保存！','提示', MB_ICONINFORMATION or MB_OK);
    result:=false;
    exit;
  end;

  result:=DoSave(ID);
end;

procedure TTxtFrm.InsPic;
var
  pic:TPicture;
  gr:TGraphic;
  DlgOpenPic:TOpenPictureDialog;
begin
  DlgOpenPic:=TOpenPictureDialog.Create(nil);
  try
    pic:=TPicture.Create;
    DlgOpenPic.Title:='插入图片'; 
    DlgOpenPic.Filter:='All (*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf|'+#13+
                  'JPEG Image File (*.jpg)|*.jpg|'+#13+
                  'JPEG Image File (*.jpeg)|*.jpeg|'+#13+
                  'Bitmaps (*.bmp)|*.bmp|'+#13+
                  'Icons (*.ico)|*.ico|'+#13+
                  'Enhanced Metafiles (*.emf)|*.emf|'+#13+
                  'Metafiles (*.wmf)|*.wmf';
    if DlgOpenPic.Execute then
    begin
      LockWindowUpdate(Handle);
      try
        pic.LoadFromFile(DlgOpenPic.FileName);
        if pic.Graphic is TIcon then
        begin
          gr:=TIcon.Create;
          gr.Assign(pic.Graphic);
        end
        else if (pic.Graphic is TBitmap) or (pic.Graphic is TJpegImage) then
        begin
          gr:=TJpegImage.Create;
          gr.Assign(pic.Graphic);
        end
        else
        begin
          gr:=TBitmap.Create;
          gr.Height:=pic.Graphic.Height;
          gr.Width:=pic.Graphic.Width;
          TBitmap(gr).Canvas.Draw(0,0,pic.Graphic);
        end;
        RichEdit.InsertPicture('',gr,rvvaBaseline);
        pic.Free;
      finally
        LockWindowUpdate(0);
      end;
    end;
  finally
    DlgOpenPic.free;
  end;
end;

procedure TTxtFrm.TBXToolPalette1CellClick(Sender: TTBXCustomToolPalette;
  var ACol, ARow: Integer; var AllowChange: Boolean);
var
  Bmp:TBitMap;
  idx:integer;
begin
  idx:=Acol+ARow*5;
  Bmp:=TBitMap.Create;
  ImageList2.GetBitmap(idx,Bmp);
  RichEdit.InsertPicture('',Bmp,rvvaBaseline);
end;

procedure TTxtFrm.InsSymbol;
var
  frm:TfrmRVInsertSymbol;