tabset控件的使用问题吗?(200分)

  • 主题发起人 主题发起人 牛刀小试
  • 开始时间 开始时间

牛刀小试

Unregistered / Unconfirmed
GUEST, unregistred user!
我按照《Delphi 2.0高级程序设计指南》教程编写一文件管理程序,
其中filemana是主程序,fileext1是子程序(窗体)。
filemana程序部分如下:
unit filemana;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls;

type
TFileManager = class(TForm)
MainMenu1: TMainMenu;
Panel1: TPanel;
Panel2: TPanel;
FileWIndowsHelp1: TMenuItem;
WIndows: TMenuItem;
FileWIndowsHelp2: TMenuItem;
NewWindows1: TMenuItem;
Tile1: TMenuItem;
Cascade1: TMenuItem;
ArrangeIcon1: TMenuItem;
MinimizedAll1: TMenuItem;
exit1: TMenuItem;
procedure MinimizedAll1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FileManager: TFileManager;

implementation

uses fileext1;

{$R *.DFM}

var
ExitClick: Boolean;

procedure TFileManager.MinimizedAll1Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to MDIChildCount - 1 do
MDIChildren.Windowstate := wsMinimized;
end;

end.

fileext1程序部分如下:
unit fileext1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Tabs, Menus, ExtCtrls, FileCtrl, StdCtrls;

type
TFMForm = class(TForm)
DriveTabSet: TTabSet;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
Floppy: TImage;
Fixed: TImage;
Network: TImage;
MainMenu1: TMainMenu;
File1: TMenuItem;
Function1: TMenuItem;
Directory1: TMenuItem;
open1: TMenuItem;
exit1: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DriveTabSetClick(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
procedure DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
procedure open1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FMForm: TFMForm;

implementation

uses filemana, fmxutils;

{$R *.DFM}

var
ExitClick: Boolean;

procedure TFMForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := CaFree;
end;

procedure TFMForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
If (FileManager.MDIChildCount <= 1) and (Not ExitClick) then
CanClose := False;
end;

procedure TFMForm.Exit1Click(Sender: TObject);
begin
ExitClick := True;
FileMana.Exit1Click(Sender);
end;

procedure TFMForm.FormCreate(Sender: TObject);
var
Drive, AddedIndex: Integer;
DriveLetter: Char;
begin
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('a'));
case GetDrivetype(Pchar(DriveLetter)) of
DRIVE_REMOVABLE:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);
DRIVE_FIXED:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);
DRIVE_REMOTE:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);
end;
if UpCase(DriveLetter) = UpCase(FileListbox1.Drive) then
DriveTabSet.TAbIndex := AddedIndex;
end;
end;

procedure TFMForm.DriveTabSetClick(Sender: TObject);
begin
With DriveTabSet do
DirectoryListBox1.Drive := Tabs[TabIndex][1];

end;

procedure TFMForm.DirectoryListBox1Change(Sender: TObject);
begin
FileListBox1.Directory := DirectoryListBox1.Directory;
FileListBox1.Update;
end;

procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
var
BitmapWidth: Integer;
begin
BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;
Inc(TabWidth, 2 + BitmapWidth);
end;

procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);
with TabCanvas do
begin
Draw(R.Left, R.Top + 4, Bitmap);
TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);
end;
end;

procedure TFMForm.open1Click(Sender: TObject);
begin
With FileListbox1 do
begin
if HasAttr(FileName,faDirectory) then
Directorylistbox1.Directory := FileName
else
ExecuteFile(FileName,' ' ,Directory,SW_SHOW);
end;
end;

end.
运行以上程序,系统显示project delp77.exe raised exception class exception with message 'tab index out of bouds'.
的提示信息,按F7继续执行到fileext1部分的for Drive := 0 to 25 do时,又显示
tab index out of bouds 的提示信息。
请问各位大侠这是什么原因,该如何解决?
 
改变如下过程:
procedure TFMForm.FormCreate(Sender: TObject);
var
Drive, AddedIndex: Integer;
DriveLetter: string;
begin
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('a')) + ':';
case GetDrivetype(Pchar(DriveLetter)) of
DRIVE_REMOVABLE:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);
DRIVE_FIXED:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);
DRIVE_REMOTE:
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);
end;
if UpCase(DriveLetter[1]) = UpCase(FileListbox1.Drive) then
DriveTabSet.TAbIndex := AddedIndex;
end;
end;

 
接受答案了.
 
后退
顶部