Delphi Tips　
-----------------------------

キーワード：WWW

>> Index

● 05/17 HTMLタグ表記の大文字・小文字変換を行う
● 09/20 エクスプローラのように、アプリケーションにブラウザページをつくりたい。
● 09/17 起動中のブラウザからURLを取得する/ブラウザにURLをセットする方法
● 09/09 TWebBrowser を使って HTML の描画イメージを取得する
● 09/01 RichEditでHTMLタグを色・書式付き表示をする

最終更新： 8224 日前

0326  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 2002/05/17 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 2002/05/17 osamu 編集
HTMLタグ表記の大文字・小文字変換を行う

コードはSJISを仮定します。

HTMLのコメント部分、""などで囲まれたパラメータ部分などは変換しません。

速度を気にするのであれば IsDBCSLeadByte は避けるべきです。自分で文字テーブルを作れば速くなります。ByteType の方は最適化されていたと思います。通常の用途では速度が気になることは無いかもしれませんね。

function ChangeHTMLTagCase(s:string; Lower:Boolean):string;
const
    sNormal   = 0;
    sInComment= 1;
    sInBracket= 2;
    sInQuote  = 3;
    sInDQuote = 4;
    sAfterEq  = 5;
var
  p: PChar;
  state: Integer;
begin
  state:= 0;
  Result:= s;
  UniqueString(Result);
  p:= PChar(Result);
  while p^<>#0 do begin
    if IsDBCSLeadByte(Ord(p^)) and ((p+1)^<>#0) then begin
      Inc(p, 2);
    end else begin
      case state of
      sNormal:
        if p^='<' then
          if StrLComp(p, '<!--', 4)=0
            then state:= sInComment
            else state:= sInBracket;
      sInComment:
        if p^='-' then
          if StrLComp(p, '-->', 3)=0 then
            state:= sNormal;
      sInBracket:
        case p^ of
        '''': state:= sInQuote;
        '"':  state:= sInDQuote;
        '=':  state:= sAfterEq;
        '>':  state:= sNormal;
        'A'..'Z': if Lower     then p^:= Chr(Ord(p^)+32);
        'a'..'z': if not Lower then p^:= Chr(Ord(p^)-32);
        end;
      sInQuote:
        case p^ of
        '''': state:= sInBracket;
        end;
      sInDQuote:
        case p^ of
        '"':  state:= sInBracket;
        end;
      sAfterEq:
        case p^ of
        '''': state:= sInQuote;
        '"':  state:= sInDQuote;
        ' ':  state:= sInBracket;
        '>':  state:= sNormal;
        end;
      end;
      Inc(p);
    end;
  end;
end;
参照： [Delphi-ML:66840] <文字列> <通信> <PASCAL>

0266  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/09/19 西坂良幸 rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/20 西坂良幸 編集
エクスプローラのように、アプリケーションにブラウザページをつくりたい。

本来なら、DelphiにあるHRMLコンポーネント等を使うんでしょうが、これも、D4まででは、結局AktiveXなので、オフィス９７をお持ちの方は、Ｗｅｂブラウザコントロール(WebBrowser)を使うととても簡単です。

これは、オフィス９７のCD-ROM
 \VALUPACK\ACCESS\WEBHELP\Webrowse.hlpに
Web ブラウザ コントロールとして、詳しい解説があります。
この実体は、Shdocvw.dll というＤＬＬファイルです。

メニューで[コンポーネント|ActiveXコントロールの取り込み］を開いて下さい。
ダイアログのリストに、Microsoft Internet Contorols(version 1.??) というのがあります。
無かったら、Windows\Systemディレクトリの、Shdocvw.dllを探して追加して下さい。
クラス名の欄に、TWebBrowser_V1、TWebBrowser と表示されたら、インストール実行で、パレットのActiveXページにコンポーネントがインストールされます。

ページ切り替えは省略しますが、
フォームにこのコンポーネントを貼り付け、Alignを決めます。

procedure TForm1.FormShow(Sender: TObject);
begin
  WebBrowser1.GoHome;
end;
とすれば、Web表示が出来上がりです。

URLを指定するときは、Navigate、やNavigate2 メソッドを使います

たとえば、URLがファイル（*.htm）なら、

procedure TForm1.Button1Click(Sender: TObject);
var
 url: WideString;
 flg,Tmp: OleVariant;
begin
  if OpenDialog1.Execute then
  begin
    url := OpenDialog1.FileName;
    flg := 0;
    WebBrowser1.Navigate(url, flg, Tmp, Tmp, Tmp);
  end;
end;

メソッドや、プロパティの詳細は、上記のヘルプファイルを見て下さい。
264番のインターネットエクスプローラオブジェクトと似通っているようです。
参照： [Delphi-ML:25232] [Delphi-ML:37104] <その他Windows関連> <ShellApi> <Windows> <通信>

0044  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/02/08 osamu rev 1.5
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/17 おばＱ 編集
起動中のブラウザからURLを取得する/ブラウザにURLをセットする方法

DDE を用いれば、ブラウザが現在表示している URL を取得したり、逆に URL をブラウザにセットすることができます。

Form1 に DdeClientConv1 を配置し、ConnectMode プロパティを ddeManual にします。

type  TBrowserType = (btIE, btNN);
const BrowserServices : array [TBrowserType] of string =
                ('Iexplore', 'netscape');

を用意して、

function TForm1.GetBrowserURL(BrowserType: TBrowserType): string;
var
  ServiceStr, TopicStr, ItemStr, UrlStr: String;
  UrlPch: PChar;
begin
  ServiceStr := BrowserServices[BrowserType];
  TopicStr   := 'WWW_GetWindowInfo';
  UrlStr     := '';

  with DdeClientConv1 do
  begin
    if SetLink(ServiceStr, TopicStr) then
      if OpenLink then
      begin
        ItemStr:= '0xFFFFFFFF';
        UrlPch := RequestData(ItemStr);
        UrlStr := UrlPch;
        StrDispose(UrlPch)
        CloseLink;
      end;
  end; {with}

  Result := copy( UrlStr, 2, Pos('",',UrlStr) - 2);
end;

GetBrowserURL(btIE) とすると起動中のインターネットエクスプローラの URL を文字列として取得出来ます。btNN とするとネットスケープから URL を取得します。
ブラウザは起動しておいてください。

URL をセットするには以下の関数を使います。

function TForm1.SetBrowserURL(BrowserType: TBrowserType; UrlStr: String): Boolean;
var
  ServiceStr, TopicStr: String;
  Pch: PChar;
begin
  Result := false;

  ServiceStr := BrowserServices[BrowserType];
  TopicStr   := 'WWW_OpenURL';

  with DdeClientConv1 do
  begin
    if SetLink(ServiceStr, TopicStr) then
      if OpenLink then
      begin
        Pch := RequestData( PChar(UrlStr) );
        CloseLink;
        StrDispose(Pch);
        Result := true; {成功すれば戻り値がTrue}
      end;
  end; {with}
end;

IE の場合は起動中のブラウザ画面にセットされた URL のページが表示されます。NN の場合は新しく Window を開いてページを表示するようです。
参照： [Delphi-ML:42589] [Delphi-ML:42621] <その他Windows関連> <Windows> <通信>

0247  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/09/09 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/09 osamu 編集
TWebBrowser を使って HTML の描画イメージを取得する

WebBrowser1.ControlInterface.Width と 同.Height を保存し、ページのサイズにして OleDraw の後で復元したところ、イメージが取得できました。

IWebBrowser の Width, Height は表示しているコントロールの Width/Height にイコールであるため、TWebBrowser(TOleContainer)の大きさが可変であることが必要なのがちょっと困者ですが、なんとかなった、、、ことにします。

  web: TWebBrowser;

var
  bmp: TBitmap;
  body: OleVariant;
  w, h: Integer;
begin
  body := (Web.Document as IHTMLDocument2).Body;

  bmp := TBitmap.Create;
  try
    // 軽くマージンをつけておかないとスクロールバーがついちゃいます。
    bmp.Width  := body.scrollWidth  + 16;
    bmp.Height := body.scrollHeight + 16;

    (* ここで WindowLock(Web.Handle) すべきでしょうか？
       CPU などの性能によってはチラつきそうです。       *)

    // 現在値を保存してリサイズします。
    w := Web.ControllInterface.Width;
    h := Web.ControllInterface.Height;
    Web.ControllInterface.Width  := bmp.Width;
    Web.ControllInterface.Height := bmp.Height;

    // 描画します。
    OleDraw(Web.ControllInterface, DVASPECT_DOCPRINT, bmp.Canvas.Handle,
            Rect(0, 0, bmp.Width, bmp.Height));

    // 元の大きさに戻します。
    Web.ControllInterface.Width  := w;
    Web.ControllInterface.Height := h;

    (* ここで WindowLock() してるなら戻す *)
    (* ここでいろいろ bmp を使って遊べます *)

  finally
    bmp.Free;
  end;
end;

一応、上記のようなかんじなのですが、dislable なスクロールバーがつくものの、全体をイメージにできました。scrollbar の幅と高さを GetSystemMetrics などで手にいれてカットすれば okay っぽいのですが、常に scrollbar がついているか…など検証が必要そうです。

＃ IWebBrowser 関連を操作して、強制的に消せましたっけ？
参照： [Delphi-ML:33701] <通信>

0216  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/08/25 おばＱ rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/01 おばＱ 編集
RichEditでHTMLタグを色・書式付き表示をする

HTMLソースを表示する時タグだけ色分けや書式付きで表示されると便利です。
以下のソースを入力して、RichEditにHTMLソースを表示させて
ボタンを押すと、なかなか高速にタグだけに色がつきます。
テキストを検索してSelAttributesで色付けしてもいいのですが、
あまりにも遅いのでほとんどAPIを使います。

タグを入力してリアルタイムに色をつけることは少々ムズカシそうだったので
実装していません。こちらと組み合わせてみるのもよいでしょう。
そちらの方法は、自分で考えてね(^^;;;

//関数部
procedure RichEditHTMLTagPickUp(RichEdit: TRichEdit; TagColor: TColor);
    function ColorToStringHex(Value: TColor): string;
    begin
      Result := '$00' + IntToHex(ColorToRGB(Value),6)
    end;
var
  mask: Longint;
  CFmt: TCharFormat;
  Str: String;
  PTop, PPos, PEnd, PNext: PChar;
  CR: TCharRange;
begin
  try
    RichEdit.Lines.BeginUpdate;//高速化、１

    mask := SendMessage(RichEdit.Handle, EM_GETEVENTMASK, 0, 0);//高速化、２
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, 0);
    with RichEdit do
    begin
        SelStart := length(Text);//高速化、３
        Perform(EM_SCROLLCARET, 0, 0);

        case 1 of
          0:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_BOLD;
            CFmt.dwEffects := CFE_BOLD;
          end;
          1:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_COLOR;
            CFmt.crTextColor := ColorToRGB(TagColor);
          end;
        end;

        Str := RichEdit.Text;
        PTop := PChar(Str);
        PPos := PTop;

        while (AnsiStrScan(PPos, '<') <> nil) do//高速化、４
        begin
          PPos := AnsiStrScan(PPos, '<');
          PEnd := PPos;
          while (AnsiStrScan(PEnd +1 , '>') <> nil) do
          begin
            PNext := AnsiStrScan(PEnd +1 , '>');
            PEnd := PNext +1;
              while (PEnd = PChar(#13)) or (PEnd = PChar(#10)) do
                Inc(PEnd);
              if PEnd <> PChar('<') then Break;
          end;
          CR.cpMin := PPos - PTop;
          CR.cpMax := PEnd - PTop;
          RichEdit.Perform(EM_EXSETSEL, 0, lParam(@CR));
          RichEdit.Perform(EM_SETCHARFORMAT, 1, lParam(@CFmt));//書式決定
          PPos := PEnd;
        end;
    end;
  finally
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, mask);//高速化、２終
    RichEdit.Lines.EndUpdate;//高速化、１終
  end;
end;

//実装部
procedure TForm1.Button2Click(Sender: TObject);
begin
  RichEditHTMLTagPickUp(RichEdit1, Form1.Color);
end;

注意：タグが綺麗に閉じられていないと無限ループに
　　　はまってしまう事が考えられます。気をつけてください

内部でcase文に1を設定している所があります。
ここを0にしますとHTMLタグがBold属性になります。
1の場合ですとForm1.Colorになります。
適当に書きなおしてください。

RichEditのUndoバッファは影響を受けますので注意です。

元々はC++BuilderMLでのC++Builder用のTipsでしたが、
Delphiに書き換えました。
MLのC++BuilderでのサンプルソースはMLを参照してください。
Delphi版とほぼ同じ内容です。
参照： [builder:8463] <通信> <Win95> <コンポーネント >

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords
Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp