documentproperty.pas

帮助编写程序

{*******************************************************}
{                                                       }
{                动 态 网 页 编 辑 器                   }
{                                                       }
{       Copyright (C) 00,00 Justep Corporation          }
{                                                       }
{*******************************************************}
unit DocumentProperty;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, extdlgs, ExtCtrls;

type
  TDocumentPropertyForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    cbUseBGPicture: TCheckBox;
    Label8: TLabel;
    edtBGPicture: TEdit;
    sbBGPicture: TSpeedButton;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    ComboBox1: TComboBox;
    cbProportionFont: TComboBox;
    cbFixedFont: TComboBox;
    cbProportionFontSize: TComboBox;
    cbFixedFontSize: TComboBox;
    Label11: TLabel;
    Label12: TLabel;
    ccbBG: TColorBox;
    ccbText: TColorBox;
    ccbLink: TColorBox;
    ccbLinked: TColorBox;
    ccbLinking: TColorBox;
    btnApplay: TButton;
    procedure FormCreate(Sender: TObject);
    procedure cbUseBGPictureClick(Sender: TObject);
    procedure sbBGPictureClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnApplayClick(Sender: TObject);
  private
    { Private declarations }
    FDocument: IHTMLDocument2;
  public
    { Public declarations }
    class function ShowForm(Document: IHTMLDocument2): Boolean;
  end;

implementation

uses
  AppComm;

{$R *.DFM}

class function TDocumentPropertyForm.ShowForm(Document: IHTMLDocument2): Boolean;
var
  i: Integer;

begin
  if not Assigned(Document) then Exit;
  with TDocumentPropertyForm.Create(nil) do
  begin
    try
      FDocument := Document;
      ShowMessage(ColorToString(HtmlToColor(FDocument.fgColor)));
{      ccbBG.ColorValue := HtmlToColor(FDocument.bgColor);
      ccbText.ColorValue := HtmlToColor(FDocument.fgColor);
      ccbLink.ColorValue := HtmlToColor(FDocument.linkColor);
      ccbLinked.ColorValue := HtmlToColor(FDocument.vlinkColor);
      ccbLinking.ColorValue := HtmlToColor(FDocument.alinkColor);}
      edtBGPicture.Text := Document.body.getAttribute('background', Integer(True));
      if edtBGPicture.Text <> '' then
        cbUseBGPicture.Checked := True;
      ShowModal;
    finally
      Free;
    end;
  end;
end;

procedure TDocumentPropertyForm.FormCreate(Sender: TObject);
var
  FontStrings: TStrings;
  c: TColor;
begin
  try
    FontStrings := GetSystemFont;
    cbProportionFont.Items := FontStrings;
    cbFixedFont.Items := FontStrings;
  finally
    FontStrings.Free;
  end;
  ccbBG.Items.Insert(0, '默认');
  ccbBG.Items.Objects[0] := TObject(clWhite);
  ccbText.Items.Insert(0, '默认');
  ccbLink.Items.Insert(0, '默认');
  ccbLink.Items.Objects[0] := TObject(clBlue);
  ccbLinked.Items.Insert(0, '默认');
  ccbLinked.Items.Objects[0] := TObject(clPurple);
  ccbLinking.Items.Insert(0, '默认');
  ccbLinking.Items.Objects[0] := TObject(clRed);
  ccbBG.ItemIndex := 0;
  ccbText.ItemIndex := 0;
  ccbLink.ItemIndex := 0;
  ccbLinked.ItemIndex := 0;
  ccbLinking.ItemIndex := 0;
end;

procedure TDocumentPropertyForm.cbUseBGPictureClick(Sender: TObject);
begin
  edtBGPicture.Enabled := cbUseBGPicture.Checked;
  sbBGPicture.Enabled := edtBGPicture.Enabled;
  if edtBGPicture.Enabled then
    edtBGPicture.Color := clWindow
  else
    edtBGPicture.Color := clBtnFace;
end;

procedure TDocumentPropertyForm.sbBGPictureClick(Sender: TObject);
begin
  with TOpenPictureDialog.Create(self) do
  begin
    try
      FileName := edtBGPicture.Text;
      if Execute then edtBGPicture.Text := FileName;
    finally
      Free;
    end;
  end;
end;

procedure TDocumentPropertyForm.Button1Click(Sender: TObject);
begin
  btnApplayClick(Sender);
end;

procedure TDocumentPropertyForm.btnApplayClick(Sender: TObject);
begin
  if not cbUseBGPicture.Checked then edtBGPicture.Text := '';
  FDocument.bgColor :=    ColorToHtml(ccbBG.Selected);
  FDocument.fgColor :=    ColorToHtml(ccbText.Selected);
  FDocument.LinkColor :=  ColorToHtml(ccbLink.Selected);
  FDocument.aLinkColor := ColorToHtml(ccbLinked.Selected);
  FDocument.vLinkColor := ColorToHtml(ccbLinking.Selected);
  FDocument.body.setAttribute('background', edtBGPicture.Text, Integer(True));
end;

end.