utxtfrm.pas

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

          if frm.cbMerge.Checked then
            table.MergeSelectedCells(True);
          if frm.seColumns.Value>1 then
            table.SplitSelectedCellsVertically(frm.seColumns.AsInteger);
          if frm.seRows.Value>1 then
            table.SplitSelectedCellsHorizontally(frm.seRows.AsInteger);
          table.DeleteEmptyRows;
          table.DeleteEmptyCols;
        finally
          rve.SetUndoGroupMode(False);
        end;
      end
      else
      begin
        table.UnmergeSelectedCells(frm.cbUnmergeRows.Checked,frm.cbUnmergeCols.Checked);
      end;
    end;
  finally
    frm.Free;
  end;

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

procedure TTxtFrm.TBXSubmenuItem2DrawImage(Item: TTBCustomItem;
  Viewer: TTBItemViewer; Canvas: TCanvas; ImageRect: TRect;
  ImageOffset: TPoint; StateFlags: Integer);
var
  //DC: HDC;
  Color: TColor;
begin
  //DC := Canvas.Handle;
  if not Boolean(StateFlags and ISF_DISABLED) then
  begin
    Color := TBXColorPalette2.Color;
    OffsetRect(ImageRect, ImageOffset.X, ImageOffset.Y);
    ImageRect.Top := ImageRect.Bottom - 4;
    if Color <> clNone then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(ImageRect);
    end
    else
    begin
      Canvas.Brush.Color := Clblack;
      Canvas.FillRect(ImageRect);
      //FrameRectEx(DC, ImageRect, clBtnShadow, True);
      //DitherRect(DC, ImageRect, clBtnFace, clBtnShadow);
    end;
  end;
end;

procedure TTxtFrm.SpTBXItem17Click(Sender: TObject);
begin
  InsHyperlink;
end;

procedure TTxtFrm.SetURLToSelection(const URL: String);
var
  i, StartNo, EndNo, StartOffs, EndOffs: Integer;
  rve: TCustomRichViewEdit;
begin
  rve := RichEdit.TopLevelEditor;
  rve.GetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs, True);
  if StartOffs >= rve.GetOffsAfterItem(StartNo) then
    inc(StartNo);
  if EndOffs <= rve.GetOffsBeforeItem(EndNo) then
    dec(EndNo);
  rve.BeginUndoGroup(rvutTag);
  rve.SetUndoGroupMode(True);
  for i := StartNo to EndNo do
  begin
    rve.SetItemTagEd(i, Integer(StrNew(PChar(URL))));
  end;
  rve.SetUndoGroupMode(False);
end;

procedure TTxtFrm.RichEditJump(Sender: TObject; id: Integer);
var
  URL: String;
  RVData: TCustomRVFormattedData;
  ItemNo: Integer;
begin
  RichEdit.GetJumpPointLocation(id, RVData, ItemNo);
  URL := PChar(RVData.GetItemTag(ItemNo));
  ShellExecute(0, 'open', PChar(URL), nil, nil, SW_SHOW);
end;

procedure TTxtFrm.NewOnStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var
  FontInfo: TFontInfo;
begin
  FontInfo := TFontInfo.Create(nil);
  try
    FontInfo.Assign(Sender.Style.TextStyles[StyleNo]);
    if UserData=0 then
    begin
      FontInfo.Jump:=true;
      FontInfo.Color:=clblue;
      FontInfo.Style:=FontInfo.Style+[fsUnderLine];
    end
    else if UserData=1 then
    begin
      FontInfo.Jump:=false;
      FontInfo.Color:=TheColor;
      FontInfo.Style:=FontInfo.Style-[fsUnderLine];
    end;
    NewStyleNo := Sender.Style.TextStyles.FindSuchStyle(StyleNo, FontInfo, RVAllFontInfoProperties);
    if NewStyleNo<0 then
    begin
      Sender.Style.TextStyles.Add;
      NewStyleNo := Sender.Style.TextStyles.Count - 1;
      Sender.Style.TextStyles[NewStyleNo].Assign(FontInfo);
      Sender.Style.TextStyles[NewStyleNo].Standard := False;
    end;
  finally
    FontInfo.Free;
  end;
end;

function TTxtFrm.HasItems(rve: TCustomRichViewEdit;
  var Target: String): Boolean;
  function CheckItem(ItemNo: Integer): Boolean;
  begin
    Result := (rve.GetItemStyle(ItemNo)>=0) and (rve.Style.TextStyles[rve.GetItemStyle(ItemNo)].Jump);
    if Result then begin
      rve.SetSelectionBounds(ItemNo, rve.GetOffsBeforeItem(ItemNo),
                             ItemNo, rve.GetOffsAfterItem(ItemNo));
      rve.Refresh;
    end;
  end;

  function CheckItem2(ItemNo: Integer): Boolean;
  begin
    Result :=(rve.GetItem(ItemNo) is TRVGraphicItemInfo);
    if Result then
    begin
      rve.SetSelectionBounds(ItemNo, rve.GetOffsBeforeItem(ItemNo),
                             ItemNo, rve.GetOffsAfterItem(ItemNo));
      rve.Refresh;
    end;
  end;
