Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Problem mit Vererbung (https://www.delphipraxis.net/100628-problem-mit-vererbung.html)

xZise 1. Okt 2007 17:20


Problem mit Vererbung
 
Ich wollte folgende Grundkronstruktion verwenden:
Delphi-Quellcode:
TTab = class(TObject)
private
  FSheet: TTabSheet;
  FTabs : TTabs;

  procedure SetSheet(const Value: TTabSheet);
published
  property Sheet : TTabSheet read FSheet write SetSheet;
  property Tabs : TTabs read FTabs;
public
  constructor Create(const APageControl : TPageControl);
  destructor Destroy;
end;
Nun soll es davon 2 verschiedene Tabtypen geben:
Delphi-Quellcode:
TMemoTab = class(TTab)

end;

TExplorerTab = class(TTab)

end;
Funktioniert soweit.
Nun habe ich auch eine Liste:
Delphi-Quellcode:
TTabs = class(TObject)
private
  FTabs : TObjectList;
end;
Nun soll TTab keine Funktionen haben.
Also habe ich alle Funktionen als "virtual; abstract;" bezeichnet.

Wenn ich nun der Tabliste ein Tab hinzufüge mit folgender Funktion:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FTabs := self;
end;
Dann gibt es dort einen Abstrakten Fehler.

Wenn ich nun die nicht als abstrakt bezeichne und "Quasileerfunktionen" einsetze, dann habe ich das Problem in der Add-Funktion, ATab nicht mehr "aktuell" ist.
Folgender Aufruf (Tabs : TTabs):
Delphi-Quellcode:
Tabs.Add(TExplorerTab.Create(pcTabs, CreatePath(Node)));
Alles wunderbar... Jedenfalls scheint es so.
Wenn ich jetzt in der Add-Methode die Caption des TabSheets ändere, dann hat es keine Auswirkungen:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FSheet.Caption := 'BOM!';
  // Oder auch so (Die Add-Methode darüber wird entfernt):
  (FTabs.Items[FTabs.Add(ATab)] as TTab).FSheet.Caption := 'BOM!';

  ATab.FTabs := self;
end;
Wo liegt nun der Fehler?
Wenn ihr noch Informationen braucht, dann sagt bitte welche, damit ich die nachliefern kann :)

MfG
xZise

PS: Die TTabs Klasse:
Delphi-Quellcode:
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(const ATab : TTab);
  procedure Delete(const AIndex : Integer);

  constructor Create;
  destructor Destroy; override;
end;

shmia 1. Okt 2007 18:13

Re: Problem mit Vererbung
 
Zitat:

Zitat von xZise
Nun habe ich auch eine Liste:
Delphi-Quellcode:
TTabs = class(TObject)
private
  FTabs : array of TTab;
end;

Das ist keine Liste. Nimm doch TObjectList aus Unit contnrs!

Progman 1. Okt 2007 18:30

Re: Problem mit Vererbung
 
außerdem hats du in TTab bereits FTabs deklariert, vielleicht kommt da was durcheinander?

xZise 1. Okt 2007 20:33

Re: Problem mit Vererbung
 
Zitat:

Zitat von shmia
Zitat:

Zitat von xZise
Nun habe ich auch eine Liste:
Delphi-Quellcode:
TTabs = class(TObject)
private
  FTabs : array of TTab;
end;

Das ist keine Liste. Nimm doch TObjectList aus Unit contnrs!

OOPs ^^ Nein ;) Es ist ja gerade eine ObjectListe :)

Zitat:

Zitat von Progman
außerdem hats du in TTab bereits FTabs deklariert, vielleicht kommt da was durcheinander?

Genau dieses FTabs will ich haben ;)
Damit der Tab nachher "weis" in welcher Liste der gehört, um selber für die Tabliste Tabs zu erzeugen.

Hier ist nochmal TTabs ^^
Delphi-Quellcode:
TTabs = class(TObject)
private
  FTabs : TObjectList;
  FIcons : TIconList; // wird nicht verwendet
  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(const ATab : TTab);
  procedure Delete(const AIndex : Integer);

  constructor Create;
  destructor Destroy; override;
end;

Muetze1 2. Okt 2007 10:21

Re: Problem mit Vererbung
 
Zitat:

Zitat von xZise
Wenn ich nun der Tabliste ein Tab hinzufüge mit folgender Funktion:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FTabs := self;
end;
Dann gibt es dort einen Abstrakten Fehler.

