echmmain.pas

帮助编写程序

procedure TEchmForm.dxBarButtonInsertImageClick(Sender: TObject);
const
  Filter = '*.JPG|*.JPG|*.*|*.*';
begin
  OpenDialog.Filter := Filter;
  OpenDialog.FileName := '';
  if OpenDialog.Execute then
  begin
    if IsActiveEdit ='webDesign' then
    begin
     ActiveWebDesign.Edit.InsertImage(OpenDialog.FileName);    //webDesign
    end else
    begin
     InsertBitmapIntoRichEdit(OpenDialog.FileName, ActiveEditor);
     ActiveEditor.SetFocus;
    end;
  end;
end;

function TEchmForm.SaveDocument(SaveMode: Boolean; SaveQuery: Boolean = False): Boolean;
//SaveMode True: SaveAs  False: Save
//SaveQuery True: New、Open、Exit  False: SaveAs、Save
  function SaveToFile(SaveMode: Boolean): Boolean;
  var
    SaveResult: Boolean;
  begin
    Result := True;
    if (not SaveMode) or (FDocPathName = '') then
      with TSaveDialog.Create(self) do
      begin
        Filter := 'HTML Documents(*.htm,*.html)|*.htm;*.html';
        FileName := FDocPathName;
        SaveResult := Execute;
        if SaveResult then FDocPathName := FileName;
        Free;
        if not SaveResult then
        begin
          Result :=  False;
          Exit;
        end;
      end;
    try
      ActiveWebDesign.SaveToFile(FDocPathName);
     // DHTMLEditForm.Caption := MainFormTitle + ' - ' + FDocPathName;
    except
      Showmessage('保存文件出错');
      FDocPathName := '';
      Result :=  False;
    end;
  end;
var
  Save: Integer;
begin
  Result := True;
  if not SaveQuery then
    SaveToFile(SaveMode)
  else
  begin
   //-- if ActiveWebDesign.IsDirty then
    begin
      Save := MessageBox(self.Handle, '文件的内容已经改变'#13 + '要保存文件吗？',
        '提示', MB_IconQuestion or MB_YesNoCancel);
      case Save of
        IDYES: if not SaveToFile(True) then Result := False;
        IDCANCEL: Result := False;
      end;
    end;
  end;
end;

procedure TEchmForm.UpdateState;
var
//?  CmdID: DHTMLEDITCMDID;
//?  State: DHTMLEDITCMDF;
  i, j: Integer;
  lAction: TAction;
  V : OleVariant;
begin
  if ActiveWebDesign.Busy then Exit;
 { lAction := nil;
  for i := 0 to Commands.Count - 1 do
  begin
    CmdID := DHTMLEDITCMDID(Commands.Items[i]^);
    State := ActiveWebDesign.QueryStatus(CmdID);
    for j := 0 to ActionList.ActionCount - 1 do
    begin
      if ActionList.Actions[j].Tag = i + 1 then
      begin
        lAction := TAction(ActionList.Actions[j]);
        Break;
      end;
    end;
    if lAction = nil then Break;
    lAction.Enabled := True;
    case State of
      DECMDF_ENABLED: lAction.Checked := False;
      DECMDF_LATCHED: lAction.Checked := True;
      else            lAction.Enabled := False;
    end;
  end;   }
  //设置字体状态
//?  State := ActiveWebDesign.QueryStatus(DECMD_GETFONTNAME);
//?  if State = DECMDF_ENABLED then
//?//?  begin
//?    V := ActiveWebDesign.ExecCommand(DECMD_GETFONTNAME, OLECMDEXECOPT_DONTPROMPTUSER);
//?    dxBarComboFontName.ItemIndex := dxBarComboFontName.Items.IndexOf(V);
//?    dxBarComboFontName.Enabled := True;
//?  end
//?  else
//?  begin
//?    if State = DECMDF_NINCHED Then
//?       dxBarComboFontName.Enabled := True
//?    else
//?       dxBarComboFontName.Enabled := False;
//?  end;
  //设置字号状态
