schecklistbox.pas

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

  C.Pen.Color := clBtnShadow;
  C.Rectangle(DrawRect.Left + 1, DrawRect.Top + 1, DrawRect.Right - 1, DrawRect.Bottom - 1);
  C.Brush.Style := OldBrushStyle;
  C.Brush.Color := OldBrushColor;
  C.Pen.Color := OldPenColor;
end;

procedure TsCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Enable: Boolean;
  ACheckWidth: Integer;
  TempBmp : Graphics.TBitmap;
  R : TRect;
  CI : TCacheInfo;
  Flags : word;
begin
  if (Index < 0) or (Index > Items.Count - 1) then Exit;
  if SkinData.BGChanged then SendAMessage(Handle, AC_PREPARECACHE);
  ACheckWidth := GetCheckWidth;
  if SkinData.Skinned then begin
    TempBmp := CreateBmp24(WidthOf(Rect), HeightOf(Rect));
    TempBmp.Canvas.Font.Assign(Font);
    try
      if not UseRightToLeftAlignment then begin
        R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
      end
      else begin
        R := Classes.Rect(0, 0, TempBmp.Width - ACheckWidth - 2, TempBmp.Height);
      end;
      BitBlt(TempBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, SkinData.FCacheBmp.Canvas.Handle, Rect.Left + 2, Rect.Top + 2, SRCCOPY);
      if (odSelected in State) then begin // If selected
        TempBmp.Canvas.Brush.Color := clHighlight;
        TempBmp.Canvas.Brush.Style := bsSolid;
        TempBmp.Canvas.FillRect(R);
        TempBmp.Canvas.Font.Color := clHighlightText;
      end
      else begin
        TempBmp.Canvas.Brush.Color := Color;
        TempBmp.Canvas.Brush.Style := bsClear;
        TempBmp.Canvas.Font.Color := Font.Color;
      end;
      R := Rect;
      if not UseRightToLeftAlignment
        then begin R.Left := 0; R.Right := ACheckWidth end
        else begin R.Left := Rect.Right - ACheckWidth; R.Right := Rect.Right end;
      Enable := Self.Enabled and GetItemEnabled(Index);
      if not Header[Index] then begin
        DrawCheck(R, GetState(Index), Enable, TempBmp);
        Flags := DT_VCENTER or DT_NOPREFIX;
        if not UseRightToLeftAlignment then begin
          R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
          R.Left := ACheckWidth + 2;
        end
        else begin
          R := Classes.Rect(1, 1, TempBmp.Width - ACheckWidth - 3, TempBmp.Height);
          Flags := Flags or DT_RIGHT;