Nur, wenn du eine TTab Instanz übergibst anstatt z.B. einer TExplorerTab Instanz.

Zitat:

Zitat von xZise
Wenn ich nun die nicht als abstrakt bezeichne und "Quasileerfunktionen" einsetze, dann habe ich das Problem in der Add-Funktion, ATab nicht mehr "aktuell" ist.
Folgender Aufruf (Tabs : TTabs):
Delphi-Quellcode:
Tabs.Add(TExplorerTab.Create(pcTabs, CreatePath(Node)));
Alles wunderbar... Jedenfalls scheint es so.
Wenn ich jetzt in der Add-Methode die Caption des TabSheets ändere, dann hat es keine Auswirkungen:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FSheet.Caption := 'BOM!';
  // Oder auch so (Die Add-Methode darüber wird entfernt):
  (FTabs.Items[FTabs.Add(ATab)] as TTab).FSheet.Caption := 'BOM!';

  ATab.FTabs := self;
end;

Wird denn im Constructor von TTab auch ordentlich FSheet entsprechend belegt mit auch der Instanz wo du die Caption Änderung erwartest?

Das vergessene Override beim Destruktor hast du ja nun schon ergänzt...

xZise 2. Okt 2007 13:56

Re: Problem mit Vererbung
 
Hi,
Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Wenn ich nun der Tabliste ein Tab hinzufüge mit folgender Funktion:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FTabs := self;
end;
Dann gibt es dort einen Abstrakten Fehler.

Nur, wenn du eine TTab Instanz übergibst anstatt z.B. einer TExplorerTab Instanz.

Aber warum funktioniert das denn nicht? TExplorerTab ist do ein Nachfahre von TTab? Müsste ich also die Funktio überladen?
Weil bei TStrings funktionierts ja auch :)
Delphi-Quellcode:
var
  sl : TStrings;
begin
  {...}
  sl := TStringList.Create;
  ini.ReadSections(sl);
  {...}
end;
Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Wenn ich nun die nicht als abstrakt bezeichne und "Quasileerfunktionen" einsetze, dann habe ich das Problem in der Add-Funktion, ATab nicht mehr "aktuell" ist.
Folgender Aufruf (Tabs : TTabs):
Delphi-Quellcode:
Tabs.Add(TExplorerTab.Create(pcTabs, CreatePath(Node)));
Alles wunderbar... Jedenfalls scheint es so.
Wenn ich jetzt in der Add-Methode die Caption des TabSheets ändere, dann hat es keine Auswirkungen:
Delphi-Quellcode:
procedure TTabs.Add(const ATab: TTab);
begin
  FTabs.Add(ATab);
  ATab.FSheet.Caption := 'BOM!';
  // Oder auch so (Die Add-Methode darüber wird entfernt):
  (FTabs.Items[FTabs.Add(ATab)] as TTab).FSheet.Caption := 'BOM!';

  ATab.FTabs := self;
end;

Wird denn im Constructor von TTab auch ordentlich FSheet entsprechend belegt mit auch der Instanz wo du die Caption Änderung erwartest?

Nein, aber der Konstruktor von TExplorer/MemoTab, welche ich ja ausschließlich übergebe.

Zitat:

Zitat von Muetze1
Das vergessene Override beim Destruktor hast du ja nun schon ergänzt...

Selbst wenn würde es keinen Fehler verursachen, da Explizit nirgends .Free aufgerufen wird.

MfG
xZise

Muetze1 2. Okt 2007 15:04

Re: Problem mit Vererbung
 
Zitat:

Zitat von xZise
Aber warum funktioniert das denn nicht? TExplorerTab ist do ein Nachfahre von TTab? Müsste ich also die Funktio überladen?

Die Exception wird geschmissen, wenn es auch nur eine noch abstracte Methode in der Klasse gibt. Also: hast du wirklich alle abstracte Methoden überschrieben (und implementiert)?

Zitat:

Zitat von xZise
Nein, aber der Konstruktor von TExplorer/MemoTab, welche ich ja ausschließlich übergebe.

Wenn du eine AV bekommst, dann schau im Debugger nach, was den nil ist. Also ob fSheet wirklich assigned ist etc. Auch kannst du bei unklarer Gesamtlage mit Debug-DCUs dein Projekt neu erstellen und dann in die VCL debuggen um zu schauen wo die Exception herkommt.

Zitat:

