suichecklistbox.pas

SUIPack v6.40.Full.Source for Delphi 5 - 2009 (实际上 2010 上也能编译通过)

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUICheckListBox.pas
//  Creator     :   Shen Min
//  Date        :   2002-09-07 V1-V3
//                  2003-07-15 V4
//                  2006-06-14 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUICheckListBox;

interface

{$I SUIPack.inc}

uses Windows, Messages, CheckLst, Graphics, Forms, Classes, Controls, SysUtils,
     SUIScrollBar, SUIThemes, SUIMgr, SUI2Define;

type
    TsuiCheckListBox = class(TCheckListBox)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;

        // scroll bar
        m_VScrollBar : TsuiScrollBar;
        m_HScrollBar : TsuiScrollBar;
        m_MouseDown : Boolean;
        m_SelfChanging : Boolean;
        procedure SetVScrollBar(const Value: TsuiScrollBar);
        procedure SetHScrollBar(const Value: TsuiScrollBar);
        procedure OnVScrollBarChange(Sender : TObject);
        procedure OnHScrollBarChange(Sender : TObject);
        procedure UpdateScrollBars();
        procedure UpdateScrollBarsPos();

        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure LBADDSTRING(var Msg : TMessage); message LB_ADDSTRING;
        procedure LBDELETESTRING(var Msg : TMessage); message LB_DELETESTRING;
        procedure LBINSERTSTRING(var Msg : TMessage); message LB_INSERTSTRING;
        procedure LBSETCOUNT(var Msg : TMessage); message LB_SETCOUNT;
        procedure LBNSELCHANGE(var Msg : TMessage); message LBN_SELCHANGE;
        procedure LBNSETFOCUS(var Msg : TMessage); message LBN_SETFOCUS;
        procedure WMDELETEITEM(var Msg : TMessage); message WM_DELETEITEM;
        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;

        procedure SetBorderColor(const Value: TColor);
        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        function GetBorderStyle() : TBorderStyle;
        procedure SetBorderStyle(const Value : TBorderStyle);
        function GetBorderWidth: TBorderWidth;
        procedure SetBorderWidth(const Value: TBorderWidth);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetFileTheme(const Value: TsuiFileTheme);

    private
        FSelectedTextColor: TColor;
        FSelectedColor: TColor;
        FDisabledTextColor: TColor;

        procedure SetSelectedColor(const Value: TColor);
        procedure SetSelectedTextColor(const Value: TColor);
        procedure SetDisabledTextColor(const Value: TColor);
        procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;          
        
    protected
        procedure DrawItem(Index: Integer; Rect: TRect;State: TOwnerDrawState); override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure Loaded(); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property SelectedColor: TColor read FSelectedColor write SetSelectedColor;
        property SelectedTextColor: TColor read FSelectedTextColor write SetSelectedTextColor;
        property DisabledTextColor: TColor read FDisabledTextColor  write SetDisabledTextColor;

        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        property BorderStyle : TBorderStyle read GetBorderStyle write SetBorderStyle;
        property BorderWidth : TBorderWidth read GetBorderWidth write SetBorderWidth;

        // scroll bar
        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
        property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
    end;


implementation

uses SUIPublic, SUIProgressBar;

procedure DrawBorder(WinControl : TWinControl; BorderColor, Color : TColor);
var
    DC : HDC;
    Brush : HBRUSH;
    R: TRect;
begin
    DC := GetWindowDC(WinControl.Handle);

    GetWindowRect(WinControl.Handle, R);
    OffsetRect(R, -R.Left, -R.Top);

    Brush := CreateSolidBrush(ColorToRGB(BorderColor));
    FrameRect(DC, R, Brush);
    DeleteObject(Brush);

    ReleaseDC(WinControl.Handle, DC);
end;

{ TsuiCheckListBox }

procedure TsuiCheckListBox.CMEnabledChanged(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.CMVisibleChanged(var Msg: TMEssage);
begin
    inherited;

    if not Visible then
    begin
        if m_VScrollBar <> nil then
            m_VScrollBar.Visible := Visible;
        if m_HScrollBar <> nil then
            m_HScrollBar.Visible := Visible;
    end
    else
        UpdateScrollBarsPos();
end;

procedure TsuiCheckListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  inherited;
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(LongRec(itemState).Lo);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if Integer(itemID) >= 0 then
    begin
      if odSelected in State then
      begin
        Canvas.Brush.Color := FSelectedColor;
        Canvas.Font.Color := FSelectedTextColor;
      end;
      if (([odDisabled, odGrayed] * State) <> []) or not Enabled then
        Canvas.Font.Color := FDisabledTextColor;
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
    begin
      Canvas.FillRect(rcItem);
      if odFocused in State then
        DrawFocusRect(hDC, rcItem);
    end;
    Canvas.Handle := 0;
  end;
end;

constructor TsuiCheckListBox.Create(AOwner: TComponent);
begin
    inherited;

    Flat := True;
    inherited BorderStyle := bsNone;
    BorderWidth := 2;
    m_SelfChanging := false;
    m_MouseDown := false;

    UIStyle := GetSUIFormStyle(AOwner);
    FSelectedColor := clHighlight;
    FSelectedTextColor := clHighlightText;
    FDisabledTextColor := clGrayText;
end;

procedure TsuiCheckListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
    Bitmap : TBitmap;
    bChecked : Boolean;
    nIndex : Integer;
    OutUIStyle : TsuiUIStyle;
begin
    bChecked := Checked[Index];
    inherited;
    Bitmap := TBitmap.Create();

    if Enabled then
    begin
        if bChecked  then
            nIndex := 1
        else
            nIndex := 2
    end
    else
    begin
        if bChecked then
            nIndex := 3
        else
            nIndex := 4;
    end;

    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_FileTheme.GetBitmap2(SKIN2_CHECKBOXLIST, Bitmap, 4, nIndex)
    else
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_CHECKLISTBOX_IMAGE, Bitmap, 4, nIndex);

    if Canvas.TextHeight('W') < 12 then
        Rect.Bottom := Rect.Bottom + 1;
    Canvas.Draw(Rect.Left - 13, Rect.Top + (Rect.Bottom - Rect.Top - 11) div 2, Bitmap);

    Bitmap.Free();
end;

function TsuiCheckListBox.GetBorderStyle: TBorderStyle;
begin
    Result := bsSingle;
end;

function TsuiCheckListBox.GetBorderWidth: TBorderWidth;
begin
    Result := 1;
end;

procedure TsuiCheckListBox.LBADDSTRING(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.LBDELETESTRING(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.LBINSERTSTRING(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.LBNSELCHANGE(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.LBNSETFOCUS(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.LBSETCOUNT(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiCheckListBox.Loaded;
begin
    inherited;
    UpdateScrollBarsPos();
end;

procedure TsuiCheckListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if AComponent = nil then
        Exit;

    if (
        (Operation = opRemove) and
        (AComponent = m_VScrollBar)
    )then
        m_VScrollBar := nil;

    if (
        (Operation = opRemove) and
        (AComponent = m_HScrollBar)
    )then
        m_HScrollBar := nil;

    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);