sadapter.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sAdapter;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sConst, sCommondata{, sPanel};

type
{$IFNDEF NOTFORHELP}
  TAddItemEvent = procedure(Item: TComponent; var CanBeAdded: boolean; var SkinSection: string) of object;
{$ENDIF} // NOTFORHELP
  TsCtrlAdapter = class;

  TacAdapterItem = class(TObject)
  public
    Ctrl : TWinControl;
    SkinData : TsCommonData;
    OldFontColor : integer;
    OldWndProc: TWndMethod;
    Adapter : TsCtrlAdapter;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure BeforeDelete; virtual;
  end;

  TacAdapterItems = array of TacAdapterItem;
  TsCtrlAdapter = class(TComponent)
{$IFNDEF NOTFORHELP}
  private
    FAutoSearch: boolean;
    FOnAddItem: TAddItemEvent;
  public
    CtrlClass : TsCtrlClass;
    DefaultSection : string;
    Items : TacAdapterItems;
    function IsControlSupported(Control : TComponent) : boolean; virtual;
    function Count : integer;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure DoHook(Index : integer; Ctrl : TWinControl); virtual;
    function GetItem(Index : integer) : TacAdapterItem; virtual;
    function GetCommonData(Index : integer) : TsCommonData; virtual;
    procedure HookAll;
    function IndexOf(Ctrl : TWinControl) : integer;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function Form: TScrollingWinControl;
{$ENDIF} // NOTFORHELP
    procedure AddAllItems(OwnerCtrl : TWinControl = nil);
    procedure AddNewItem(Ctrl : TWinControl); overload; virtual;
    procedure AddNewItem(Ctrl : TWinControl; const SkinSection : string); overload; virtual;
    procedure RemoveItem(Index : integer); virtual;
    procedure RemoveAllItems;
  published
    property AutoSearch : boolean read FAutoSearch write FAutoSearch default True;
    property OnAddItem: TAddItemEvent read FOnAddItem write FOnAddItem;
  end;

implementation

uses math, sSkinProps, sVCLUtils;

{ TsCtrlAdapter }

procedure TsCtrlAdapter.AddNewItem(Ctrl: TWinControl); begin end;
procedure TsCtrlAdapter.AddNewItem(Ctrl: TWinControl; const SkinSection: string); begin end;

procedure TsCtrlAdapter.AddAllItems(OwnerCtrl : TWinControl = nil);
var
  i : integer;
  CanAdd : boolean;
  sSection : string;
  Owner : TWinControl;
begin
  if OwnerCtrl = nil then Owner := Form else Owner := OwnerCtrl;
  if Owner = nil then Exit;
  for i := 0 to Owner.ComponentCount - 1 do begin
    if IsControlSupported(Owner.Components[i]) then begin
      CanAdd := True; sSection := s_Edit;
      if Assigned(FOnAddItem) and not (csDesigning in ComponentState) then FOnAddItem(Owner.Components[i], CanAdd, sSection);
      if CanAdd then AddNewItem(TWinControl(Owner.Components[i]), sSection);
    end
    else if (Owner.Components[i] is TCustomFrame) then AddAllItems(TWinControl(Owner.Components[i])); // Recursion
  end;
end;

function TsCtrlAdapter.Count: integer;
begin
  Result := Length(Items);
end;

constructor TsCtrlAdapter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoSearch := True;
end;

destructor TsCtrlAdapter.Destroy;
begin
  RemoveAllItems;
  inherited Destroy;
end;

procedure TsCtrlAdapter.DoHook(Index: integer; Ctrl: TWinControl); begin end;

function TsCtrlAdapter.GetCommonData(Index: integer): TsCommonData;
begin
  Result := nil;
end;

function TsCtrlAdapter.Form: TScrollingWinControl;
begin
  Result := nil;
  if (csDesigning in ComponentState) then begin
    if GetOwnerFrame(Self) = nil then Result := TScrollingWinControl(GetOwnerForm(Self));
  end
  else begin
    Result := TScrollingWinControl(GetOwnerFrame(Self));
    if (Result = nil) then
    Result := TScrollingWinControl(GetOwnerForm(Self));
  end;
end;

function TsCtrlAdapter.GetItem(Index: integer) : TacAdapterItem;
begin
  Result := nil;
end;

procedure TsCtrlAdapter.HookAll;
begin
  if Form <> nil then AddAllItems;
end;

function TsCtrlAdapter.IndexOf(Ctrl : TWinControl): integer;
var
  i : integer;
begin
  Result := -1;
  for i := 0 to Length(Items) - 1 do if Items[i].Ctrl = Ctrl then begin
    Result := i;
    Exit;
  end;
end;

procedure TsCtrlAdapter.Loaded;
begin
  inherited;
  if not (csDesigning in ComponentState) then AddAllItems;// else HookAll;
end;

procedure TsCtrlAdapter.Notification(AComponent: TComponent; Operation: TOperation);
var
  i : integer;
  Item : TacAdapterItem;
begin
  inherited Notification(AComponent, Operation);
  if (csDestroying in ComponentState) or (csDestroying in AComponent.ComponentState) or (csDesigning in ComponentState) then Exit;
  case Operation of
    opInsert : if IsControlSupported(AComponent) then AddNewItem(TWinControl(AComponent));
    opRemove : if IsControlSupported(AComponent) then for i := 0 to Count - 1 do begin
      Item := GetItem(i);
      if (Item <> nil) and (Item.Ctrl = AComponent) then begin
        RemoveItem(i);
        Exit;
      end;
    end;
  end;
end;

procedure TsCtrlAdapter.RemoveItem(Index: integer);
var
  i, l : integer;
begin
  if (Index < Count) then begin
    Items[Index].BeforeDelete;
    FreeAndNil(Items[Index]);
    i := Index;
    l := Length(Items) - 1;
    while i <= l - 1 do begin
      Items[i] := Items[i + 1];
      inc(i);
    end;
    SetLength(Items, l - 1);
  end;
end;

function TsCtrlAdapter.IsControlSupported(Control: TComponent): boolean;
begin
  Result := Control is CtrlClass;
end;

procedure TsCtrlAdapter.RemoveAllItems;
var
  l : integer;
begin
  while Length(Items) > 0 do begin
    l := Length(Items);
    Items[l - 1].BeforeDelete;
    FreeAndNil(Items[l - 1]);
    SetLength(Items, l - 1);
  end;
end;

{ TacAdapterItem }
constructor TacAdapterItem.Create;
begin
  inherited Create;
  OldFontColor := -1;
  SkinData := TsCommonData.Create(Self, True);
  SkinData.COC := COC_TsAdapter;
end;

procedure TacAdapterItem.BeforeDelete; begin end;

destructor TacAdapterItem.Destroy;
begin
  FreeAndNil(SkinData);
  inherited Destroy;
end;

end.