AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit Vererbung

Ein Thema von xZise · begonnen am 1. Okt 2007 · letzter Beitrag vom 3. Okt 2007
 
Benutzerbild von xZise
xZise

Registriert seit: 3. Mär 2006
Ort: Waldbronn
4.303 Beiträge
 
Delphi 2009 Professional
 
#16

Re: Problem mit Vererbung

  Alt 2. Okt 2007, 22:08
Okay hier mal der Code Ich habe unwichtiges soweit ein bisschen entfernt.
Der aufruf (s.o.) erfolg weiterhin mit:
<TTabs>.Add(<TExplorer/TMemoTab>.Create(<PageControl>, <Pfad/Dateiname>)) Hier ist die Unit! Aber mit TntControls.
TSheets ist ein Nachfahre von TabSheet mit ein paar Komponenten drauf.
Ich hoffe mal das reicht
Delphi-Quellcode:
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.
Fabian
Eigentlich hat MS Windows ab Vista den Hang zur Selbstzerstörung abgewöhnt – mkinzler
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:57 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz