Delphi控件源码

开发平台：

Delphi

bsSkinBoxCtrls.pas：源码内容

if Down and MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNACTIVECOLOR;
Cnvs.FillRect(R1);
end
else
begin
Cnvs.Brush.Color := clBtnFace;
Cnvs.FillRect(R1);
end;
C := clBlack;
case i of
0: DrawArrowImage(Cnvs, R, C, 3);
1: DrawArrowImage(Cnvs, R, C, 4);
2: DrawCheckImage(Cnvs, R.Left + 4, R.Top + 4, C);
end;
end
else
with Buttons[i] do
if not IsNullRect(R) then
begin
R1 := NullRect;
case I of
0:
begin
if Down and MouseIn
then R1 := DownUpButtonRect
else if MouseIn then R1 := ActiveUpButtonRect;
end;
1:
begin
if Down and MouseIn
then R1 := DownDownButtonRect
else if MouseIn then R1 := ActiveDownButtonRect;
end;
2: begin
if Down and MouseIn
then R1 := DownCheckButtonRect
else if MouseIn then R1 := ActiveCheckButtonRect;
end;
end;
if not IsNullRect(R1)
then
Cnvs.CopyRect(R, Picture.Canvas, R1)
else
begin
case I of
0: R1 := UpButtonRect;
1: R1 := DownButtonRect;
2: R1 := CheckButtonRect;
end;
OffsetRect(R1, SkinRect.Left, SkinRect.Top);
Cnvs.CopyRect(R, Picture.Canvas, R1);
end;
end;
end;
procedure TbsSkinCustomListBox.CreateControlSkinImage;
var
GX, GY, GlyphNum, TX, TY, i, OffX, OffY: Integer;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
function CalcBRect(BR: TRect): TRect;
var
R: TRect;
begin
R := BR;
if BR.Top <= LTPt.Y
then
begin
if BR.Left > RTPt.X then OffsetRect(R, OffX, 0);
end
else
begin
OffsetRect(R, 0, OffY);
if BR.Left > RBPt.X then OffsetRect(R, OffX, 0);
end;
Result := R;
end;
begin
inherited;
// calc rects
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewClRect := ClRect;
Inc(NewClRect.Right, OffX);
Inc(NewClRect.Bottom, OffY);
if FCaptionMode
then
begin
NewCaptionRect := CaptionRect;
if CaptionRect.Right >= RTPt.X
then
Inc(NewCaptionRect.Right, OffX);
Buttons[0].R := CalcBRect(UpButtonRect);
Buttons[1].R := CalcBRect(DownButtonRect);
Buttons[2].R := CalcBRect(CheckButtonRect);
end;
// paint caption
if not IsNullRect(CaptionRect)
then
with B.Canvas do
begin
Font.Name := CaptionFontName;
Font.Height := CaptionFontHeight;
Font.Color := CaptionFontColor;
Font.Style := CaptionFontStyle;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := DefaultCaptionFont.CharSet;
TY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 -
TextHeight(Caption) div 2;
TX := NewCaptionRect.Left + 2;
case Alignment of
taCenter: TX := TX + RectWidth(NewCaptionRect) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := NewCaptionRect.Right - GetGlyphTextWidth - 2;
end;
Brush.Style := bsClear;
if not FGlyph.Empty
then
begin
GY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 - FGlyph.Height div 2;
GX := TX;
TX := GX + FGlyph.Width div FNumGlyphs + FSpacing;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
end;
TextRect(NewCaptionRect, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
end;
// paint buttons
for i := 0 to 2 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinCustomListBox.CreateControlDefaultImage;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
var
BW, i, TX, TY: Integer;
R: TRect;
GX, GY: Integer;
GlyphNum: Integer;
begin
inherited;
if FCaptionMode
then
begin
BW := 17;
if BW > FDefaultCaptionHeight - 3 then BW := FDefaultCaptionHeight - 3;
Buttons[0].R := Rect(Width - BW - 2, 2, Width - 2, 1 + BW);
Buttons[1].R := Rect(Buttons[0].R.Left - BW, 2, Buttons[0].R.Left, 1 + BW);
Buttons[2].R := Rect(Buttons[1].R.Left - BW, 2, Buttons[1].R.Left, 1 + BW);
end;
R := ClientRect;
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
if FCaptionMode
then
with B.Canvas do
begin
R := Rect(3, 2, Width - BW * 3 - 3, FDefaultCaptionHeight - 2);
Font.Assign(FDefaultCaptionFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
case Alignment of
taLeftJustify: TX := R.Left;
taCenter: TX := R.Left + RectWidth(R) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := R.Right - GetGlyphTextWidth;
end;
TY := (FDefaultCaptionHeight - 2) div 2 - TextHeight(Caption) div 2;
if not FGlyph.Empty
then
begin
GY := R.Top + RectHeight(R) div 2 - FGlyph.Height div 2 - 1;
GX := TX;
if FNumGlyphs = 0 then FNumGlyphs := 1;
TX := GX + FGlyph.Width div FNumGlyphs + FSpacing;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
end;
TextRect(R, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
Pen.Color := clBtnShadow;
MoveTo(1, FDefaultCaptionHeight - 1); LineTo(Width - 1, FDefaultCaptionHeight - 1);
for i := 0 to 2 do DrawButton(B.Canvas, i);
end;
end;
procedure TbsSkinCustomListBox.SetCaptionMode;
begin
FCaptionMode := Value;
if FIndex = -1
then
begin
CalcRects;
RePaint;
end;
end;
function TbsSkinCustomListBox.CalcHeight;
begin
if FIndex = -1
then
begin
Result := AitemsCount * ListBox.ItemHeight + 4;
if CaptionMode then Result := Result + FDefaultCaptionHeight;
end
else
Result := ClRect.Top + AitemsCount * ListBox.ItemHeight +
RectHeight(SkinRect) - ClRect.Bottom;
if HScrollBar <> nil
then
Inc(Result, HScrollBar.Height);
end;
procedure TbsSkinCustomListBox.Clear;
begin
ListBox.Clear;
UpDateScrollBar;
end;
function TbsSkinCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
begin
Result := ListBox.ItemAtPos(Pos, Existing);
end;
function TbsSkinCustomListBox.ItemRect(Item: Integer): TRect;
begin
Result := ListBox.ItemRect(Item);
end;
function TbsSkinCustomListBox.GetListBoxPopupMenu;
begin
Result := ListBox.PopupMenu;
end;
procedure TbsSkinCustomListBox.SetListBoxPopupMenu;
begin
ListBox.PopupMenu := Value;
end;
function TbsSkinCustomListBox.GetCanvas: TCanvas;
begin
Result := ListBox.Canvas;
end;
function TbsSkinCustomListBox.GetListBoxDragMode: TDragMode;
begin
Result := ListBox.DragMode;
end;
procedure TbsSkinCustomListBox.SetListBoxDragMode(Value: TDragMode);
begin
ListBox.DragMode := Value;
end;
function TbsSkinCustomListBox.GetListBoxDragKind: TDragKind;
begin
Result := ListBox.DragKind;
end;
procedure TbsSkinCustomListBox.SetListBoxDragKind(Value: TDragKind);
begin
ListBox.DragKind := Value;
end;
function TbsSkinCustomListBox.GetListBoxDragCursor: TCursor;
begin
Result := ListBox.DragCursor;
end;
procedure TbsSkinCustomListBox.SetListBoxDragCursor(Value: TCursor);
begin
ListBox.DragCursor := Value;
end;
function TbsSkinCustomListBox.GetExtandedSelect: Boolean;
begin
Result := ListBox.ExtendedSelect;
end;
procedure TbsSkinCustomListBox.SetExtandedSelect(Value: Boolean);
begin
ListBox.ExtendedSelect := Value;
end;
function TbsSkinCustomListBox.GetSelCount: Integer;
begin
Result := ListBox.SelCount;
end;
function TbsSkinCustomListBox.GetSelected(Index: Integer): Boolean;
begin
Result := ListBox.Selected[Index];
end;
procedure TbsSkinCustomListBox.SetSelected(Index: Integer; Value: Boolean);
begin
ListBox.Selected[Index] := Value;
end;
function TbsSkinCustomListBox.GetSorted: Boolean;
begin
Result := ListBox.Sorted;
end;
procedure TbsSkinCustomListBox.SetSorted(Value: Boolean);
begin
if ScrollBar <> nil then HideScrollBar;
ListBox.Sorted := Value;
end;
function TbsSkinCustomListBox.GetTopIndex: Integer;
begin
Result := ListBox.TopIndex;
end;
procedure TbsSkinCustomListBox.SetTopIndex(Value: Integer);
begin
ListBox.TopIndex := Value;
end;
function TbsSkinCustomListBox.GetMultiSelect: Boolean;
begin
Result := ListBox.MultiSelect;
end;
procedure TbsSkinCustomListBox.SetMultiSelect(Value: Boolean);
begin
ListBox.MultiSelect := Value;
end;
function TbsSkinCustomListBox.GetListBoxFont: TFont;
begin
Result := ListBox.Font;
end;
procedure TbsSkinCustomListBox.SetListBoxFont(Value: TFont);
begin
ListBox.Font.Assign(Value);
end;
function TbsSkinCustomListBox.GetListBoxTabOrder: TTabOrder;
begin
Result := ListBox.TabOrder;
end;
procedure TbsSkinCustomListBox.SetListBoxTabOrder(Value: TTabOrder);
begin
ListBox.TabOrder := Value;
end;
function TbsSkinCustomListBox.GetListBoxTabStop: Boolean;
begin
Result := ListBox.TabStop;
end;
procedure TbsSkinCustomListBox.SetListBoxTabStop(Value: Boolean);
begin
ListBox.TabStop := Value;
end;
procedure TbsSkinCustomListBox.ShowScrollBar;
begin
ScrollBar := TbsSkinScrollBar.Create(Self);
with ScrollBar do
begin
if Columns > 0
then
Kind := sbHorizontal
else
Kind := sbVertical;
Height := 100;
Width := 20;
PageSize := 0;
Min := 0;
Position := 0;
OnChange := SBChange;
if Self.FIndex = -1
then
SkinDataName := ''
else
if Columns > 0
then
SkinDataName := HScrollBarName
else
SkinDataName := VScrollBarName;
SkinData := Self.SkinData;
//
if HScrollBar <> nil
then
with HScrollBar do
begin
if Self.FIndex = -1
then
begin
SkinDataName := '';
FBoth := True;
BothMarkerWidth := 19;
end
else
begin
BothSkinDataName := BothScrollBarName;
SkinDataName := BothScrollBarName;
FBoth := True;
end;
SkinData := Self.SkinData;
end;
//
Parent := Self;
CalcRects;
Visible := True;
end;
RePaint;
end;
procedure TbsSkinCustomListBox.ShowHScrollBar;
begin
HScrollBar := TbsSkinScrollBar.Create(Self);
with HScrollBar do
begin
Kind := sbHorizontal;
Height := 100;
Width := 20;
PageSize := 0;
Min := 0;
Position := 0;
OnChange := HSBChange;
if Self.FIndex = -1
then
begin
SkinDataName := '';
if ScrollBar <> nil
then
begin
FBoth := True;
BothMarkerWidth := 19;
end;
end
else
if ScrollBar <> nil
then
begin
BothSkinDataName := BothScrollBarName;
SkinDataName := BothScrollBarName;
FBoth := True;
end
else
begin
BothSkinDataName := HScrollBarName;
SkinDataName := HScrollBarName;
FBoth := False;
end;
SkinData := Self.SkinData;
Parent := Self;
Visible := True;
CalcRects;
end;
RePaint;
end;
procedure TbsSkinCustomListBox.ListBoxEnter;
begin
end;
procedure TbsSkinCustomListBox.ListBoxExit;
begin
end;
procedure TbsSkinCustomListBox.ListBoxKeyDown;
begin
if Assigned(FOnListBoxKeyDown) then FOnListBoxKeyDown(Self, Key, Shift);
end;
procedure TbsSkinCustomListBox.ListBoxKeyUp;
begin
if Assigned(FOnListBoxKeyUp) then FOnListBoxKeyUp(Self, Key, Shift);
end;
procedure TbsSkinCustomListBox.ListBoxKeyPress;
begin
if Assigned(FOnListBoxKeyPress) then FOnListBoxKeyPress(Self, Key);
end;
procedure TbsSkinCustomListBox.ListBoxDblClick;
begin
if Assigned(FOnListBoxDblClick) then FOnListBoxDblClick(Self);
end;
procedure TbsSkinCustomListBox.ListBoxClick;
begin
if Assigned(FOnListBoxClick) then FOnListBoxClick(Self);
end;
procedure TbsSkinCustomListBox.ListBoxMouseDown;
begin
if Assigned(FOnListBoxMouseDown) then FOnListBoxMouseDown(Self, Button, Shift, X, Y);
end;
procedure TbsSkinCustomListBox.ListBoxMouseMove;
begin
if Assigned(FOnListBoxMouseMove) then FOnListBoxMouseMove(Self, Shift, X, Y);
end;
procedure TbsSkinCustomListBox.ListBoxMouseUp;
begin
if Assigned(FOnListBoxMouseUp) then FOnListBoxMouseUp(Self, Button, Shift, X, Y);
end;
procedure TbsSkinCustomListBox.HideScrollBar;
begin
ScrollBar.Visible := False;
ScrollBar.Free;
ScrollBar := nil;
CalcRects;
end;
procedure TbsSkinCustomListBox.HideHScrollBar;
begin
ListBox.HorizontalExtentValue := 0;
HScrollBar.Visible := False;
HScrollBar.Free;
HScrollBar := nil;
CalcRects;
ListBox.Repaint;
end;
procedure TbsSkinCustomListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TbsSkinCustomListBox.HSBChange(Sender: TObject);
begin
ListBox.HorizontalExtentValue := HScrollBar.Position;
ListBox.Repaint;
end;
procedure TbsSkinCustomListBox.SBChange;
var
LParam, WParam: Integer;
begin
LParam := 0;
WParam := MakeWParam(SB_THUMBPOSITION, ScrollBar.Position);
if Columns > 0
then
SendMessage(ListBox.Handle, WM_HSCROLL, WParam, LParam)
else
begin
SendMessage(ListBox.Handle, WM_VSCROLL, WParam, LParam);
end;
end;
function TbsSkinCustomListBox.GetItemIndex;
begin
Result := ListBox.ItemIndex;
end;
procedure TbsSkinCustomListBox.SetItemIndex;
begin
ListBox.ItemIndex := Value;
end;
procedure TbsSkinCustomListBox.SetItems;
begin
ListBox.Items.Assign(Value);
UpDateScrollBar;
end;
function TbsSkinCustomListBox.GetItems;
begin
Result := ListBox.Items;
end;
destructor TbsSkinCustomListBox.Destroy;
begin
if ScrollBar <> nil then ScrollBar.Free;
if ListBox <> nil then ListBox.Free;
FDefaultCaptionFont.Free;
FGlyph.Free;
inherited;
end;
procedure TbsSkinCustomListBox.CalcRects;
var
LTop: Integer;
OffX, OffY: Integer;
HSY: Integer;
begin
if FIndex <> -1
then
begin
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewClRect := ClRect;
Inc(NewClRect.Right, OffX);
Inc(NewClRect.Bottom, OffY);
end
else
if FCaptionMode
then
LTop := FDefaultCaptionHeight
else
LTop := 1;
if (Columns = 0) and (HScrollBar <> nil) and (HScrollBar.Visible)
then
begin
if FIndex = -1
then
begin
HScrollBar.SetBounds(1, Height - 20, Width - 2, 19);
HSY := HScrollBar.Height - 1;
end
else
begin
HScrollBar.SetBounds(NewClRect.Left,
NewClRect.Bottom - HScrollBar.Height,
RectWidth(NewClRect), HScrollBar.Height);
HSY := HScrollBar.Height;
end;
end
else
HSY := 0;
if (ScrollBar <> nil) and ScrollBar.Visible
then
begin
if FIndex = -1
then
begin
if Columns > 0
then
begin
ScrollBar.SetBounds(1, Height - 20, Width - 2, 19);
ListRect := Rect(2, LTop + 1, Width - 2, ScrollBar.Top);
end
else
begin
ScrollBar.SetBounds(Width - 20, LTop, 19, Height - 1 - LTop - HSY);
ListRect := Rect(2, LTop + 1, ScrollBar.Left, Height - 2 - HSY);
end;
end
else
begin
if Columns > 0
then
begin
ScrollBar.SetBounds(NewClRect.Left,
NewClRect.Bottom - ScrollBar.Height,
RectWidth(NewClRect), ScrollBar.Height);
ListRect := NewClRect;
Dec(ListRect.Bottom, ScrollBar.Height);
end
else
begin
ScrollBar.SetBounds(NewClRect.Right - ScrollBar.Width,
NewClRect.Top, ScrollBar.Width, RectHeight(NewClRect) - HSY);
ListRect := NewClRect;
Dec(ListRect.Right, ScrollBar.Width);
Dec(ListRect.Bottom, HSY);
end;
end;
end
else
begin
if FIndex = -1
then
ListRect := Rect(2, LTop + 1, Width - 2, Height - 2)
else
ListRect := NewClRect;
end;
if ListBox <> nil
then
ListBox.SetBounds(ListRect.Left, ListRect.Top,
RectWidth(ListRect), RectHeight(ListRect));
end;
procedure TbsSkinCustomListBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinListBox
then
with TbsDataSkinListBox(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.SItemRect := SItemRect;
Self.ActiveItemRect := ActiveItemRect;
if isNullRect(ActiveItemRect)
then
Self.ActiveItemRect := SItemRect;
Self.FocusItemRect := FocusItemRect;
if isNullRect(FocusItemRect)
then
Self.FocusItemRect := SItemRect;
Self.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.FocusFontColor := FocusFontColor;
//
Self.CaptionRect := CaptionRect;
Self.CaptionFontName := CaptionFontName;
Self.CaptionFontStyle := CaptionFontStyle;
Self.CaptionFontHeight := CaptionFontHeight;
Self.CaptionFontColor := CaptionFontColor;
Self.UpButtonRect := UpButtonRect;
Self.ActiveUpButtonRect := ActiveUpButtonRect;
Self.DownUpButtonRect := DownUpButtonRect;
if IsNullRect(Self.DownUpButtonRect)
then Self.DownUpButtonRect := Self.ActiveUpButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.ActiveDownButtonRect := ActiveDownButtonRect;
Self.DownDownButtonRect := DownDownButtonRect;
if IsNullRect(Self.DownDownButtonRect)
then Self.DownDownButtonRect := Self.ActiveDownButtonRect;
Self.CheckButtonRect := CheckButtonRect;
Self.ActiveCheckButtonRect := ActiveCheckButtonRect;
Self.DownCheckButtonRect := DownCheckButtonRect;
if IsNullRect(Self.DownCheckButtonRect)
then Self.DownCheckButtonRect := Self.ActiveCheckButtonRect;
//
Self.VScrollBarName := VScrollBarName;
Self.HScrollBarName := HScrollBarName;
Self.BothScrollBarName := BothScrollBarName;
end;
end;
procedure TbsSkinCustomListBox.ChangeSkinData;
begin
inherited;
//
FStopUpDateHScrollBar := True;
if (FIndex <> -1)
then
begin
if FUseSkinItemHeight
then
ListBox.ItemHeight := RectHeight(sItemRect);
end
else
begin
ListBox.ItemHeight := FDefaultItemHeight;
Font.Assign(FDefaultFont);
end;
if ScrollBar <> nil
then
with ScrollBar do
begin
if Self.FIndex = -1
then
SkinDataName := ''
else
if Columns > 0
then
SkinDataName := HScrollBarName
else
SkinDataName := VScrollBarName;
SkinData := Self.SkinData;
end;
if HScrollBar <> nil
then
with HScrollBar do
begin
if Self.FIndex = -1
then
begin
SkinDataName := '';
if ScrollBar <> nil
then
begin
FBoth := True;
BothMarkerWidth := 19;
end;
end
else
if ScrollBar <> nil
then
begin
SkinDataName := BothScrollBarName;
BothSkinDataName := BothScrollBarName;
FBoth := True;
end
else
begin
BothSkinDataName := HScrollBarName;
SkinDataName := HScrollBarName;
FBoth := False;
end;
SkinData := Self.SkinData;
end;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
CalcRects;
FStopUpDateHScrollBar := False;
UpDateScrollBar;
ListBox.RePaint;
end;
procedure TbsSkinCustomListBox.WMSIZE;
begin
inherited;
CalcRects;
UpDateScrollBar;
if ScrollBar <> nil then ScrollBar.RePaint;
end;
procedure TbsSkinCustomListBox.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
function TbsSkinCustomListBox.GetFullItemWidth(Index: Integer; ACnvs: TCanvas): Integer;
begin
Result := ACnvs.TextWidth(Items[Index]);
end;
procedure TbsSkinCustomListBox.UpDateScrollBar;
var
I, FMaxWidth, Min, Max, Pos, Page: Integer;
function GetPageSize: Integer;
begin
if FIndex = -1
then Result := ListBox.Width - 4
else
begin
Result := RectWidth(SItemRect) - RectWidth(ItemTextRect);
Result := ListBox.Width - Result;
end;
if Images <> nil then Result := Result - Images.Width - 4;
end;
begin
if (ListBox = nil) then Exit;
if Columns > 0
then
begin
GetScrollRange(ListBox.Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(ListBox.Handle, SB_HORZ);
Page := ListBox.Columns;
if (Max > Min) and (Pos <= Max) and (Page <= Max) and
((ListBox.Height div ListBox.ItemHeight) * Columns < ListBox.Items.Count)
then
begin
if ScrollBar = nil
then ShowScrollBar;
ScrollBar.SetRange(Min, Max, Pos, Page);
end
else
if (ScrollBar <> nil) and ScrollBar.Visible
then HideScrollBar;
end
else
begin
if FHorizontalExtent and not FStopUpDateHScrollBar
then
begin
FMaxWidth := 0;
with ListBox.Canvas do
begin
if (FIndex = -1)
then
Font.Assign(ListBox.Font)
else
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end;
end;
for I := 0 to Items.Count - 1 do
FMaxWidth := bsUtils.Max(FMaxWidth, GetFullItemWidth(I, ListBox.Canvas));
Page := GetPageSize;
if FMaxWidth > Page
then
begin
if HScrollBar = nil then ShowHScrollBar;
HScrollBar.SetRange(0, FMaxWidth, HScrollBar.Position, Page);
HScrollBar.SmallChange := ListBox.Canvas.TextWidth('0');
HScrollBar.LargeChange := ListBox.Canvas.TextWidth('0');
end
else
if (HScrollBar <> nil) and HScrollBar.Visible then HideHScrollBar;
end
else
if (HScrollBar <> nil) and HScrollBar.Visible then HideHScrollBar;
if not ((FRowCount > 0) and (RowCount = Items.Count))
then
begin
GetScrollRange(ListBox.Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(ListBox.Handle, SB_VERT);
Page := ListBox.Height div ListBox.ItemHeight;
if (Max > Min) and (Pos <= Max) and (Page < Items.Count)
then
begin
if ScrollBar = nil then ShowScrollBar;
ScrollBar.SetRange(Min, Max, Pos, Page);
ScrollBar.LargeChange := Page;
end
else
if (ScrollBar <> nil) and ScrollBar.Visible then HideScrollBar;
end
else
if (ScrollBar <> nil) and ScrollBar.Visible then HideScrollBar;
end;
end;
// combobox
constructor TbsSkinCustomComboBox.Create;
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csReplicatable, csOpaque, csDoubleClicks, csAcceptsControls];
FLBDown := False;
WasInLB := False;
TimerMode := 0;
FHideSelection := True;
FAutoComplete := True;
FAlphaBlendAnimation := False;
FAlphaBlend := False;
TabStop := True;
Font.Name := 'Arial';
Font.Color := clWindowText;
Font.Style := [];
Font.Height := 14;
Width := 120;
Height := 20;
FromEdit := False;
FEdit := nil;
//
FStyle := bscbFixedStyle;
FOnListBoxDrawItem := nil;
FListBox := TbsPopupListBox.Create(Self);
FListBox.Visible := False;
FlistBox.Parent := Self;
FListBox.ListBox.TabStop := False;
FListBox.ListBox.OnMouseMove := ListBoxMouseMove;
FListBoxWindowProc := FlistBox.ListBox.WindowProc;
FlistBox.ListBox.WindowProc := ListBoxWindowProcHook;
FListBox.OnCheckButtonClick := CheckButtonClick;
FLBDown := False;
FDropDownCount := 8;
//
CalcRects;
FSkinDataName := 'combobox';
FLastTime := 0;
FListBoxWidth := 0;
end;
procedure TbsSkinCustomComboBox.FindLBItemFromEdit;
var
I: Integer;
S1, S2: String;
begin
if (FListBox = nil) or (FListBox.ListBox = nil) then Exit;
if GetTickCount - FLastTime <= 200
then
Exit
else
FLastTime := GetTickCount;
if Length(Text) = 1
then
I := SendMessage(FListBox.ListBox.Handle, LB_FINDSTRING, ItemIndex, LongInt(PChar(Text)))
else
I := SendMessage(FListBox.ListBox.Handle, LB_FINDSTRING, -1, LongInt(PChar(Text)));
if I >= 0
then
begin
S1 := Text;
ItemIndex := I;
S2 := Text;
SelStart := Length(S1);
SelLength := Length(S2) - Length(S1);
end;
end;
procedure TbsSkinCustomComboBox.FindLBItem(S: String);
var
I: Integer;
S1: String;
begin
if (FListBox = nil) or (FListBox.ListBox = nil) then Exit;
if FAutoComplete
then
begin
if GetTickCount - FLastTime >= 500 then FFilter := '';
FLastTime := GetTickCount;
FFilter := FFilter + S;
S := FFilter;
end;
if Length(S) > 0
then
begin
if Length(S) = 1
then
I := SendMessage(FListBox.ListBox.Handle, LB_FINDSTRING, ItemIndex, LongInt(PChar(S)))
else
I := SendMessage(FListBox.ListBox.Handle, LB_FINDSTRING, -1, LongInt(PChar(S)));
end
else
I := -1;
if I >= 0 then ItemIndex := I;
end;
procedure TbsSkinCustomComboBox.KeyPress;
begin
inherited;
FindLBItem(Key);
end;
function TbsSkinCustomComboBox.GetSelStart: Integer;
begin
if (FEdit <> nil) then Result := FEdit.SelStart else Result := 0;
end;
procedure TbsSkinCustomComboBox.SetSelStart(Value: Integer);
begin
if (FEdit <> nil) then FEdit.SelStart := Value;
end;
function TbsSkinCustomComboBox.GetSelLength: Integer;
begin
if (FEdit <> nil) then Result := FEdit.SelLength else Result := 0;
end;
procedure TbsSkinCustomComboBox.SetSelLength(Value: Integer);
begin
if (FEdit <> nil) then FEdit.SelLength := Value;
end;
procedure TbsSkinCustomComboBox.EditKeyDown;
begin
if Assigned(OnKeyDown) then OnKeyDown(Self, Key, Shift);
end;
procedure TbsSkinCustomComboBox.EditKeyUp;
begin
if Assigned(OnKeyUp) then OnKeyUp(Self, Key, Shift);
end;
procedure TbsSkinCustomComboBox.EditKeyPress(Sender: TObject; var Key: Char);
begin
if Assigned(OnKeyPress) then OnKeyPress(Self, Key);
end;
destructor TbsSkinCustomComboBox.Destroy;
begin
if FEdit <> nil then FEdit.Free;
FlistBox.Free;
FlistBox := nil;
inherited;
end;
procedure TbsSkinCustomComboBox.CMEnabledChanged;
begin
inherited;
RePaint;
end;
function TbsSkinCustomComboBox.GetListBoxUseSkinItemHeight: Boolean;
begin
Result := FListBox.UseSkinItemHeight;
end;
procedure TbsSkinCustomComboBox.SetListBoxUseSkinItemHeight(Value: Boolean);
begin
FListBox.UseSkinItemHeight := Value;
end;
function TbsSkinCustomComboBox.GetListBoxUseSkinFont: Boolean;
begin
Result := FListBox.UseSkinFont;
end;
procedure TbsSkinCustomComboBox.SetListBoxUseSkinFont(Value: Boolean);
begin
FListBox.UseSkinFont := Value;
end;
function TbsSkinCustomComboBox.GetHorizontalExtent: Boolean;
begin
Result := FlistBox.HorizontalExtent;
end;
procedure TbsSkinCustomComboBox.SetHorizontalExtent(Value: Boolean);
begin
FlistBox.HorizontalExtent := Value;
end;
procedure TbsSkinCustomComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
function TbsSkinCustomComboBox.GetImages: TCustomImageList;
begin
if FListBox <> nil
then
Result := FListBox.Images
else
Result := nil;
end;
function TbsSkinCustomComboBox.GetImageIndex: Integer;
begin
Result := FListBox.ImageIndex;
end;
procedure TbsSkinCustomComboBox.SetImages(Value: TCustomImageList);
begin
FListBox.Images := Value;
RePaint;
end;
procedure TbsSkinCustomComboBox.SetImageIndex(Value: Integer);
begin
FListBox.ImageIndex := Value;
RePaint;
end;
procedure TbsSkinCustomComboBox.EditCancelMode(C: TControl);
begin
if (C <> Self) and
(C <> Self.FListBox) and
(C <> Self.FListBox.ScrollBar) and
(C <> Self.FListBox.HScrollBar) and
(C <> Self.FListBox.ListBox)
then
CloseUp(False);
end;
procedure TbsSkinCustomComboBox.CMCancelMode;
begin
inherited;
if (Message.Sender <> Self) and
(Message.Sender <> Self.FListBox) and
(Message.Sender <> Self.FListBox.ScrollBar) and
(Message.Sender <> Self.FListBox.HScrollBar) and
(Message.Sender <> Self.FListBox.ListBox)
then
CloseUp(False);
end;
procedure TbsSkinCustomComboBox.Change;
begin
end;
function TbsSkinCustomComboBox.GetListBoxDefaultFont;
begin
Result := FListBox.DefaultFont;
end;
procedure TbsSkinCustomComboBox.SetListBoxDefaultFont;
begin
FListBox.DefaultFont.Assign(Value);
end;
function TbsSkinCustomComboBox.GetListBoxDefaultCaptionFont;
begin
Result := FListBox.DefaultCaptionFont;
end;
procedure TbsSkinCustomComboBox.SetListBoxDefaultCaptionFont;
begin
FListBox.DefaultCaptionFont.Assign(Value);
end;
function TbsSkinCustomComboBox.GetListBoxDefaultItemHeight;
begin
Result := FListBox.DefaultItemHeight;
end;
procedure TbsSkinCustomComboBox.SetListBoxDefaultItemHeight;
begin
FListBox.DefaultItemHeight := Value;
end;
function TbsSkinCustomComboBox.GetListBoxCaptionAlignment;
begin
Result := FListBox.Alignment;
end;
procedure TbsSkinCustomComboBox.SetListBoxCaptionAlignment;
begin
FListBox.Alignment := Value;
end;
procedure TbsSkinCustomComboBox.DefaultFontChange;
begin
Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomComboBox.CheckButtonClick;
begin
CloseUp(True);
end;
procedure TbsSkinCustomComboBox.SetListBoxCaption;
begin
FListBox.Caption := Value;
end;
function TbsSkinCustomComboBox.GetListBoxCaption;
begin
Result := FListBox.Caption;
end;
procedure TbsSkinCustomComboBox.SetListBoxCaptionMode;
begin
FListBox.CaptionMode := Value;
end;
function TbsSkinCustomComboBox.GetListBoxCaptionMode;
begin
Result := FListBox.CaptionMode;
end;
function TbsSkinCustomComboBox.GetSorted: Boolean;
begin
Result := FListBox.Sorted;
end;
procedure TbsSkinCustomComboBox.SetSorted(Value: Boolean);
begin
FListBox.Sorted := Value;
end;
procedure TbsSkinCustomComboBox.SetListBoxDrawItem;
begin
FOnListboxDrawItem := Value;
FListBox.OnDrawItem := FOnListboxDrawItem;
end;
procedure TbsSkinCustomComboBox.ListBoxDrawItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
begin
if Assigned(FOnListBoxDrawItem)
then FOnListBoxDrawItem(Cnvs, Index, ItemWidth, ItemHeight, TextRect, State);
end;
procedure TbsSkinCustomComboBox.SetStyle;
begin
if (FStyle = Value) and (csDesigning in ComponentState) then Exit;
FStyle := Value;
case FStyle of
bscbFixedStyle:
begin
TabStop := True;
if FEdit <> nil then HideEditor;
end;
bscbEditStyle:
begin
TabStop := False;
ShowEditor;
FEdit.Text := Text;
if Focused then FEdit.SetFocus;
end;
end;
CalcRects;
ReCreateWnd;
RePaint;
end;
procedure TbsSkinCustomComboBox.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
case Msg.CharCode of
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Msg.Result := 1;
end;
end;
procedure TbsSkinCustomComboBox.KeyDown;
var
I: Integer;
begin
inherited KeyDown(Key, Shift);
case Key of
VK_UP, VK_LEFT:
if ssAlt in Shift
then
begin
if FListBox.Visible then CloseUp(False);
end
else
EditUp1(True);
VK_DOWN, VK_RIGHT:
if ssAlt in Shift
then
begin
if not FListBox.Visible then DropDown;
end
else
EditDown1(True);
VK_NEXT: EditPageDown1(True);
VK_PRIOR: EditPageUp1(True);
VK_ESCAPE: if FListBox.Visible then CloseUp(False);
VK_RETURN: if FListBox.Visible then CloseUp(True);
end;
end;
procedure TbsSkinCustomComboBox.WMMOUSEWHEEL;
begin
if FEdit <> nil then Exit;
if Message.WParam > 0
then
EditUp1(not FListBox.Visible)
else
EditDown1(not FListBox.Visible);
end;
procedure TbsSkinCustomComboBox.WMSETFOCUS;
begin
if FEdit <> nil
then
FEDit.SetFocus
else
begin
inherited;
RePaint;
end;
end;
procedure TbsSkinCustomComboBox.WMKILLFOCUS;
begin
inherited;
if FListBox.Visible and (FEdit = nil)
then CloseUp(False);
RePaint;
end;
procedure TbsSkinCustomComboBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinComboBox
then
with TbsDataSkinComboBox(FSD.CtrlList.Items[FIndex]) do
begin
Self.SItemRect := SItemRect;
Self.FocusItemRect := FocusItemRect;
if isNullRect(FocusItemRect)
then
Self.FocusItemRect := SItemRect;
Self.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.FocusFontColor := FocusFontColor;
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.UnEnabledButtonRect := UnEnabledButtonRect;
Self.ListBoxName := ListBoxName;
end;
end;
procedure TbsSkinCustomComboBox.Invalidate;
begin
inherited;
if (FIndex <> -1) and (FEdit <> nil) then FEdit.Invalidate;
end;
function TbsSkinCustomComboBox.GetItemIndex;
begin
Result := FListBox.ItemIndex;
end;
procedure TbsSkinCustomComboBox.SetItemIndex;
begin
FListBox.ItemIndex := Value;
if (FListBox.Items.Count > 0) and (FListBox.ItemIndex <> -1)
then
Text := FListBox.Items[FListBox.ItemIndex];
FOldItemIndex := FListBox.ItemIndex;
if FEdit = nil then RePaint;
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState)
then
begin
if Assigned(FOnClick) then FOnClick(Self);
Change;
end;
end;
function TbsSkinCustomComboBox.IsPopupVisible: Boolean;
begin
Result := FListBox.Visible;
end;
function TbsSkinCustomComboBox.CanCancelDropDown;
begin
Result := FListBox.Visible and not FMouseIn;
end;
procedure TbsSkinCustomComboBox.EditWindowProcHook(var Message: TMessage);
function GetCharSet: TFontCharSet;
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Result := SkinData.ResourceStrData.CharSet
else
Result := FDefaultFont.Charset;
end;
var
FOld: Boolean;
Index: Integer;
CharSet: TFontCharSet;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONDOWN, WM_RBUTTONDOWN:
begin
if FListBox.Visible then CloseUp(False);
end;
WM_KILLFOCUS:
begin
if FListBox.Visible then CloseUp(False);
end;
WM_MOUSEWHEEL:
begin
if Message.WParam > 0
then
EditUp(not FListBox.Visible)
else
EditDown(not FListBox.Visible);
end;
WM_SYSKEYUP:
begin
CharSet := GetCharSet;
if (CharSet = SHIFTJIS_CHARSET) or (CharSet = GB2312_CHARSET) or
(CharSet = SHIFTJIS_CHARSET) or (CharSet = CHINESEBIG5_CHARSET)
then
begin
if not ((TWMKEYUP(Message).CharCode = 46) or
(TWMKEYUP(Message).CharCode =8))
then
begin
FEdit.ClearSelection;
FEditWindowProc(Message);
FOld := False;
if FAutoComplete then FindLBItemFromEdit;
end;
end;
end;
WM_KEYUP:
begin
CharSet := GetCharSet;
if (CharSet = SHIFTJIS_CHARSET) or (CharSet = GB2312_CHARSET) or
(CharSet = SHIFTJIS_CHARSET) or (CharSet = CHINESEBIG5_CHARSET)
then
begin
if not ((TWMKEYUP(Message).CharCode = 46) or
(TWMKEYUP(Message).CharCode = 8))
then
begin
FEdit.ClearSelection;
FEditWindowProc(Message);
FOld := False;
if FAutoComplete then FindLBItemFromEdit;
end;
end
else
if TWMKEYUP(Message).CharCode > 47
then
begin
FEditWindowProc(Message);
FOld := False;
if FAutoComplete then FindLBItemFromEdit;
end;
end;
WM_KEYDOWN:
begin
case TWMKEYDOWN(Message).CharCode of
VK_PRIOR:
if FListBox.Visible
then
begin
Index := FListBox.ItemIndex - DropDownCount - 1;
if Index < 0
then
Index := 0;
FListBox.ItemIndex := Index;
end;
VK_NEXT:
if FListBox.Visible
then
begin
Index := FListBox.ItemIndex + DropDownCount - 1;
if Index > FListBox.Items.Count - 1
then
Index := FListBox.Items.Count - 1;
FListBox.ItemIndex := Index;
end;
VK_RETURN:
begin
if FListBox.Visible then CloseUp(True);
end;
VK_ESCAPE:
begin
if FListBox.Visible then CloseUp(False);
end;
VK_UP:
begin
EditUp(True);
FOld := False;
end;
VK_DOWN:
begin
EditDown(True);
FOld := False;
end;
end;
end;
end;
if FOld then FEditWindowProc(Message);
end;
procedure TbsSkinCustomComboBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 25, nil);
end;
procedure TbsSkinCustomComboBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinCustomComboBox.WMTimer;
begin
inherited;
case TimerMode of
1: if FListBox.ItemIndex > 0
then
FListBox.ItemIndex := FListBox.ItemIndex - 1;
2:
if FListBox.ItemIndex < FListBox.Items.Count
then
FListBox.ItemIndex := FListBox.ItemIndex + 1;
end;
end;
procedure TbsSkinCustomComboBox.ProcessListBox;
var
R: TRect;
P: TPoint;
LBP: TPoint;
begin
GetCursorPos(P);
P := FListBox.ListBox.ScreenToClient(P);
if (P.Y < 0) and (FListBox.ScrollBar <> nil) and WasInLB
then
begin
if (TimerMode <> 1)
then
begin
TimerMode := 1;
StartTimer;
end;
end
else
if (P.Y > FListBox.ListBox.Height) and (FListBox.ScrollBar <> nil) and WasInLB
then
begin
if (TimerMode <> 2)
then
begin
TimerMode := 2;
StartTimer;
end
end
else
if (P.Y >= 0) and (P.Y <= FListBox.ListBox.Height)
then
begin
if TimerMode <> 0 then StopTimer;
FListBox.ListBox.MouseMove([], 1, P.Y);
WasInLB := True;
end;
end;
procedure TbsSkinCustomComboBox.ListBoxWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONDOWN:
begin
FOLd := False;
FLBDown := True;
WasInLB := True;
SetCapture(Self.Handle);
end;
WM_LBUTTONUP:
begin
CloseUp(True);
FOLD := False;
end;
WM_RBUTTONDOWN, WM_RBUTTONUP,
WM_MBUTTONDOWN, WM_MBUTTONUP:
begin
FOLd := False;
end;
WM_MOUSEACTIVATE:
begin
Message.Result := MA_NOACTIVATE;
end;
end;
if FOld then FListBoxWindowProc(Message);
end;
procedure TbsSkinCustomComboBox.CMMouseEnter;
begin
inherited;
FMouseIn := True;
end;
procedure TbsSkinCustomComboBox.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCustomComboBox.SetDropDownCount(Value: Integer);
begin
if Value > 0
then
FDropDownCount := Value;
end;
procedure TbsSkinCustomComboBox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Index: Integer;
begin
Index := FListBox.ItemAtPos(Point (X, Y), True);
if (Index >= 0) and (Index < Items.Count)
then
FListBox.ItemIndex := Index;
end;
procedure TbsSkinCustomComboBox.SetItems;
begin
FListBox.Items.Assign(Value);
end;
function TbsSkinCustomComboBox.GetItems;
begin
Result := FListBox.Items;
end;
procedure TbsSkinCustomComboBox.MouseDown;
begin
inherited;
if not Focused and (FEdit = nil) then SetFocus;
if Button <> mbLeft then Exit;
if Self.Button.MouseIn or
(PtInRect(CBItem.R, Point(X, Y)) and (FEdit = nil))
then
begin
Self.Button.Down := True;
RePaint;
if FListBox.Visible then CloseUp(False)
else
begin
WasInLB := False;
FLBDown := True;
DropDown;
end;
end
else
if FListBox.Visible then CloseUp(False);
end;
procedure TbsSkinCustomComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
P: TPoint;
begin
if FLBDown and WasInLB
then
begin
ReleaseCapture;
FLBDown := False;
GetCursorPos(P);
if WindowFromPoint(P) = FListBox.ListBox.Handle
then
CloseUp(True)
else
CloseUp(False);
end
else
FLBDown := False;
inherited;
if Self.Button.Down
then
begin
Self.Button.Down := False;
RePaint;
end;
end;
procedure TbsSkinCustomComboBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if FLBDown
then
begin
ProcessListBox;
end
else
if PtInRect(Button.R, Point(X, Y)) and not Button.MouseIn
then
begin
Button.MouseIn := True;
RePaint;
end
else
if not PtInRect(Button.R, Point(X, Y)) and Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCustomComboBox.CloseUp;
begin
if TimerMode <> 0 then StopTimer;
if not FListBox.Visible then Exit;
FListBox.Hide;
if (FListBox.ItemIndex >= 0) and
(FListBox.ItemIndex < FListBox.Items.Count) and Value
then
begin
if FEdit <> nil
then
FEdit.Text := FListBox.Items[FListBox.ItemIndex]
else
begin
Text := FListBox.Items[FListBox.ItemIndex];
RePaint;
end;
if Assigned(FOnClick) then FOnClick(Self);
Change;
end
else
FListBox.ItemIndex := FOldItemIndex;
RePaint;
if Value
then
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
procedure TbsSkinCustomComboBox.DropDown;
function GetForm(AControl : TControl) : TForm;
var
temp : TControl;
begin
result := nil;
temp := AControl;
repeat
if assigned(temp) then
begin
if temp is TForm then
break;
end;
temp := temp.Parent;
until temp = nil;
end;
var
P: TPoint;
WorkArea: TRect;
begin
if Items.Count = 0 then Exit;
WasInLB := False;
if TimerMode <> 0 then StopTimer;
if Assigned(FOnDropDown) then FOnDropDown(Self);
if FListBoxWidth = 0
then
FListBox.Width := Width
else
FListBox.Width := FListBoxWidth;
if Items.Count < DropDownCount
then
FListBox.RowCount := Items.Count
else
FListBox.RowCount := DropDownCount;
P := Point(Left, Top + Height);
P := Parent.ClientToScreen (P);
WorkArea := GetMonitorWorkArea(Handle, True);
if P.Y + FListBox.Height > WorkArea.Bottom
then
P.Y := P.Y - Height - FListBox.Height;
if FEdit <> nil then FEdit.SetFocus;
FOldItemIndex := FListBox.ItemIndex;
if (FListBox.ItemIndex = 0) and (FListBox.Items.Count > 1)
then
begin
FListBox.ItemIndex := 1;
FListBox.ItemIndex := 0;
end;
FListBox.TopIndex := FListBox.ItemIndex;
FListBox.SkinData := SkinData;
FListBox.Show(P);
end;
procedure TbsSkinCustomComboBox.EditPageUp1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex - DropDownCount - 1;
if Index < 0 then Index := 0;
if AChange
then
ItemIndex := Index
else
FListBox.ItemIndex := Index;
end;
procedure TbsSkinCustomComboBox.EditPageDown1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex + DropDownCount - 1;
if Index > FListBox.Items.Count - 1
then
Index := FListBox.Items.Count - 1;
if AChange
then
ItemIndex := Index
else
FListBox.ItemIndex := Index;
end;
procedure TbsSkinCustomComboBox.EditUp1;
begin
if FListBox.ItemIndex > 0
then
begin
if AChange
then
ItemIndex := ItemIndex - 1
else
FListBox.ItemIndex := FListBox.ItemIndex - 1;
end;
end;
procedure TbsSkinCustomComboBox.EditDown1;
begin
if FListBox.ItemIndex < FListBox.Items.Count - 1
then
begin
if AChange
then
ItemIndex := ItemIndex + 1
else
FListBox.ItemIndex := FListBox.ItemIndex + 1;
end;
end;
procedure TbsSkinCustomComboBox.EditUp;
begin
if ItemIndex > 0
then
begin
ItemIndex := ItemIndex - 1;
if AChange
then
begin
Text := Items[ItemIndex];
if Assigned(FOnClick) then FOnClick(Self);
end;
end;
end;
procedure TbsSkinCustomComboBox.EditDown;
begin
if ItemIndex < Items.Count - 1
then
begin
FListBox.ItemIndex := FListBox.ItemIndex + 1;
if AChange
then
begin
Text := FListBox.Items[FListBox.ItemIndex];
if Assigned(FOnClick) then FOnClick(Self);
end;
end;
end;
procedure TbsSkinCustomComboBox.EditChange(Sender: TObject);
var
I: Integer;
begin
FromEdit := True;
if (FListBox <> nil) and (FEdit.Text <> '')
then
begin
I := SendMessage(FListBox.ListBox.Handle, LB_FINDSTRING, -1, LongInt(PChar(FEdit.Text)));
if I >= 0
then
if FAutoComplete
then
SendMessage(FListBox.ListBox.Handle, LB_SETCURSEL, I, 0)
else
SendMessage(FListBox.ListBox.Handle, LB_SETTOPINDEX, I, 0);
end;
Text := FEdit.Text;
FromEdit := False;
end;
procedure TbsSkinCustomComboBox.ShowEditor;
begin
FEdit := TbsCustomEdit.Create(Self);
FEdit.Parent := Self;
FEdit.AutoSize := False;
FEdit.HideSelection := FHideSelection;
FEdit.Visible := True;
FEdit.EditTransparent := False;
FEdit.OnChange := EditChange;
FEditWindowProc := FEdit.WindowProc;
FEdit.WindowProc := EditWindowProcHook;
FEdit.OnEditCancelMode := EditCancelMode;
FEdit.OnKeyDown := EditKeyDown;
FEdit.OnKeyPress := EditKeyPress;
FEdit.OnKeyUp := EditKeyUp;
//
if FIndex <> -1
then
with FEdit.Font do
begin
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
Name := FontName;
end
else
with FEdit.Font do
begin
Name := Self.Font.Name;
Style := Self.Font.Style;
Color := Self.Font.Color;
Height := Self.Font.Height;
end;
if FIndex <> -1
then FEdit.EditTransparent := True
else FEdit.EditTransparent := False;
//
CalcRects;
end;
procedure TbsSkinCustomComboBox.HideEditor;
begin
FEdit.Visible := False;
FEdit.Free;
FEdit := nil;
end;
procedure TbsSkinCustomComboBox.CMTextChanged;
begin
inherited;
if (FEdit <> nil) and not FromEdit then FEdit.Text := Text;
if Assigned(FOnChange) then FOnChange(Self);
if FromEdit then Change;
end;
procedure TbsSkinCustomComboBox.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TbsSkinCustomComboBox.DrawButton;
var
ArrowColor: TColor;
R1: TRect;
begin
if FIndex = -1
then
with Button do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(C, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := BS_XP_BTNDOWNCOLOR;
C.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(C, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := BS_XP_BTNACTIVECOLOR;
C.FillRect(R1);
end
else
begin
Frame3D(C, R1, clBtnShadow, clBtnShadow, 1);
C.Brush.Color := clBtnFace;
C.FillRect(R1);
end;
if Enabled
then
ArrowColor := clBlack
else
ArrowColor := clBtnShadow;
DrawArrowImage(C, R, ArrowColor, 4);
end
else
with Button do
begin
R1 := NullRect;
if not Enabled and not IsNullRect(UnEnabledButtonRect)
then
R1 := UnEnabledButtonRect
else
if Down and MouseIn
then R1 := DownButtonRect
else if MouseIn then R1 := ActiveButtonRect;
if not IsNullRect(R1)
then
C.CopyRect(R, Picture.Canvas, R1);
end;
end;
procedure TbsSkinCustomComboBox.DrawDefaultItem;
var
Buffer: TBitMap;
R, R1: TRect;
Index, IIndex, IX, IY: Integer;
begin
if RectWidth(CBItem.R) <=0 then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(CBItem.R);
Buffer.Height := RectHeight(CBItem.R);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
Font.Name := Self.Font.Name;
Font.Style := Self.Font.Style;
Font.Height := Self.Font.Height;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.Charset := FDefaultFont.Charset;
if Focused
then
begin
Brush.Color := clHighLight;
Font.Color := clHighLightText;
end
else
begin
Brush.Color := clWindow;
Font.Color := clWindowText;
end;
FillRect(R);
end;
if FListBox.Visible
then Index := FOldItemIndex
else Index := FListBox.ItemIndex;
CBItem.State := [];
if Focused then CBItem.State := [odFocused];
R1 := Rect(R.Left + 2, R.Top, R.Right - 2, R.Bottom);
if (Index > -1) and (Index < FListBox.Items.Count)
then
if Assigned(FOnComboBoxDrawItem)
then
FOnComboBoxDrawItem(Buffer.Canvas, Index, Buffer.Width, Buffer.Height,
R1, CBItem.State)
else
begin
if Images <> nil
then
begin
if ImageIndex > -1
then IIndex := ImageIndex
else IIndex := Index;
if IIndex < Images.Count
then
begin
IX := R1.Left;
IY := R1.Top + RectHeight(R1) div 2 - Images.Height div 2;
Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R1.Left, Images.Width + 2);
end;
BSDrawText2(Buffer.Canvas, FListBox.Items[Index], R1);
end;
if Focused then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TbsSkinCustomComboBox.DrawSkinItem;
var
Buffer: TBitMap;
R, R2: TRect;
W, H: Integer;
Index, IIndex, IX, IY: Integer;
begin
W := RectWidth(CBItem.R);
if W <= 0 then Exit;
H := RectHeight(SItemRect);
if H = 0 then H := RectHeight(FocusItemRect);
if H = 0 then H := RectWidth(CBItem.R);
Buffer := TBitMap.Create;
if Focused
then
begin
if not IsNullRect(FocusItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end
else
begin
if not IsNullRect(SItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end;
R := ItemTextRect;
if not IsNullRect(SItemRect)
then
Inc(R.Right, W - RectWidth(SItemRect))
else
Inc(R.Right, W - RectWidth(ClRect));
with Buffer.Canvas do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end
else
Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
if Focused
then
Font.Color := FocusFontColor
else
Font.Color := FontColor;
Brush.Style := bsClear;
end;
if FListBox.Visible
then Index := FOldItemIndex
else Index := FListBox.ItemIndex;
if (Index > -1) and (Index < FListBox.Items.Count)
then
if Assigned(FOnComboBoxDrawItem)
then
FOnComboBoxDrawItem(Buffer.Canvas, Index, Buffer.Width, Buffer.Height,
R, CBItem.State)
else
begin
if Images <> nil
then
begin
if ImageIndex > -1
then IIndex := ImageIndex
else IIndex := Index;
if IIndex < Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - Images.Height div 2;
Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, Images.Width + 2);
end;
BSDrawText2(Buffer.Canvas, FListBox.Items[Index], R);
end;
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TbsSkinCustomComboBox.CalcRects;
const
ButtonW = 17;
var
OX: Integer;
begin
if FIndex = -1
then
begin
Button.R := Rect(Width - ButtonW - 2, 2, Width - 2, Height - 2);
CBItem.R := Rect(2, 2, Button.R.Left - 1 , Height - 2);
end
else
begin
OX := Width - RectWidth(SkinRect);
Button.R := ButtonRect;
if ButtonRect.Left >= RectWidth(SkinRect) - RTPt.X
then
OffsetRect(Button.R, OX, 0);
CBItem.R := ClRect;
Inc(CBItem.R.Right, OX);
end;
if FEdit <> nil
then
begin
FEdit.Left := CBItem.R.Left;
FEdit.Top := CBItem.R.Top;
FEdit.Width := RectWidth(CBItem.R);
FEdit.Height := RectHeight(CBItem.R);
end;
end;
procedure TbsSkinCustomComboBox.ChangeSkinData;
begin
inherited;
CalcRects;
if FEdit <> nil
then
begin
if FIndex <> -1
then
with FEdit.Font do
begin
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
Name := FontName;
end
else
FEdit.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
FEdit.Font.Charset := SkinData.ResourceStrData.CharSet
else
FEdit.Font.CharSet := FDefaultFont.CharSet;
if FIndex <> -1
then FEdit.EditTransparent := True
else FEdit.EditTransparent := False;
end;
RePaint;
if FIndex = -1
then
begin
FListBox.SkinDataName := '';
end
else
FListBox.SkinDataName := ListBoxName;
FListBox.SkinData := SkinData;
FListBox.UpDateScrollBar;
//
end;
procedure TbsSkinCustomComboBox.CreateControlDefaultImage;
var
R: TRect;
begin
CalcRects;
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
DrawButton(B.Canvas);
if FEdit = nil then DrawDefaultItem(B.Canvas);
end;
procedure TbsSkinCustomComboBox.CreateControlSkinImage;
begin
CalcRects;
inherited;
DrawButton(B.Canvas);
if FEdit = nil then DrawSkinItem(B.Canvas);
end;
// ==================== TbsSkinFontComboBox ======================= //
const
WRITABLE_FONTTYPE = 256;
function IsValidFont(Box: TbsSkinFontComboBox; LogFont: TLogFont;
FontType: Integer): Boolean;
begin
Result := True;
if (foAnsiOnly in Box.Options) then
Result := Result and (LogFont.lfCharSet = ANSI_CHARSET);
if (foTrueTypeOnly in Box.Options) then
Result := Result and (FontType and TRUETYPE_FONTTYPE = TRUETYPE_FONTTYPE);
if (foFixedPitchOnly in Box.Options) then
Result := Result and (LogFont.lfPitchAndFamily and FIXED_PITCH = FIXED_PITCH);
if (foOEMFontsOnly in Box.Options) then
Result := Result and (LogFont.lfCharSet = OEM_CHARSET);
if (foNoOEMFonts in Box.Options) then
Result := Result and (LogFont.lfCharSet <> OEM_CHARSET);
if (foNoSymbolFonts in Box.Options) then
Result := Result and (LogFont.lfCharSet <> SYMBOL_CHARSET);
if (foScalableOnly in Box.Options) then
Result := Result and (FontType and RASTER_FONTTYPE = 0);
end;
function EnumFonTbsroc(var EnumLogFont: TEnumLogFont;
var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer;
export; stdcall;
var
FaceName: string;
begin
FaceName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
with TbsSkinFontComboBox(Data) do
if (Items.IndexOf(FaceName) < 0) and
IsValidFont(TbsSkinFontComboBox(Data), EnumLogFont.elfLogFont, FontType) then
begin
if EnumLogFont.elfLogFont.lfCharSet <> SYMBOL_CHARSET then
FontType := FontType or WRITABLE_FONTTYPE;
Items.AddObject(FaceName, TObject(FontType));
end;
Result := 1;
end;
constructor TbsSkinFontComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnListBoxDrawItem := DrawLBFontItem;
OnComboBoxDrawItem := DrawCBFontItem;
FDevice := fdScreen;
Sorted := True;
end;
procedure TbsSkinFontComboBox.DrawTT;
begin
with Cnvs do
begin
Pen.Color := C;
MoveTo(X, Y);
LineTo(X + 7, Y);
LineTo(X + 7, Y + 3);
MoveTo(X, Y);
LineTo(X, Y + 3);
MoveTo(X + 1, Y);
LineTo(X + 1, Y + 1);
MoveTo(X + 6, Y);
LineTo(X + 6, Y + 1);
MoveTo(X + 3, Y);
LineTo(X + 3, Y + 8);
MoveTo(X + 4, Y);
LineTo(X + 4, Y + 8);
MoveTo(X + 2, Y + 8);
LineTo(X + 6, Y + 8);
end;
end;
procedure TbsSkinFontComboBox.Reset;
var
SaveName: TFontName;
begin
if HandleAllocated then begin
FUpdate := True;
try
SaveName := FontName;
PopulateList;
FontName := SaveName;
finally
FUpdate := False;
if FontName <> SaveName
then
begin
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
end;
end;
end;
end;
procedure TbsSkinFontComboBox.WMFontChange(var Message: TMessage);
begin
inherited;
Reset;
end;
procedure TbsSkinFontComboBox.SetFontName(const NewFontName: TFontName);
var
Item: Integer;
begin
if FontName <> NewFontName then begin
if not (csLoading in ComponentState) then begin
HandleNeeded;
{ change selected item }
for Item := 0 to Items.Count - 1 do
if AnsiCompareText(Items[Item], NewFontName) = 0 then begin
ItemIndex := Item;
//
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
//
Exit;
end;
if Style = bscbFixedStyle then ItemIndex := -1
else Text := NewFontName;
end
else inherited Text := NewFontName;
//
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
//
end;
end;
function TbsSkinFontComboBox.GetFontName: TFontName;
begin
Result := inherited Text;
end;
function TbsSkinFontComboBox.GetTrueTypeOnly: Boolean;
begin
Result := foTrueTypeOnly in FOptions;
end;
procedure TbsSkinFontComboBox.SetOptions;
begin
if Value <> Options then begin
FOptions := Value;
Reset;
end;
end;
procedure TbsSkinFontComboBox.SetTrueTypeOnly(Value: Boolean);
begin
if Value <> TrueTypeOnly then begin
if Value then FOptions := FOptions + [foTrueTypeOnly]
else FOptions := FOptions - [foTrueTypeOnly];
Reset;
end;
end;
procedure TbsSkinFontComboBox.SetDevice;
begin
if Value <> FDevice then begin
FDevice := Value;
Reset;
end;
end;
procedure TbsSkinFontComboBox.SetUseFonts(Value: Boolean);
begin
if Value <> FUseFonts then begin
FUseFonts := Value;
Invalidate;
end;
end;
procedure TbsSkinFontComboBox.DrawCBFontItem;
var
FName: array[0..255] of Char;
R: TRect;
begin
R := TextRect;
R.Left := R.Left + 2;
with Cnvs do
begin
StrPCopy(FName, Items[Index]);
BSDrawText2(Cnvs, FName, R);
end;
end;
procedure TbsSkinFontComboBox.DrawLBFontItem;
var
FName: array[0..255] of Char;
R: TRect;
X, Y: Integer;
begin
R := TextRect;
if (Integer(Items.Objects[Index]) and TRUETYPE_FONTTYPE) <> 0
then
begin
X := TextRect.Left;
Y := TextRect.Top + RectHeight(TextRect) div 2 - 7;
DrawTT(Cnvs, X, Y, clGray);
DrawTT(Cnvs, X + 4, Y + 4, clBlack);
end;
Inc(R.Left, 15);
with Cnvs do
begin
Font.Name := Items[Index];
Font.Style := [];
StrPCopy(FName, Items[Index]);
BSDrawText2(Cnvs, Items[Index], R);
end;
end;
procedure TbsSkinFontComboBox.PopulateList;
var
DC: HDC;
Proc: TFarProc;
OldItemIndex: Integer;
begin
if not HandleAllocated then Exit;
OldItemIndex := ItemIndex;
Items.BeginUpdate;
try
Items.Clear;
DC := GetDC(0);
try
if (FDevice = fdScreen) or (FDevice = fdBoth) then
EnumFontFamilies(DC, nil, @EnumFonTbsroc, Longint(Self));
if (FDevice = fdPrinter) or (FDevice = fdBoth) then
try
EnumFontFamilies(Printer.Handle, nil, @EnumFonTbsroc, Longint(Self));
except
{ skip any errors }
end;
finally
ReleaseDC(0, DC);
end;
finally
Items.EndUpdate;
end;
ItemIndex := OldItemIndex;
end;
procedure TbsSkinFontComboBox.CreateWnd;
var
OldFont: TFontName;
begin
OldFont := FontName;
inherited CreateWnd;
FUpdate := True;
try
PopulateList;
inherited Text := '';
SetFontName(OldFont);
finally
FUpdate := False;
end;
// if AnsiCompareText(FontName, OldFont) <> 0 then DoChange;
end;
// ==================== TbsSkinColorComboBox ======================= //
const
SColorBoxCustomCaption = 'Custom...';
NoColorSelected = TColor($FF000000);
StandardColorsCount = 16;
ExtendedColorsCount = 4;
constructor TbsSkinColorComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := bscbFixedStyle;
FExStyle := [bscbStandardColors, bscbExtendedColors, bscbSystemColors];
FSelectedColor := clBlack;
FDefaultColorColor := clBlack;
FNoneColorColor := clBlack;
OnListBoxDrawItem := DrawColorItem;
OnComboBoxDrawItem := DrawColorItem;
OnCloseUp := OnLBCloseUp;
FShowNames := True;
end;
procedure TbsSkinColorComboBox.SetShowNames(Value: Boolean);
begin
FShowNames := Value;
RePaint;
end;
procedure TbsSkinColorComboBox.DrawColorItem;
var
R: TRect;
MarkerRect: TRect;
begin
if FShowNames
then
MarkerRect := Rect(TextRect.Left + 2, TextRect.Top + 2,
TextRect.Left + RectHeight(TextRect) - 2, TextRect.Bottom - 2)
else
MarkerRect := Rect(TextRect.Left + 2, TextRect.Top + 2,
TextRect.Right - 2, TextRect.Bottom - 2);
with Cnvs do
begin
Brush.Style := bsSolid;
Brush.Color := Colors[Index];
FillRect(MarkerRect);
Brush.Style := bsClear;
end;
if FShowNames
then
begin
R := TextRect;
R := Rect(R.Left + 5 + RectWidth(MarkerRect), R.Top, R.Right - 2, R.Bottom);
BSDrawText2(Cnvs, FListBox.Items[Index], R);
end;
end;
procedure TbsSkinColorComboBox.OnLBCloseUp;
begin
if (bscbCustomColor in ExStyle) and (ItemIndex = 0) then
PickCustomColor;
end;
function TbsSkinColorComboBox.PickCustomColor: Boolean;
var
LColor: TColor;
begin
with TbsSkinColorDialog.Create(nil) do
try
SkinData := Self.SkinData;
CtrlSkinData := Self.SkinData;
LColor := ColorToRGB(TColor(Items.Objects[0]));
Color := LColor;
Result := Execute;
if Result then
begin
Items.Objects[0] := TObject(Color);
Self.Invalidate;
if Assigned(FOnClick) then FOnClick(Self);
if Assigned(FOnChange) then FOnChange(Self);
end;
finally
Free;
end;
end;
procedure TbsSkinColorComboBox.KeyDown;
begin
if (bscbCustomColor in ExStyle) and (Key = VK_RETURN) and (ItemIndex = 0)
then
begin
PickCustomColor;
Key := 0;
end;
inherited;
end;
procedure TbsSkinColorComboBox.CreateWnd;
begin
inherited;
PopulateList;
end;
procedure TbsSkinColorComboBox.SetDefaultColorColor(const Value: TColor);
begin
if Value <> FDefaultColorColor then
begin
FDefaultColorColor := Value;
Invalidate;
end;
end;
procedure TbsSkinColorComboBox.SetNoneColorColor(const Value: TColor);
begin
if Value <> FNoneColorColor then
begin
FNoneColorColor := Value;
Invalidate;
end;
end;
procedure TbsSkinColorComboBox.ColorCallBack(const AName: String);
var
I, LStart: Integer;
LColor: TColor;
LName: string;
begin
LColor := StringToColor(AName);
if bscbPrettyNames in ExStyle then
begin
if Copy(AName, 1, 2) = 'cl' then
LStart := 3
else
LStart := 1;
LName := '';
for I := LStart to Length(AName) do
begin
case AName[I] of
'A'..'Z':
if LName <> '' then
LName := LName + ' ';
end;
LName := LName + AName[I];
end;
end
else
LName := AName;
Items.AddObject(LName, TObject(LColor));
end;
procedure TbsSkinColorComboBox.SetSelected(const AColor: TColor);
var
I: Integer;
begin
if HandleAllocated and (FListBox <> nil) then
begin
I := FListBox.Items.IndexOfObject(TObject(AColor));
if (I = -1) and (bscbCustomColor in ExStyle) and (AColor <> NoColorSelected) then
begin
Items.Objects[0] := TObject(AColor);
I := 0;
end;
ItemIndex := I;
end;
FSelectedColor := AColor;
end;
procedure TbsSkinColorComboBox.PopulateList;
procedure DeleteRange(const AMin, AMax: Integer);
var
I: Integer;
begin
for I := AMax downto AMin do
Items.Delete(I);
end;
procedure DeleteColor(const AColor: TColor);
var
I: Integer;
begin
I := Items.IndexOfObject(TObject(AColor));
if I <> -1 then
Items.Delete(I);
end;
var
LSelectedColor, LCustomColor: TColor;
begin
if HandleAllocated then
begin
Items.BeginUpdate;
try
LCustomColor := clBlack;
if (bscbCustomColor in ExStyle) and (Items.Count > 0) then
LCustomColor := TColor(Items.Objects[0]);
LSelectedColor := FSelectedColor;
Items.Clear;
GetColorValues(ColorCallBack);
if not (bscbIncludeNone in ExStyle) then
DeleteColor(clNone);
if not (bscbIncludeDefault in ExStyle) then
DeleteColor(clDefault);
if not (bscbSystemColors in ExStyle) then
DeleteRange(StandardColorsCount + ExtendedColorsCount, Items.Count - 1);
if not (bscbExtendedColors in ExStyle) then
DeleteRange(StandardColorsCount, StandardColorsCount + ExtendedColorsCount - 1);
if not (bscbStandardColors in ExStyle) then
DeleteRange(0, StandardColorsCount - 1);
if bscbCustomColor in ExStyle then
Items.InsertObject(0, SColorBoxCustomCaption, TObject(LCustomColor));
Self.Selected := LSelectedColor;
finally
Items.EndUpdate;
FNeedToPopulate := False;
end;
end
else
FNeedToPopulate := True;
end;
procedure TbsSkinColorComboBox.SetExStyle(AStyle: TbsColorBoxStyle);
begin
FExStyle := AStyle;
Enabled := ([bscbStandardColors, bscbExtendedColors, bscbSystemColors, bscbCustomColor] * FExStyle) <> [];
PopulateList;
if (Items.Count > 0) and (ItemIndex = -1) then ItemIndex := 0;
end;
function TbsSkinColorComboBox.GetColor(Index: Integer): TColor;
begin
Result := TColor(Items.Objects[Index]);
end;
function TbsSkinColorComboBox.GetColorName(Index: Integer): string;
begin
Result := Items[Index];
end;
function TbsSkinColorComboBox.GetSelected: TColor;
begin
if HandleAllocated then
if ItemIndex <> -1 then
Result := Colors[ItemIndex]
else
Result := NoColorSelected
else
Result := FSelectedColor;
end;
//================= check listbox ===================//
type
TbsCheckListBoxDataWrapper = class
private
FData: LongInt;
FState: TCheckBoxState;
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;
end;
procedure TbsCheckListBoxDataWrapper.SetChecked(Check: Boolean);
begin
if Check then FState := cbChecked else FState := cbUnchecked;
end;
function TbsCheckListBoxDataWrapper.GetChecked: Boolean;
begin
Result := FState = cbChecked;
end;
class function TbsCheckListBoxDataWrapper.GetDefaultState: TCheckBoxState;
begin
Result := cbUnchecked;
end;
constructor TbsCheckListBox.Create;
begin
inherited;
SkinListBox := nil;
Ctl3D := False;
BorderStyle := bsNone;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
{$IFDEF VER130}
FAutoComplete := True;
{$ENDIF}
end;
destructor TbsCheckListBox.Destroy;
begin
inherited;
end;
procedure TbsCheckListBox.WMNCCALCSIZE;
begin
end;
procedure TbsCheckListBox.CMEnter;
begin
if SkinListBox <> nil then SkinListBox.ListBoxEnter;
inherited;
end;
procedure TbsCheckListBox.CMExit;
begin
if SkinListBox <> nil then SkinListBox.ListBoxExit;
inherited;
end;
procedure TbsCheckListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseUp(Button, Shift, X, Y);
inherited;
end;
procedure TbsCheckListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseMove(Shift, X, Y);
inherited;
end;
procedure TbsCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyDown(Key, Shift);
inherited;
end;
procedure TbsCheckListBox.Click;
begin
if SkinListBox <> nil then SkinListBox.ListBoxClick;
inherited;
end;
procedure TbsCheckListBox.PaintBGWH;
var
X, Y, XCnt, YCnt, XO, YO, w, h, w1, h1: Integer;
Buffer: TBitMap;
begin
w1 := AW;
h1 := AH;
Buffer := TBitMap.Create;
Buffer.Width := w1;
Buffer.Height := h1;
with Buffer.Canvas, SkinListBox do
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
XCnt := w1 div w;
YCnt := h1 div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
if Y * h + h > h1 then YO := Y * h + h - h1 else YO := 0;
CopyRect(Rect(X * w, Y * h, X * w + w - XO, Y * h + h - YO),
Picture.Canvas,
Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
SkinRect.Left + ClRect.Right - XO,
SkinRect.Top + ClRect.Bottom - YO));
end;
end;
Cnvs.Draw(AX, AY, Buffer);
Buffer.Free;
end;
function TbsCheckListBox.GetItemData(Index: Integer): LongInt;
begin
Result := 0;
if HaveWrapper(Index) then
Result := TbsCheckListBoxDataWrapper(GetWrapper(Index)).FData;
end;
procedure TbsCheckListBox.SetItemData(Index: Integer; AData: LongInt);
var
Wrapper: TbsCheckListBoxDataWrapper;
begin
Wrapper := TbsCheckListBoxDataWrapper(GetWrapper(Index));
Wrapper.FData := AData;
if FSaveStates <> nil then
if FSaveStates.Count > 0 then
begin
Wrapper.FState := TCheckBoxState(FSaveStates[0]);
FSaveStates.Delete(0);
end;
end;
procedure TbsCheckListBox.ResetContent;
var
I: Integer;
begin
for I := 0 to Items.Count - 1 do
if HaveWrapper(I) then
GetWrapper(I).Free;
inherited;
end;
procedure TbsCheckListBox.CreateWnd;
begin
inherited CreateWnd;
if FSaveStates <> nil then
begin
FSaveStates.Free;
FSaveStates := nil;
end;
end;
procedure TbsCheckListBox.DestroyWnd;
var
I: Integer;
begin
if Items.Count > 0 then
begin
FSaveStates := TList.Create;
for I := 0 to Items.Count -1 do
FSaveStates.Add(TObject(State[I]));
end;
inherited DestroyWnd;
end;
procedure TbsCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
i: Integer;
begin
for i := 0 to Items.Count -1 do
ExtractWrapper(i).Free;
inherited;
end;
procedure TbsCheckListBox.DeleteString(Index: Integer);
begin
if HaveWrapper(Index) then
GetWrapper(Index).Free;
inherited;
end;
procedure TbsCheckListBox.KeyPress(var Key: Char);
{$IFDEF VER130}
procedure FindString;
var
Idx: Integer;
begin
if Length(FFilter) = 1
then
Idx := SendMessage(Handle, LB_FINDSTRING, ItemIndex, LongInt(PChar(FFilter)))
else
Idx := SendMessage(Handle, LB_FINDSTRING, -1, LongInt(PChar(FFilter)));
if Idx <> LB_ERR then
begin
if MultiSelect then
begin
SendMessage(Handle, LB_SELITEMRANGE, 1, MakeLParam(Idx, Idx))
end;
ItemIndex := Idx;
Click;
end;
if not Ord(Key) in [VK_RETURN, VK_BACK, VK_ESCAPE] then
Key := #0;
end;
{$ENDIF}
begin
inherited;
if (Key = ' ') then ToggleClickCheck(ItemIndex);
if SkinListBox <> nil then SkinListBox.ListBoxKeyPress(Key);
{$IFDEF VER130}
if not FAutoComplete then Exit;
if GetTickCount - FLastTime >= 500 then
FFilter := '';
FLastTime := GetTickCount;
if Ord(Key) <> VK_BACK
then
begin
FFilter := FFilter + Key;
Key := #0;
end
else
Delete(FFilter, Length(FFilter), 1);
if Length(FFilter) > 0 then
FindString
else
begin
ItemIndex := 0;
Click;
end;
{$ENDIF}
end;
procedure TbsCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
function InCheckArea(IR: TRect): Boolean;
var
R, R1: TRect;
OX: Integer;
begin
R := SkinListBox.ItemTextRect;
OX := RectWidth(IR) - RectWidth(SkinListBox.SItemRect);
Inc(R.Right, OX);
R1 := SkinListBox.ItemCheckRect;
if R1.Left >= SkinListBox.ItemTextRect.Right
then OffsetRect(R1, OX, 0);
OffsetRect(R1, IR.Left, IR.Top);
Result := PtInRect(R1, Point(X, Y));
end;
var
Index: Integer;
begin
inherited;
Index := ItemAtPos(Point(X,Y),True);
if (Index <> -1)
then
if (SkinListBox <> nil) and (SkinListBox.FIndex <> -1)
then
begin
if InCheckArea(ItemRect(Index)) then ToggleClickCheck(Index);
end
else
begin
if X - ItemRect(Index).Left < 20 then ToggleClickCheck(Index);
end;
if SkinListBox <> nil then SkinListBox.ListBoxMouseDown(Button, Shift, X, Y);
end;
procedure TbsCheckListBox.ToggleClickCheck;
var
State: TCheckBoxState;
begin
if (Index >= 0) and (Index < Items.Count) then
begin
State := Self.State[Index];
case State of
cbUnchecked: State := cbChecked;
cbChecked: State := cbUnchecked;
end;
Self.State[Index] := State;
if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;
end;
procedure TbsCheckListBox.InvalidateCheck(Index: Integer);
var
R: TRect;
begin
R := ItemRect(Index);
InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
UpdateWindow(Handle);
end;
function TbsCheckListBox.GetWrapper(Index: Integer): TObject;
begin
Result := ExtractWrapper(Index);
if Result = nil then
Result := CreateWrapper(Index);
end;
function TbsCheckListBox.ExtractWrapper(Index: Integer): TObject;
begin
Result := TbsCheckListBoxDataWrapper(inherited GetItemData(Index));
if LB_ERR = Integer(Result) then
raise EListError.CreateFmt('List index out of bounds (%d)', [Index]);
if (Result <> nil) and (not (Result is TbsCheckListBoxDataWrapper)) then
Result := nil;
end;
function TbsCheckListBox.CreateWrapper(Index: Integer): TObject;
begin
Result := TbsCheckListBoxDataWrapper.Create;
inherited SetItemData(Index, LongInt(Result));
end;
function TbsCheckListBox.HaveWrapper(Index: Integer): Boolean;
begin
Result := ExtractWrapper(Index) <> nil;
end;
procedure TbsCheckListBox.SetChecked(Index: Integer; Checked: Boolean);
begin
if Checked <> GetChecked(Index) then
begin
TbsCheckListBoxDataWrapper(GetWrapper(Index)).SetChecked(Checked);
InvalidateCheck(Index);
end;
end;
procedure TbsCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
begin
if AState <> GetState(Index) then
begin
TbsCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
InvalidateCheck(Index);
end;
end;
function TbsCheckListBox.GetChecked(Index: Integer): Boolean;
begin
if HaveWrapper(Index) then
Result := TbsCheckListBoxDataWrapper(GetWrapper(Index)).GetChecked
else
Result := False;
end;
function TbsCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
if HaveWrapper(Index) then
Result := TbsCheckListBoxDataWrapper(GetWrapper(Index)).State
else
Result := TbsCheckListBoxDataWrapper.GetDefaultState;
end;
function TbsCheckListBox.GetState1;
begin
Result := [];
if AItemID = ItemIndex
then
begin
Result := Result + [odSelected];
if Focused then Result := Result + [odFocused];
end
else
if SelCount > 0
then
if Selected[AItemID] then Result := Result + [odSelected];
end;
procedure TbsCheckListBox.PaintBG(DC: HDC);
var
C: TControlCanvas;
begin
C := TControlCanvas.Create;
C.Handle := DC;
SkinListBox.GetSkinData;
if SkinListBox.FIndex <> -1
then
PaintBGWH(C, Width, Height, 0, 0)
else
with C do
begin
C.Brush.Color := clWindow;
FillRect(Rect(0, 0, Width, Height));
end;
C.Handle := 0;
C.Free;
end;
procedure TbsCheckListBox.PaintColumnsList(DC: HDC);
var
C: TCanvas;
i, j, DrawCount: Integer;
IR: TRect;
begin
C := TCanvas.Create;
C.Handle := DC;
DrawCount := (Height div ItemHeight) * Columns;
i := TopIndex;
j := i + DrawCount;
if j > Items.Count - 1 then j := Items.Count - 1;
if Items.Count > 0
then
for i := TopIndex to j do
begin
IR := ItemRect(i);
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState1(i))
else
DrawStretchSkinItem(C, i, IR, GetState1(i));
end
else
DrawDefaultItem(C, i, IR, GetState1(i));
end;
C.Free;
end;
procedure TbsCheckListBox.PaintList(DC: HDC);
var
C: TCanvas;
i, j, k, DrawCount: Integer;
IR: TRect;
begin
C := TCanvas.Create;
C.Handle := DC;
DrawCount := Height div ItemHeight;
i := TopIndex;
j := i + DrawCount;
if j > Items.Count - 1 then j := Items.Count - 1;
k := 0;
if Items.Count > 0
then
for i := TopIndex to j do
begin
IR := ItemRect(i);
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState1(i))
else
DrawStretchSkinItem(C, i, IR, GetState1(i));
end
else
DrawDefaultItem(C, i, IR, GetState1(i));
k := IR.Bottom;
end;
if k < Height
then
begin
SkinListBox.GetSkinData;
if SkinListBox.FIndex <> -1
then
PaintBGWH(C, Width, Height - k, 0, k)
else
with C do
begin
C.Brush.Color := clWindow;
FillRect(Rect(0, k, Width, Height));
end;
end;
C.Free;
end;
procedure TbsCheckListBox.PaintWindow;
var
SaveIndex: Integer;
begin
if (Width <= 0) or (Height <=0) then Exit;
SaveIndex := SaveDC(DC);
try
if Columns > 0
then
PaintColumnsList(DC)
else
PaintList(DC);
finally
RestoreDC(DC, SaveIndex);
end;
end;
procedure TbsCheckListBox.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TbsCheckListBox.WMEraseBkgnd;
begin
PaintBG(Message.DC);
Message.Result := 1;
end;
procedure TbsCheckListBox.DrawDefaultItem;
var
Buffer: TBitMap;
R, R1, CR: TRect;
AState: TCheckBoxState;
IIndex, IX, IY: Integer;
begin
if (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(rcItem);
Buffer.Height := RectHeight(rcItem);
R := Rect(20, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
Font.Name := SkinListBox.Font.Name;
Font.Style := SkinListBox.Font.Style;
Font.Height := SkinListBox.Font.Height;
if (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.Charset := SkinListBox.DefaultFont.Charset;
if odSelected in State1
then
begin
Brush.Color := clHighLight;
Font.Color := clHighLightText;
end
else
begin
Brush.Color := clWindow;
Font.Color := SkinListBox.Font.Color;
end;
FillRect(R);
end;
R1 := Rect(R.Left + 2, R.Top, R.Right - 2, R.Bottom);
CR := Rect(3, Buffer.Height div 2 - 6, 16, Buffer.Height div 2 + 7);
Frame3D(Buffer.Canvas, CR, clBtnShadow, clBtnShadow, 1);
if AState = cbChecked
then
DrawCheckImage(Buffer.Canvas, 6, Buffer.Height div 2 - 4, clWindowText);
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R1, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R1.Left;
IY := R1.Top + RectHeight(R1) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R1.Left, SkinListBox.Images.Width + 2);
end;
BSDrawText2(Buffer.Canvas, Items[ItemID], R1);
end;
if odFocused in State1 then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TbsCheckListBox.SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);
var
B: TBitMap;
begin
B := TBitMap.Create;
B.Width := RectWidth(IR);
B.Height := RectHeight(IR);
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), Cnvs, IR);
B.Transparent := True;
DestCnvs.Draw(X, Y, B);
B.Free;
end;
procedure TbsCheckListBox.DrawSkinItem;
var
Buffer: TBitMap;
R, R1: TRect;
W, H: Integer;
OX: Integer;
AState: TCheckBoxState;
cw, ch, cx, cy: Integer;
IIndex, IX, IY: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State1
then
begin
if not (odSelected in State1)
then
begin
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
DrawFocusRect(Buffer.Canvas.Handle, R);
end
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
end
else
if odSelected in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
OX := W - RectWidth(SItemRect);
Inc(R.Right, OX);
R1 := ItemCheckRect;
if R1.Left >= ItemTextRect.Right then OffsetRect(R1, OX, 0);
cw := RectWidth(CheckImageRect);
ch := RectHeight(CheckImageRect);
cx := R1.Left + RectWidth(R1) div 2;
cy := R1.Top + RectHeight(R1) div 2;
R1 := Rect(cx - cw div 2, cy - ch div 2,
cx - cw div 2 + cw, cy - ch div 2 + ch);
if AState = cbChecked
then
SkinDrawCheckImage(R1.Left, R1.Top, Picture.Canvas, CheckImageRect, Buffer.Canvas)
else
SkinDrawCheckImage(R1.Left, R1.Top, Picture.Canvas, UnCheckImageRect, Buffer.Canvas);
end;
with Buffer.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
end
else
Font.Assign(SkinListBox.DefaultFont);
if (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.CharSet := SkinListBox.DefaultFont.CharSet;
if odFocused in State1
then
begin
if not (odSelected in State1)
then
Font.Color := SkinListBox.FontColor
else
Font.Color := SkinListBox.FocusFontColor;
end
else
if odSelected in State1
then
Font.Color := SkinListBox.ActiveFontColor
else
Font.Color := SkinListBox.FontColor;
Brush.Style := bsClear;
end;
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, SkinListBox.Images.Width + 2);
end;
BSDrawText2(Buffer.Canvas, Items[ItemID], R);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TbsCheckListBox.DrawStretchSkinItem;
var
Buffer, Buffer2: TBitMap;
R, R1: TRect;
W, H: Integer;
OX, OY: Integer;
AState: TCheckBoxState;
cw, ch, cx, cy: Integer;
IIndex, IX, IY: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
if odSelected in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
OX := W - RectWidth(SItemRect);
OY := RectHeight(rcItem) - RectHeight(SItemRect);
Inc(R.Right, OX);
Inc(R.Bottom, OY);
R1 := ItemCheckRect;
if R1.Left >= ItemTextRect.Right then OffsetRect(R1, OX, 0);
Inc(R1.Bottom, OY);
cw := RectWidth(CheckImageRect);
ch := RectHeight(CheckImageRect);
cx := R1.Left + RectWidth(R1) div 2;
cy := R1.Top + RectHeight(R1) div 2;
R1 := Rect(cx - cw div 2, cy - ch div 2,
cx - cw div 2 + cw, cy - ch div 2 + ch);
end;
W := RectWidth(rcItem);
H := RectHeight(rcItem);
Buffer2 := TBitMap.Create;
Buffer2.Width := W;
Buffer2.Height := H;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
Buffer.Free;
//
if AState = cbChecked
then
SkinDrawCheckImage(R1.Left, R1.Top, SkinListBox.Picture.Canvas, SkinListBox.CheckImageRect, Buffer2.Canvas)
else
SkinDrawCheckImage(R1.Left, R1.Top, SkinListBox.Picture.Canvas, SkinListBox.UnCheckImageRect, Buffer2.Canvas);
//
with Buffer2.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
end
else
Font.Assign(SkinListBox.DefaultFont);
if (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.CharSet := SkinListBox.DefaultFont.CharSet;
if odFocused in State1
then
Font.Color := SkinListBox.FocusFontColor
else
if odSelected in State1
then
Font.Color := SkinListBox.ActiveFontColor
else
Font.Color := SkinListBox.FontColor;
Brush.Style := bsClear;
end;
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer2.Canvas, ItemID, Buffer2.Width, Buffer2.Height,
R, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer2.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, SkinListBox.Images.Width + 2);
end;
BSDrawText2(Buffer2.Canvas, Items[ItemID], R);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer2);
Buffer2.Free;
end;
procedure TbsCheckListBox.CreateParams;
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
WindowClass.style := CS_DBLCLKS;
Style := Style or WS_TABSTOP;
end;
end;
procedure TbsCheckListBox.CNDrawItem;
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
{$IFDEF VER120}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
{$IFDEF VER125}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
State := TOwnerDrawState(LongRec(itemState).Lo);
{$ENDIF}
{$ENDIF}
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(Canvas, itemID, rcItem, State)
else
DrawStretchSkinItem(Canvas, itemID, rcItem, State);
end
else
DrawDefaultItem(Canvas, itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TbsCheckListBox.WndProc;
var
LParam, WParam: Integer;
begin
inherited;
case Message.Msg of
WM_LBUTTONDBLCLK:
begin
if SkinListBox <> nil then SkinListBox.ListBoxDblClick;
end;
WM_MOUSEWHEEL:
if (SkinListBox <> nil) and (SkinListBox.ScrollBar <> nil)
then
begin
LParam := 0;
if Message.WParam > 0
then
WParam := MakeWParam(SB_LINEUP, 0)
else
WParam := MakeWParam(SB_LINEDOWN, 0);
SendMessage(Handle, WM_VSCROLL, WParam, LParam);
SkinListBox.UpDateScrollBar;
end;
WM_ERASEBKGND:
SkinListBox.UpDateScrollBar;
LB_ADDSTRING, LB_INSERTSTRING,
LB_DELETESTRING:
begin
if SkinListBox <> nil
then
SkinListBox.UpDateScrollBar;
end;
end;
end;
constructor TbsSkinCheckListBox.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csClickEvents,
csOpaque, csDoubleClicks, csReplicatable, csAcceptsControls];
FUseSkinItemHeight := True;
FRowCount := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FSpacing := 2;
FImageIndex := -1;
FDefaultCaptionFont := TFont.Create;
FDefaultCaptionFont.OnChange := OnDefaultCaptionFontChange;
FDefaultCaptionFont.Name := 'Arial';
FDefaultCaptionFont.Height := 14;
FDefaultCaptionHeight := 20;
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FCaptionMode := False;
FDefaultItemHeight := 20;
TimerMode := 0;
WaitMode := False;
Font.Name := 'Arial';
Font.Height := 14;
Font.Color := clWindowText;
Font.Style := [];
ScrollBar := nil;
ListBox := TbsCheckListBox.Create(Self);
ListBox.SkinListBox := Self;
ListBox.Style := lbOwnerDrawFixed;
ListBox.ItemHeight := FDefaultItemHeight;
ListBox.Parent := Self;
ListBox.Visible := True;
Height := 120;
Width := 120;
FSkinDataName := 'checklistbox';
end;
function TbsSkinCheckListBox.GetAutoComplete: Boolean;
begin
Result := ListBox.AutoComplete;
end;
procedure TbsSkinCheckListBox.SetAutoComplete(Value: Boolean);
begin
ListBox.AutoComplete := Value;
end;
function TbsSkinCheckListBox.GetOnListBoxEndDrag: TEndDragEvent;
begin
Result := ListBox.OnEndDrag;
end;
procedure TbsSkinCheckListBox.SetOnListBoxEndDrag(Value: TEndDragEvent);
begin
ListBox.OnEndDrag := Value;
end;
function TbsSkinCheckListBox.GetOnListBoxStartDrag: TStartDragEvent;
begin
Result := ListBox.OnStartDrag;
end;
procedure TbsSkinCheckListBox.SetOnListBoxStartDrag(Value: TStartDragEvent);
begin
ListBox.OnStartDrag := Value;
end;
function TbsSkinCheckListBox.GetOnListBoxDragOver: TDragOverEvent;
begin
Result := ListBox.OnDragOver;
end;
procedure TbsSkinCheckListBox.SetOnListBoxDragOver(Value: TDragOverEvent);
begin
ListBox.OnDragOver := Value;
end;
function TbsSkinCheckListBox.GetOnListBoxDragDrop: TDragDropEvent;
begin
Result := ListBox.OnDragDrop;
end;
procedure TbsSkinCheckListBox.SetOnListBoxDragDrop(Value: TDragDropEvent);
begin
ListBox.OnDragDrop := Value;
end;
procedure TbsSkinCheckListBox.SetOnClickCheck(const Value: TNotifyEvent);
begin
FOnClickCheck := Value;
Listbox.OnClickCheck := Value;
end;
function TbsSkinCheckListBox.GetListBoxDragMode: TDragMode;
begin
Result := ListBox.DragMode;
end;
procedure TbsSkinCheckListBox.SetListBoxDragMode(Value: TDragMode);
begin
ListBox.DragMode := Value;
end;
function TbsSkinCheckListBox.GetListBoxDragKind: TDragKind;
begin
Result := ListBox.DragKind;
end;
procedure TbsSkinCheckListBox.SetListBoxDragKind(Value: TDragKind);
begin
ListBox.DragKind := Value;
end;
function TbsSkinCheckListBox.GetListBoxDragCursor: TCursor;
begin
Result := ListBox.DragCursor;
end;
procedure TbsSkinCheckListBox.SetListBoxDragCursor(Value: TCursor);
begin
ListBox.DragCursor := Value;
end;
function TbsSkinCheckListBox.GetColumns;
begin
Result := ListBox.Columns;
end;
procedure TbsSkinCheckListBox.SetColumns;
begin
ListBox.Columns := Value;
UpDateScrollBar;
end;
procedure TbsSkinCheckListBox.SetRowCount;
begin
FRowCount := Value;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
end;
procedure TbsSkinCheckListBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
ListBox.RePaint;
end;
procedure TbsSkinCheckListBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
ListBox.RePaint;
end;
procedure TbsSkinCheckListBox.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinCheckListBox.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinCheckListBox.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TbsSkinCheckListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TbsSkinCheckListBox.OnDefaultCaptionFontChange;
begin
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TbsSkinCheckListBox.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
CalcRects;
RePaint;
end;
end;
procedure TbsSkinCheckListBox.SetDefaultCaptionFont;
begin
FDefaultCaptionFont.Assign(Value);
end;
procedure TbsSkinCheckListBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TbsSkinCheckListBox.SetDefaultItemHeight;
begin
FDefaultItemHeight := Value;
if FIndex = -1
then
ListBox.ItemHeight := FDefaultItemHeight;
end;
procedure TbsSkinCheckListBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinCheckListBox.WMTimer;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartTimer;
Exit;
end;
case TimerMode of
1: if ItemIndex > 0 then ItemIndex := ItemIndex - 1;
2: ItemIndex := ItemIndex + 1;
end;
end;
procedure TbsSkinCheckListBox.CreateControlSkinImage;
var
GX, GY, GlyphNum, TX, TY, i, OffX, OffY: Integer;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
function CalcBRect(BR: TRect): TRect;
var
R: TRect;
begin
R := BR;
if BR.Top <= LTPt.Y
then
begin
if BR.Left > RTPt.X then OffsetRect(R, OffX, 0);
end
else
begin
OffsetRect(R, 0, OffY);
if BR.Left > RBPt.X then OffsetRect(R, OffX, 0);
end;
Result := R;
end;
begin
inherited;
// calc rects
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewClRect := ClRect;
Inc(NewClRect.Right, OffX);
Inc(NewClRect.Bottom, OffY);
if FCaptionMode
then
begin
NewCaptionRect := CaptionRect;
if CaptionRect.Right >= RTPt.X
then
Inc(NewCaptionRect.Right, OffX);
Buttons[0].R := CalcBRect(UpButtonRect);
Buttons[1].R := CalcBRect(DownButtonRect);
Buttons[2].R := CalcBRect(CheckButtonRect);
end;
// paint caption
if not IsNullRect(CaptionRect)
then
with B.Canvas do
begin
Font.Name := CaptionFontName;
Font.Height := CaptionFontHeight;
Font.Color := CaptionFontColor;
Font.Style := CaptionFontStyle;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := DefaultCaptionFont.CharSet;
TY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 -
TextHeight(Caption) div 2;
TX := NewCaptionRect.Left + 2;
case Alignment of
taCenter: TX := TX + RectWidth(NewCaptionRect) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := NewCaptionRect.Right - GetGlyphTextWidth - 2;
end;
Brush.Style := bsClear;
if not FGlyph.Empty
then
begin
GY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 - FGlyph.Height div 2;
GX := TX;
TX := GX + FGlyph.Width div FNumGlyphs + FSpacing;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
end;
TextRect(NewCaptionRect, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
end;
// paint buttons
for i := 0 to 2 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinCheckListBox.CreateControlDefaultImage;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
var
BW, i, TX, TY: Integer;
R: TRect;
GX, GY: Integer;
GlyphNum: Integer;
begin
inherited;
if FCaptionMode
then
begin
BW := 17;
if BW > FDefaultCaptionHeight - 3 then BW := FDefaultCaptionHeight - 3;
Buttons[0].R := Rect(Width - BW - 2, 2, Width - 2, 1 + BW);
Buttons[1].R := Rect(Buttons[0].R.Left - BW, 2, Buttons[0].R.Left, 1 + BW);
Buttons[2].R := Rect(Buttons[1].R.Left - BW, 2, Buttons[1].R.Left, 1 + BW);
end;