sdblistbox.pas

AlphaControls是一个Delphi标准控件的集合

unit sDBListBox;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, sConst, sStyleEdits;

type
  TsDBListBox = class(TDBListBox)
  private
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  protected
    FsStyle : TsStyle;
    procedure CreateWnd; override;
    procedure WndProc (var Message: TMessage); override;
  public
    LastControl : boolean;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
  published
    property sStyle:TsStyle read FsStyle write FsStyle;
  end;

implementation

{ TsDBListBox }

constructor TsDBListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bsNone;
  sStyle := TsStyle.Create(Self);
  sStyle.COC := COC_TsDBListBox;
  OnKeyDown := sStyle.onKeyDown;
  ParentColor := False;
end;

procedure TsDBListBox.CreateWnd;
begin
  inherited;
end;

destructor TsDBListBox.Destroy;
begin
  FreeAndNil(FsStyle);
  OnKeyDown := nil;
  inherited Destroy;
end;

procedure TsDBListBox.Invalidate;
begin
  Color := sStyle.GetActiveColor;
  if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
    FsStyle.BGChanged := True;
  end;
  if Assigned(Parent) then sStyle.RedrawBorder;
  inherited;
end;

procedure TsDBListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TsDBListBox.WMNCPaint(var Message: TMessage);
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  Color := sStyle.GetActiveColor;
  sStyle.RedrawBorder;
  inherited;
end;

procedure TsDBListBox.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  inherited;
end;

end.