|
15番会議室「FAQ編纂委員会」に寄せられた「よくある質問の答え」
[Q]
Delphi2.0J の DirectoryOutline を用いて、FDエラー回避のファイル/ディ
レクトリー選択を行うにはどうすればいいですか?
[A]
DirectoryOutline には、利用する上でいくつかの不備な点があり、まず、そ
れらをソースで修正し、新たに得られた Diroutln.dcu を、ディフォルトの、
\Program Files\Borland\Delphi 2.0\LIB にオーバーライト、さらにコンポ
ーネントライブラリの再構築をしておきます。[関連事項]をご覧下さい。
さて、
>[FAQ][D2]FileListBox等のI/Oエラー回避
に準じた動作を実現したいわけですが、ユーザーズガイドのファイルマネー
ジャの例にあるように、ドライブをTabSetで選択できるようにします。
[例]
{------ここから Form1 ユニット---------------------------------------
ユーザーズガイドにあるように、フォームにはTabSet1と、ドライブのTImage
を配置。FileListBoxとDirectoryOutlineは動的に生成}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Tabs, FileCtrl, Grids, Outline,
DirOutln;
type
TArrFileListBox=array[1..2] of TFileListBox;
TArrDirectoryOutline=array[1..2] of TDirectoryOutline;
TForm1 = class(TForm)
(..略..)
private
{ Private 宣言 }
fTabS,
gTabS: integer; {カラントタフ゛index}
DirectoryOutline
: TArrDirectoryOutline;{DirectoryOutline[]も動的に作成}
FileListBox
: TArrFileListBox; {FileListBox[]は動的に作成}
gDBox, {GlobalなDirectoryOutline番号}
gFBox: integer; {GlobalなFileListBox番号}
sDir: string;
(..メソッド略..)
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
(..略..)
{単にドライブ番号が無効かどうかだけ知らせる。A:以上は 0 以上に対応}
function DriveState(iDrive: integer): boolean;
(..略..)
function OtherBox(iBox: integer): integer;
{iBox=1: 2; =2: 1}
(..略..)
function GetNearHD(iDrive: integer): integer;
(*ドライブ番号iDrive(カレント=0; 1以上が'A'以上に相当)
以外の、iDriveに近いハードディスクドライブを求める。
戻り値はドライブ番号1以上*)
(..略..)
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
cDrive: char;
begin
{FileListBox[] 動的生成}
gDBox:=1; gFBox:=1;
GetDir(0,sDir);
ChDir(sDir);
gTabS:=ord(UpCase(sDir[1]))-ord('A');
CreateFileListBox(gFBox);
Application.OnException:=AppExcept;
for i:=0 to 25 do begin
cDrive:=char(i+ord('a'));
case GetDriveType(PChar(cDrive+':\')) of
DRIVE_REMOVABLE:
TabSet1.Tabs.AddObject(cDrive,Floppy.Picture.Graphic);
DRIVE_FIXED:
TabSet1.Tabs.AddObject(cDrive,Fixed.Picture.Graphic);
DRIVE_REMOTE:
TabSet1.Tabs.AddObject(cDrive,Network.Picture.Graphic);
DRIVE_CDROM:
TabSet1.Tabs.AddObject(cDrive,CDROM.Picture.Graphic);
DRIVE_RAMDISK:
TabSet1.Tabs.AddObject(cDrive,RAMDRIVE.Picture.Graphic);
end; {case}
end; {next i}
ChDir(sDir);
CreateDirectoryOutline(sDir,gDBox);
end;
procedure TForm1.TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
(..ユーザーズガイドに同じ..略..)
procedure TForm1.TabSet1MeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
(..ユーザーズガイドに同じ..略..)
{TabSet表示更新}
procedure TForm1.UpdateDrive(
okTabS: integer; var badTabS: integer);
begin
TabSet1.TabIndex:=okTabS;
gTabS:=okTabS;
GetDir(gTabS+1,sDir);
ChDir(sDir);
DirectoryOutline[gDBox].Directory:=sDir;
badTabS:=okTabS;
end; {UpdateDrive}
procedure TForm1.ToNearHDRestore;
var
aTabS: Integer;
begin
aTabS:=gTabS;
gTabS:=GetNearHD(aTabS+1)-1;
UpdateDrive(gTabS,fTabS);
UpdateDrive(aTabS,fTabS);
end;
{DirectoryOutline[iBox]生成}
procedure TForm1.CreateDirectoryOutline(Dir: string; iBox: integer);
var
i: integer;
cDrive: char;
begin
ChDir(Dir);
DirectoryOutline[iBox]:=TDirectoryOutline.Create(Form1);
with DirectoryOutline[iBox] do begin
Parent:=Self;
Name:='DirectoryOutline'+IntToStr(iBox);
Setbounds(200,30,170,130); {1例です}
OnChange:=DirectoryOutline1Changed;
OnKeyPress:=DirectoryOutline1KeyPressed; {展開不備に対応するための}
OnDblClick:=DirectoryOutline1DblClicked; {メソッドへアタッチ}
end;
TabSet1.TabIndex:=gTabS;
fTabS:=gTabS;
end; {CreateDirectoryOutline}
{FileListBox[] 動的生成}
procedure TForm1.CreateFileListBox(iBox: integer);
例:Setbounds(25,30,170,130);
>[FAQ][D2]FileListBox等のI/Oエラー回避、に同じ
procedure TForm1.DirectoryOutline1Changed(Sender: TObject);
begin
FileListBox[gFBox].Directory:=DirectoryOutline[gDBox].Directory;
end;
procedure TForm1.RenewDirFileBox(Dir: string;
okTabS: integer; var badTabS: integer);
{DirectoryOutline[]、FileListBox[]の破棄・生成}
var
jDBox,jFBox: integer;
begin
jDBox:=OtherBox(gDBox);
jFBox:=OtherBox(gFBox);
TabSet1.TabIndex:=okTabS;
gTabS:=okTabS;
DirectoryOutline[gDBox].OnChange:=nil;
FileListBox[gFBox].Directory:='';
DirectoryOutline[gDBox].Directory:='';
ChDir(Dir);
CreateFileListBox(jFBox); {新規のFileListBox作成}
CreateDirectoryOutLine(Dir,jDBox);
FileListBox[gFBox].Free; {使えなくなった古いのは廃棄}
DirectoryOutline[gDBox].Free;
gDBox:=jDBox; gFBox:=jFBox;
badTabS:=okTabS;
end; {RenewDirFileBox}
{FileListBox[]の破棄・生成}
procedure TForm1.RenewFileListBox(
okTabS: integer; var badTabS: integer);
var
jFBox: integer;
begin
jFBox:=OtherBox(gFBox);
CreateFileListBox(jFBox); {先に新規のFileListBox作成}
TabSet1.TabIndex:=okTabS;
FileListBox[gFBox].Free; {使えなくなった古いのは廃棄}
gFBox:=jFBox;
badTabS:=okTabS;
end; {RenewFileListBox}
procedure TForm1.AppExcept(Sender: TObject; E: Exception);
var
cDrive: Char;
ErrMes: String;
begin
if E is EInOutError then begin
if EInOutError(E).ErrorCode in
[2, {ファイルが見つかりません-同ドライブ表示更新の場合}
5, {ファイルアクセスが拒否された:(*E1)}
21] {ドライブの準備ができていない:(*E2)}
then begin
if ((fTabS=gTabS) and DriveState(gTabS))
then begin
sDir:=chr(ord('A')+gTabS)+':\';
RenewDirFileBox(sDir,gTabS,fTabS);
end else if (DriveState(gTabS) and (not DriveState(fTabS)))
then begin
sDir:=chr(ord('A')+gTabS)+':\';
RenewFileListBox(gTabS,fTabS);
DirectoryOutline[gDBox].Drive:=sDir[1];
end;
end;
end;
end; {AppExcept}
procedure TForm1.TabSet1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
aTabS: integer;
aDrive,gDrive,fDrive: char;
ErrMes: String;
begin
with TabSet1 do begin
gTabS:=TabIndex;
if (fTabS=gTabS) and DriveState(gTabS)
then begin
FileListBox[gFBox].Update;
DirectoryOutline[gDBox].Update;
ToNearHDRestore;
end else if DriveState(fTabS) and
(not DriveState(gTabS)) then begin
aDrive:=Chr(ord('A')+gTabS);
ErrMes:=aDrive+':ドライブの準備ができていません...';
ShowMessage(ErrMes);
UpdateDrive(fTabS,gTabS);
end else if (not DriveState(fTabS)) and
(not DriveState(gTabS)) then begin
{FDにはもはやアクセスできない}
aTabS:=gTabS;
fDrive:=Chr(ord('A')+fTabS);
aDrive:=Chr(ord('A')+gTabS);
gTabS:=GetNearHD(aTabS+1)-1;
gDrive:=Chr(ord('A')+gTabS);
ShowMessage(UpCase(aDrive)+':ドライブ、'+UpCase(fDrive)+
':ドライブには'#13+'アクセスできませんので'#13+
gDrive+':ドライブを表示します...');
GetDir(gTabS+1,sDir);
RenewFileListBox(gTabS,fTabS);
ToNearHDRestore;
end else begin
GetDir(gTabS+1,sDir);
ChDir(sDir);
DirectoryOutline[gDBox].Directory:=sDir;
fTabS:=gTabS;
end;
end; {with}
end; {TabSet1MouseUp}
procedure TForm1.FormDestroy(Sender: TObject);
begin
FileListBox[gFBox].Free;
DirectoryOutline[gDBox].Free;
end;
procedure TForm1.FullyExpand;
procedure TForm1.DirectoryOutline1DblClicked(Sender: TObject);
procedure TForm1.DirectoryOutline1KeyPressed(Sender: TObject; var Key: Char);
(..以上3メソッド..略..)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum FDELPHIに寄せられる質問の中から、よくある質問への回答を FDELPHIのメンバーがまとめたものです。 したがって、これらの回答はボーランド株式会社がサポートする公式のものではなく、掲示されている内容についての問い合わせは受けられない場合があります。
Copyright 1996-1998 Delphi Users' ForumFAQ編纂委員会
|