Zitat von xZise
Selbst wenn würde es keinen Fehler verursachen, da Explizit nirgends .Free aufgerufen wird.

Kein Fehler, nur (ein) Speicherleck(s)...

xZise 2. Okt 2007 15:11

Re: Problem mit Vererbung
 
Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Aber warum funktioniert das denn nicht? TExplorerTab ist do ein Nachfahre von TTab? Müsste ich also die Funktio überladen?

Die Exception wird geschmissen, wenn es auch nur eine noch abstracte Methode in der Klasse gibt. Also: hast du wirklich alle abstracte Methoden überschrieben (und implementiert)?

Das Hauptproblem ist selbst ohne abstrakten Methoden funktioniert das nicht :) Oder müssen die nun abstrakt sein, damit er auch die richtige Methode aufruft?

Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Nein, aber der Konstruktor von TExplorer/MemoTab, welche ich ja ausschließlich übergebe.

Wenn du eine AV bekommst, dann schau im Debugger nach, was den nil ist. Also ob fSheet wirklich assigned ist etc. Auch kannst du bei unklarer Gesamtlage mit Debug-DCUs dein Projekt neu erstellen und dann in die VCL debuggen um zu schauen wo die Exception herkommt.

Laut Debugger ist in der AddFunktion "FSheets" und ehm "FTabs" nil

Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Selbst wenn würde es keinen Fehler verursachen, da Explizit nirgends .Free aufgerufen wird.

Kein Fehler, nur (ein) Speicherleck(s)...

Achso :) Naja die Speicherlecks kann man nur beheben, wenn es funktioniert xD

So ! Ich habe jetzt TTab komplett "deabstrahiert" xD und die Add Methode überladen (mit TMemoTab und TExplorerTab)
So funktionierts, aber das war nicht der Zweck des Vererben :)

MfG
xZise

Muetze1 2. Okt 2007 15:20

Re: Problem mit Vererbung
 
Zitat:

Zitat von xZise
Das Hauptproblem ist selbst ohne abstrakten Methoden funktioniert das nicht :) Oder müssen die nun abstrakt sein, damit er auch die richtige Methode aufruft?

Was bedeutet dabei nun "funktioniert nicht"? Wenn ich wieder auf die alte Aussage schliesse (abstrakter Fehler), dann kann dies in dem Falle nicht mehr sein.

Zitat:

Zitat von xZise
Laut Debugger ist in der AddFunktion "FSheets" und ehm "FTabs" nil

Dann wird nicht der richtige Constructor aufgerufen. Somit ist die Frage von inherited etc. gegeben. Schonmal den Konstruktoraufruf im Add() debuggt? Wenn du in die Zeile mit F7 hineinstoperst, dann solltest du durch den entsprechenden Konstruktor (nach dem die Ermittlung der Parameter abgehandelt wurde) kommen, welcher dann nach deinem Quellcode und Aussagen doch eigentlich FSheets und FTabs initialisiert. Wenn dem nicht so ist, dann ist das nicht der Constructor. (wobei ich die Konstruktoren von den beiden abgeleiteten Klassen nicht kenne)

Zitat:

Zitat von xZise
So ! Ich habe jetzt TTab komplett "deabstrahiert" xD und die Add Methode überladen (mit TMemoTab und TExplorerTab)
So funktionierts, aber das war nicht der Zweck des Vererben :)

Das ist auch nicht das gewollte und dein vorgestelltes Konzept klappt auch 100%ig so wie du es vorhast. Es ist ein anderes Problem. Diese Lösung musst du nicht weiter verfolgen/benutzen.

r2c2 2. Okt 2007 15:28

Re: Problem mit Vererbung
 
Meine Glaskugel meint, es könnten n paar override; fehlen...

mfg

Christian

Muetze1 2. Okt 2007 16:41

Re: Problem mit Vererbung
 
Zitat:

Zitat von r2c2
Meine Glaskugel meint, es könnten n paar override; fehlen...

Wenn dem so ist, dann sollte xZise aber arglistig Compilerhinweise verschwiegen haben.

xZise 2. Okt 2007 18:45

Re: Problem mit Vererbung
 
Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Das Hauptproblem ist selbst ohne abstrakten Methoden funktioniert das nicht :) Oder müssen die nun abstrakt sein, damit er auch die richtige Methode aufruft?

