Delphi Tips
>> Index
● 05/17 HTMLタグ表記の大文字・小文字変換を行う
● 09/20 エクスプローラのように、アプリケーションにブラウザページをつくりたい。
● 09/19 簡易アプリケーション間通信
● 09/17 起動中のブラウザからURLを取得する/ブラウザにURLをセットする方法
● 09/09 TWebBrowser を使って HTML の描画イメージを取得する
● 09/09 サブネットマスク値など TCP/IP 関連パラメータを取得する
● 09/09 UDP 通信で NoParam ???
● 09/01 RichEditでHTMLタグを色・書式付き表示をする
● 02/08 ダイヤルアップネットワークで設定されている接続先を取得する
最終更新： 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] <WWW> <文字列> <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関連> <WWW> <ShellApi> <Windows>
0268 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成： 1999/09/19 K.Takaoka rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新： 1999/09/19 K.Takaoka 編集
簡易アプリケーション間通信
Win32 環境で 2 つのアプリケーションがお互いに通信する方法は非常に多くあります.
同じコンピュータ上の 2 つのフォーム(ウィンドウ)の間で簡単に通信を行うには WM_COPYDATA というメッセージを使うという方法があります.
これは、2 つのフォームが同じアプリケーションであっても違うアプリケーションであっても問題ありません.
WM_COPYDATA を利用するには, 相手の WindowHandle が分かっている必要があります. Form1 の WindowHandle は Form1.Handle で取得できます.
画面内にあるフォーム(ウィンドウ)の検索は FindWindow API を用いて行うことができます.
ここでは相手の WindowHandle の得方については言及しません.
受信側では TForm1 のインターフェス部にメッセージハンドラを追加します. private でかまわないでしょう.
private
procedure WMCopyData(var msg: TWMCopyData);
message WM_COPYDATA;
送信側では、CopyDataStruct 構造体に送信するデータを格納してから、WM_COPYDATA を送信します.
procedure TForm1.Button1Click(Sender: TObject);
var
buf: PChar;
i: Integer;
cd: TCopyDataStruct;
begin
cd.dwData := SIGNATURE_STRING;
cd.cbData := Length(Memo1.Lines.Text)+1;
cd.lpData := StrAlloc(cd.cbData);
try
StrCopy(cd.lpData, PChar(Memo1.Lines.Text));
SendMessage(Handle, WM_COPYDATA, WPARAM(Handle), LPARAM(@cd));
finally
StrDispose(cd.lpData);
end;
end;
この例では, Memo1 の内容を自分自身に送信しています.
このメッセージの受信側実装は
procedure TForm1.WMCopyData(var msg: TWMCopyData);
var
i: Integer;
buf: PChar;
begin
if msg.CopyDataStruct.dwData=SIGNATURE_STRING then
begin
buf := StrALloc(msg.CopyDataStruct.cbData);
try
StrCopy(buf, msg.CopyDataStruct.lpData);
Memo2.Lines.Text := buf;
finally
StrDispose(buf);
end;
end
else
inherited;
end;
このような感じになります. この例では受信した文字列を Memo2 に設定しています.
受信した CopyDataStruct の内容は読み出し専用になっていますので注意してください.
双方で使われている SIGNATURE_STRING は適当な DWORD 値を指定します.たとえば
cosnt SIGNATURE_STRING: DWORD = $00000001;
のような値でも良いでしょう, 重要なのは送信側と受信側で同じ値を使うことです.
CopyDataStruct には 3 つの要素 dwData と cbData と lpData があります.
lpData に目的のデータを格納し cbData には lpData に保持されたデータのバイト数を格納します.
dwData は独立して利用できますが, 一般的には lpData の内容を示すユニークな値を格納しておきます.
参照： [Delphi-ML:4527] [Tips:90]
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関連> <WWW> <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] <WWW>
0245 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 編集
サブネットマスク値など TCP/IP 関連パラメータを取得する
>ネットワークコンピュータに設定されているTCP/IPのアドレスは
>gethostbynameで取得できると思いますが、サブネットマスクの
>アドレスはどうやって取得すればよいのでしょうか。
こういうことは MS で検索しましょう。
http://support.microsoft.com/support/
で WindowsNT workStation を SUBNETMASK で検索すると
http://support.microsoft.com/support/kb/articles/q120/6/42.asp?FR=0
が見つかります。
TCP/IP 関連パラメータの格納場所が公開されています。
参照： [Delphi-ML:33813]
0244 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 編集
UDP 通信で NoParam ???
Ｑ：
UDPで受信するコードを書こうとしています。
ヘルプで調べてみたのですが、以下のNoParamの部分が分かりません。
procedure TForm1.UDP1DataArrival(Sender: TObject; bytesTotal: Integer);
begin
UDP1.GetData(data, NoParam); //データを取得する
Memo1.Lines.Append(data); //表示を追加する
end;
Ａ：
function NoParam: Variant;
begin
TVarData(Result).VType := varError;
TVarData(Result).VError:= DISP_E_PARAMNOTFOUND;
end;
わかりにくいのですが、一応載っています。「パラメータの省略」というページです。
参照： [Delphi-ML:33778]
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] <WWW> <Win95> <コンポーネント >
0124 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成： 1999/02/08 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新： 1999/02/08 osamu 編集
ダイヤルアップネットワークで設定されている接続先を取得する
> ダイヤルアップネットワークで設定されている複数の接続先を
> すべて取得して、選択した接続先に接続するには
> どうすればよいのでしょうか？
http://www.kh.rim.or.jp/~maruoka/Builder/TIPS/tips14.html
に説明があります、参考にしてください。
参照： [builder:6282]
[新規作成] [最新の情報に更新]
How To
Lounge
KeyWords
Osamu Takeuchi osamu@big.or.jp
Tips
Delphi
Home
