scustomlistbox.pas

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

unit sCustomListBox;
interface

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

type
  TsCustomListBox = class(TCustomListBox)
  private
    procedure OnVSBChange(Sender : TObject; OldValue : integer);
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMPaint (var Message: TMessage); message WM_PAINT;
    procedure WMsize (var Message: TMessage); message WM_SIZE;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
    procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
    procedure CNKeyDown(var Message: TWMKey); message CN_KEYDOWN;
    procedure CNKeyUp(var Message: TWMKey); message CN_KEYUP;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    property BorderStyle;
  protected
    FsStyle : TsStyle;
    procedure WndProc (var Message: TMessage); override;
  public
    VSBar : TsScrollBar;
//    LastControl : boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure RefreshScrolls;
    procedure RefreshScrollBounds;
    procedure Invalidate; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property Columns;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ExtendedSelect;
    property Font;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ItemHeight;
    property Items;
    property MultiSelect;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

    property sStyle:TsStyle read FsStyle write FsStyle;
  end;

  TsListBox = class(TsCustomListBox)
  end;

implementation

uses sStyleSimply, sUtils, sMessages, sVclUtils, sMaskData;

{ TsCustomListBox }

constructor TsCustomListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bsNone;
  sStyle := TsStyle.Create(Self);
  sStyle.COC := COC_TsCustomListBox;
  OnKeyDown := sStyle.onKeyDown;
  ParentColor := False;
//  DoubleBuffered := True;
end;

destructor TsCustomListBox.Destroy;
begin
  VSBar := nil;
//  FreeAndNil(VSBar);
  FreeAndNil(FsStyle);
  OnKeyDown := nil;
  inherited Destroy;
end;


procedure TsCustomListBox.Invalidate;
begin            
  Color := sStyle.GetActiveColor;
  if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
    if not RestrictDrawing then FsStyle.BGChanged := True;
  end;
  inherited;
  if ControlIsReady(Self) then begin
    RefreshScrolls;
  end;
end;

procedure TsCustomListBox.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
  RefreshScrolls;
end;

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

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

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

  if Assigned(sStyle) and IsValidSkinIndex(sStyle.SkinIndex) then begin
    case Message.Msg of
      CM_VISIBLECHANGED : begin
        RefreshScrolls;
      end;
    end;
  end;
  if (Message.MSG = SM_REMOVESKIN) and not (csDestroying in ComponentState) then begin
    invalidate;
  end;
end;

procedure TsCustomListBox.Loaded;
begin
  inherited;
  sStyle.Loaded;
  RefreshScrolls;
end;

procedure TsCustomListBox.RefreshScrolls;
var
  SI : TScrollInfo;
  SBI : TScrollBarInfo;
begin
  if not ControlIsReady(Self) then Exit;

  SBI.cbSize := SizeOf(TScrollBarInfo);

  SI.cbSize := SizeOf(TScrollInfo);
  SI.fMask := SIF_ALL;

  if not GetScrollInfo(Handle, SB_VERT, SI) then Exit;
  if not GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), SBI) then Exit;

  if (not sSkinData.Active or not Visible or (SBI.rgstate[0] = STATE_SYSTEM_INVISIBLE) or (SBI.rgstate[0] = STATE_SYSTEM_UNAVAILABLE)) then begin
    if (VSBar <> nil) then FreeAndNil(VSBar);
    Exit;
  end;

  if SI.nMax <= SI.nMin then Exit;
  if (VSBar = nil) and
       not (SBI.rgstate[0] = STATE_SYSTEM_INVISIBLE) then begin
//    BringToFront;
    VSBar := TsScrollBar.Create(Self);
    VSBar.LinkedControl := Self;
    VSBar.OnChange := OnVSBChange;
    VSBar.DrawingForbidden := True;
    VSBar.Parent := Parent;
    VSBar.Visible := True;
    VSBar.TabStop := False;
    VSBar.Kind := sbVertical;
    VSBar.Width := WidthOf(SBI.rcScrollBar);
  end;

  if Assigned(VSBar) then begin
    VSBar.DrawingForbidden := True;
    VSBar.Height := Height - 6;
    VSBar.Enabled := Enabled;
    if (SI.nMax < SI.nMin) or (SI.nMax = 0) or (SI.nMax - integer(SI.nPage) + 1 = 0) then begin
      VSBar.Max := 1;
      VSBar.Min := 0;
      VSBar.PageSize := 1;
      VSBar.Position := 0;
      VSBar.Enabled := False;
    end
    else begin
      VSBar.Max := SI.nMax - integer(SI.nPage) + 1;
      VSBar.Min := SI.nMin;
      VSBar.Position := SI.nPos;
      VSBar.PageSize := SI.nPage;
      if VSBar.PageSize > 0 then VSBar.LargeChange := VSBar.PageSize else VSBar.LargeChange := 1;
    end;
    RefreshScrollBounds;
    VSBar.DrawingForbidden := False;
  end;
end;

procedure TsCustomListBox.WMPaint(var Message: TMessage);
begin
  inherited;
end;

procedure TsCustomListBox.OnVSBChange(Sender: TObject; OldValue : integer);
begin
  SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, VSBar.Position), 0);
  Invalidate;
end;

procedure TsCustomListBox.RefreshScrollBounds;
begin
  if Assigned(VSBar) then
    VSBar.SetBounds(Left + Width - VSBar.Width - 3, Top + 3, VSBar.Width, VSBar.Height);
end;

procedure TsCustomListBox.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsCustomListBox.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsCustomListBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsCustomListBox.WMMouseWheel(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsCustomListBox.CNKeyDown(var Message: TWMKey);
begin
  inherited;
  case Message.CharCode of
    VK_UP, VK_DOWN, VK_HOME, VK_END, VK_SCROLL, VK_PRIOR, VK_NEXT : begin
      RefreshScrolls;
    end;
  end;
end;

procedure TsCustomListBox.CNKeyUp(var Message: TWMKey);
begin
  inherited;
  case Message.CharCode of
    VK_UP, VK_DOWN, VK_HOME, VK_END, VK_SCROLL, VK_PRIOR, VK_NEXT : begin
      RefreshScrolls;
    end;
  end;
end;

procedure TsCustomListBox.CMMouseLeave(var Msg: TMessage);
var
  p : TPoint;
  r : TRect;
begin
  p := ClientToScreen(Point(Left, Top));
  r := Rect(p.x, p.y, p.x + Width, p.y + Height);
  p := Mouse.CursorPos;
  if //(ParentSStyle.FMouseAbove <> False) and
     not PtInRect(r, p) then begin
    inherited;
  end;
end;

procedure TsCustomListBox.WMsize(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

end.