//?  State := ActiveWebDesign.QueryStatus(DECMD_GETFONTSIZE);
//?  if State = DECMDF_ENABLED then
//?  begin
//?    V := ActiveWebDesign.ExecCommand(DECMD_GETFONTSIZE, OLECMDEXECOPT_DONTPROMPTUSER);
//?    if V >= 1 Then
//?      dxBarComboFontSize.ItemIndex := V - 1
//?    else
//?      dxBarComboFontSize.ItemIndex := -1;
//?    dxBarComboFontSize.Enabled := True;
//?  end
//?  else if State = DECMDF_NINCHED then
//?  begin
//?    dxBarComboFontSize.ItemIndex := -1;
//?    if State = DECMDF_NINCHED Then
//?      dxBarComboFontSize.Enabled := True
//?    else
//?      dxBarComboFontSize.Enabled := False;
//?  end;
  //设置段落格式状态
//?  State := ActiveWebDesign.QueryStatus(DECMD_GETBLOCKFMT);
//?  if State = DECMDF_ENABLED then
//?  begin
//?    V := ActiveWebDesign.ExecCommand(DECMD_GETBLOCKFMT, OLECMDEXECOPT_DONTPROMPTUSER);
//?    dxBarComboStyle.ItemIndex := dxBarComboStyle.Items.IndexOf(V);
   // mmiStyle.Items[dxBarComboStyle.ItemIndex].Checked := True;
//?  end;
  //设置编号列表和项目符号列表
//?  State := ActiveWebDesign.QueryStatus(DECMD_ORDERLIST);
//?  dxBarButtonNumberList.Enabled := True;
//?  case State of
//?    DECMDF_ENABLED: dxBarButtonNumberList.Down := False;
//?    DECMDF_LATCHED: dxBarButtonBullets.Down  := True;
//?    else            dxBarButtonNumberList.Enabled  := False;
//?  end;
//?  State := ActiveWebDesign.QueryStatus(DECMD_UNORDERLIST);
//?  dxBarButtonNumberList.Enabled := True;
//?  case State of
//?    DECMDF_ENABLED: dxBarButtonNumberList.Down  := False;
//?    DECMDF_LATCHED: dxBarButtonBullets.Down  := True;
//?    else            dxBarButtonNumberList.Enabled := False;
//?  end;
  //设置字体颜色和背景
//?  State := ActiveWebDesign.QueryStatus(DECMD_GETFORECOLOR);
//?  dxBarComboFontColor.Enabled := True;
//?  if State = DECMDF_DISABLED then
//?    dxBarComboFontColor.Enabled := False
//?  else
//?    dxBarComboFontColor.Color := HTMLToColor(ActiveWebDesign.ExecCommand(DECMD_GETFORECOLOR, OLECMDEXECOPT_DONTPROMPTUSER));
 { State := ActiveWebDesign.QueryStatus(DECMD_GETBACKCOLOR);
  btnBGColor.Enabled := True;
  if State = DECMDF_DISABLED then
    btnBGColor.Enabled := False
  else
   btnBGColor.Color := HTMLToColor(ActiveWebDesign.ExecCommand(DECMD_GETBACKCOLOR, OLECMDEXECOPT_DONTPROMPTUSER));
}end;


procedure TEchmForm.dxBarComboStyleChange(Sender: TObject);
var
  V : OleVariant;
begin
    V := dxBarComboStyle.Text;
//?  if ActiveWebDesign.QueryStatus(DECMD_SETBLOCKFMT) >= DECMDF_ENABLED then
//?    ActiveWebDesign.ExecCommand(DECMD_SETBLOCKFMT, OLECMDEXECOPT_DODEFAULT, V);
end;

function TEchmForm.GetBlockFmtNamesParam: TStrings;
var
  V : OleVariant;
  lBlockFmtName: string;
  i: Integer;
begin
  Result := TStringList.Create;
//?  V := CoDEGetBlockFmtNamesParam.Create;
//?  ActiveWebDesign.ExecCommand(DECMD_GETBLOCKFMTNAMES, OLECMDEXECOPT_DODEFAULT, V);
  for i := VarArrayLowBound(V.Names, 1) to VarArrayHighBound(V.Names, 1) do
  begin
    lBlockFmtName := (V.Names)[i];
    Result.Add(lBlockFmtName);
  end;
end;


procedure TEchmForm.DHTMLEditDisplayChanged(Sender: TObject);
begin
  UpdateState;
end;

////

procedure TEchmForm.PCTCanClose(Sender: TObject; var ACanClose: Boolean);
var
  Res: Integer;