//          R.Left := ACheckWidth + 2;
        end;

        if not Assigned(OnDrawItem) then begin
          if State = []
            then acWriteTextEx(TempBmp.Canvas, PacChar(Items[Index]), True, R, Flags, SkinData, ControlIsActive(SkinData))
            else acWriteText(TempBmp.Canvas, PacChar(Items[Index]), True, R, Flags);
        end;
        if not UseRightToLeftAlignment then begin
          R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
        end
        else begin
          R := Classes.Rect(0, 0, TempBmp.Width - ACheckWidth - 2, TempBmp.Height);
        end;
        if odFocused in State then DrawFocusRect(TempBmp.Canvas.Handle, R);
      end
      else begin
        R := Classes.Rect(0, 0, TempBmp.Width, TempBmp.Height);
        if SkinData.CustomColor then begin
          Canvas.Font.Color := HeaderColor;
          Canvas.Brush.Color := HeaderBackgroundColor;
          inherited;
          exit
        end
        else
        if HeaderSkin <> '' then begin
          ACheckWidth := SkinData.SkinManager.GetSkinIndex(HeaderSkin);
          if ACheckWidth > -1 then begin
            CI := MakeCacheInfo(TempBmp);
            PaintItem(ACheckWidth, HeaderSkin, CI, True, 1, R, Point(0, 0), TempBmp);
            TempBmp.Canvas.Font.Color := SkinData.SkinManager.gd[ACheckWidth].HotFontColor[1];
          end;
          if not Assigned(OnDrawItem) then begin
            acWriteText(TempBmp.Canvas, PacChar(Items[Index]), True, R, DT_VCENTER or DT_NOPREFIX)
          end;
        end
        else begin
          if SkinData.SkinManager.ConstData.IndexGlobalInfo > -1 then TempBmp.Canvas.Brush.Color := SkinData.SkinManager.gd[SkinData.SkinManager.ConstData.IndexGlobalInfo].Color else TempBmp.Canvas.Brush.Color := Color;
          TempBmp.Canvas.Brush.Style := bsSolid;
          TempBmp.Canvas.FillRect(R);
          if not Assigned(OnDrawItem) then begin
            acWriteTextEx(TempBmp.Canvas, PacChar(WideString(Items[Index])), True, R, DT_VCENTER or DT_NOPREFIX, SkinData, ControlIsActive(SkinData))
          end;
        end;
        R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
        R := Classes.Rect(0, 0, TempBmp.Width, TempBmp.Height);
        if (odFocused in State) then DrawFocusRect(TempBmp.Canvas.Handle, R);
      end;

      if not Enabled then begin
        CI := MakeCacheInfo(SkinData.FCacheBmp);
        BmpDisabledKind(TempBmp, DisabledKind, Parent, CI, Point(Rect.Left + 3, Rect.Top + 3));
      end;
      BitBlt(Canvas.Handle, Rect.Left, Rect.Top, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
      if Assigned(OnDrawItem) then begin
        R := Rect;
        R.Left := ACheckWidth + 2;
        OnDrawItem(Self, Index, R, State);
      end;
    finally
      FreeAndNil(TempBmp);
    end;
  end
  else begin
    Canvas.FillRect(Rect);
    if Header[Index] then begin
      Canvas.Font.Color := HeaderColor;
      Canvas.Brush.Color := HeaderBackgroundColor;
      inherited;
    end
    else begin
      inherited;
      Enable := False;
      if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State) else
      if (Index < Items.Count) and (Index > -1) then begin
        R := Rect;
        if not UseRightToLeftAlignment then begin
          R.Right := Rect.Left; R.Left := R.Right - ACheckWidth;
        end
        else begin
          R.Left := Rect.Right; R.Right := R.Left + ACheckWidth;
        end;
        Enable := Self.Enabled and GetItemEnabled(Index);
        DrawCheck(R, GetState(Index), Enable, Canvas);
      end;
      if not Enable then Canvas.Font.Color := clGrayText;
    end;
  end;
end;

function TsCheckListBox.ExtractWrapper(Index: Integer): TObject;
begin
  if Index < 0 then begin
    Result := nil;
    Exit;
  end;
  Result := TsCheckListBoxDataWrapper(inherited GetItemData(Index));
  if LB_ERR = Integer(Result) then
    raise EListError.CreateResFmt(@SListIndexError, [Index]);
  if (Result <> nil) and (not (Result is TsCheckListBoxDataWrapper)) then Result := nil;
end;

function TsCheckListBox.GetChecked(Index: Integer): Boolean;
begin
  if HaveWrapper(Index)
    then Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).GetChecked
    else Result := False;
end;

function TsCheckListBox.GetCheckWidth: Integer;
begin
  Result := CheckWidth(Self) + 2;
end;

function TsCheckListBox.GetHeader(Index: Integer): Boolean;
begin
  if HaveWrapper(Index) then
    Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).Header
  else
    Result := False;
end;

function TsCheckListBox.GetItemData(Index: Integer): LongInt;
begin
  Result := 0;
  if HaveWrapper(Index) then
    Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).FData;
end;

function TsCheckListBox.GetItemEnabled(Index: Integer): Boolean;
begin
  Result := False;
  if (Index = -1) or (Index > Items.Count - 1) then Exit;
  if HaveWrapper(Index)
    then Result := not TsCheckListBoxDataWrapper(GetWrapper(Index)).Disabled
    else Result := True;
end;

function TsCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
  if HaveWrapper(Index)
    then Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).State
    else Result := TsCheckListBoxDataWrapper.GetDefaultState;
end;

function TsCheckListBox.GetWrapper(Index: Integer): TObject;
begin
  Result := ExtractWrapper(Index);
  if Result = nil then Result := CreateWrapper(Index);
end;

function TsCheckListBox.HaveWrapper(Index: Integer): Boolean;
begin
  Result := ExtractWrapper(Index) <> nil;
