unit uCode;
interface
uses
Windows, ComCtrls, SysUtils, Classes, Contnrs, uTabSheet, ShellAPI, Graphics,
Controls, TntIniFiles, TntStdCtrls, StdCtrls, TntComCtrls;
type
TData = (dFile, dDirectory);
TTabs =
class;
TTab =
class(TObject)
private
FSheet: TTabSheet;
FTabs : TTabs;
procedure SetSheet(
const Value: TTabSheet);
// virtual; abstract;
published
property Sheet : TTabSheet
read FSheet
write SetSheet;
property Tabs : TTabs
read FTabs;
public
//constructor Create(const APageControl : TPageControl);// virtual; abstract;
destructor Destroy;
override;
// virtual; abstract;
end;
TMemoTab =
class(TTab)
private
FFileName :
string;
FMemo : TTntMemo;
procedure SetMemo(
const Value: TTntMemo);
// procedure DblClick(Sender : TObject);
// procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
published
property FileName :
string read FFileName;
property Memo : TTntMemo
read FMemo
write SetMemo;
public
constructor Create(
const APageControl : TPageControl;
const AFileName :
string);
reintroduce;
destructor Destroy;
override;
end;
TExplorerTab =
class(TTab)
private
FImages : TImageList;
FExt : TStringList;
FSheet: TSheet;
FTabs : TTabs;
FPath :
string;
FData :
array of TData;
procedure DblClick(Sender : TObject);
procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SetSheet(
const Value: TSheet);
procedure GenerateView(
const AFilter :
string = '
*.*');
published
property Path :
string read FPath;
property Sheet : TSheet
read FSheet
write SetSheet;
property Tabs : TTabs
read FTabs;
public
procedure GoUp;
constructor Create(
const APageControl : TPageControl;
const APath :
string);
reintroduce;
destructor Destroy;
override;
end;
TTabs =
class(TObject)
private
FTabs : TObjectList;
FIcons : TIconList;
FFileToolBar: TToolBar;
FDirectoryToolBar: TToolBar;
function GetTab(idx: Integer): TTab;
procedure SetTab(idx: Integer;
const Value: TTab);
public
property Tab[idx : Integer] : TTab
read GetTab
write SetTab;
property FileToolBar : TToolBar
read FFileToolBar
write FFileToolBar;
property DirectoryToolBar : TToolBar
read FDirectoryToolBar
write FDirectoryToolBar;
procedure Add(ATab : TTab);
overload;
procedure Delete(
const AIndex : Integer);
constructor Create;
destructor Destroy;
override;
end;
implementation
uses ImgList, Consts, CommCtrl;
Procedure ConvertTo32BitImageList(
Const ImageList: TImageList);
Const
Mask:
Array[Boolean]
Of Longint = (0, ILC_MASK);
Var
TemporyImageList: TImageList;
Begin
If Assigned(ImageList)
Then
Begin
TemporyImageList := TImageList.Create(
Nil);
Try
TemporyImageList.Assign(ImageList);
With ImageList
Do
Begin
ImageList.Handle := ImageList_Create(Width, Height, ILC_COLOR32
Or Mask[Masked], 0, AllocBy);
If Not ImageList.HandleAllocated
Then
Begin
Raise EInvalidOperation.Create(SInvalidImageList);
End;
End;
ImageList.AddImages(TemporyImageList);
Finally
TemporyImageList.Free;
End;
End;
End;
function GetFileIcon(
const FileName:
string;
const Icon: TIcon;
const FileMustExist: Boolean): Boolean;
var
FI: TSHFileInfo;
Attributes: DWORD;
Flags: Word;
begin
if FileMustExist
then
begin
Attributes := 0;
Flags := SHGFI_ICON
or SHGFI_LARGEICON;
end
else
begin
Attributes := FILE_ATTRIBUTE_NORMAL;
Flags := SHGFI_USEFILEATTRIBUTES
or SHGFI_ICON
or SHGFI_LARGEICON;
end;
if SHGetFileInfo(PChar(FileName), Attributes, FI, SizeOf(FI), Flags) <> 0
then
begin
Icon.ReleaseHandle;
Icon.Handle := FI.hIcon;
Result := True;
end
else
Result := False;
end;
function GetIconFromFile(FileName:
string;
Index: Integer): Ticon;
begin
Result := TIcon.Create;
Result.Handle := ExtractIcon(HInstance, PCHAR(FileName),
Index);
end;
function GetIconFromFile2(
const Path:
String): TIcon;
var
KommaPos, Len, IconNumber: Integer;
begin
Len := Length(Path);
KommaPos := LastDelimiter('
,', Path);
IconNumber := StrToInt(copy(Path,KommaPos + 1, Len));
Result := GetIconFromFile(Copy(Path, 1, KommaPos - 1), IconNumber);
end;
function GetLastFolder(
const APath :
string) :
string;
var
i, start: Integer;
begin
if APath[Length(APath)] = '
\'
then
start := 1
else
start := 0;
for i := Length(APath) - start
downto 1
do
begin
if APath[i] <> '
\'
then
Result := APath[i] + Result
else
break;
end;
end;
{ TExplorerTab }
constructor TExplorerTab.Create(
const APageControl: TPageControl;
const APath :
string);
begin
inherited Create;
FSheet := TSheet.Create(APageControl);
FSheet.Caption := GetLastFolder(APath);
FPath := APath;
// Icons einlesen
FImages := TImageList.Create(APageControl);
FImages.Width := 32;
FImages.Height := 32;
ConvertTo32BitImageList(FImages);
FExt := TStringList.Create;
FExt.Add('
folder');
FImages.AddIcon(GetIconFromFile('
%SystemRoot%\system32\SHELL32.dll', 3));
FSheet.lvListView.LargeImages := FImages;
FSheet.lvListView.OnDblClick := DblClick;
FSheet.lvListView.OnMouseUp := MouseUp;
GenerateView;
end;
procedure TExplorerTab.DblClick(Sender: TObject);
begin
// Beep;
if FData[FSheet.lvListView.ItemIndex] = dDirectory
then
begin
FPath := FPath + FSheet.lvListView.Selected.Caption + '
\';
FSheet.Caption := GetLastFolder(FPath);
GenerateView;
end;
end;
destructor TExplorerTab.Destroy;
begin
FreeAndNil(FImages);
FreeAndNil(FExt);
inherited;
end;
procedure TExplorerTab.GenerateView(
const AFilter :
string);
begin
{...}
end;
procedure TExplorerTab.GoUp;
begin
{...}
end;
procedure TExplorerTab.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{...}
end;
procedure TExplorerTab.SetSheet(
const Value: TSheet);
begin
FSheet := Value;
end;
{ TTabs }
procedure TTabs.Add(ATab: TTab);
begin
FTabs.Add(ATab);
ATab.FTabs := self;
end;
constructor TTabs.Create;
begin
inherited;
FTabs := TObjectList.Create;
FIcons := TIconList.Create;
end;
procedure TTabs.Delete(
const AIndex: Integer);
begin
if AIndex >= 0
then
FTabs.Delete(AIndex);
end;
destructor TTabs.Destroy;
begin
FreeAndNil(FTabs);
inherited;
end;
function TTabs.GetTab(idx: Integer): TTab;
begin
if idx >= 0
then
Result := TTab(FTabs[idx])
else
Result :=
nil;
end;
procedure TTabs.SetTab(idx: Integer;
const Value: TTab);
begin
FTabs[idx] := Value;
end;
{ TMemoTab }
constructor TMemoTab.Create(
const APageControl: TPageControl;
const AFileName:
string);
begin
inherited Create;
FSheet := TTabSheet.Create(APageControl.Owner);
FSheet.PageControl := APageControl;
FSheet.Caption := ExtractFileName(AFileName);
FMemo := TTntMemo.Create(APageControl.Owner);
FMemo.Parent := FSheet;
FMemo.Align := alClient;
FMemo.ScrollBars := ssBoth;
FMemo.WordWrap := false;
FMemo.Lines.LoadFromFile(AFileName);
end;
destructor TMemoTab.Destroy;
begin
FreeAndNil(FMemo);
inherited;
end;
procedure TMemoTab.SetMemo(
const Value: TTntMemo);
begin
FMemo := Value;
end;
{ TTab }
destructor TTab.Destroy;
begin
FreeAndNil(FSheet);
inherited;
end;
procedure TTab.SetSheet(
const Value: TTabSheet);
begin
FSheet := Value;
end;
end.