begin
  if ActiveEditor.Modified then
  begin
    Res := Application.MessageBox(
      PChar(Format('Do you want to save the changes you made to "%s"?', [Caption])),
      PChar(Application.Title), MB_ICONQUESTION or MB_YESNOCANCEL);
    case Res of
      ID_YES: ACanClose := self.SaveFile(False);
      ID_NO: ACanClose := True;
      ID_CANCEL: ACanClose := False;
    end;
  end;

  if self.FileName <> '' then
    self.dxBarMRUFiles.AddItem(self.FileName, nil);
end;

procedure TEchmForm.cxPageControlChange(Sender: TObject);
var sHTML: string;I,J:integer;
    IsEditor:TRichEdit;
    IsWebDesign:THTMLEdit;
    IsWebBrowser:TWebBrowser;
begin
 for I:=0 to self.ComponentCount-1 do
 begin
 if self.Components[I].Name= 'EchmChildForm'+IntToStr(PCT.ActivePage.PageIndex) then
  if self.Components[I].InheritsFrom(TEchmChildForm) then
  with TEchmChildForm(self.Components[I]) do
  begin
   for J:=0 to ComponentCount-1 do
   begin
    if Components[J].InheritsFrom(TRichEdit) then
      IsEditor :=  TRichEdit(Components[J]);
    if Components[J].InheritsFrom(THTMLEdit) then
      IsWebDesign :=  THTMLEdit(Components[J]);
    if Components[J].InheritsFrom(TWebBrowser) then
      IsWebBrowser :=  TWebBrowser(Components[J]);
   end;
  end;
 end;


 case TcxPageControl(Sender).ActivePageIndex of
  0: begin
      self.IsActiveEdit :='webDesign';
      sHTML :=IsEditor.Text;
      IsWebDesign.Html:=sHTML;
     end;
  1: begin
      self.IsActiveEdit :='Editor';
      sHTML :=IsWebDesign.Html;
      IsEditor.Text :=sHTML;
      end;
  2: begin
      self.IsActiveEdit :='WebBrowser';
      sHTML :=IsEditor.Text;
      //IsWebBrowser.OleObject.Document.body.innerHTML :=sHTML;
      IsWebBrowser.Navigate('about:'+sHTML);
     end;
  end;
  dxStatusBar.Panels[3].Text :=IsActiveEdit;
end;

procedure TEchmForm.dxBarButtonOutdentClick(Sender: TObject);
begin
  if IsActiveEdit ='webDesign' then
  begin
   ActiveWebDesign.Edit.InDent;
  end;
end;

procedure TEchmForm.dxBarButtonIndentClick(Sender: TObject);
begin
  if IsActiveEdit ='webDesign' then
  begin
   ActiveWebDesign.Edit.OutDent;
  end;
end;

procedure TEchmForm.dxBarButtonRedoClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
   ActiveWebDesign.Redo;
 end else
 SendMessage(ActiveEditor.Handle, EM_REDO, 0, 0);
end;

