schecklistbox.pas

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

unit sCheckListBox;
{$I sDefs.inc}

{$T-,H+,X+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, {$IFDEF TNTUNICODE}sListBox,{$ELSE}sAlphaListBox,{$ENDIF}sConst;

type
  TsCheckListBox = class(TsListBox)
{$IFNDEF NOTFORHELP}
  private
    FAllowGrayed: Boolean;
    FOnClickCheck: TNotifyEvent;
    FSaveStates: TList;
    FHeaderColor: TColor;
    FHeaderBackgroundColor: TColor;
    FHeaderSkin: TsSkinSection;
    procedure DrawCheck(R: TRect; AState: TCheckBoxState; AEnabled: Boolean; Bmp : TBitmap); overload;
    procedure DrawCheck(R: TRect; AState: TCheckBoxState; AEnabled: Boolean; C : TCanvas); overload;
    procedure SetChecked(Index: Integer; Checked: Boolean);
    function GetChecked(Index: Integer): Boolean;
    procedure SetState(Index: Integer; AState: TCheckBoxState);
    function GetState(Index: Integer): TCheckBoxState;
    procedure ToggleClickCheck(Index: Integer);
    procedure InvalidateCheck(Index: Integer);
    function CreateWrapper(Index: Integer): TObject;
    function ExtractWrapper(Index: Integer): TObject;
    function GetWrapper(Index: Integer): TObject;
    function HaveWrapper(Index: Integer): Boolean;
    procedure WMDestroy(var Msg : TWMDestroy);message WM_DESTROY;
    function GetItemEnabled(Index: Integer): Boolean;
    procedure SetItemEnabled(Index: Integer; const Value: Boolean);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    function GetHeader(Index: Integer): Boolean;
    procedure SetHeader(Index: Integer; const Value: Boolean);
    procedure SetHeaderBackgroundColor(const Value: TColor);
    procedure SetHeaderColor(const Value: TColor);
    procedure SetHeaderSkin(const Value: TsSkinSection);
  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    function InternalGetItemData(Index: Integer): Longint; override;
    procedure InternalSetItemData(Index: Integer; AData: Longint); override;
    procedure SetItemData(Index: Integer; AData: LongInt); override;
    function GetItemData(Index: Integer): LongInt; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyPress(var Key: Char); override;
    procedure ResetContent; override;
    procedure DeleteString(Index: Integer); override;
    procedure ClickCheck; dynamic;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    function GetCheckWidth: Integer;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
{$ENDIF} // NOTFORHELP
    property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
    property ItemEnabled[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
    property State[Index: Integer]: TCheckBoxState read GetState write SetState;
    property Header[Index: Integer]: Boolean read GetHeader write SetHeader;
  published
    {:@event}
    property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;

    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
    property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clInfoText;
    property HeaderBackgroundColor: TColor read FHeaderBackgroundColor write SetHeaderBackgroundColor default clInfoBk;
    property HeaderSkin : TsSkinSection read FHeaderSkin write SetHeaderSkin;
{$IFNDEF NOTFORHELP}
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle default bsNone;
    property Color;
    property Columns;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ItemHeight;
    property Items;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    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;
{$ENDIF} // NOTFORHELP
  end;

implementation

uses Consts, sVclUtils, acntUtils, sMessages, sGraphUtils, sAlphaGraph, sCommonData,
  sStyleSimply {$IFDEF DELPHI6UP}, RTLConsts{$ENDIF};

type
  TsCheckListBoxDataWrapper = class
  private
    FData: LongInt;
    FState: TCheckBoxState;
    FDisabled: Boolean;
    FHeader: Boolean;
    procedure SetChecked(Check: Boolean);
    function GetChecked: Boolean;
  public
    class function GetDefaultState: TCheckBoxState;
    property Checked: Boolean read GetChecked write SetChecked;
    property State: TCheckBoxState read FState write FState;
    property Disabled: Boolean read FDisabled write FDisabled;
    property Header: Boolean read FHeader write FHeader;
  end;

var
  FCheckWidth, FCheckHeight: Integer;

function CheckWidth(cb : TsCheckListBox) : integer;
begin
  if Assigned(cb.SkinData.SkinManager) and cb.SkinData.SkinManager.IsValidImgIndex(cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked) then begin
    Result := WidthOf(cb.SkinData.SkinManager.ma[cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked].R) div cb.SkinData.SkinManager.ma[cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked].ImageCount;
  end
  else Result := FCheckWidth;
end;

function CheckHeight(cb : TsCheckListBox) : integer;
begin
  if Assigned(cb.SkinData.SkinManager) and cb.SkinData.SkinManager.IsValidImgIndex(cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked) then begin
    Result := HeightOf(cb.SkinData.SkinManager.ma[cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked].R) div (cb.SkinData.SkinManager.ma[cb.SkinData.SkinManager.ConstData.SmallCheckBoxChecked].MaskType + 1);
  end
  else Result := FCheckHeight;
end;

procedure GetCheckSize;
begin
  with TBitmap.Create do
  try
    Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
    FCheckWidth := Width div 4;
    FCheckHeight := Height div 3;
  finally
    Free;
  end;
end;

function MakeSaveState(State: TCheckBoxState; Disabled: Boolean): TObject;
begin
  Result := TObject((Byte(State) shl 16) or Byte(Disabled));
end;

function GetSaveState(AObject: TObject): TCheckBoxState;
begin
  Result := TCheckBoxState(Integer(AObject) shr 16);
end;

function GetSaveDisabled(AObject: TObject): Boolean;
begin
  Result := Boolean(Integer(AObject) and $FF);
end;

{ TsCheckListBoxDataWrapper }

function TsCheckListBoxDataWrapper.GetChecked: Boolean;
begin
  Result := FState = cbChecked;
end;

class function TsCheckListBoxDataWrapper.GetDefaultState: TCheckBoxState;
begin
  Result := cbUnchecked;
end;

procedure TsCheckListBoxDataWrapper.SetChecked(Check: Boolean);
begin
  if Check then FState := cbChecked else FState := cbUnchecked;
end;

{ TsCheckListBox }

procedure TsCheckListBox.ClickCheck;
begin
  if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;

procedure TsCheckListBox.CNDrawItem(var Message: TWMDrawItem);
begin
  if not SkinData.Skinned then
    with Message.DrawItemStruct^ do
      if not Header[itemID] then
        if not UseRightToLeftAlignment
          then rcItem.Left := rcItem.Left + GetCheckWidth
          else rcItem.Right := rcItem.Right - GetCheckWidth;
  inherited;
end;

constructor TsCheckListBox.Create(AOwner: TComponent);
begin
  inherited;
  FHeaderColor := clInfoText;
  FHeaderBackgroundColor := clInfoBk;
end;

procedure TsCheckListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then Style := Style or LBS_OWNERDRAWFIXED;
end;

procedure TsCheckListBox.CreateWnd;
begin
  inherited CreateWnd;
  if FSaveStates <> nil then begin
    FreeAndNil(FSaveStates);
  end;
end;

function TsCheckListBox.CreateWrapper(Index: Integer): TObject;
begin
  Result := TsCheckListBoxDataWrapper.Create;
  inherited SetItemData(Index, LongInt(Result));
end;

procedure TsCheckListBox.DeleteString(Index: Integer);
begin
  if HaveWrapper(Index) then GetWrapper(Index).Free;
  inherited;
end;

destructor TsCheckListBox.Destroy;
begin
  FreeAndNil(FSaveStates);
  inherited;
end;

procedure TsCheckListBox.DestroyWnd;
var
  I: Integer;
begin
  if Items.Count > 0 then begin
    FSaveStates := TList.Create;
    for I := 0 to Items.Count - 1 do FSaveStates.Add(MakeSaveState(State[I], not ItemEnabled[I]));
  end;
  inherited DestroyWnd;
end;

procedure TsCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState; AEnabled: Boolean; Bmp : TBitmap);
var
  DrawState: Integer;
  DrawRect: TRect;
  SkinnedGlyph : boolean;
  CI : TCacheInfo;
  C : TsColor;
begin
  SkinnedGlyph := False;
  case AState of
    cbChecked : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxChecked) then SkinnedGlyph := True;
    cbUnChecked : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxUnChecked) then SkinnedGlyph := True;
    cbGrayed : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxGrayed) then SkinnedGlyph := True;
  end;

  DrawRect := R;
  DrawState := 0;
  if not SkinnedGlyph then begin
    OffsetRect(DrawRect, - DrawRect.Left, - DrawRect.Top);
    BitBlt(Bmp.Canvas.Handle, DrawRect.Left, DrawRect.Top, CheckWidth(Self) + 2, HeightOf(R), SkinData.FCacheBmp.Canvas.Handle, R.Left + 1, R.Top + 1, SRCCOPY);
    case AState of
      cbChecked: DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
      cbUnchecked: DrawState := DFCS_BUTTONCHECK;
      else DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
    end;
    if not AEnabled then DrawState := DrawState or DFCS_INACTIVE;
  end;
  DrawRect.Left := DrawRect.Left + (DrawRect.Right - DrawRect.Left - CheckWidth(Self)) div 2;
  DrawRect.Top := DrawRect.Top + (DrawRect.Bottom - DrawRect.Top - CheckHeight(Self)) div 2;
  DrawRect.Right := DrawRect.Left + CheckWidth(Self);
  DrawRect.Bottom := DrawRect.Top + CheckHeight(Self);

  if SkinnedGlyph then begin
    if not UseRightToLeftAlignment
      then OffsetRect(DrawRect, - DrawRect.Left, - DrawRect.Top + (HeightOf(R) - CheckHeight(Self)) div 2)
      else OffsetRect(DrawRect, 0, - DrawRect.Top + (HeightOf(R) - CheckHeight(Self)) div 2);
    BitBlt(Bmp.Canvas.Handle, DrawRect.Left, DrawRect.Top, CheckWidth(Self) + 2, HeightOf(R), SkinData.FCacheBmp.Canvas.Handle, R.Left + 1, R.Top + 1, SRCCOPY);

    case AState of // v4.65
      cbChecked : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxChecked)
        then sAlphaGraph.DrawSkinGlyph(Bmp, DrawRect.TopLeft, 0, 1, SkinData.SkinManager.ma[SkinData.SkinManager.ConstData.SmallCheckBoxChecked]);
      cbUnChecked : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxUnChecked)
        then sAlphaGraph.DrawSkinGlyph(Bmp, DrawRect.TopLeft, 0, 1, SkinData.SkinManager.ma[SkinData.SkinManager.ConstData.SmallCheckBoxUnChecked]);
      cbGrayed : if SkinData.SkinManager.IsValidImgIndex(SkinData.SkinManager.ConstData.SmallCheckBoxGrayed)
        then sAlphaGraph.DrawSkinGlyph(Bmp, DrawRect.TopLeft, 0, 1, SkinData.SkinManager.ma[SkinData.SkinManager.ConstData.SmallCheckBoxGrayed]);
    end;
    if not AEnabled then begin
      CI := MakeCacheInfo(SkinData.FCacheBMP);
      C.A := 255;
      BlendTransRectangle(Bmp, 0, 0, CI.Bmp, R, 0.4, C);
    end;
  end
  else DrawFrameControl(Bmp.Canvas.Handle, DrawRect, DFC_BUTTON, DrawState);
