お知らせ

電子会議

ライブラリ

FDelphi サイト全文検索

Delphi FAQ一覧

サンプル蔵



FDelphi FAQ
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編纂委員会