var
  ItemNo, StartItemNo, EndItemNo, StartOffs, EndOffs: Integer;
  s: String;
  Expanded, IsFirst: Boolean;
begin
  rve := rve.TopLevelEditor;
  if not rve.SelectionExists then
  begin
    ItemNo := rve.CurItemNo;
    Expanded := False;
    if not CheckItem(ItemNo) then
    begin
      if (ItemNo>0) and not rve.IsFromNewLine(ItemNo) and (rve.OffsetInCurItem<=rve.GetOffsBeforeItem(ItemNo)) then
        Expanded := CheckItem(ItemNo-1)
      else if (ItemNo+1<rve.ItemCount) and not rve.IsFromNewLine(ItemNo+1) and (rve.OffsetInCurItem>=rve.GetOffsAfterItem(ItemNo)) then
        Expanded := CheckItem(ItemNo+1)
      end
    else
      Expanded := True;
    if not Expanded then
      CheckItem2(ItemNo);
  end;
  Target := '';
  rve.GetSelectionBounds(StartItemNo, StartOffs, EndItemNo, EndOffs, True);
  Result := (StartItemNo>=0) and not ((StartItemNo=EndItemNo) and (StartOffs=EndOffs));
  if not Result then
    exit;
  IsFirst := True;
  for ItemNo := StartItemNo to EndItemNo do
    if (rve.GetItemStyle(ItemNo)>=0) or
       ((rve.GetItem(ItemNo) is TRVGraphicItemInfo)) then
    begin
      s := PChar(rve.GetItemTag(ItemNo));
      if IsFirst then
        Target := s
      else if Target<>s then
      begin
        Target := '';
        exit;
      end;
      IsFirst := False;
    end;
end;

function TTxtFrm.GetHyperlinkStyleNo(rve: TCustomRichViewEdit;
  StyleNo: Integer): Integer;
var
  FontInfo: TFontInfo;
begin
  if StyleNo<0 then
    StyleNo := rve.CurTextStyleNo;
  FontInfo := TFontInfo.Create(nil);
  FontInfo.Assign(rve.Style.TextStyles[StyleNo]);
  FontInfo.Jump:=true;
  FontInfo.Color:=clblue;
  FontInfo.Style:=FontInfo.Style+[fsUnderLine];
  Result := rve.Style.TextStyles.FindSuchStyle(StyleNo, FontInfo, RVAllFontInfoProperties);
  if Result<0 then
  begin
    rve.Style.TextStyles.Add.Assign(FontInfo);
    Result := rve.Style.TextStyles.Count-1;
    rve.Style.TextStyles[Result].Standard := False;
    rve.Style.TextStyles[Result].NextStyleNo := StyleNo;
  end;
  FontInfo.Free;
end;

procedure TTxtFrm.InsHyperlink;
var
  frm: TfrmHyperlink;
  URL: String;
  FOldOnStyleConversion: TRVStyleConversionEvent;
  SelText:string;
  procedure SetStyleConversionEvent(rve: TCustomRichViewEdit; Event: TRVStyleConversionEvent);
  begin
    while rve<>nil do begin
      rve.OnStyleConversion := Event;
      rve := TCustomRichViewEdit(rve.InplaceEditor);
    end;
  end;
