お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"ファイル以外に Readln, Writelnを使いたい"

この発言に対し以下のコメントが寄せられています
#01409 ぜえた さん RE:ファイル以外に Readln, Writelnを使い

 こんにちは、ぜえた です。 ファイルや標準入出力には Readlnや Writelnといった便利なプロシージャが 使えますが、文字列や TStringsオブジェクトには使えません。 しかし、Object Pascalではユーザが独自のテキストファイルデバイスドライ バを定義できるので、これを利用することによって、どのようなオブジェクト に対しても Readlnといったプロシージャが利用できるようになります。 ここでは文字列に対しての実装例を示します。Printersユニットにはプリンタ 、「Insade Delphi」(アスキー出版局)には TStringsオブジェクトに対しての 実装が載っています。 詳しくは「Object Pascal言語リファレンス」を参照してください。 //使用例 procedure TForm1.Button1Click(Sender: TObject); var F: TextFile; N1, N2, N3: Integer; begin AssignString(F, ' 123 456 789'); Reset(F); Read(F, N1, N2, N3); CloseFile(F); AssignString(F, ''); Rewrite(F); Write(F, N3, N2, N1); Caption := GetString(F); CloseFile(F); end; // StrDev ユニット unit StrDev; interface uses SysUtils; procedure AssignString(var F: TextFile; const S: string); function GetString(const F: TextFile): string; implementation type PUserData = ^TUserData; TUserData = record TextStr: string; StrPos: Integer; end; function GetString(const F: TextFile): string; begin Result := PUserData(@TTextRec(F).UserData)^.TextStr; end; function StrIgnore(var F: TTextRec): Integer; begin Result := 0; end; function StrIn(var F: TTextRec): Integer; var Len: Integer; begin with F, PUserData(@UserData)^ do begin Len := Length(TextStr); BufEnd := BufSize; if StrPos + BufEnd > Len then BufEnd := Len - StrPos; Move(TextStr[StrPos+1], BufPtr^, BufEnd); Inc(StrPos, BufEnd); BufPos := 0; end; Result := 0; end; function StrOut(var F: TTextRec): Integer; var Len: Integer; begin with F, PUserData(@UserData)^ do begin Len := Length(TextStr); BufEnd := BufPos; if StrPos + BufEnd > Len then SetLength(TextStr, StrPos + BufEnd); Move(BufPtr^, TextStr[StrPos+1], BufEnd); Inc(StrPos, BufEnd); BufPos := 0; end; Result := 0; end; function StrClose(var F: TTextRec): Integer; begin Finalize(PUserData(@TTextRec(F).UserData)^); Result := 0; end; function StrOpen(var F: TTextRec): Integer; begin with F, PUserData(@UserData)^ do begin BufPos := 0; BufEnd := 0; case Mode of fmInput: begin InOutFunc := @StrIn; FlushFunc := @StrIgnore; CloseFunc := @StrClose; StrPos := 0; end; fmOutput: begin InOutFunc := @StrOut; FlushFunc := @StrOut; CloseFunc := @StrClose; StrPos := 0; end; fmInOut: begin Mode := fmOutput; InOutFunc := @StrOut; FlushFunc := @StrOut; CloseFunc := @StrClose; StrPos := Length(TextStr); end; else Result := 1; Exit; end; end; Result := 0; end; procedure AssignString(var F: Text; const S: string); begin FillChar(F, SizeOf(TTextRec), 0); with TTextRec(F) do begin Handle := -1; Mode := fmClosed; BufSize := SizeOf(Buffer); BufPtr := @Buffer; OpenFunc := @StrOpen; Initialize(PUserData(@UserData)^); PUserData(@UserData)^.TextStr := S; end; end; end. ぜえた (QZC05100)  Original document by ぜえた 氏 ID:(QZC05100)



ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum