uhtmleditform.pas

一个html编辑器,支持可见即可得!!!

begin
  HtmlEdit.Print;
end;

procedure THtmlEditForm.Act_PrintPreviewExecute(Sender: TObject);
begin
  HtmlEdit.PrintPreview;
end;

procedure THtmlEditForm.Act_RedoExecute(Sender: TObject);
begin
  HtmlEdit.Redo;
end;

procedure THtmlEditForm.Act_RemoveformatExecute(Sender: TObject);
begin
  HtmlEdit.Edit.Removeformat;
end;

procedure THtmlEditForm.Act_SaveExecute(Sender: TObject);
begin
  HtmlEdit.Save;
end;

procedure THtmlEditForm.Act_SelectAllExecute(Sender: TObject);
begin
  HtmlEdit.SelectAll;
end;

procedure THtmlEditForm.Act_UnderlineExecute(Sender: TObject);
begin
  HtmlEdit.Edit.Underline;
end;

procedure THtmlEditForm.Act_UndoExecute(Sender: TObject);
begin
  HtmlEdit.Undo;
end;

procedure THtmlEditForm.FormCreate(Sender: TObject);

  procedure ClearFontName;
  var
    i: integer;
  begin
    for i := cbbFontName.Items.Count - 1 downto 0 do
    begin
      if Pos('@', cbbFontName.Items[i]) = 1 then
        cbbFontName.Items.Delete(i);
    end;
    for i := cbFontName.Items.Count - 1 downto 0 do
    begin
      if Pos('@', cbFontName.Items[i]) = 1 then
        cbFontName.Items.Delete(i);
    end;
  end;

begin
  Self.BorderIcons := [biSystemMenu, biMinimize];
  Self.BorderStyle := bsSingle;

  pgc2.ActivePageIndex := 0;

  cbbFontName.Items.AddStrings(Screen.Fonts);
  cbFontName.Items.AddStrings(Screen.Fonts);
  ClearFontName;

  HtmlEditRecv.ReadOnly := TRUE;
  HtmlEdit.ImageFolder := ExtractFilePath(Application.ExeName) + '\Image\';
end;

{
Cut 将当前选中区复制到剪贴板并删除之。
Copy 将当前选中区复制到剪贴板。
Paste 用剪贴板内容覆盖当前选中区。
Delete 删除当前选中区。
Removeformat 从当前选中区中删除格式化标签。
--
Redo 目前尚未支持
Undo 目前尚未支持。
--
SelectAll 选中整个文档。
Unselect 清除当前选中区的选中状态。
--
Indent 增加选中文本的缩进。
Outdent 减少选中区所在格式化块的缩进。
InsertOrderedList 切换当前选中区是编号列表还是常规格式化块。
--
Bold 切换当前选中区的粗体显示与否。
Italic 切换当前选中区斜体显示与否。
Underline 切换当前选中区的下划线显示与否。
--
FontName 设置或获取当前选中区的字体。
FontSize 设置或获取当前选中区的字体大小。
ForeColor 设置或获取当前选中区的前景(文本)颜色。 )
BackColor 设置或获取当前选中区的背景颜色。
--
JustifyCenter 将当前选中区在所在格式化块置中。
JustifyLeft 将当前选中区所在格式化块左对齐。
JustifyRight 将当前选中区所在格式化块右对齐。

CreateLink 在当前选中区上插入超级链接，或显示一个对话框允许用户指定要为当前选中区插入的超级链接的 URL。

InsertImage 用图像覆盖当前选中区。

OverWrite 切换文本状态的插入和覆盖。

Print 打开打印对话框以便用户可以打印当前页。

SaveAs 将当前 Web 页面保存为文件。
Unlink 从当前选中区中删除全部超级链接。

}

procedure THtmlEditForm.cbbFontNameKeyPress(Sender: TObject;
  var Key: Char);
begin
  Key := #0;
end;

