Delphi-PRAXiS - SubClassed Control

Einwas ist aber noch falsch.

Delphi-Quellcode:

			  function HookedCombo_Create: IHookedCombo; stdcall;

  procedure HookedCombo_Destroy; stdcall;

var

  HookedCombo: IHookedCombo;

  CloseHandle: HWND;

implementation

Und zwar die bösen globalen Variablen. :warn:

HookedCombo_Destroy kann also immer nur das zuletzt erstelle Control freigeben.
Entweder du gibst dieser Prozedur das richtige Handle mit, oder ... du nutzt doch eh Interfaces.

Also laß' einfach diese Funktion und die beiden Variablen weg.
Die Komponenten wird doch zusammen mit dem im Interface liegenden Objekt freigegeben.

Nutze stattdessen TInterfacedObject als Vorfahre, dann hat man im Hauptprogramm noch die Kontrolle und kann darüber das SubclassesControl freigeben, indem man den Interfacezeiger freigibt.
Dazu muß dann natürlich im Hauptprogramm immer dieser Zeiger gespeichert werden/bleiben.

Und auch im Hauptprogramm gehören diese Variablen nicht global, sondern z.B. als private Felder in die Form-Klasse.

Delphi-Quellcode:

			type

  TForm1 = class(TForm)

    Memo1: TMemo;

    ...

  private

    { Private-Deklarationen }

    ScrbMemoHook : IHookedScrollbar;

    ScrbMemoHook2 : IHookedScrollbar;

    ComboHook    : IHookedCombo;

  public

    { Public-Deklarationen }

  end;

Statt den vielen Variablen könnte man auch eine TInterfaceList verwenden, dazu dann noch eine Funktion, welche die Components der Form durchgeht, alle passenden Kombonenten sucht, für alle die SubclassedObjects erstellt und sie in der TInterfaceList speichert, welcher mit der Form dann freigegeben wird.

[add]

Delphi-Quellcode:

			type

  TSubclassedList = class(TComponent)

    List: TInterfaceList;

    constructor Create(Owner: TComponent); override;

    destructor Destroy; override;

  end;

constructor TSubclassedList.Create(Owner: TComponent);

begin

  inherited;

  List := TInterfaceList.Create;

end;

destructor TSubclassedList.Destroy;

begin

  List.Free;

  inherited;

end;

procedure FindSubclassed(Comp: TWinControl; Config: TStrings; L: TSubclassedList = nil);

var

  i: Integer;

  S: IHookedScrollbar;

  C: IHookedCombo;

begin

  if Config.Values['Path'] = '' then

    Config.Values['Path'] := ExtractFilePath(ParamStr(0));

  if not Assigned(L) then

    L := TSubclassedList.Create(Comp);

  for i := 0 to Comp.ControlCount - 1 do begin

    if Comp.Controls[i] is TCustomMemo then begin

      S := HookedScroolBar_Create;

      L.List.Add(S);

      // Vertikale ScrollBar Images

      if Config.Values['VTrack']    > '' then S.VTrack    := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['VTrack']);

      if Config.Values['VBtnUp']    > '' then S.VBtnUp    := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['VBtnUp']);

      if Config.Values['VThumb']    > '' then S.VThumb    := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['VThumb']);

      if Config.Values['VBtnDown']  > '' then S.VBtnDown  := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['VBtnDown']);

      // Horizontale ScrollBar Images

      if Config.Values['HTrack']    > '' then S.HTrack    := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['HTrack']);

      if Config.Values['HBtnLeft']  > '' then S.HBtnLeft  := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['HBtnLeft']);

      if Config.Values['HThumb']    > '' then S.HThumb    := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['HThumb']);

      if Config.Values['HBtnRight'] > '' then S.HBtnRight := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['HBtnRight']);

      // Size Images

      if Config.Values['Sizer']     > '' then S.Sizer     := S.CreateImageFromFile(Config.Values['Path'] + Config.Values['Sizer']);

      //

      S.SetScrollBarObj(Comp.Controls[i]);

      S.Connect;

    end else if Comp.Controls[i] is TCustomCombo then begin

      // Comboox

      C := HookedCombo_Create;

      L.List.Add(C);

      if Config.Values['ComboImg']      > '' then C.ComboImg      := C.CreateImageFromFile(Config.Values['Path'] + Config.Values['ComboImg']);

      if Config.Values['FrameColor']    > '' then C.FrameColor    := StringToColor(Config.Values['FrameColor']);

      if Config.Values['FrameHighLite'] > '' then C.FrameHighLite := StringToColor(Config.Values['FrameHighLite']);

    //if Config.Values['FrameStyle']    > '' then C.FrameStyle    := StringToXxx(Config.Values['FrameStyle']);

      C.SetComboParentObj(Comp.Controls[i]);

      C.Connect;

    end;

    FindSubclassed(Comp.Controls[i], Config, L);

  end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

  Config: TStringList;

begin

  Config := TStringList.Create;

  try

    Config.Values['Path']          := ExtractFilePath(ParamStr(0)) + 'ScrollBarSkin\';

    // Vertikale ScrollBar Images

    Config.Values['VTrack']        := 'VTrack.png';

    Config.Values['VBtnUp']        := 'VBtnUp.png';

    Config.Values['VThumb']        := 'VThumb.png';

    Config.Values['VBtnDown']      := 'VBtnDown.png';

    // Horizontale ScrollBar Images

    Config.Values['HTrack']        := 'HTrack.png';

    Config.Values['HBtnLeft']      := 'HBtnLeft.png';

    Config.Values['HThumb']        := 'HThumb.png';

    Config.Values['HBtnRight']     := 'HBtnRight.png';

    // Size Images

    Config.Values['Sizer']         := 'Sizer.png';

    // Comboox

    Config.Values['ComboImg']      := 'Combo.png';

    Config.Values['FrameColor']    := '$FED3AC';

    Config.Values['FrameHighLite'] := '$666666';

    Config.Values['FrameStyle']    := 'FrameFlat';

    //

    FindSubclassed(Self, Config);

  finally

    Config.Free;

  end;

end;

(siehe Signatur)

[add]
Tut mir Leid das jetzt so hart sagen zu müssen, aber das Teil ist das reinste Speichergrab.
So

Delphi-Quellcode:

if assigned(VTrack) then VTrack := nil;

gibt man jedenfalls keine Komonente ala TBitmap frei.

Wobei, wie schon gesagt, hier eh fast keine Komponenten freigegeben werden, da HookedScroolBar_Destroy nur beim Letzen wirkt.