自定义基础类

列表与容器类

列表和字符串列表

TList定义指针列表

unit uXClasses;

interface

uses
  Classes, Sysutils, Messages, Windows,Dialogs;
type
  TMsgClass = class
  private
    FHandle: HWnd;
    function GetHandle: HWnd;
    procedure WndProc(var Message: TMessage);
  public
    property Handle: HWnd read GetHandle;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TTimerClass = class(TMsgClass)
  private
    FHTimer: LongWord;
    FEnabled: boolean;
    FInterval: integer;
    procedure OnTimer(var Message: TMessage); message WM_TIMER;
    procedure SetEnabled(const Value: boolean);
    procedure SetInterval(const Value: integer);
  public
    constructor Create; override;
    destructor Destroy; override;
  public
    procedure DoTimer; virtual;
    property TimerEnabled: boolean read FEnabled write SetEnabled;
    property TimerInterval: integer read FInterval write SetInterval;
  end;

  TClassList = Class(TList)
  private
  public
    function Get(Index: Integer): Pointer;
    procedure Delete(Index: Integer);
    procedure Clear; override;
  public
    destructor Destroy; override;
  end;

  TSafeList = Class(TList)
  private
  public
    function Get(Index: Integer): Pointer;
  end;

  TViewObjs = class
  private
  protected
    FColumns: TStringList;
  public
    property Columns: TStringList read FColumns;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TMsgClass }

constructor TMsgClass.Create;
begin
  FHandle := 0;
end;

destructor TMsgClass.Destroy;
begin
  if FHandle <> 0 then
    DeallocateHWnd(FHandle);
  inherited;
end;

function TMsgClass.GetHandle: HWnd;
begin
  if FHandle = 0 then
    FHandle := AllocateHwnd(WndProc);
  Result := FHandle;
end;

procedure TMsgClass.WndProc(var Message: TMessage);
begin
  try
    Dispatch(Message);
  except
//    if Assigned(ApplicationHandleException) then
//      ApplicationHandleException(Self);
  end;
end;

{ TTimerClass }

constructor TTimerClass.Create;
begin
  inherited;
  FInterval := 1000;
  FHTimer := 0;
  FEnabled := false;
end;

destructor TTimerClass.Destroy;
begin
  TimerEnabled := false;
  FInterval := 0;
  inherited;
end;

procedure TTimerClass.DoTimer;
begin

end;

procedure TTimerClass.OnTimer(var Message: TMessage);
begin
  DoTimer;
end;

procedure TTimerClass.SetEnabled(const Value: boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    if FEnabled then
    begin
      if FHTimer = 0 then
        FHTimer := SetTimer(Handle, 1, FInterval, nil);
    end
    else
    begin
      if FHTimer <> 0 then
        KillTimer(Handle, 1);
      FHTimer := 0;
    end;
  end;
end;

procedure TTimerClass.SetInterval(const Value: integer);
begin
  if FInterval <> Value then
  begin
    FInterval := Value;
    if TimerEnabled then
    begin
      TimerEnabled := false;
      TimerEnabled := true;
    end
  end;
end;

{ TClassList }

procedure TClassList.Clear;
var
  i: integer;
begin
  try
    for i := 0 to Count - 1 do
      TObject(Items[i]).Free;
  except
  end;
  inherited;
end;

procedure TClassList.Delete(Index: Integer);
begin
  try
    if (Index >= 0) and (Index < Count) then
      TObject(Items[Index]).Free;
  except
  end;
  Inherited Delete(Index);
end;

destructor TClassList.Destroy;
begin
  Clear;
  inherited;
end;

function TClassList.Get(Index: Integer): Pointer;
begin
  try
    Result := inherited Get(Index);
  except
    result := nil;
  end;
end;

{ TViewObjs }

constructor TViewObjs.Create;
begin
  FColumns := TStringList.Create;
end;

destructor TViewObjs.Destroy;
begin
  FColumns.Free;
  inherited;
end;

{ TSafeList }

function TSafeList.Get(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= Count) then
    Result := nil
  else
    Result := inherited Get(Index);
end;

end.