procedure THtmlEditForm.btnExecClick(Sender: TObject);
begin
  HtmlEdit.Edit.Format(Trim(edt1.Text));
end;

procedure THtmlEditForm.chkReadOnlyClick(Sender: TObject);
begin
  HtmlEdit.ReadOnly := chkReadOnly.Checked;
end;

procedure THtmlEditForm.btnSendClick(Sender: TObject);
begin
  //  HtmlEdit1.Add(HtmlEdit.HTML);
  //  HtmlEdit1.Add('/BR');

  HtmlEditRecv.Append(HtmlEdit.HTML);

  HtmlEdit.Clear;

  HtmlEditRecv.Edit.ScrollToBottom;

end;

procedure THtmlEditForm.cbbFontNameChange(Sender: TObject);
begin
  if cbbFontName.Text <> '' then
    HtmlEdit.Edit.FontName(cbbFontName.Text);
end;

procedure THtmlEditForm.sedtFontSizeChange(Sender: TObject);
begin
  HtmlEdit.Edit.FontSize(sedtFontSize.Value);
end;

procedure THtmlEditForm.Act_SaveAsExecute(Sender: TObject);
begin
  HtmlEdit.SaveAs;
end;

procedure THtmlEditForm.Act_SaveToExecute(Sender: TObject);
begin
  if dlgSave.Execute then
    HtmlEdit.SaveToFile(dlgSave.FileName);
end;

procedure THtmlEditForm.Act_PageSetupExecute(Sender: TObject);
begin
  HtmlEdit.PrintPageSetup;
end;

procedure THtmlEditForm.Act_ClearExecute(Sender: TObject);
begin
  HtmlEdit.Clear;
end;

procedure THtmlEditForm.Act_WriteExecute(Sender: TObject);
var
  strTable: string;
  RowCnt, ColCnt: integer;
begin
  strTable := '<TABLE border=1 >';
  for RowCnt := 1 to 3 do
  begin
    strTable := strTable + '<TR>';
    for ColCnt := 1 to 5 do
      strTable := strTable + '<TD>&nbsp;</TD>';
    strTable := strTable + '</TR>';
  end;
  strTable := strTable + '</TABLE>';

  HtmlEdit.Write(strTable);

end;

procedure THtmlEditForm.Act_CopyExecute(Sender: TObject);
begin
  HtmlEdit.Copy;
end;

procedure THtmlEditForm.Act_CutExecute(Sender: TObject);
begin
  HtmlEdit.Cut;
end;

procedure THtmlEditForm.Act_InsertExecute(Sender: TObject);
begin
  HtmlEditRecv.Insert(HtmlEdit.HTML);
  HtmlEdit.Clear;
end;

procedure THtmlEditForm.Act_AppendExecute(Sender: TObject);
begin
  HtmlEditRecv.Append(HtmlEdit.HTML);
  HtmlEdit.Clear;
end;

procedure THtmlEditForm.Act_ViewSourceExecute(Sender: TObject);
begin
  mmo1.Clear;
  mmo1.Lines.Text := HtmlEdit.HTML;
  pgc2.ActivePageIndex := 1;
end;

procedure THtmlEditForm.Act_ViewTextExecute(Sender: TObject);
begin
  mmo1.Clear;
  mmo1.Lines.Text := HtmlEdit.Text;
  pgc2.ActivePageIndex := 1;
end;

procedure THtmlEditForm.Act_Edit_BackColoerExecute(Sender: TObject);
begin
  if dlgColor1.Execute then
    HtmlEdit.Edit.BackColor(dlgColor1.Color);
end;

procedure THtmlEditForm.Act_Edit_BoldExecute(Sender: TObject);
begin
  HtmlEdit.Edit.Bold;
end;

procedure THtmlEditForm.Act_Edit_CreateLinkExecute(Sender: TObject);
begin
  HtmlEdit.Edit.CreateLink;
end;