Was bedeutet dabei nun "funktioniert nicht"? Wenn ich wieder auf die alte Aussage schliesse (abstrakter Fehler), dann kann dies in dem Falle nicht mehr sein.

Es wird nicht das korrekte Objekt übergeben.
Der abstrakte Fehler erscheint dann, wenn ich das alles als abstrakt deklariere nicht :)

Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Laut Debugger ist in der AddFunktion "FSheets" und ehm "FTabs" nil

Dann wird nicht der richtige Constructor aufgerufen. Somit ist die Frage von inherited etc. gegeben. Schonmal den Konstruktoraufruf im Add() debuggt? Wenn du in die Zeile mit F7 hineinstoperst, dann solltest du durch den entsprechenden Konstruktor (nach dem die Ermittlung der Parameter abgehandelt wurde) kommen, welcher dann nach deinem Quellcode und Aussagen doch eigentlich FSheets und FTabs initialisiert. Wenn dem nicht so ist, dann ist das nicht der Constructor. (wobei ich die Konstruktoren von den beiden abgeleiteten Klassen nicht kenne)

Also ich habe das einfach nochmal komplett durchgebuggt:

Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
So ! Ich habe jetzt TTab komplett "deabstrahiert" xD und die Add Methode überladen (mit TMemoTab und TExplorerTab)
So funktionierts, aber das war nicht der Zweck des Vererben :)

Das ist auch nicht das gewollte und dein vorgestelltes Konzept klappt auch 100%ig so wie du es vorhast. Es ist ein anderes Problem. Diese Lösung musst du nicht weiter verfolgen/benutzen.

:)

Hier ist der Konstruktor von TExplorerTab (ich spare mir mal TMemoTab): (Aufgrund von inherited auch von TTab)
Delphi-Quellcode:
constructor TExplorerTab.Create(const APageControl: TPageControl; const APath : string);
begin
  inherited Create(APageControl);
  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;

constructor TTab.Create(const APageControl: TPageControl);
begin
  inherited Create;
end;
Zitat:

Zitat von Muetze1
Zitat:

Zitat von r2c2
Meine Glaskugel meint, es könnten n paar override; fehlen...

Wenn dem so ist, dann sollte xZise aber arglistig Compilerhinweise verschwiegen haben.

Dem ist nicht so :)

Muetze1 2. Okt 2007 19:10

Re: Problem mit Vererbung
 
Wozu bekommt der Konstruktor von TTab ein TPageControl übergeben, wenn er nichts damit macht? Auch TExplorerTab macht nichts damit als es nur weiter zu reichen.

Zitat:

Zitat von xZise
Also ich habe das einfach nochmal komplett durchgebuggt:

Und was ist dabei rausgekommen? Ist er in den Konstruktor von TExplorerTab reingesprungen? Hat er alles wie gewünscht durchlaufen?

xZise 2. Okt 2007 19:13

Re: Problem mit Vererbung
 
Hi,
Zitat:

Zitat von Muetze1
Wozu bekommt der Konstruktor von TTab ein TPageControl übergeben, wenn er nichts damit macht? Auch TExplorerTab macht nichts damit als es nur weiter zu reichen.

Naja eigentlich sollten die ja alle abstrakt sein :) Und das mit APageControl ist die einzige gemeinsamkeit :) Ich weiß der Code is nicht gerade gut, aber solange dass mit Add nicht vernünfig läuft xD

[edit]so :) Ich habe jetzt von TTab die Konstruktor Methode entfernt, und es ändert sich NICHTS :) Vielleicht ist es wichtig, dass es mit Überladen funktioniert?[/edit]

Zitat:

Zitat von Muetze1
Zitat:

Zitat von xZise
Also ich habe das einfach nochmal komplett durchgebuggt:

Und was ist dabei rausgekommen? Ist er in den Konstruktor von TExplorerTab reingesprungen? Hat er alles wie gewünscht durchlaufen?

Ehm ja ;) Alles so wie es sein sollte ;) Er ist in den Konstruktor gekommen und dann in die Add Methode. Dort war dann aber alles wieder nil ?!

MfG
xZise

Muetze1 2. Okt 2007 21:40

Re: Problem mit Vererbung
 
Ich kann das einfach nicht glauben. Das sind grundlegende OOP Dinge und das kann sich nicht so beschissen verhalten. Würde etwas dagegen sprechen, wenn man selber mal den Quelltext als ganzen beschauen kann? Ich komm nicht damit klar, dass das nicht gehen sollte...