begin
  frm:=TfrmHyperlink.Create(self);
  if (Pos(#13,SelText)>0) or (Pos(#10,SelText)>0) then
    SelText:='';
  HasItems(RichEdit,Url);
  if URL='' then
    URL := 'http://';
  frm.Edit1.Text := URL;

  if frm.ShowModal=mrOk then
  begin
    FOldOnStyleConversion := RichEdit.OnStyleConversion;
    SetStyleConversionEvent(RichEdit, NewOnStyleConversion);
    try
      URL := frm.Edit1.Text;
      SelText:=RichEdit.GetSelText;
      if URL<>'' then
      begin
        if SelText<>'' then
        begin
          RichEdit.ApplyStyleConversion(0);
          SetURLToSelection(URL);
        end
        else
        begin
          RichEdit.CurTextStyleNo := GetHyperlinkStyleNo(RichEdit);
          RichEdit.InsertStringTag(URL, Integer(StrNew(PChar(EncodeTarget(URL)))));
        end;
      end
      else
      begin
        RichEdit.ApplyStyleConversion(1);
        SetURLToSelection('');
      end;
    finally
      SetStyleConversionEvent(RichEdit, FOldOnStyleConversion);
    end;
  end;
  frm.Free;
end;

function TTxtFrm.EncodeTarget(const Target: String): String;
var
  p: Integer;
begin
  Result := Target;
  for p := Length(Result) downto 1 do
    if Result[p] in [#10, #13] then
      Delete(Result, p, 1);
  while True do
  begin
    p := Pos(' ', Result);
    if p=0 then
      exit;
    Delete(Result, p, 1);
    Insert(' ', Result, p);
  end;
end;

procedure TTxtFrm.RichEditReadHyperlink(Sender: TCustomRichView;
  const Target, Extras: String; DocFormat: TRVLoadFormat; var StyleNo,
  ItemTag: Integer; var ItemName: String);
var
  URL: String;
begin
  URL := EncodeTarget(Target);
  ItemTag := Integer(StrNew(PChar(URL)));
end;

procedure TTxtFrm.RichEditWriteHyperlink(Sender: TCustomRichView;
  id: Integer; RVData: TCustomRVData; ItemNo: Integer;
  SaveFormat: TRVSaveFormat; var Target, Extras: String);
begin
  Target := PChar(RVData.GetItemTag(ItemNo));
end;

procedure TTxtFrm.DoPlugAction(sender: TObject);
begin

end;

procedure TTxtFrm.SpTBXItem22Click(Sender: TObject);
begin
  if not SpTBXItem22.Checked then
    RichEdit.ApplyListStyle(0,-1,1,false,false)
  else
    RichEdit.RemoveLists(false);
end;

procedure TTxtFrm.SpTBXItem21Click(Sender: TObject);
begin
  if not SpTBXItem21.Checked then
    RichEdit.ApplyListStyle(1,-1,1,false,false)
  else
    RichEdit.RemoveLists(false);
end;

procedure TTxtFrm.DoPlugDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; ItemInfo: TTBXItemInfo; const PaintStage: TSpTBXPaintStage;
  var PaintDefault: Boolean);
begin
  DrawMenuItem(TSpTBXItem(sender).Name,PlugList,ACanvas,ARect);
end;

procedure TTxtFrm.TBXPopupMenu1Popup(Sender: TObject);
var
  i,j:integer;
  PlugName:widestring;
  ItemHeight,ItemWidth:integer;
begin
  Screen.Cursor:=crHourGlass;
  try
    if PlugList<>nil then
    begin
      for i:=0 to PlugList.Count-1 do
      begin
        if not ISecPlug(PlugList[i]).DisplayInMenu then
          continue;
        if ISecPlug(PlugList[i]).PlugType=ptText then
        begin
          ISecPlug(PlugList[i]).MenuPopup(VarArrayOf([' ']),PlugName,ItemHeight,ItemWidth);
          if ISecPlug(PlugList[i]).DrawMenu then
            for j:=0 to TBXPopupMenu1.Items.Count-1 do
            begin
              if TBXPopupMenu1.Items[j].Name=PlugName+'_D' then
              begin
                TSpTBXItem(TBXPopupMenu1.Items[j]).Visible:=true;
                TSpTBXItem(TBXPopupMenu1.Items[j]).MinHeight:=ItemHeight;
                TSpTBXItem(TBXPopupMenu1.Items[j]).MinWidth:=ItemWidth;
              end;
            end;
        end;
      end;
    end;
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TTxtFrm.SpTBXItem23Click(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  try
    SaveFile;
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TTxtFrm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent:=0;
end;

procedure TTxtFrm.SpTBXItem24Click(Sender: TObject);
begin
  InsertFile; 
end;

procedure TTxtFrm.SpTBXItem25Click(Sender: TObject);
begin
  InsPic;
end;

procedure TTxtFrm.SpTBXItem26Click(Sender: TObject);
begin
  InsertBreak;
end;

procedure TTxtFrm.SpTBXItem27Click(Sender: TObject);
begin
  SpTBXItem27.Checked:=not SpTBXItem27.Checked;
  SetParaStyle(4);
end;

procedure TTxtFrm.ExportDBFile;
var
  s:TMemoryStream;
begin
  s:=TMemoryStream.Create;
  case OprList.FileType of
    0:RichEdit.SaveTextToStream('',s,80,false,true);
    1:RichEdit.SaveRTF('',false);
    2:RichEdit.SaveRVF('',false);
  end;
  OprList.SaveFileTextToDB(s);
  s.Free;
end;

procedure TTxtFrm.ImportDBFile;
var
  s:TStream;
begin
  RichEdit.Clear;
  s:=TMemoryStream.Create;
  OprList.ReadFileTextFromDB(s);
  s.Position:=0; 
  case OprList.FileType of
    0:RichEdit.LoadTextFromStream(s,0,0,false);
    1:RichEdit.LoadRTFFromStream(s);
    2:RichEdit.LoadRVFFromStream(s); 
  end;
  RichEdit.Format;
  s.Free;
  DoSave(ID);
end;

end.