end;

function TsCheckListBox.InternalGetItemData(Index: Integer): Longint;
begin
  Result := inherited GetItemData(Index);
end;

procedure TsCheckListBox.InternalSetItemData(Index, AData: Integer);
begin
  inherited SetItemData(Index, AData);
end;

procedure TsCheckListBox.InvalidateCheck(Index: Integer);
var
  R: TRect;
begin
  if not Header[Index] then begin
    R := ItemRect(Index);
    if not UseRightToLeftAlignment
      then R.Right := R.Left + GetCheckWidth
      else R.Left := R.Right - GetCheckWidth;
    InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
    UpdateWindow(Handle);
  end;
end;

procedure TsCheckListBox.KeyPress(var Key: Char);
begin
  if (Key = ' ') then ToggleClickCheck(ItemIndex) else inherited;
end;

procedure TsCheckListBox.ResetContent;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do if HaveWrapper(I) then GetWrapper(I).Free;
  inherited;
end;

procedure TsCheckListBox.SetChecked(Index: Integer; Checked: Boolean);
begin
  if Checked <> GetChecked(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).SetChecked(Checked);
    InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.SetHeader(Index: Integer; const Value: Boolean);
begin
  if Value <> GetHeader(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).Header := Value;
    SkinData.Invalidate;
  end;
end;

procedure TsCheckListBox.SetHeaderBackgroundColor(const Value: TColor);
begin
  if Value <> HeaderBackgroundColor then begin
    FHeaderBackgroundColor := Value;
    SkinData.Invalidate;
  end;
end;

procedure TsCheckListBox.SetHeaderColor(const Value: TColor);
begin
  if Value <> HeaderColor then begin
    FHeaderColor := Value;
    SkinData.Invalidate;
  end;
end;

procedure TsCheckListBox.SetHeaderSkin(const Value: TsSkinSection);
begin
  if FHeaderSkin <> Value then begin
    FHeaderSkin := Value;
    SkinData.Invalidate
  end;
end;

procedure TsCheckListBox.SetItemData(Index, AData: Integer);
var
  Wrapper: TsCheckListBoxDataWrapper;
  SaveState: TObject;
begin
  Wrapper := TsCheckListBoxDataWrapper(GetWrapper(Index));
  Wrapper.FData := AData;
  if FSaveStates <> nil then
    if FSaveStates.Count > 0 then begin
      SaveState := FSaveStates[0];
      Wrapper.FState := GetSaveState(SaveState);
      Wrapper.FDisabled := GetSaveDisabled(SaveState);
      FSaveStates.Delete(0);
    end;
end;

procedure TsCheckListBox.SetItemEnabled(Index: Integer; const Value: Boolean);
begin
  if Value <> GetItemEnabled(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).Disabled := not Value;
    InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
begin
  if AState <> GetState(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
    InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.ToggleClickCheck(Index: Integer);
var
  State: TCheckBoxState;
begin
  if (Index >= 0) and (Index < Items.Count) and GetItemEnabled(Index) then begin
    State := Self.State[Index];
    case State of
      cbUnchecked: if AllowGrayed then State := cbGrayed else State := cbChecked;
      cbChecked: State := cbUnchecked;
      cbGrayed: State := cbChecked;
    end;
    Self.State[Index] := State;
    ClickCheck;
  end;
end;

procedure TsCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
  i: Integer;
begin
  if Items <> nil then for i := 0 to Items.Count -1 do ExtractWrapper(i).Free;
  inherited;
end;

procedure TsCheckListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  Index: Integer;
begin
  inherited;
  Index := ItemAtPos(Point(Message.XPos,Message.YPos), True);
  if (Index <> -1) and GetItemEnabled(Index) then begin
    if not UseRightToLeftAlignment then begin
      if Message.XPos - ItemRect(Index).Left < GetCheckWidth then ToggleClickCheck(Index)
    end
    else begin
      Dec(Message.XPos, ItemRect(Index).Right - GetCheckWidth);
      if (Message.XPos > 0) and (Message.XPos < GetCheckWidth) then ToggleClickCheck(Index)
    end;
  end;
end;

initialization
  GetCheckSize;

finalization

end.