end;

procedure TsCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState; AEnabled: Boolean; C : TCanvas);
var
  DrawState: Integer;
  DrawRect: TRect;
  OldBrushColor: TColor;
  OldBrushStyle: TBrushStyle;
  OldPenColor: TColor;
  Rgn, SaveRgn: HRgn;
begin
  DrawRect := R;
  DrawRect.Left := DrawRect.Left + (DrawRect.Right - DrawRect.Left - CheckWidth(Self)) div 2;
  DrawRect.Top := DrawRect.Top + (DrawRect.Bottom - DrawRect.Top - CheckHeight(Self)) div 2;
  DrawRect.Right := DrawRect.Left + CheckWidth(Self);
  DrawRect.Bottom := DrawRect.Top + CheckHeight(Self);
  case AState of
    cbChecked: DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
    cbUnchecked: DrawState := DFCS_BUTTONCHECK;
    else DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
  end;
  if not AEnabled then DrawState := DrawState or DFCS_INACTIVE;

  SaveRgn := CreateRectRgn(0, 0, 0, 0);
  GetClipRgn(C.Handle, SaveRgn);
  with DrawRect do Rgn := CreateRectRgn(Left + 2, Top + 2, Right - 2, Bottom - 2);
  SelectClipRgn(C.Handle, Rgn);
  DeleteObject(Rgn);

  DrawFrameControl(C.Handle, DrawRect, DFC_BUTTON, DrawState);

  SelectClipRgn(C.Handle, SaveRgn);
  DeleteObject(SaveRgn);
  OldBrushStyle := C.Brush.Style;
  OldBrushColor := C.Brush.Color;
  OldPenColor := C.Pen.Color;
  C.Brush.Style := bsClear;