procedure THtmlEditForm.Act_Edit_HorizontalRuleExecute(Sender: TObject);
begin
  HtmlEdit.Edit.InsertHorizontalRule;
end;

procedure THtmlEditForm.Act_Edit_ForeColorExecute(Sender: TObject);
begin
  if dlgColor1.Execute then
    HtmlEdit.Edit.ForeColor(dlgColor1.Color);
end;

procedure THtmlEditForm.Act_Edit_InsertImageExecute(Sender: TObject);
begin
  if dlgOpenPic.Execute then
    HtmlEdit.Edit.InsertImage(dlgOpenPic.FileName);
end;

procedure THtmlEditForm.Act_Edit_InsertLineBreakExecute(Sender: TObject);
begin
  HtmlEdit.Edit.InsertLineBreak;
end;

procedure THtmlEditForm.Act_Edit_InsertOrderedlistExecute(Sender: TObject);
begin
  HtmlEdit.Edit.InsertOrderedList;
end;

procedure THtmlEditForm.Act_Edit_InsertTableExecute(Sender: TObject);
begin
  HtmlEdit.Edit.InsertTable(StrToInt(edt2.Text), StrToInt(edt3.Text));
end;

procedure THtmlEditForm.Act_Edit_InsertUnOrderedListExecute(
  Sender: TObject);
begin
  HtmlEdit.Edit.InsertUnOrderedList;
end;

procedure THtmlEditForm.Act_Edit_JustifyCenterExecute(Sender: TObject);
begin
  HtmlEdit.Edit.JustifyCenter;
end;

procedure THtmlEditForm.Act_Edit_JustifyFullExecute(Sender: TObject);
begin
  HtmlEdit.Edit.JustifyFull;
end;

procedure THtmlEditForm.Act_Edit_JustifyLeftExecute(Sender: TObject);
begin
  HtmlEdit.Edit.JustifyLeft;
end;

procedure THtmlEditForm.Act_Edit_JustifyRightExecute(Sender: TObject);
begin
  HtmlEdit.Edit.JustifyRight;
end;

procedure THtmlEditForm.Act_Edit_ItalicExecute(Sender: TObject);
begin
  HtmlEdit.Edit.Italic;
end;

procedure THtmlEditForm.Act_Edit_RemoveFormatExecute(Sender: TObject);
begin
  HtmlEdit.Edit.RemoveFormat;
end;

procedure THtmlEditForm.Act_Edit_ScrollToBottomExecute(Sender: TObject);
begin
  HtmlEdit.Edit.ScrollToBottom;
end;

procedure THtmlEditForm.Act_Edit_ScrollToTopExecute(Sender: TObject);
begin
  HtmlEdit.Edit.ScrollToTop;
end;

procedure THtmlEditForm.Act_Edit_OutDentExecute(Sender: TObject);
begin
  HtmlEdit.Edit.OutDent;
end;

procedure THtmlEditForm.Act_Edit_InDentExecute(Sender: TObject);
begin
  HtmlEdit.Edit.InDent;
end;

procedure THtmlEditForm.Act_Edit_SuperScriptExecute(Sender: TObject);
begin
  HtmlEdit.Edit.SuperScript;
end;

procedure THtmlEditForm.Act_Edit_SubScriptExecute(Sender: TObject);
begin
  HtmlEdit.Edit.SubScript;
end;

procedure THtmlEditForm.Act_Edit_UnderLineExecute(Sender: TObject);
begin
  HtmlEdit.Edit.UnderLine;
end;

procedure THtmlEditForm.Act_Edit_StrikeThroughExecute(Sender: TObject);
begin
  HtmlEdit.Edit.StrikeThrough;
end;

procedure THtmlEditForm.Act_M_ExampleWindowExecute(Sender: TObject);
begin
  pgc2.ActivePageIndex := 0;
end;

procedure THtmlEditForm.Act_M_ExampleButtonExecute(Sender: TObject);
begin
  pgc2.ActivePageIndex := 1;
end;

end.