xZise 2. Okt 2007 22:08

Re: Problem mit Vererbung
 
Okay hier mal der Code ;) Ich habe unwichtiges soweit ein bisschen entfernt.
Der aufruf (s.o.) erfolg weiterhin mit:
Delphi-Quellcode:
<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.

Muetze1 2. Okt 2007 23:10

Re: Problem mit Vererbung
 
Moin!

Grundlegend ist zZ vieles recht komisch. Ein abstrakt virtueller Constructor ist nun schon wirklich recht speziell (ok, wird zZ nicht genutzt), aber auch ein Overload bei der Add() Methode ist noch übrig, aber das tut auch nichts zur Sache. ABER: Du hast zwei unterschiedliche Definitionen von Sheet. Einmal in der Basis und einmal in einer Ableitung. Das recht komische dabei ist dabei, dass du unterschiedliche Klassen verwendest. Dazu kommt noch, dass du die Instanz in der Ableitung erstellst aber in der Basis freigibst.

Und zu deinem NIL Problem: Du greifst auf fSheet zu, wobei du eine Variable vom Typ TTab nutzt. Dadurch greifst du auf den Typ von Sheet von TTab zu. Da du aber in der Ableitung einen neuen Typ definierst (und eine neue Variable) aber die Basisklasse nutzt zum Zugriff, bekommst du fSheet von der Basis TTab - und die ist natürlich nil (schliesslich initialisierst du es nicht in TTab). Wenn du nun den Typ nicht neu definieren würdest in der Ableitung, dann hättest du Sheet vererbt und dann wäre beim Zugriff über TTab auch die Instanz von TExplorerTab zu finden - es gibt schliesslich nur noch ein Tab.

Aber das du die alte Eigenschaft verdeckst und eine neue deklarierst, hättest du aber wirklich mal sagen können. Schliesslich hat das ganze Problem nachweislich nichts virtual & | abstract zu tun. Also: dein Weg ist wie beschrieben begehbar - ABER: einige dich auf einen Typ...

Live long and prosper, Locutus!

xZise 3. Okt 2007 09:17

Re: Problem mit Vererbung
 
Zitat:

Zitat von Muetze1
Ein abstrakt virtueller Constructor ist nun schon wirklich recht speziell (ok, wird zZ nicht genutzt)

Naja, weil ich da leider nichts machen könnte :)

Zitat:

Zitat von Muetze1
aber auch ein Overload bei der Add() Methode ist noch übrig, aber das tut auch nichts zur Sache.

Naja ;) Funktionierte ja auch nicht vorher ohne ^^ Es lag daran, dass ich die Funktion ja mal überladen hatte :)

Zitat:

Zitat von Muetze1
ABER: Du hast zwei unterschiedliche Definitionen von Sheet. Einmal in der Basis und einmal in einer Ableitung.

Naja :) Jeder Tab hat eine Instanz von TTabSheet...

Zitat:

Zitat von Muetze1
Das recht komische dabei ist dabei, dass du unterschiedliche Klassen verwendest.

... wobei ja TSheet ein Nachfahre von TTabSheet ist! Deshalb habe ich angenommen, der schluckt das.

Zitat:

Zitat von Muetze1
Dazu kommt noch, dass du die Instanz in der Ableitung erstellst aber in der Basis freigibst.

Naja :) Wenn ich den Tab freigebe, dann gebe ich auch das TabSheet dazu frei. Aber wenn ich das erstelle weiß ich nicht ob der Tab vom Typ "TTabSheet" oder vom Typ "TSheet" ist.

Zitat:

Zitat von Muetze1
Und zu deinem NIL Problem: Du greifst auf fSheet zu, wobei du eine Variable vom Typ TTab nutzt. Dadurch greifst du auf den Typ von Sheet von TTab zu. Da du aber in der Ableitung einen neuen Typ definierst (und eine neue Variable) aber die Basisklasse nutzt zum Zugriff, bekommst du fSheet von der Basis TTab - und die ist natürlich nil (schliesslich initialisierst du es nicht in TTab).

Und warum kann man nicht einfach FSheet override;n ? Ist doch müll xD
Also werde ich wohl einer der einzigen Gemeinsamkeit entfernen :(
OBWOHL :) müsste es nicht gehen, wenn ich einfach den FSheet : TSheet entferne (und die Prozedur/Property) müsste es doch laufen :) Gleich mal ausprobieren xD

Zitat:

Zitat von Muetze1
Wenn du nun den Typ nicht neu definieren würdest in der Ableitung, dann hättest du Sheet vererbt und dann wäre beim Zugriff über TTab auch die Instanz von TExplorerTab zu finden - es gibt schliesslich nur noch ein Tab.

Hört sich gut an ^^

Zitat:

Zitat von Muetze1
Aber das du die alte Eigenschaft verdeckst und eine neue deklarierst, hättest du aber wirklich mal sagen können.

^^ Naja die IDE hat sich nicht beschwert xD

Zitat:

Zitat von Muetze1
Schliesslich hat das ganze Problem nachweislich nichts virtual & | abstract zu tun.

Naja. Ich hatte auch im ersten Post geschrieben, dass es mir nicht nur um abstract &|| (solle das nicht eher so sein ^^) virtual geht.

Muetze1 3. Okt 2007 11:26

Re: Problem mit Vererbung
 
Zitat:

Zitat von xZise
Zitat:

Zitat von Muetze1
Das recht komische dabei ist dabei, dass du unterschiedliche Klassen verwendest.

... wobei ja TSheet ein Nachfahre von TTabSheet ist! Deshalb habe ich angenommen, der schluckt das.

Ja klar, wenn du es nicht neu definiert hättest. Du kannst doch die Eigenschaft mit dem Typ der Basisklasse (TTabSheet) doch einfach mit vererben und auch mit einer Instanz einer abgeleiteten Form befüllen. Ist doch kein Problem!

Zitat:

Zitat von xZise
Zitat:

Zitat von Muetze1
Dazu kommt noch, dass du die Instanz in der Ableitung erstellst aber in der Basis freigibst.

Naja :) Wenn ich den Tab freigebe, dann gebe ich auch das TabSheet dazu frei. Aber wenn ich das erstelle weiß ich nicht ob der Tab vom Typ "TTabSheet" oder vom Typ "TSheet" ist.

Das ist egal - der Destruktor ist virtuell und wird überschrieben. Dadurch kannst du auch TObject(fSheet).Free; aufrufen und es wird der Destruktor von TSheet bzw. TTabSheet aufgerufen.

Zitat:

Zitat von xZise
Und warum kann man nicht einfach FSheet override;n ?

Das ist eine Property und keine Methode. Was du hier suchst ist eine virtuelle Property die du überschreiben kannst. Wenn du eine Methode nicht mit virtuell kennzeichnest und in der Ableitung nochmal eine gleichnamige Methode mit einer anderen Signatur einfügst, dann wird die originale auch verdeckt. Gleiches hier bei den Properties, nur das du bei Methoden virtual angeben könntest und bei Properties nicht.

Zitat:

Zitat von xZise
Ist doch müll xD Also werde ich wohl einer der einzigen Gemeinsamkeit entfernen :(
OBWOHL :) müsste es nicht gehen, wenn ich einfach den FSheet : TSheet entferne (und die Prozedur/Property) müsste es doch laufen :) Gleich mal ausprobieren xD

Ja, sollte: wie oben beschrieben: In der Basisklasse TTab die Eigenschaft auf Basis der TTabSheet (also der Basisklasse) und in der Ableitung kannst du dort dann genauso die Instanz deiner abgeleiteten Klasse TSheet ablegen. Das einzige ist dann halt: Du müsstest für den Zugriff auf die erweiterten Eigenschaften von TSheet einen Typecast vollziehen - also IS / AS Operationen. IS ist ja auch wichtig, weil du ja erstmal in Erfahrung bringen musst, ob du nun ein TTabSheet oder ein TSheet in der Eigenschaft hast (oder nil, dann sagt IS zu beiden nein).

Zitat:

Zitat von xZise
Zitat:

Zitat von Muetze1
Aber das du die alte Eigenschaft verdeckst und eine neue deklarierst, hättest du aber wirklich mal sagen können.

^^ Naja die IDE hat sich nicht beschwert xD

Nein, ist auch ein normales sprachliches Mittel der Delphi Language...

Zitat:

Zitat von xZise
Zitat:

Zitat von Muetze1
Schliesslich hat das ganze Problem nachweislich nichts virtual & | abstract zu tun.

Naja. Ich hatte auch im ersten Post geschrieben, dass es mir nicht nur um abstract &|| (solle das nicht eher so sein ^^) virtual geht.

Naja, deshalb ja das | ...


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:36 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