在论坛上曾经看到的代码:共享给你!
unit hedform;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, OleCtrls, DHTMLEDLib_TLB, ComCtrls, Menus, ExtCtrls, ActiveX,
mshtml_tlb, IEConst;
type
TGetInputArg = procedure(Sender : TObject; var pVarIn : OleVariant; var FuncResult : boolean) of object;
TClearInputArg = procedure(Sender : TObject; var pVarIn : OleVariant) of object;
TDHEDForm = class(TForm)
DHTMLEdit1: TDHTMLEdit;
ToolBar: TPanel;
NewBtn: TSpeedButton;
StatusBar1: TStatusBar;
OpenBtn: TSpeedButton;
SaveBtn: TSpeedButton;
BoldBtn: TSpeedButton;
ItalicBtn: TSpeedButton;
UnderlineBtn: TSpeedButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
New1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
SaveAs1: TMenuItem;
N2: TMenuItem;
Exit1: TMenuItem;
CutBtn: TSpeedButton;
CopyBtn: TSpeedButton;
PasteBtn: TSpeedButton;
TEFindBtn: TSpeedButton;
TEFontNameBox: TComboBox;
TEFontSizeBox: TComboBox;
TEStylesBox: TComboBox;
Insert1: TMenuItem;
Edit1: TMenuItem;
Find1: TMenuItem;
N4: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N5: TMenuItem;
Redo1: TMenuItem;
Undo1: TMenuItem;
OpenDialog1: TOpenDialog;
UndoBtn: TSpeedButton;
RedoBtn: TSpeedButton;
HorizontalRule1: TMenuItem;
Image1: TMenuItem;
HyperLink1: TMenuItem;
TEColorBtn: TSpeedButton;
ColorDialog1: TColorDialog;
TENumListBtn: TSpeedButton;
TEBulletListBtn: TSpeedButton;
TEDecreaseIndent: TSpeedButton;
TEIncreaseIndent: TSpeedButton;
TEAlignLeftBtn: TSpeedButton;
TEAlignCenterBtn: TSpeedButton;
TEAlignRightBtn: TSpeedButton;
SelectAll1: TMenuItem;
N3: TMenuItem;
ClearSelection1: TMenuItem;
RemoveFormat1: TMenuItem;
Format1: TMenuItem;
Font1: TMenuItem;
Alignment1: TMenuItem;
NumberedList1: TMenuItem;
BulletList1: TMenuItem;
Indent1: TMenuItem;
Outdent1: TMenuItem;
Left1: TMenuItem;
Center1: TMenuItem;
Right1: TMenuItem;
Table1: TMenuItem;
Insert2: TMenuItem;
Delete1: TMenuItem;
Table2: TMenuItem;
InsertRow1: TMenuItem;
InsertColumn1: TMenuItem;
InsertCell1: TMenuItem;
N6: TMenuItem;
MergeCells1: TMenuItem;
SplitCell1: TMenuItem;
DeleteRows1: TMenuItem;
DeleteColumns1: TMenuItem;
DeleteCells1: TMenuItem;
Position1: TMenuItem;
MakeAbsolute1: TMenuItem;
N7: TMenuItem;
BringtoFront1: TMenuItem;
SendtoBack1: TMenuItem;
BringForward1: TMenuItem;
SendBackward1: TMenuItem;
SendbehindHTMLstream1: TMenuItem;
BringAboveHTMLstream1: TMenuItem;
N8: TMenuItem;
Constrainelementpositioning1: TMenuItem;
Setgridcelldimensions1: TMenuItem;
N9: TMenuItem;
NudgeElement1: TMenuItem;
LockElement1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure DHTMLEdit1DocumentComplete(Sender: TObject);
procedure DHTMLEdit1DisplayChanged(Sender: TObject);
procedure BoldBtnClick(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
procedure SaveBtnClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure ItalicBtnClick(Sender: TObject);
procedure UnderlineBtnClick(Sender: TObject);
procedure CutBtnClick(Sender: TObject);
procedure CopyBtnClick(Sender: TObject);
procedure PasteBtnClick(Sender: TObject);
procedure TEFindBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TEFontNameBoxChange(Sender: TObject);
procedure TEFontSizeBoxChange(Sender: TObject);
procedure TEStylesBoxChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure UndoBtnClick(Sender: TObject);
procedure RedoBtnClick(Sender: TObject);
procedure Edit1Click(Sender: TObject);
procedure HorizontalRule1Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure HyperLink1Click(Sender: TObject);
procedure TEColorBtnClick(Sender: TObject);
procedure TENumListBtnClick(Sender: TObject);
procedure TEBulletListBtnClick(Sender: TObject);
procedure TEDecreaseIndentClick(Sender: TObject);
procedure TEIncreaseIndentClick(Sender: TObject);
procedure TEAlignLeftBtnClick(Sender: TObject);
procedure TEAlignCenterBtnClick(Sender: TObject);
procedure TEAlignRightBtnClick(Sender: TObject);
procedure SelectAll1Click(Sender: TObject);
procedure ClearSelection1Click(Sender: TObject);
procedure RemoveFormat1Click(Sender: TObject);
procedure Font1Click(Sender: TObject);
procedure Format1Click(Sender: TObject);
procedure Alignment1Click(Sender: TObject);
procedure Table1Click(Sender: TObject);
procedure Table2Click(Sender: TObject);
procedure InsertColumn1Click(Sender: TObject);
procedure InsertRow1Click(Sender: TObject);
procedure InsertCell1Click(Sender: TObject);
procedure DeleteRows1Click(Sender: TObject);
procedure DeleteColumns1Click(Sender: TObject);
procedure DeleteCells1Click(Sender: TObject);
procedure MergeCells1Click(Sender: TObject);
procedure SplitCell1Click(Sender: TObject);
procedure Position1Click(Sender: TObject);
procedure MakeAbsolute1Click(Sender: TObject);
procedure BringtoFront1Click(Sender: TObject);
procedure SendtoBack1Click(Sender: TObject);
procedure BringForward1Click(Sender: TObject);
procedure SendBackward1Click(Sender: TObject);
procedure BringAboveHTMLstream1Click(Sender: TObject);
procedure SendbehindHTMLstream1Click(Sender: TObject);
procedure NudgeElement1Click(Sender: TObject);
procedure LockElement1Click(Sender: TObject);
procedure Constrainelementpositioning1Click(Sender: TObject);
procedure Setgridcelldimensions1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
DocComplete : boolean;
CommandTarget : IOleCommandTarget;
DOMInterface : IHtmlDocument2;
TEIgnoreChange : boolean;
OldMessageHandler : TMessageEvent;
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
FConstrain : boolean;
{ Private declarations }
function GetCommandStatus(ucmdID : Cardinal; bTriEditCmdGroup : boolean) : DWORD;
function TridentCommand(Cmd : Cardinal; hasInputArg : boolean; promptUser : boolean;
editModeOnly : boolean; bTriEditCommandGroup : boolean;
getInputArg : TGetInputArg; clearInputArg : TClearInputArg) : HRESULT;
procedure GetTridentCommandState(cmdID : Cardinal; bTrieditCommandGroup : boolean;
var bEnabled, bChecked : boolean);
function HrExecCommand(ucmdID : cardinal; const pVarIn : OleVariant;
var pVarOut : OleVariant; bPromptUser : boolean;
bTriEditCmdGroup : boolean) : HResult;
procedure GetAvailableStyles;
procedure ExecCommand(cmdID, cmdExecOpt, pVar: OleVariant);
function QueryStatus(cmdID: OleVariant): OleVariant;
procedure TranslateAcceleratorHandler(var Msg : TMsg; var Handled : Boolean);
procedure ShowHint(Sender : TObject);
procedure GetTableArg(Sender : TObject; var pVarIn : OleVariant; var FuncResult : boolean);
procedure GetNudgeArg(Sender : TObject; var pVarIn : OleVariant; var FuncResult : boolean);
procedure ClearVariantLPPOint(Sender : TObject; var pVarIn : OleVariant);
procedure GetConstrainArg(Sender : TObject; var pVarIn : OleVariant; var FuncResult : boolean);
procedure GetAlignmentArg(Sender : TObject; var pVarIn : OleVariant; var FuncResult : boolean);
public
{ Public declarations }
end;
var
DHEDForm: TDHEDForm;
implementation
uses
IEAddTbl
,IENudge
,EPAbt
;
{$R *.DFM}
var
NilVariant : OleVariant absolute 0;
procedure TDHEDForm.ExecCommand;
begin
if (DocComplete) then
if ((QueryStatus(CmdID) and DECMDF_ENABLED) = DECMDF_ENABLED) then
DHTMLEdit1.ExecCommand(cmdID, cmdExecOpt, pVar);
end;
function TDHEDForm.QueryStatus(cmdID: OleVariant): OleVariant;
begin
Result := DHTMLEdit1.QueryStatus(cmdID);
end;
procedure TDHEDForm.DHTMLEdit1DocumentComplete(Sender: TObject);
begin
DocComplete := True;
DOMInterface := DHTMLEdit1.DOM as IHtmlDocument2;
CommandTarget := DOMInterface as IOleCommandTarget;
end;
procedure TDHEDForm.DHTMLEdit1DisplayChanged(Sender: TObject);
var
FontNameStatus : DWORD;
FontSizeStatus : DWORD;
StyleNameStatus : DWORD;
vo : OleVariant;
TxtAlign : integer; // 0 = left, 1 = center, 2 = right
bEnabled, bChecked : boolean;
begin
if (not DocComplete) then
exit;
BoldBtn.Down := ((QueryStatus(DECMD_BOLD) and DECMDF_LATCHED) = DECMDF_LATCHED);
ItalicBtn.Down := ((QueryStatus(DECMD_ITALIC) and DECMDF_LATCHED) = DECMDF_LATCHED);
UnderlineBtn.Down := ((QueryStatus(DECMD_UNDERLINE) and DECMDF_LATCHED) = DECMDF_LATCHED);
CutBtn.Enabled := ((QueryStatus(DECMD_CUT) and DECMDF_ENABLED) = DECMDF_ENABLED);
CopyBtn.Enabled := ((QueryStatus(DECMD_COPY) and DECMDF_ENABLED) = DECMDF_ENABLED);
PasteBtn.Enabled := ((QueryStatus(DECMD_PASTE) and DECMDF_ENABLED) = DECMDF_ENABLED);
FontNameStatus := GetCommandStatus(IDM_FONTNAME, False);
FontSizeStatus := GetCommandStatus(IDM_FONTSIZE, False);
if ((FontNameStatus and OleCmdf_Enabled) <> 0) then begin
HrExecCommand(IDM_FONTNAME, NilVariant, vo, false, false);
if (VarType(vo) = VarOleStr) then
TEFontNameBox.ItemIndex := TEFontNameBox.Items.IndexOf(Vo);
end;
VarClear(vo);
if ((FontSizeStatus and OleCmdf_Enabled) <> 0) then begin
HrExecCommand(IDM_FONTSIZE, NilVariant, vo, false, false);
if (VarType(vo) = VarInteger) then
TEFontSizeBox.ItemIndex := TEFontSizeBox.Items.IndexOf(vo);
end;
if (TEStylesBox.Items.Count = 0) then begin
TEIgnoreChange := true;
GetAvailableStyles;
// TEStylesBox.Items.Assign(AvailableStyles);
TEIgnoreChange := false;
end;
varClear(vo);
StyleNameStatus := GetCommandStatus(IDM_BLOCKFMT, False);
if ((StyleNameStatus and OleCmdf_Enabled) <> 0) then begin
TVariantArg(vo).vt := vt_bstr;
TVariantArg(vo).bStrVal := nil;
HrExecCommand(IDM_BLOCKFMT, NilVariant, vo, false, false);
if (VarType(vo) = VarOleStr) then
TEStylesBox.ItemIndex := TEStylesBox.Items.IndexOf(vo);
end;
TxtAlign := 0; // assume it's left
GetTridentCommandState(IDM_JustifyRight, false, bEnabled, bChecked);
if (bEnabled and bChecked) then begin
TxtAlign := 2;
end else begin
GetTridentCommandState(IDM_JustifyCenter, false, bEnabled, bChecked);
if (bEnabled and bChecked) then begin
TxtAlign := 1;
end;
end;
TEAlignLeftBtn.Down := (TxtAlign = 0);
TEAlignCenterBtn.Down := (TxtAlign = 1);
TEAlignRightBtn.Down := (TxtAlign = 2);
GetTridentCommandState(IDM_ORDERLIST, false, bEnabled, bChecked);
TENumListBtn.Down := (bEnabled and bChecked);
GetTridentCommandState(IDM_UNORDERLIST, false, bEnabled, bChecked);
TEBulletListBtn.Down := (bEnabled and bChecked);
end;
procedure TDHEDForm.GetAvailableStyles;
var
varRange : OleVariant;
b : TBStr;
a : PSafeArray;
l, h, i : longint;
hr : HRESULT;
begin
TVariantArg(VarRange).VT := VT_ARRAY; // VarArray or VarOleStr;
TVariantArg(VarRange).ppArray := nil;
hr := HrExecCommand(IDM_GETBLOCKFMTS, NilVariant, VarRange, false, false);
// OleCheck(hr);
if (hr = 0) then begin
l := VarArrayLowBound(VarRange, 1);
h := VarArrayHighBound(VarRange, 1);
a := TVariantArg(VarRange).pArray;
for i := l to h do begin
SafeArrayGetElement(a, i, b);
TEStylesBox.Items.Add(OleStrToString(b));
end;
end;
end;
procedure TDHEDForm.BoldBtnClick(Sender: TObject);
var
pCmd : OleVariant;
pValue : OleVariant;
begin
pCMD := DECMD_BOLD;
pValue := not (BoldBtn.Down);
DHTMLEdit1.ExecCommand(pCmd, OLECMDEXECOPT_DONTPROMPTUSER, pValue);
end;
procedure TDHEDForm.OpenBtnClick(Sender: TObject);
var
pVIn : OleVariant;
Prompt : OleVariant;
begin
pVIn := '';
Prompt := True;
DHtmlEdit1.LoadDocument(pVIn, Prompt);
DocComplete := False;
end;
procedure TDHEDForm.SaveBtnClick(Sender: TObject);
var
vo, vb : OleVariant;
begin
vo := DHTMLEdit1.CurrentDocumentPath;
if (vo <> '') then begin
vb := false;
end else begin
vo := '';
vb := true;
end;
DHTMLEdit1.SaveDocument(vo, vb);
end;
procedure TDHEDForm.SpeedButton1Click(Sender: TObject);
begin
// ExecCommand(DECMD_BOLD, OLECMDEXECOPT_DONTPROMPTUSER, Null);
TridentCommand(IDM_BOLD, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.ItalicBtnClick(Sender: TObject);
begin
ExecCommand(DECMD_Italic, OLECMDEXECOPT_DONTPROMPTUSER, Null);
end;
procedure TDHEDForm.UnderlineBtnClick(Sender: TObject);
begin
ExecCommand(DECMD_Underline, OLECMDEXECOPT_DONTPROMPTUSER, Null);
end;
procedure TDHEDForm.CutBtnClick(Sender: TObject);
begin
// TridentCommand(DECMD_CUT, false, false, false, false, nil, nil);
ExecCommand(DECMD_CUT, OLECMDEXECOPT_DODEFAULT, Null);
end;
procedure TDHEDForm.CopyBtnClick(Sender: TObject);
begin
// TridentCommand(IDM_COPY, false, false, false, false, nil, nil);
ExecCommand(DECMD_COPY, OLECMDEXECOPT_DODEFAULT, Null);
end;
procedure TDHEDForm.PasteBtnClick(Sender: TObject);
begin
ExecCommand(DECMD_PASTE, OLECMDEXECOPT_DODEFAULT, Null);
end;
function TDHEDForm.GetCommandStatus(ucmdID : Cardinal; bTriEditCmdGroup : boolean) : DWORD;
var
FMsoCmd : TOleCmd;
begin
result := 0;
if (Not Assigned(CommandTarget)) then
Exit;
FMsoCmd.CmdID := ucmdID;
FMsoCmd.cmdf := 0;
if (bTriEditCmdGroup) then begin
CommandTarget.QueryStatus(@GUID_TriEditCommandGroup, 1, @FMsoCmd, nil);
end else begin
CommandTarget.QueryStatus(@CMDSETID_Forms3, 1, @FMsoCmd, nil);
end;
result := FMsoCmd.cmdf;
end;
procedure TDHEDForm.GetTridentCommandState;
var
dwStatus : DWORD;
begin
dwStatus := GetCommandStatus(cmdID, bTriEditCommandGroup);
bEnabled := ((dwStatus and OLECMDF_ENABLED) <> 0);
bChecked := ((dwStatus and OLECMDF_LATCHED) <> 0);
end;
function TDHEDForm.TridentCommand(Cmd : Cardinal; hasInputArg : boolean; promptUser : boolean;
editModeOnly : boolean; bTriEditCommandGroup : boolean;
getInputArg : TGetInputArg; clearInputArg : TClearInputArg) : HRESULT;
var
pVarIn : OleVariant;
bContinue : boolean;
begin
result := S_OK;
if (hasInputArg) then begin
getInputArg(Self, pVarIn, bContinue);
if (not bContinue) then
exit;
result := HrExecCommand(Cmd, pVarIn, nilVariant, promptUser, bTriEditCommandGroup)
end else begin
result := HrExecCommand(Cmd, nilVariant, nilVariant, promptUser, bTriEditCommandGroup);
end;
if (HasInputArg and Assigned(ClearInputArg)) then
ClearInputArg(Self, pVarIn);
end;
function TDHEDForm.HrExecCommand;
var
dwCmdOpt : DWORD;
begin
result := S_OK;
if (Not Assigned(CommandTarget)) then
Exit;
if (bPromptUser) then
dwCmdOpt := MSOCMDEXECOPT_PROMPTUSER
else
dwCmdOpt := MSOCMDEXECOPT_DONTPROMPTUSER;
if (bTriEditCmdGroup) then begin
result := CommandTarget.Exec(@GUID_TriEditCommandGroup,
ucmdID,
dwCmdOpt,
pVarIn,
pVarOut);
end else begin
result := CommandTarget.Exec(@CMDSETID_Forms3,
ucmdID,
dwCmdOpt,
pVarIn,
pVarOut);
end;
end;
procedure TDHEDForm.TEFindBtnClick(Sender: TObject);
begin
TridentCommand(IDM_FIND, false, true, false, false, nil, nil);
end;
procedure TDHEDForm.FormShow(Sender: TObject);
begin
TEIgnoreChange := true;
TEFontNameBox.Items.Assign(Screen.Fonts);
TEIgnoreChange := false;
Application.OnHint := ShowHint;
end;
procedure TDHEDForm.TEFontNameBoxChange(Sender: TObject);
var
vi, vo : OleVariant;
begin
if (TEIgnoreChange) then
exit;
vi := TEFontNameBox.Text;
HrExecCommand(IDM_FONTNAME, vi, vo, false, false);
end;
procedure TDHEDForm.TEFontSizeBoxChange(Sender: TObject);
var
vi, vo : OleVariant;
begin
if (TEIgnoreChange) then
exit;
vi := TEFontSizeBox.ItemIndex + 1;
HrExecCommand(IDM_FONTSIZE, vi, vo, false, false);
end;
procedure TDHEDForm.TEStylesBoxChange(Sender: TObject);
var
vi, vo : OleVariant;
begin
if (TEIgnoreChange) then
exit;
vi := TEStylesBox.Text;
HrExecCommand(IDM_BLOCKFMT, vi, vo, false, false);
end;
procedure TDHEDForm.FormActivate(Sender: TObject);
begin
OldMessageHandler := Application.OnMessage;
Application.OnMessage := TranslateAcceleratorHandler;
end;
procedure TDHEDForm.FormDeactivate(Sender: TObject);
begin
Application.OnMessage := OldMessageHandler;
end;
procedure TDHEDForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FOleInPlaceActiveObject := nil;
end;
procedure TDHEDForm.TranslateAcceleratorHandler;
const
DuplicatedKeys: set of Byte =
[VK_BACK, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT];
var
iOIPAO: IOleInPlaceActiveObject;
Dispatch: IDispatch;
begin
if (Assigned(DHTMLEdit1)) then begin
Handled := (IsDialogMessage(DHTMLEdit1.Handle, Msg) = True);
if ((Handled) and (not DHTMLEdit1.Busy)) then begin
if (FOleInPlaceActiveObject = nil) then begin
Dispatch := DHTMLEdit1.ControlInterface;
if (Assigned(Dispatch)) then begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
if (Assigned(iOIPAO)) then begin
FOleInPlaceActiveObject := iOIPAO;
iOIPAO._Release;
end; // have an active inplace object
end; // have dispatch
end; // need active inplace object
if (Assigned(FOleInPlaceActiveObject)) then
if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
(Msg.wParam in DuplicatedKeys) then
// nothing - do not pass on cursor movement keys or they will
// happen twice
else
FOleInPlaceActiveObject.TranslateAccelerator(Msg);
end;
end
else
Handled := False;
end;
procedure TDHEDForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TDHEDForm.Open1Click(Sender: TObject);
var
PathIn, UserPrompt : OleVariant;
begin
if (OpenDialog1.Execute) then begin
DocComplete := false;
UserPrompt := false;
PathIn := OpenDialog1.FileName;
DHTMLEdit1.LoadDocument(PathIn, UserPrompt);
end;
end;
procedure TDHEDForm.New1Click(Sender: TObject);
begin
DocComplete := false;
DHTMLEdit1.NewDocument;
end;
procedure TDHEDForm.SaveAs1Click(Sender: TObject);
var
vo, vb : OleVariant;
begin
vo := '';
vb := true;
DHTMLEdit1.SaveDocument(vo, vb);
end;
procedure TDHEDForm.UndoBtnClick(Sender: TObject);
begin
TridentCommand(IDM_Undo, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.RedoBtnClick(Sender: TObject);
begin
TridentCommand(IDM_Redo, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.ShowHint;
begin
StatusBar1.Panels[0].Text := Application.Hint;
end;
procedure TDHEDForm.Edit1Click(Sender: TObject);
begin
Cut1.Enabled := CutBtn.Enabled;
Copy1.Enabled := CopyBtn.Enabled;
Paste1.Enabled := PasteBtn.Enabled;
end;
procedure TDHEDForm.HorizontalRule1Click(Sender: TObject);
begin
TridentCommand(IDM_HORIZONTALLINE, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.Image1Click(Sender: TObject);
begin
TridentCommand(IDM_IMAGE, false, true, true, false, Nil, Nil);
end;
procedure TDHEDForm.HyperLink1Click(Sender: TObject);
begin
TridentCommand(IDM_HyperLink, false, true, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEColorBtnClick(Sender: TObject);
var
vo, TheColor : OleVariant;
begin
if (ColorDialog1.Execute) then begin
TheColor := ColorDialog1.Color;
HrExecCommand(IDM_FORECOLOR, TheColor, vo, false, false);
end;
end;
procedure TDHEDForm.TENumListBtnClick(Sender: TObject);
begin
TridentCommand(IDM_ORDERLIST, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEBulletListBtnClick(Sender: TObject);
begin
TridentCommand(IDM_UNORDERLIST, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEDecreaseIndentClick(Sender: TObject);
begin
TridentCommand(IDM_OUTDENT, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEIncreaseIndentClick(Sender: TObject);
begin
TridentCommand(IDM_INDENT, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEAlignLeftBtnClick(Sender: TObject);
begin
TridentCommand(IDM_JUSTIFYLEFT, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEAlignCenterBtnClick(Sender: TObject);
begin
TridentCommand(IDM_JUSTIFYCENTER, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.TEAlignRightBtnClick(Sender: TObject);
begin
TridentCommand(IDM_JUSTIFYRIGHT, false, false, true, false, Nil, Nil);
end;
procedure TDHEDForm.SelectAll1Click(Sender: TObject);
begin
TridentCommand(IDM_SELECTALL, false, false, false, false, nil, nil);
end;
procedure TDHEDForm.ClearSelection1Click(Sender: TObject);
begin
TridentCommand(IDM_CLEARSELECTION, false, false, false, false, nil, nil);
end;
procedure TDHEDForm.RemoveFormat1Click(Sender: TObject);
begin
TridentCommand(IDM_REMOVEFORMAT, false, false, true, false, nil, nil);
end;
procedure TDHEDForm.Font1Click(Sender: TObject);
begin
TridentCommand(IDM_FONT, False, True, True, False, Nil, Nil);
end;
procedure TDHEDForm.Format1Click(Sender: TObject);
begin
NumberedList1.Checked := TENumListBtn.Down;
BulletList1.Checked := TEBulletListBtn.Down;
end;
procedure TDHEDForm.Alignment1Click(Sender: TObject);
begin
Left1.Checked := TEAlignLeftBtn.Down;
Center1.Checked := TEAlignCenterBtn.Down;
Right1.Checked := TEAlignRightBtn.Down;
end;
procedure TDHEDForm.Table1Click(Sender: TObject);
var
bEnabled, bChecked : boolean;
begin
GetTridentCommandState(IDM_TRIED_INSERTROW, true, bEnabled, bChecked);
InsertRow1.Enabled := bEnabled;
InsertCell1.Enabled := bEnabled;
InsertColumn1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_DELETEROWS, true, bEnabled, bChecked);
DeleteRows1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_DELETECELLS, true, bEnabled, bChecked);
DeleteCells1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_DELETECOLS, true, bEnabled, bChecked);
DeleteColumns1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_MERGECELLS, true, bEnabled, bChecked);
MergeCells1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_SPLITCELL, true, bEnabled, bChecked);
SplitCell1.Enabled := bEnabled;
end;
procedure TDHEDForm.Table2Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_INSERTTABLE, true, false, true, true, GetTableArg, Nil);
end;
procedure TDHEDForm.GetTableArg;
var
d : TIEInsertTableDlg;
begin
FuncResult := false;
d := TIEInsertTableDlg.Create(Self);
try
d.TableCaption.Text := 'The Caption';
d.ColCount.Text := '2';
d.RowCount.Text := '2';
d.TableAttr.Text := 'BORDER=1 CELLPADDING=2 CELLSPACING=2';
d.CellAttr.Text := 'BGCOLOR=white';
if (d.ShowModal = mrOk) then begin
pVarIn := VarArrayCreate([0, 4], varVariant);
pVarIn[0] := StrToInt(d.RowCount.Text);
pVarIn[1] := StrToInt(d.ColCount.Text);
pVarIn[2] := d.TableAttr.Text;
pVarIn[3] := d.CellAttr.Text;
pVarIn[4] := d.TableCaption.Text;
end;
FuncResult := true;
finally
d.free;
end;
end;
procedure TDHEDForm.InsertColumn1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_INSERTCOL, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.InsertRow1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_INSERTROW, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.InsertCell1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_INSERTCELL, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.DeleteRows1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_DELETEROWS, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.DeleteColumns1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_DELETECOLS, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.DeleteCells1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_DELETECELLS, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.MergeCells1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_MERGECELLS, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.SplitCell1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SPLITCELL, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.Position1Click(Sender: TObject);
var
bEnabled, bChecked : boolean;
begin
GetTridentCommandState(IDM_TRIED_MAKE_ABSOLUTE, true, bEnabled, bChecked);
MakeAbsolute1.Enabled := bEnabled;
MakeAbsolute1.Checked := bChecked;
GetTridentCommandState(IDM_TRIED_SEND_TO_FRONT, true, bEnabled, bChecked);
BringToFront1.Enabled := bEnabled;
SendToBack1.Enabled := bEnabled;
BringForward1.Enabled := bEnabled;
SendBackward1.Enabled := bEnabled;
BringAboveHTMLStream1.Enabled := bEnabled;
SendBehindHTMLStream1.Enabled:= bEnabled;
GetTridentCommandState(IDM_TRIED_NUDGE_ELEMENT, true, bEnabled, bChecked);
NudgeElement1.Enabled := bEnabled;
GetTridentCommandState(IDM_TRIED_LOCK_ELEMENT, true, bEnabled, bChecked);
LockElement1.Enabled := bEnabled;
LockElement1.Checked := bChecked;
GetTridentCommandState(IDM_TRIED_CONSTRAIN, true, bEnabled, bChecked);
ConstrainElementPositioning1.Enabled := bEnabled;
ConstrainElementPositioning1.Checked := FConstrain;
GetTridentCommandState(IDM_TRIED_SET_ALIGNMENT, true, bEnabled, bChecked);
SetGridCellDimensions1.Enabled := bEnabled;
end;
procedure TDHEDForm.MakeAbsolute1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_MAKE_ABSOLUTE, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.BringtoFront1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_TO_FRONT, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.SendtoBack1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_TO_BACK, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.BringForward1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_FORWARD, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.SendBackward1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_BACKWARD, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.BringAboveHTMLstream1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_FRONT_1D, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.SendbehindHTMLstream1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SEND_BEHIND_1D, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.NudgeElement1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_NUDGE_ELEMENT, true, false, true, true,
GetNudgeArg, ClearVariantLPPOINT);
end;
procedure TDHEDForm.GetNudgeArg;
var
d : TNudgeDlg;
lpPoint : PPoint;
begin
FuncResult := false;
d := TNudgeDlg.Create(Self);
try
if (d.ShowModal = mrOk) then begin
new(lpPoint);
lpPoint^.x := StrToInt(d.XAxis.Text);
lpPoint^.y := StrToInt(d.YAxis.Text);
TVariantArg(pVarIn).vt := VT_BYREF;
TVariantArg(pVarIn).ByRef := lpPoint;
FuncResult := true;
end;
finally
d.free;
end;
end;
procedure TDHEDForm.ClearVariantLPPOint;
var
lpPoint : PPoint;
begin
if (TVariantArg(pVarIn).vt = VT_BYREF) then begin
lpPoint := TVariantArg(pVarIn).ByRef;
if (Assigned(lpPoint)) then
Dispose(lpPoint);
end;
end;
procedure TDHEDForm.LockElement1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_LOCK_ELEMENT, false, false, true, true, Nil, Nil);
end;
procedure TDHEDForm.Constrainelementpositioning1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_CONSTRAIN, true, false, true, true, GetConstrainArg, Nil);
end;
procedure TDHEDForm.GetConstrainArg;
begin
FConstrain := not FConstrain;
pVarIn := FConstrain;
FuncResult := true;
end;
procedure TDHEDForm.Setgridcelldimensions1Click(Sender: TObject);
begin
TridentCommand(IDM_TRIED_SET_ALIGNMENT, true, false, true, true, GetAlignmentArg, ClearVariantLPPOINT);
end;
procedure TDHEDForm.GetAlignmentArg;
var
d : TNudgeDlg;
lpPoint : PPoint;
begin
FuncResult := false;
d := TNudgeDlg.Create(Self);
try
if (d.ShowModal = mrOk) then begin
d.Caption := 'Set Grid Cell Dimensions';
d.GroupBox1.Caption := 'Cell Dimensions';
new(lpPoint);
lpPoint^.x := StrToInt(d.XAxis.Text);
lpPoint^.y := StrToInt(d.YAxis.Text);
TVariantArg(pVarIn).vt := VT_BYREF;
TVariantArg(pVarIn).ByRef := lpPoint;
FuncResult := true;
end;
finally
d.free;
end;
end;
procedure TDHEDForm.About1Click(Sender: TObject);
var
d : TDHEDAboutBox;
begin
d := TDHEDAboutBox.Create(Self);
try
d.ShowModal;
finally
d.free;
end;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.