procedure TEchmForm.dxBarLargeButton1Click(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
   ActiveWebDesign.Edit.SuperScript;
 end;
end;

procedure TEchmForm.dxBarLargeButton3Click(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
   ActiveWebDesign.Edit.SubScript;
 end;
end;

procedure TEchmForm.dxBarButtonStrikeThroughClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
   ActiveWebDesign.Edit.StrikeThrough;
 end;
end;

procedure TEchmForm.dxBarButtonInsertHLineClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
   ActiveWebDesign.Edit.InsertHorizontalRule;
 end;
end;

procedure TEchmForm.dxBarButtonPagePropertyClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
  ActiveWebDesign.ExecWB(OLECMDID_PROPERTIES ,OLECMDEXECOPT_PROMPTUSER); ;
 end;
end;

procedure TEchmForm.dxBarButtonInsertAnchorClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
  ActiveWebDesign.Edit.CreateLink;
 end;
end;

procedure TEchmForm.dxBarButtonInsertTableClick(Sender: TObject);
begin
 if IsActiveEdit ='webDesign' then
 begin
  ActiveWebDesign.Edit.InsertTable(3,3);
 end;
end;

procedure TEchmForm.FormShow(Sender: TObject);
begin
  if FDesign then
  begin
   dxBarButtonNewClick(Sender);
   HtmLoadForm(FDataSource,FKeyField,FDataField,FPasField,FFrmName,FUnitName);
  end;
end;

procedure TEchmForm.HtmSaveToTable(Form:TForm;SourceTable:TDataSource; KeyField,DfmField,UnitField:string;FrmName,UnitName:string); //窗体保存到数据库
var
   DfmName:string;
   PasName:string;
   Ext:string;
   TempDir:string;
begin
 if FIsMHT then Ext:='.mht' else Ext:='.htm';
 DfmName:=FrmName+Ext;
 PasName:=UnitName+Ext;

 TempDir:=ExtractFilePath(Application.Exename);
 if TempDir[Length(TempDir)]<>'\' then TempDir:=TempDir+'\';

 If Not DirectoryExists(TempDir+'help\') Then CreateDir(TempDir+'help\');
 if FIsMHT then
 begin
  if FUser then
   SaveToMHT(ActiveWebDesign.HTML,TempDir+'help\'+DfmName,True,False)
  else
   SaveToMHT(ActiveWebDesign.HTML,TempDir+'help\'+PasName,True,False);
 end else
 begin
  if FUser then
   ActiveWebDesign.SaveToFile(TempDir+'help\'+DfmName)
  else
   ActiveWebDesign.SaveToFile(TempDir+'help\'+PasName);
 end;

 SourceTable.DataSet.Open;
 if SourceTable.DataSet.Locate(KeyField,FrmName,[]) then
 begin
  SourceTable.DataSet.Edit;
  SourceTable.DataSet.FieldByName(KeyField).AsString:=FrmName;
  if FUser then
   TBlobField(SourceTable.DataSet.FieldByName(DfmField)).LoadFromFile(TempDir+'help\'+DfmName)
  else
   TBlobField(SourceTable.DataSet.FieldByName(UnitField)).LoadFromFile(TempDir+'help\'+PasName);
 end else
 begin
  SourceTable.DataSet.Append;
  SourceTable.DataSet.FieldByName(KeyField).AsString:=FrmName;
  if FUser then
   TBlobField(SourceTable.DataSet.FieldByName(DfmField)).LoadFromFile(TempDir+'help\'+DfmName)
  else
   TBlobField(SourceTable.DataSet.FieldByName(UnitField)).LoadFromFile(TempDir+'help\'+PasName);
 end;
 SourceTable.DataSet.Post;
end;

procedure TEchmForm.HtmLoadForm(SourceTable:TDataSource; KeyField,DfmField,UnitField:string;FrmName,UnitName:string);
var
   DfmName:string;
   Ext:string;   
   PasName:string;
   TempDir:string;
begin
 if FIsMHT then Ext:='.mht' else Ext:='.htm';
 DfmName:=FrmName+Ext;
 PasName:=UnitName+Ext;
 
 TempDir:=ExtractFilePath(Application.Exename);
 if TempDir[Length(TempDir)]<>'\' then TempDir:=TempDir+'\';

  if FileExists(TempDir+'help\'+DfmName) or FileExists(TempDir+'help\'+PasName)then
  begin
   if FUser then
   begin
    if FIsMHT then ActiveWebDesign.Navigate(TempDir+'help\'+DfmName) else
    ActiveWebDesign.LoadFromFile(TempDir+'help\'+DfmName);
   end
   else
   begin
    if FIsMHT then ActiveWebDesign.Navigate(TempDir+'help\'+PasName) else
    ActiveWebDesign.LoadFromFile(TempDir+'help\'+PasName);
   end;
  end else
  begin
   If Not DirectoryExists(TempDir+'help\') Then CreateDir(TempDir+'help\');
   SourceTable.DataSet.Open;
   if SourceTable.DataSet.Locate(KeyField,FrmName,[]) then
   begin
   if FUser then
   begin
    TBlobField(SourceTable.DataSet.FieldByName(DfmField)).SaveToFile(TempDir+'help\'+DfmName);
    if FIsMHT then
    ActiveWebDesign.Navigate(TempDir+'help\'+DfmName) else
    ActiveWebDesign.LoadFromFile(TempDir+'help\'+DfmName);
   end else
   begin
    TBlobField(SourceTable.DataSet.FieldByName(UnitField)).SaveToFile(TempDir+'help\'+PasName);
    if FIsMHT then
    ActiveWebDesign.Navigate(TempDir+'help\'+PasName) else
    ActiveWebDesign.LoadFromFile(TempDir+'help\'+PasName);
   end;
   end else raise Exception.Create('找不到相关文件内容');
  end;
end;

end.