Delphi-Tips-1 (Delphiの情報) |
---|
'97-Jan-30th 初出
[A] インラインアセンブラで記述できます。
しかし、これはWindows95だけです。 NTではドライバを書かなければなりません。
{ 任意のポートからバイトデータを読む } function PortR( PortNo: word): byte; begin asm mov dx, PortNo cli in al, dx // 読み込み sti mov Result, al end; end; { 任意のポートへバイトデータを書き出す } procedure PortW( PortNo: word; value: byte); begin asm mov dx, PortNo mov al, value cli out dx, al // 書き出し sti end; end; { 任意のポートからバイトデータを読み、書き戻す } function PortRW( PortNo: word): byte; begin asm mov dx, PortNo cli in al, dx // 読み込み out dx, al // 再書き出し(読むだけで破壊されるポートのため) sti mov Result, al end; end;補足:('97-07-29)
[A] GetTempFileNameというAPIがあります。これを使えば、ユニークな名前を生成できます。
var Junk: array[0..144] of char; begin GetTempFileName('.', 'TMP', 0, @junk[0]); ShowMessage(StrPas(@junk[0])); end;
[A] 下の関数で行なえます。
{ 再帰的にSFN(Short File Name)をLFN(Long File Name)に変換する } function TMainForm.ExpandShortName(const ShortName: string): string; var FindData: TWin32FindData; Handle: THandle; Path, Tail: string; begin Path := ExtractFilePath(ShortName); Tail := ExtractFileName(ShortName); if Tail = '' then Result := ShortName else // ドライブ名だけの時 (例 D:\) begin if (Length(Path) > 0) and (Path[Length(Path)] = '\') then Delete(Path, Length(Path), 1); Path := ExpandShortName(Path); if (Length(Path) > 0) and (Path[Length(Path)] <> '\') then AppendStr(Path, '\'); Handle := FindFirstFile(PChar(Path + Tail), FindData); if Handle = Invalid_Handle_Value then Result := Path + Tail else // ファイルが無い時 try Result := Path + FindData.cFilename; finally Windows.FindClose(Handle); end; end; end; function TMainform.GetLongFileName(ShortName: string): string; begin if Copy(ShortName, 1, 2) = '\\' then Exit else Result := ExpandShortName(ExpandFileName(ShortName)); end;補足:('97-07-29)
[A] SDIアプリの様にいかないのは、Windowsの仕様です。下の様な方法で可能になります。
(1) 親フォームにVCLからImageを貼り付けます。
(2) メインのPrivate宣言のところに、以下の変数と手続きを加えます。
private { Private 宣言 } FClientInstance, FPrevClientProc: TFarProc; procedure ClientWndProc(var Message: TMessage);(3) 実現部分に手続きの処理を記述します。
procedure TMainForm.ClientWndProc(var Message: TMessage); var MyDC: hDC; Ro,Co: Word; begin with Message do begin if Msg = WM_ERASEBKGND then begin MyDC := TWMEraseBkGnd(Message).DC; for Ro := 0 to ClientHeight div Image1.Picture.Height do begin for Co := 0 to ClientWidth div Image1.Picture.Width do BitBlt( MyDC, Co * Image1.Picture.Width, Ro * Image1.Picture.Height, Image1.Picture.Width, Image1.Picture.Height, Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); end; Result := 1; Invalidate; // Delphi4ではこの行が無いと更新されません end else Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam); end; end;
[A] RichEditにはHideScrollBarsというプロパティがありますが、これをオフにすれば直ります。
ヘルプには、
とありますが、ScrollBars プロパティと密接な関係があり、
ScrollBarsプロパティをSsBothなどにした時は、
HideScrollBarsプロパティをoffに設定しておくことが必要です。
補足:(97-05-03)
この方法を使用しても縦方向にリサイズすると不具合が出ます。
対処には2つの方法があります。
(1)タイマーを使う
Interval = 50msec、Enabled = False に設定したタイマーを置き、
procedure TForm1.FormResize(Sender: TObject); begin Timer1.Enabled := True; end; procedure TForm1.Timer1Timer(Sender: TObject); begin RichEdit1.Refresh; Timer1.Enabled := False; end;とします。
(2)EM_SETRECTメッセージを使う
procedure TForm1.SetEditRect; var R: TRect; begin with RichEdit1 do begin R := Rect(0, 0, ClientWidth, ClientHeight); Perform(EM_SETRECT, 0, Longint(@R)); end; end; という手続きを用意して、Form の Paint と Resize イベント時に呼び出します。
補足(97-05-11)
一見、(2)の方がスマートなようですが、これもおかしくなる時があるようです。
ダサいけれども(1)が確実。
[A] 次の関数で可能です。また、逆のSJISからJISコードへの変換も載せます。
ついでに EUCとの変換も載せます。
{ JISコードをSJISコードに変換 } function JisToSJis(c0,c1: char): string; var v0: byte absolute c0; v1: byte absolute c1; begin if (v0>=$21) and (v0<=$7E) then begin if (v0 and 1) = 1 then begin if v1 < $60 then Inc(v1,$1F) else Inc(v1,$20); end else Inc(v1,$7E); if v0 < $5F then v0 := (v0 + $E1) shr 1 else v0 := (v0 + $161) shr 1; Result := c0 + c1; end else Result := ''; end; { SJISコードをJISコードに変換 } function SJisToJis(c0,c1: char): string; var v0: byte absolute c0; v1: byte absolute c1; begin Result := ''; if ((v0>=$81) and (v0<=$9F)) or ((v0>=$E0) and (v0<=$FC)) then begin if ((v1>=$40) and (v1<=$FC) and (v1<>$7F)) then begin if v0<=$9F then begin if v1<$9F then v0:=(v0 shl 1)-$E1 else v0:=(v0 shl 1)-$E0; end else begin if v1<$9F then v0:=(v0 shl 1)-$161 else v0:=(v0 shl 1)-$160; end; if (v1<$7F) then Dec(v1,$1F) else begin if (v1<$9F) then Dec(v1,$20) else Dec(v1,$7E); end; Result := C0 + c1; end; end; end; { EUCをSJISコードに変換 } function EucToSJis(c0,c1: char): string; var v0: byte absolute c0; v1: byte absolute c1; begin if (v0>=$A1) and (v0<=$FE) then begin if (v0 and 1) = 1 then begin if v1 < $E0 then Dec(v1,$61) else Dec(v1,$60); end else Dec(v1,2); if v0 < $DF then v0 := (v0 + $61) shr 1 else v0 := (v0 + $E1) shr 1; Result := c0 + c1; end else Result := ''; end; { SJISコードをEUCに変換 } function SJisToEuc(c0,c1: char): string; var v0: byte absolute c0; v1: byte absolute c1; begin Result := ''; if ((v0>=$81) and (v0<=$9F)) or ((v0>=$E0) and (v0<=$FC)) then begin if ((v1>=$40) and (v1<=$FC) and (v1<>$7F)) then begin if v0<=$9F then begin if v1<$9F then v0:=(v0 shl 1)-$E1 else v0:=(v0 shl 1)-$E0; end else begin if v1<$9F then v0:=(v0 shl 1)-$161 else v0:=(v0 shl 1)-$160; end; if (v1<$7F) then Dec(v1,$1F) else begin if (v1<$9F) then Dec(v1,$20) else Dec(v1,$7E); end; v0 := v0 or $80;// EUC は JISのMSBを1にしたものです。 v1 := v1 or $80; Result := C0 + c1; end; end; end;
[A] RichEditでの例を示します。OnKeyPressイベントの発生に対して、以下のようにします。
アプリケーション内での処理は、OnKeyPress→画面書き換え→OnKeyDownと進むので、
画面書き換え前に処理してやればいいのです。
(* キー押下 *) procedure TMainForm.RichEdit1KeyPress(Sender: TObject; var Key: Char); var CurrentLine : string; LineNo,Column: LongInt; i : integer; begin if Key = #13 then // CR begin with RichEdit1 do begin LineNo := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0); // 現在の行位置を求める Column := SelStart - SendMessage(Handle, EM_LINEINDEX, LineNo, 0); // 現在の桁位置を求める end; CurrentLine := RichEdit1.Lines[LineNo]; // 現在のキャレットのある行を取り込む if (Length(CurrentLine) > 0) and (Column > 0) then begin { space、TAB の数を数える } i := 0; while (CurrentLine[i+1] = #$20) or (CurrentLine[i+1] = #$09) do begin Inc(i); end; // 例えば5個のSPACEだけの行があり3桁目にキャレットがある場合に対応 if i > Column then i := Column; RichEdit1.SelText := #13 + #10 + Copy(CurrentLine, 1, i); // 現在のキャレットの位置に挿入 end else RichEdit1.SelText := #13 + #10; Key := #0; end; end;
[A] SystemParametersInfo
というAPIを使います。敷き詰めるにはレジストリを書き換えます。
また、オープンになっている仕様ではありませんが、
Windows95ではX方向、Y方向にオフセットつけて表示も可能です。 Windows98では効果がありません。
(* BMPファイルを壁紙にする *) procedure WChange(Sender: TObject; DrawFileName: string); const WPaperKey = '\Control Panel\desktop'; var Ss : string; Reg: TRegistry; begin if (UpperCase(ExtractFileExt(DrawFileName)) = '.BMP') then begin Reg := TRegistry.Create; try Reg.RootKey := HKey_Current_User; if not Reg.OpenKey(WPaperKey, False) then Exit else begin if TileCheckBox.Checked // 別途チェックボックスを用意しておく then Reg.WriteString('TileWallpaper', '1') // タイリング else Reg.WriteString('TileWallpaper', '0'); // 中央に表示 end; // オフセットをつける。 Reg.WriteString('WallPaperOriginX', IntToStr(SpinEdit1.Value)); // 別途SpinEditを用意しておく Reg.WriteString('WallPaperOriginY', IntToStr(SpinEdit2.Value)); finally Reg.Free; end; Ss := DrawFileName + #0; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, @Ss[1], SPIF_UPDATEINIFILE); end; end;
[A] GetDeviceCaps というAPIを使います。
下の例では、BITSPIXELという予約された値を与えて色解像度を調べてますが、
HORZSIZE、VERTSIZEという値を与えることにより、 画面の解像度も調べることができます。
(* ピクセルあたりの色のビット数を調べる *) var ColorPerPixel : integer; DC : HDC; begin DC := GetDC(handle); ColorPerPixel := GetDeviceCaps(DC, BITSPIXEL); ReleaseDC(handle, DC); end; 補足: 画面の縦、横のサイズを調べるだけならば、 Screen.Height Screen.Width の方が簡単です。
[A] すでにNetscapeが動いている時はそのWindowを目的のURLに変更し、
まだ動いていない時は新しくNetscapeを起動するような例を挙げます。
ただし、Delphi
Ver3.1のみ動作しません。Ver.3.0、Ver.4.0はOKです。
Netscape DDEのAPIの詳細は、 http://home.netscape.com/newsref/std/ddeapi.htmlで得られます。
(* Netscape 3/4のDDE機能を使う *) uses DDEMan; procedure GotoURL(sURL: string); var DDE : TDDEClientConv; begin DDE := TDDECLientConv.Create(nil); with DDE do begin ServiceApplication := 'c:\ns32\program\netscape.exe'; SetLink('Netscape', 'WWW_OpenURL'); RequestData(sURL + ',,0xFFFFFFFF,0x3,,,'); CloseLink; end; DDE.Free; end; また、Internet Explorer 4でも同様に以下のようにして可能となります。 (* Internet Explorer4のDDE機能を使う *) uses DDEMan; procedure GotoURL(sURL: string); var DDE : TDDEClientConv; begin DDE := TDDECLientConv.Create(nil); with DDE do begin ServiceApplication := 'c:\Program Files\Internet Explorer\Iexplore.exe'; SetLink('Iexplore', 'WWW_OpenURL'); RequestData(sURL + ',,0xFFFFFFFF,0x3,,,'); CloseLink; end; DDE.Free; end;
[A] SenMessage API ファンクションを使います。
(* デフォルトの Screen Saver を起動する *) begin SendMessage(GetDesktopWindow(), WM_SYSCOMMAND, SC_SCREENSAVE, 0); end;
[A] SendMessage API ファンクションで、EM_GETLINECOUNT メッセージを使います。
(* 総行数を調べる *) var TotalLine: integer; begin TotalLine := SendMessage(RichEdit1.Handle, EM_GETLINECOUNT, 0, 0); end;
[A] 以下の方法は、news:fj.lang.pascal に於いて、 比企さんが発表された方法です。
この方法には、Delphi
1も必要です。 なお、Delphi1を所有していない場合は、『Win32 APIのメッセージである
EM_FINDTEXTかEM_FINDTEXTEXを使えばできる。』という情報を得てますが、
私(CASA)は試していないので分かりません。
この情報の転載に快諾していただいた比企さんに感謝します。
1.Delphi1.0 の、Demos\Textdemo にある Search.pas を改造します。 なぜならば、 1.これは Memo 用である 2.スクロールしてくれない からです。 2.Uses 節を以下のように変更します。 uses Windows, Messages, SysUtils, StdCtrls, Dialogs, ComCtrls; 3.function SearchMemo(Memo: TCustomEdit; const SearchString: String; Options: TFindOptions): Boolean; 以下を次のように変更します。 function SearchMemo(Memo: TCustomEdit; const SearchString: String; Options: TFindOptions): Boolean; var Buffer, P: PChar; Size : Longint; // Wordでしたが、64kを越えるデータに対応のため変更(CASA) FindLine : integer; begin Result := False; if (Length(SearchString) = 0) then exit; Size := Memo.GetTextLen; if (Size = 0) then exit; Buffer := StrAlloc(Size + 1); try Memo.GetTextBuf(Buffer, Size + 1); P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString, Options); if P <> nil then begin with Memo do begin SelStart := P - Buffer; SelLength := Length(SearchString); FindLine := Perform(EM_LINEFROMCHAR, Selstart, 0); if frDown in Options then Perform(WM_VSCROLL, SB_LINEDOWN, FindLine) else Perform(WM_VSCROLL, SB_LINEUP, FindLine); end; Result := True; end; finally StrDispose(Buffer); end; end; 4.TCustomEdit を TRichEdit に置換します。 5.次に、Search.pasを呼び出す部分を手直しします。 Delphi1.0の \Demos\Textdemo の Main.pas の Find1click、Find、Replace1Click、 FindNextClick、Replace イベントの中のコードを丸写しします。 6.Memo1 のところを、実際に使用している RichEdit の Name に置換します。 7.RichEdit の HideSelection プロパティをFalseにします。 さらに、私が見つけた項目です。 1.Options設定を[検索する方向]を[上へ向って(U)]にし、 [単語単位で検索(W)]を選択すると、一番上の選択ワードまで検索したあと、 もう検索ワードが無いにもかかわらず、ハングアップしてしまいます。 簡単な対処方法は、 function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TFindOptions): PChar; の関数の中で、 while SearchCount >= 0 do の行を while SearchCount > 0 do に変更します。 2.以下は漢字などの2バイトコードに対応した場合にのみ必要な処理です。 2バイトコードを検索する場合、[大文字と小文字を区別する(C)]をチェックしていないと、 検索できないことがあります。 これは、このルーチンが Ansiキャラクタに特化したルーチンだからです。 2バイトコードに対応するには、 function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TFindOptions): PChar; var SearchCount, I: Integer; C : Char; Direction : Shortint; CharMap : array [Char] of Char; AnsiFlg : Boolean; // この行を追加する のようにフラグを設け、以下の追加・修正を行ないます。 { Using a Char map array is faster than calling AnsiUpper on every character } for C := Low(CharMap) to High(CharMap) do CharMap[C] := C; { 漢字が検索ワードかどうかチェック } AnsiFlg := True; // ^ for i := 1 to Length(SearchString) do // | この部分を追加 begin // | if SearchString[i] >= #$80 then AnsiFlg := false; // V end; { 大文字小文字をチェックしないならば } if not (frMatchCase in Options) and AnsiFlg then // 先のフラグも条件に加える begin // AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap)); // AnsiUpperBuff(@SearchString[1], Length(SearchString)); CharUpperBuff(PChar(@CharMap), sizeof(CharMap)); // ついでに32bits APIに変更 CharUpperBuff(@SearchString[1], Length(SearchString)); // ついでに32bits APIに変更 end; 3.また、[単語単位で検索(W)]を選択すると、漢字などの2バイトコードでうまくいきませんから、 漢字対応のアプリケーションの場合は、このOptionsの項目を使うのをあきらめます。 Search.pas を呼び出す部分で、FindDialogを実行する直前に、 FindDialog1.Options := [frHideWholeWord]; // この行を追加する FindDialog1.Execute; 4.次にこれがまた厄介なのですが、'b'(#$62)などの1文字だけを検索すると、 シフトJISの'臣'(#$90+#$62)もHitしてしまいます。 英語文化で育った人間が組んだプログラムですから仕方が無いけど、ちょっと愚痴りたくもなります。 で、小修正でしかもエレガントな解法は見つけてないのですが、 取りあえず、ラベルを使った汚い方法は見つけてあります。 先の、SearchMemoに追加します。 function SearchMemo(Memo: TRichEdit; const SearchString: String; Options: TFindOptions): Boolean; label // ラベルを導入 ReSearch; var Buffer, P: PChar; Size : Longint; FindLine : integer; begin Result := False; if (Length(SearchString) = 0) then Exit; Size := Memo.GetTextLen; if (Size = 0) then Exit; Buffer := StrAlloc(Size + 1); try Memo.GetTextBuf(Buffer, Size + 1); ReSearch: // ここにラベルを設定 P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString, Options); if P <> nil then begin with Memo do begin SelStart := P - Buffer; SelLength := Length(SearchString); FindLine := Perform(EM_LINEFROMCHAR, Selstart, 0); // MainForm.Caption := Buffer[Memo.SelStart] + Buffer[Memo.SelStart + 1]; デバグ用です。 { 以下を追加。1文字を検索し、バッファ先頭がAnsiコード以外なら・・・ } { ふつうならば、バッファの先頭には検索ワードの先頭と等しいコードとなるはずが、 } { なぜか、この時だけは、SJISの1バイト目が入ってます。 } if (Length(SearchString) = 1) and (Buffer[Memo.SelStart] > #$80) then begin if frDown in Options then SelStart := SelStart + 2 else SelStart := SelStart - 1; goto Research; end else if frDown in Options then Perform(WM_VSCROLL, SB_LINEDOWN, FindLine) else Perform(WM_VSCROLL, SB_LINEUP, FindLine); end; Result := True; end; finally StrDispose(Buffer); end; end; 長くなりましたが、以上で高機能な検索ルーチンがTRichEditで使えるようになります。
[A] 以下の方法は、 比企さんから直接頂いたものです。
この方法では、先に示したような2バイトコード対策がなされていませんので、
2バイトコード対応が必要な時には、先の情報を参考に改造してください。
なお、Delphi1はまだ販売中ですから、全ソースを掲載しておりませんので、ご了承ください。
この情報の転載に快諾していただいた比企さんに感謝します。
1.Uses 節を以下のように変更します。 uses Windows, Messages, SysUtils, StdCtrls, Dialogs; 2.TCustomEdit を TMemo に置換します。 3.Interface部に、MemoLinesShowingという新しい関数を宣言します。 function MemoLinesShowing(Memo: TMemo): integer; 4.implementation部に実際の動作を記述します。 { Memoの見えている行数を調べる } function MemoLinesShowing(Memo: TMemo: integer; var OldFont: HFont; { the old font } DC : THandle; { Device context handle } Tm : TTextMetric; { text metric structure } TheRect: TRect; begin DC := GetDC(Memo.Handle); { Get the memo's device context } try { Select the memo's font } OldFnt := SelectObject(DC, Memo.Font.Handle); try GetTextMetrics(DC, Tm); { Get the text metric info. } Memo.Perform(EM_GETRECT, 0, longint(@TheRect)); Result := (TheRect.Bottom - TheRect.Top) div (Tm.tmHeight + Tm.tmExternalLeading); finally SelectObject(DC, OldFont); { Select the old font } end; finally ReleaseDC(Memo.Handle, DC); { Release the device context } end; end; 5.function SearchMemo(Memo: TMemo; const SearchString: String; Options: TFindOptions): Boolean; 以下を次のように変更します。 function SearchMemo(Memo: TMemo; const SearchString: String; Options: TFindOptions): Boolean; var Buffer, P : PChar; Size : Word; SeeLines : integer; { 見えている行数 } TopLine,BotomLine: integer; FindLine : integer; Scrolling : integer; { スクロール行数 } begin Result := False; if (Length(SearchString) = 0) then exit; Size := Memo.GetTextLen; if (Size = 0) then exit; Buffer := StrAlloc(Size + 1); try Memo.GetTextBuf(Buffer, Size + 1); P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString, Options); if P <> nil then begin SeeLines := MemoLinesShowing(Memo); with Memo do begin TopLine := Perform(EM_GETFIRSTVISIBLELINE, 0, 0); SelStart := P - Buffer; SelLength := Length(SearchString); FindLine := Perform(EM_LINEFROMCHAR, Selstart, 0); BottomLine := TopLine + SeeLines; if (FindLine >= BottomLine) and (frDown in Options) then begin Scrolling := FindLine - TopLine - (SeeLines div 2); Perform(EM_LINESCROLL, 0, Scrolling); end if (FindLine <= TopLine) and not (frDown in Options) then begin Scrolling := FindLine - TopLine - (SeeLines div 2); Perform(EM_LINESCROLL, 0, Scrolling); end; end; Result := True; end; finally StrDispose(Buffer); end; end; 以上でスクロールを行なう高機能な検索ルーチンがTMemoで使えるようになります。
[A] Windows95にはGlobalAtomという、複数のプログラムから共有できるメモリエリアがあります。
詳細は、APIのオンラインマニュアルを見てください。
実際の例を述べます。
1.送り出し側(書き込み側)の記述例 const MessageIDStr = 'Original Program ID by Quebnoi Casa'; // 特異なメッセージを定める var s : string; MessageID: longint; Atom : TAtom; begin s := 'あぅ、これは送るテスト文字列さっ。'; MessageID := RegisterWindowMessage( MessageIDStr); Atom := GlobalAddAtom(@s[1]); // GlobalAtomに書き込む if Atom <> 0 then PostMessage(hwnd_Broadcast, MessageID, 1, Atom) // wParam=1にして、書いた事を通知 else ShowMessage('ATOM生成に失敗!'); end; 2.受け取り側(読み出し側)の記述例 2−1.Private宣言部にメッセージの受け皿を追加する。 private { Private 宣言 } : procedure AppMessage(var Msg: TMsg; var Handled: boolean); : 2−2.実装部のすぐ上に送り出し側と同じメッセージを宣言する。 : const MessageIDStr = 'Original Program ID by Quebnoi Casa'; // 送り出し側と同じメッセージ var MessageID: longint; implementation : 2−3.フォーム作成時の処理に、メッセージ受け取りのID取得と、メッセージを横取りする旨を、追加する。 procedure TMainForm.FormCreate(Sender: TObject); begin : MessageID := RegisterWindowMessage( MessageIDStr); Application.OnMessage := AppMessage; : end; 2−4.実際の処理を記述します。 procedure TMainForm.AppMessage(var Msg: TMsg; var Handled: boolean); var Exist : integer; Buffer: array[0..255] of Char; begin with Msg do begin if Message = MessageID then begin if wParam = 1 then // ATOM あり begin Exist := GlobalGetAtomName(lParam, Buffer, 255); // lParamはAtomを指す if Exist > 0 then begin GlobalDeleteAtom(lParam); // Atomを削除 ShowMessage(Buffer); : end; end; Handled := True; end; end; end; wParamをいろいろ変え、受信するアプリケーション側で動作を変えることもできます。
[A] TMemoryStreamは強力なクラスです。
DOSの時代は、64kbyteを越えてメモリの読み書きを行なうのに、
いちいち読み書きしたサイズや読み書きするポインタを管理しなければなりませんでした。
TMemoryStreamはこの作業をたいへん軽減してくれます。
ここでは、ファイルのテキストデータを大文字に加工してMemoryStreamに書き込み、 最後に、いっぺんにMemoに転送する例をあげます。
{ メモリオーバーフロー対策は行なっていません } var fi : TextFile; MemoryStream: TMemoryStream; c : Char; begin AssignFile(fi, 'c:\data\hogehoge.txt'); try Reset(fi); MemoryStream :=TMemoryStream.Create; // MemoryStreamの生成 while not Eof(fi) do begin Read(fi,c); c := UpCase(c); MemoryStream.Write(c, 1); // 1バイト書き込み end; MemoryStream.Seek(0, 0); // アクセス位置をストリームの先頭に Memo1.Lines.LoadFromStream(MemoryStream); // Memoに読み込む finally MemoryStream.Free; // MemoryStreamの破棄 CloseFile(fi); end; end; TmemoryStreamは、TStream→TCustomMemoryStreamから派生したクラスで、Seekメソッドの説明は TCustomMemoryStreamまたはTStreamにあります。
[A] 型変換を行なうのが正直な方法ですが、以下の方法でも行なえます。
type TLongintPart = record case Byte of 0: ( Long: Longint); 1: ( Word1, Word2: Word); 2: ( Byte1, Byte2, Byte3, Byte4: Byte); end; var MyPart: TLongintPart; begin MyPart.Long := $01234567; Label1.Caption := IntToStr(MyPart.Byte2); Label2.Caption := IntToStr(MyPart.Word2); end; 注意しなければならないのは、メモリ上の変数の並びは上位と下位がひっくり返っており、 Byte1 = $67 Byte2 = $45 Byte3 = $23 Byte4 = $01 Word1 = $4567 Word2 = $0123 Long = $01234567 となっていることです。
[A] VCLのAnimateコンポネントが使えます。 APIを使うならばファイルの移動・複写・削除の時にSHFileOperationというAPIを使います。
(* SHFileOperationを使う例 *) uses ShellAPI; var SFO: TSHFileOpStruct; Res: integer; begin with SFO do begin Wnd := Handle; wFunc := FO_COPY; // コピー pFrom := PChar('d:\data'#0#0); pTo := PChar('c:\temp'#0#0); fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR; fAnyOperationsAborted := False; hNameMapping := nil; end; try Res := SHFileOperation(SFO); finally end; end; 複数のファイルやフォルダを選ぶ場合は、 pFrom := PChar('d:\data'#0'd:\tool'#0#0); のように、#0(null)キャラクタを挿みます。 また、デスクトップのごみ箱に移動する場合は、 wFunc := FO_DELETE; を使います。
[A] できます。
C/S版、Delphi3.1 Professional版、Delphi4 +WebBroker for Delphi 4では、
CGI作成用のウィザードとコンポーネントが用意されていますので、 そちらを使う方がいいです。
これらを使わない場合でも可能です。
その場合標準入出力(STDIN/STDOUT)を使わなければなりませんので、 コンソールアプリケーションにします。
フォームは不要ですから、「メニュー→プロジェクト→プロジェクトから削除」を選び、 フォームを削除し、dprに以下の記述を行ないます。
program Project1; {$AppType Console} var aLine: string; begin Readln(aLine); // 標準入力から読み込む Writeln('content-type: text/html'); Writeln(''); // 空白行が必要です Writeln('<HTML>'); Writeln('<HEAD><TITLE>Delphi-TIPS</TITLE></HEAD>'); Writeln('<BODY TEXT="#104020" BGCOLOR="#EEEEEE" LINK="#0060F0" VLINK="#A02060" onLoad="return true;">'); : Writeln('</HTML>'); end;
[A] サンプルを見てください。
var UserName: array[0..127] of char; UserSize: integer; begin UserSize := 128; GetUserName(@UserName, UserSize); ShowMessage('User "' + StrPas(UserName) + '"'); end;
[A] TRichEditのバグ?。
MaxLengthプロパティが0
ならばコントロールに入力できる文字数は制限されません。
とヘルプにありますが、このプロパティをきちんとバイト単位で設定するか、以下のコードを追加してください。
RichEdit1.Perform(EM_LIMITTEXT, 0, 20000000); // 20MBまで可
[A] Delphiのアプリケーション内ではDragModeプロパティでやり取りできますが、
他のアプリケーションからDrag and
Dropするには、メッセージを処理します。
以下のコードはエクスプローラーからMemoへドラッグ&ドロップを可能にします。
uses ShellAPI; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := AppMessage; DragAcceptFiles( Form1.Handle, True); end; procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean); const BufferLength = 255; var DroppedFileName: string; begin if Msg.Message = WM_DROPFILES then begin SetLength( DroppedFileName, BufferLength); DragQueryFile(Msg.wParam, 0, PChar(DroppedFileName), BufferLength); Memo1.Lines.LoadFromFile( DroppedFileName); DragFinish(Msg.wParam); Handled := True; end; end;
[A] OnMinimizeイベントを使います。
しかし、Formで、
procedure TForm1.OnMinimize(Sender: TObject);としても処理できません。Applicationで検出します。
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private procedure AppMin(Sender: TObject); end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMinimize := AppMin; end; procedure TForm1.AppMin(Sender: TObject); begin ShowMessage('最小化検出成功'); end;
[A] 次のマジックナンバーを使うと、フォームのどこをクリックしても窓のドラッグできます。
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const SC_DragMove = $F012; begin ReleaseCapture; Perform(WM_SYSCOMMAND, SC_DragMove, 0); end;補足:(95-05-11)
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin ReleaseCapture; DefWindowProc( handle, WM_NCLBUTTONDOWN, HTCAPTION, X+Y*$10000); end; end;lParam の X+Y*$10000 は、0 でも構わないようです。
[A] KeyboardStateクラスがあります。
procedure TForm1.Button1Click(Sender: TObject); var KeyState: TKeyboardState; begin GetKeyboardState(KeyState); if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1 else KeyState[VK_NUMLOCK] := 0; SetKeyboardState(KeyState); end;VK_NUMLOCKの代わりにVK_CAPITALを使うとCaps Lockキーを制御できます。