uhtmlmessage.pas

自己写的一个 RSS 阅读器

unit uHTMLMessage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, JvExStdCtrls, JvHtControls;

type
  TfmHTMLMessage = class(TForm)
    CheckBox1: TCheckBox;
    BtnOK: TButton;
    HTMLabel: TJvHTLabel;
    procedure BtnOKClick(Sender: TObject);
    procedure HTMLabelHyperLinkClick(Sender: TObject; LinkName: String);
  private
    { Private declarations }
  public
  end;
var
  fmHTMLMessage: TfmHTMLMessage;
procedure HTMLMessage(Title:string;Str:String;ShowChechBox:Boolean = True);
implementation

{$R *.dfm}

uses FastStrings,comm;

procedure HTMLMessage(Title: string;Str:String;ShowChechBox:Boolean = True);
begin
  Application.CreateForm(TfmHTMLMessage, fmHTMLMessage);
  with fmHTMLMessage do
  begin
    Str:=FastReplace(Str,'\n','<BR>');
    Caption:=Title;
    HTMLabel.Caption:=Str;
    if HTMLabel.Width>700 then
      HTMLabel.Width:=700;

    Width:=HTMLabel.Width+30;
    Height:=HTMLabel.Height+82;
    HTMLabel.Top:=8;
    HTMLabel.Left:=ClientWidth-HTMLabel.Width-8;
    if Width<300 then
      Width:=300;
    BtnOK.Top:=ClientHeight-32;

    CheckBox1.Top:=ClientHeight-26;
    BtnOK.Caption:=TranslateStr('Dialog',9000);
    CheckBox1.Caption:=TranslateStr('Dialog',9004);

    if not ShowChechBox then
    begin
       btnOk.Left:=TRUNC(Width/2) - 40;//不显示 CheckBox 时 按钮居中
       CheckBox1.Visible:=False;
    end
    else
      btnOk.Left:=Width-92;
      
    ShowModal;
  end;    // with
end;

procedure TfmHTMLMessage.BtnOKClick(Sender: TObject);
begin
  Close;
end;

procedure TfmHTMLMessage.HTMLabelHyperLinkClick(Sender: TObject;
  LinkName: String);
begin
  if Copy(LinkName,0,7)='RCMD://' then
    ShowMessage('你点击的超链接调用 程序内部命令:'+Copy(LinkName,8,Length(LinkName)-7))
  {else
    OpenNewBrowserWindow(self.Handle, true,
                       0, 'open', Trim(LinkName), '', '', SW_SHOW);
    //不需要以上过程,HTMLLabel会自动打开正常的链接
  }
end;

end.