Delphi控件源码

开发平台：

Delphi

bsSkinBoxCtrls.pas：源码内容

B.Canvas.CopyRect(FButtonRect, Picture.Canvas, BR);
end;
//
end;
// Draw text
if ADrawText
then
with B.Canvas do
begin
Brush.Style := bsClear;
if (FIndex = -1) or not FUseSkinFont
then
Font := DefaultFont
else
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FontColor;
Font.Style := FontStyle;
Font.CharSet := FDefaultFont.CharSet;
end;
TY := FEditRect.Top - 1;
TX := FEditRect.Left + 1;
case Alignment of
taCenter:
TX := TX + RectWidth(FEditRect) div 2 - TextWidth(Text) div 2;
taRightJustify:
TX := FEditRect.Right - 1 - TextWidth(Text);
end;
TextRect(FEditRect, TX, TY, Text);
end;
//
C.Draw(0, 0, B);
finally
B.Free;
end;
end;
procedure TbsSkinCustomEdit.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
begin
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
try
DrawSkinEdit(C, False);
finally
C.Free;
ReleaseDC(Handle, DC);
end;
end;
procedure TbsSkinCustomEdit.GetSkinData;
begin
if FSD = nil
then
begin
FIndex := -1;
Exit;
end;
if FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinEditControl
then
with TbsDataSkinEditControl(FSD.CtrlList.Items[FIndex]) do
begin
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
if isNullRect(ActiveSkinRect)
then
Self.ActiveSkinRect := SkinRect;
LOffset := LTPoint.X;
ROffset := RectWidth(SkinRect) - RTPoint.X;
Self.ClRect := ClRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.DisabledFontColor := DisabledFontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
if IsNullRect(Self.DownButtonRect)
then Self.DownButtonRect := Self.ActiveButtonRect;
end;
end;
procedure TbsSkinCustomEdit.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinCustomEdit.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinCustomEdit.ChangeSkinData;
begin
GetSkinData;
//
if (FIndex <> -1)
then
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Height := RectHeight(SkinRect);
Font.Height := FontHeight;
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
Font.CharSet := FDefaultFont.CharSet;
end
else
begin
Font.Assign(FDefaultFont);
Height := RectHeight(SkinRect);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
end
else
begin
Font.Assign(FDefaultFont);
if FDefaultWidth > 0 then Width := FDefaultWidth;
if FDefaultHeight > 0 then Height := FDefaultHeight;
end;
//
ReCreateWnd;
end;
constructor TbsSkinPopupMonthCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
end;
procedure TbsSkinPopupMonthCalendar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TbsSkinPopupMonthCalendar.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
constructor TbsSkinDateEdit.Create(AOwner: TComponent);
begin
inherited;
FTodayDefault := False;
ButtonMode := True;
FSkinDataName := 'buttonedit';
FMonthCalendar := TbsSkinPopupMonthCalendar.Create(Self);
FMonthCalendar.Parent := Self;
FMonthCalendar.Visible := False;
FMonthCalendar.OnNumberClick := CalendarClick;
OnButtonClick := ButtonClick;
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
MaxLength := Length(Text);
FAlphaBlend := False;
FAlphaBlendValue := 0;
FAlphaBlendAnimation := False;
end;
destructor TbsSkinDateEdit.Destroy;
begin
FMonthCalendar.Free;
inherited;
end;
procedure TbsSkinDateEdit.Loaded;
begin
inherited;
if FTodayDefault then Date := Now;
end;
procedure TbsSkinDateEdit.SetTodayDefault;
begin
FTodayDefault := Value;
if FTodayDefault then Date := Now;
end;
function TbsSkinDateEdit.GetCalendarFont;
begin
Result := FMonthCalendar.DefaultFont;
end;
procedure TbsSkinDateEdit.SetCalendarFont;
begin
FMonthCalendar.DefaultFont.Assign(Value);
end;
function TbsSkinDateEdit.GetCalendarWidth: Integer;
begin
Result := FMonthCalendar.Width;
end;
procedure TbsSkinDateEdit.SetCalendarWidth(Value: Integer);
begin
FMonthCalendar.Width := Value;
end;
function TbsSkinDateEdit.GetCalendarHeight: Integer;
begin
Result := FMonthCalendar.Height;
end;
procedure TbsSkinDateEdit.SetCalendarHeight(Value: Integer);
begin
FMonthCalendar.Height := Value;
end;
procedure TbsSkinDateEdit.CheckSelect;
var
Pos: Integer;
begin
Pos := GetSelStart;
if Text[Pos + 1] <> DateSeparator
then
begin
SetSelStart(Pos);
end
else
SetSelStart(Pos + 1);
SetSelLength(1);
end;
function TbsSkinDateEdit.GetDate: TDate;
begin
Result := FMonthCalendar.Date;
end;
procedure TbsSkinDateEdit.SetDate(Value: TDate);
begin
FMonthCalendar.Date := Value;
StopCheck := True;
Text := DateToStr(Value);
StopCheck := False;
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
function TbsSkinDateEdit.IsValidText;
var
F: String;
s1, s2: array[1..3] of String;
D: TDate;
i, j: Integer;
MPos, DPos, YPos: Integer;
begin
D := EncodeDate(9999, 12, 31);
F := DateToStr(D);
FillChar(s1, 3, #0);
FillChar(s2, 3, #0);
j := 1;
YPos := 1;
MPos := 1;
Dpos := 1;
for i := 1 to Length(F) do
begin
if F[i] = DateSeparator
then
inc(j)
else
s1[j] := s1[j] + F[i];
end;
for i := 1 to 3 do
begin
j := StrToInt(s1[i]);
case j of
12: MPos := i;
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
j := 1;
for i := 1 to Length(S) do
begin
if S[i] = DateSeparator
then
inc(j)
else
s2[j] := s2[j] + S[i];
end;
if StrToInt(s2[Ypos]) = 0
then
Result := Length(s2[YPos]) < 2
else
Result := True;
Result := Result and
(Length(s1) = Length(s2)) and
(StrToInt(s2[Mpos]) > 0) and
(StrToInt(s2[Dpos]) > 0) and
(StrToInt(s2[1]) <= StrToInt(s1[1])) and
(StrToInt(s2[2]) <= StrToInt(s1[2])) and
(StrToInt(s2[3]) <= StrToInt(s1[3]));
end;
procedure TbsSkinDateEdit.Change;
begin
inherited;
if not StopCheck
then
if IsValidText(Text) then CheckValidDate;
end;
procedure TbsSkinDateEdit.CheckValidDate;
var
OldDate: TDate;
begin
OldDate := FMonthCalendar.Date;
try
FMonthCalendar.Date := StrToDate(Text);
finally
if OldDate <> FMonthCalendar.Date
then
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
end;
procedure TbsSkinDateEdit.KeyDown;
var
Pos: Integer;
C: Char;
begin
if Key = VK_DELETE then Key := 0;
inherited;
end;
procedure TbsSkinDateEdit.KeyPress(var Key: Char);
var
Pos: Integer;
C: Char;
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0
then
begin
inherited KeyPress(Key);
end;
end;
function TbsSkinDateEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in ['0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)) and (Key <> Chr(VK_BACK)));
end;
procedure TbsSkinDateEdit.CMCancelMode;
begin
if (Message.Sender <> FMonthCalendar) and
not FMonthCalendar.ContainsControl(Message.Sender)
then
CloseUp(False);
end;
procedure TbsSkinDateEdit.WndProc;
begin
if Message.Msg = WM_CHAR then CheckSelect;
if (Message.Msg <> WM_CUT) and (Message.Msg <> WM_PASTE)
then
inherited;
case Message.Msg of
WM_KILLFOCUS:
begin
if not FMonthCalendar.Visible
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
end
else
if Message.wParam <> FMonthCalendar.Handle
then
CloseUp(False);
end;
WM_KEYDOWN:
CloseUp(False);
end;
end;
procedure TbsSkinDateEdit.DropDown;
var
P: TPoint;
I, Y: Integer;
begin
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FMonthCalendar.Height > Screen.Height then Y := P.Y - FMonthCalendar.Height;
//
if CheckW2KWXP and FAlphaBlend
then
begin
SetWindowLong(FMonthCalendar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetAlphaBlendTransparent(FMonthCalendar.Handle, 0)
end;
//
FMonthCalendar.SkinData := Self.SkinData;
SetWindowPos(FMonthCalendar.Handle, HWND_TOP, P.X, Y,
0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FMonthCalendar.Visible := True;
if FAlphaBlend and not FAlphaBlendAnimation and CheckW2KWXP
then
begin
Application.ProcessMessages;
SetAlphaBlendTransparent(FMonthCalendar.Handle, FAlphaBlendValue)
end
else
if FAlphaBlendAnimation and FAlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > FAlphaBlendValue then i := FAlphaBlendValue;
SetAlphaBlendTransparent(FMonthCalendar.Handle, i);
until i >= FAlphaBlendValue;
end;
end;
procedure TbsSkinDateEdit.CloseUp(AcceptValue: Boolean);
begin
if FMonthCalendar.Visible
then
begin
SetWindowPos(FMonthCalendar.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FMonthCalendar.Visible := False;
if CheckW2KWXP and FAlphaBlend
then
SetWindowLong(FMonthCalendar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
if AcceptValue
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
end;
SetFocus;
end;
end;
procedure TbsSkinDateEdit.ButtonClick(Sender: TObject);
begin
if FMonthCalendar.Visible
then
CloseUp(False)
else
DropDown;
end;
procedure TbsSkinDateEdit.CalendarClick;
begin
CloseUp(True);
end;
function TbsSkinDateEdit.GetFirstDayOfWeek: TbsDaysOfWeek;
begin
Result := FMonthCalendar.FirstDayOfWeek;
end;
procedure TbsSkinDateEdit.SetFirstDayOfWeek(Value: TbsDaysOfWeek);
begin
FMonthCalendar.FirstDayOfWeek := Value;
end;
constructor TbsSkinMemo.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
ScrollBars := ssNone;
FUseSkinFont := True;
end;
procedure TbsSkinMemo.CMEnabledChanged;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMPaint;
var
DC: HDC;
FCanvas: TControlCanvas;
PS: TPaintStruct;
R: TRect;
begin
if not Enabled
then
begin
GetSkinData;
FCanvas := TControlCanvas.Create;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
with FCanvas do
begin
Brush.Style := bsClear;
if FIndex = -1
then
begin
Font := DefaultFont;
Font.Color := clGrayText;
end
else
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := clGrayText;
Font.Style := FontStyle;
Font.CharSet := FDefaultFont.CharSet;
end;
R := ClientRect;
InflateRect(R, -2, -2);
case Alignment of
taLeftJustify:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_LEFT);
taRightJustify:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_RIGHT);
taCenter:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_CENTER);
end;
end;
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
FCanvas.Free;
end;
end
else
inherited;
end;
procedure TbsSkinMemo.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinMemo.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinMemo.SetBitMapBG;
begin
FBitMapBG := Value;
ReCreateWnd;
end;
procedure TbsSkinMemo.WMSize;
begin
inherited;
UpDateScrollRange;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.Invalidate;
begin
if FBitMapBG
then
begin
if Parent = nil then Exit;
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end
else
begin
inherited;
end;
end;
procedure TbsSkinMemo.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMHSCROLL;
begin
inherited;
//UpDateScrollRange;
end;
procedure TbsSkinMemo.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TbsSkinMemo.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TbsSkinMemo.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TbsSkinMemo.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo.UpDateScrollRange;
function GetVisibleLines: Integer;
var
R: TRect;
C: TCanvas;
DC: HDC;
LineHeight: Integer;
begin
C := TCanvas.Create;
C.Font.Assign(Font);
DC := GetDC(0);
C.Handle := DC;
R := GetClientRect;
LineHeight := C.TextHeight('Wq');
if LineHeight <> 0
then
Result := RectHeight(R) div LineHeight
else
Result := 1;
ReleaseDC(0, DC);
C.Free;
end;
var
LinesCount: Integer;
VisibleLines, Pos: Integer;
P: PPoint;
X: Integer;
R: TRect;
begin
if FVScrollBar <> nil
then
if not Enabled
then
FVScrollBar.Enabled := False
else
with FVScrollBar do
begin
VisibleLines := GetVisibleLines;
LinesCount := SendMessage(Self.Handle, EM_GETLINECOUNT, 0, 0);
Pos := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
if LinesCount > VisibleLines
then
begin
SetRange(0, LinesCount, Pos, VisibleLines + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
end;
procedure TbsSkinMEmo.WMMove;
begin
inherited;
end;
procedure TbsSkinMemo.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMSetText(var Message:TWMSetText);
begin
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMMOUSEWHEEL;
var
LParam, WParam: Integer;
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);
if FBitMapBG then Invalidate;
end;
procedure TbsSkinMemo.WMCHAR(var Message:TMessage);
begin
if not FReadOnly then inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (Message.CharCode = VK_DELETE) then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FBitMapBG then Invalidate else inherited;
end;
procedure TbsSkinMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FBitMapBG
then
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(NULL_BRUSH);
end
else
inherited;
end;
procedure TbsSkinMemo.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex = -1
then
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, 2);
Inc(Top, 2);
Dec(Right, 2);
Dec(Bottom, 2);
end
else
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, ClRect.Left);
Inc(Top, ClRect.Top);
Dec(Right, RectWidth(SkinRect) - ClRect.Right);
Dec(Bottom, RectHeight(SkinRect) - ClRect.Bottom);
end;
end;
procedure TbsSkinMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
ExStyle := Exstyle and not WS_EX_Transparent;
Style := Style and not WS_BORDER or ES_MULTILINE;
Style := Style and not WS_VSCROLL and not WS_HSCROLL;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TbsSkinMemo.SkinNCPaint(C: TCanvas);
var
B: TBitMap;
R: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
OffX, OffY: Integer;
begin
GetSkinData;
B := TBitMap.Create;
B.Width := Width;
B.Height := Height;
//
if FIndex = -1
then
with B.Canvas do
begin
Brush.Color := clWindow;
R := Rect(0, 0, Width, Height);
if FMouseIn or Focused
then
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
end
else
begin
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
end;
end
else
begin
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OffX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OffY);
NewRBPoint := Point(RBPoint.X + OffX, RBPoint.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
if FMouseIn or Focused
then
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, ActiveSkinRect, Width, Height, True)
else
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, SkinRect, Width, Height, True);
end;
C.Draw(0, 0, B);
B.Free;
end;
procedure TbsSkinMemo.SkinFramePaint(C: TCanvas);
var
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
R, NewClRect: TRect;
LeftB, TopB, RightB, BottomB: TBitMap;
OffX, OffY: Integer;
begin
GetSkinData;
if FIndex = -1
then
with C do
begin
Brush.Style := bsClear;
R := Rect(0, 0, Width, Height);
if FMouseIn or Focused
then
begin
Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
Frame3D(C, R, clBtnFace, clBtnFace, 1);
end
else
begin
Frame3D(C, R, clBtnFace, clBtnFace, 1);
Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
end;
Exit;
end;
LeftB := TBitMap.Create;
TopB := TBitMap.Create;
RightB := TBitMap.Create;
BottomB := TBitMap.Create;
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OffX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OffY);
NewRBPoint := Point(RBPoint.X + OffX, RBPoint.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
if FMouseIn or Focused
then
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, ActiveSkinRect, Width, Height)
else
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, SkinRect, Width, Height);
C.Draw(0, 0, TopB);
C.Draw(0, TopB.Height, LeftB);
C.Draw(Width - RightB.Width, TopB.Height, RightB);
C.Draw(0, Height - BottomB.Height, BottomB);
TopB.Free;
LeftB.Free;
RightB.Free;
BottomB.Free;
end;
procedure TbsSkinMemo.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
R: TRect;
kf: Double;
begin
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
try
if FBitMapBG
then
SkinNCPaint(C)
else
SkinFramePaint(C);
finally
C.Free;
ReleaseDC(Handle, DC);
end;
end;
destructor TbsSkinMemo.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinMemo.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
end;
if not FMouseIn then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
end;
if not FMouseIn then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
end;
if not Focused then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
end;
if not Focused then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.GetSkinData;
begin
if FSD = nil
then
begin
FIndex := -1;
Exit;
end;
if FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMemoControl
then
with TbsDataSkinMemoControl(FSD.CtrlList.Items[FIndex]) do
begin
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
if isNullRect(ActiveSkinRect)
then
Self.ActiveSkinRect := SkinRect;
Self.LTPoint := LTPoint;
Self.RTPoint := RTPoint;
Self.LBPoint := LBPoint;
Self.RBPoint := RBPoint;
Self.ClRect := ClRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.BGColor := BGColor;
Self.ActiveBGColor := ActiveBGColor;
end;
end;
procedure TbsSkinMemo.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinMemo.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
end;
procedure TbsSkinMemo.ChangeSkinData;
begin
GetSkinData;
//
if FIndex <> -1
then
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
Font.CharSet := FDefaultFont.CharSet;
end
else
begin
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
Color := BGColor;
end
else
Font.Assign(FDefaultFont);
//
UpDateScrollRange;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
end;
constructor TbsSkinMemo2.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
FHScrollBar := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
ScrollBars := ssBoth;
FUseSkinFont := True;
end;
procedure TbsSkinMemo2.CMEnabledChanged;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinMemo2.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinMemo2.WMSize;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.Invalidate;
begin
inherited;
end;
procedure TbsSkinMemo2.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMHSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TbsSkinMemo2.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TbsSkinMemo2.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TbsSkinMemo2.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo2.SetHScrollBar;
begin
FHScrollBar := Value;
FHScrollBar.Min := 0;
FHScrollBar.Max := 0;
FHScrollBar.Position := 0;
if FHScrollBar <> nil then FHScrollBar.OnChange := OnHScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.OnHScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo2.UpDateScrollRange;
function GetVisibleLines: Integer;
var
R: TRect;
C: TCanvas;
DC: HDC;
LineHeight: Integer;
begin
C := TCanvas.Create;
C.Font.Assign(Font);
DC := GetDC(0);
C.Handle := DC;
R := GetClientRect;
LineHeight := C.TextHeight('Wq');
if LineHeight <> 0
then
Result := RectHeight(R) div LineHeight
else
Result := 1;
ReleaseDC(0, DC);
C.Free;
end;
var
SMin, SMax, SPos, SPage: Integer;
begin
if FVScrollBar <> nil
then
if not Enabled
then
FVScrollBar.Enabled := False
else
with FVScrollBar do
begin
SPage := GetVisibleLines;
SPos := GetScrollPos(Self.Handle, SB_VERT);
GetScrollRange(Self.Handle, SB_VERT, SMin, SMax);
if SMax > SPage
then
begin
SetRange(0, SMax, SPos, SPage + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
if FHScrollBar <> nil
then
if not Enabled
then
FHScrollBar.Enabled := False
else
with FHScrollBar do
begin
SPage := Width;
SPos := GetScrollPos(Self.Handle, SB_HORZ);
GetScrollRange(Self.Handle, SB_HORZ, SMin, SMax);
if SMax > SPage
then
begin
SetRange(0, SMax, SPos, SPage + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
end;
procedure TbsSkinMemo2.WMMove;
begin
inherited;
end;
procedure TbsSkinMemo2.WMCut(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMPaste(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMClear(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMUndo(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMSetText(var Message:TWMSetText);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMMOUSEWHEEL;
var
LParam, WParam: Integer;
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);
end;
procedure TbsSkinMemo2.WMCHAR(var Message:TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
inherited;
end;
procedure TbsSkinMemo2.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
inherited;
end;
procedure TbsSkinMemo2.WMNCCALCSIZE;
begin
end;
procedure TbsSkinMemo2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
Style := Style and not WS_BORDER;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
destructor TbsSkinMemo2.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinMemo2.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TbsSkinMemo2.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TbsSkinMemo2.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TbsSkinMemo2.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TbsSkinMemo2.GetSkinData;
begin
if FSD = nil
then
begin
FIndex := -1;
Exit;
end;
if FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMemoControl
then
with TbsDataSkinMemoControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.BGColor := BGColor;
Self.ActiveBGColor := ActiveBGColor;
end;
end;
procedure TbsSkinMemo2.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinMemo2.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
end;
procedure TbsSkinMemo2.ChangeSkinData;
begin
GetSkinData;
//
if FIndex <> -1
then
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
Font.CharSet := FDefaultFont.CharSet;
end
else
begin
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
Color := BGColor;
end
else
Font.Assign(FDefaultFont);
//
UpDateScrollRange;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
end;
constructor TbsListBox.Create;
begin
inherited;
SkinListBox := nil;
Ctl3D := False;
BorderStyle := bsNone;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FHorizontalExtentValue := 0;
end;
destructor TbsListBox.Destroy;
begin
inherited;
end;
procedure TbsListBox.SetBounds;
var
OldWidth: Integer;
begin
OldWidth := Width;
inherited;
if (OldWidth <> Width) and (FHorizontalExtentValue > 0)
then
begin
FHorizontalExtentValue := FHorizontalExtentValue + (OldWidth - Width);
if FHorizontalExtentValue < 0 then FHorizontalExtentValue := 0;
RePaint;
end;
end;
procedure TbsListBox.CreateWnd;
begin
inherited;
if SkinListBox <> nil then SkinListBox.ListBoxCreateWnd;
end;
procedure TbsListBox.WMNCCALCSIZE;
begin
end;
procedure TbsListBox.CMEnter;
begin
if SkinListBox <> nil then SkinListBox.ListBoxEnter;
inherited;
end;
procedure TbsListBox.CMExit;
begin
if SkinListBox <> nil then SkinListBox.ListBoxExit;
inherited;
end;
procedure TbsListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseDown(Button, Shift, X, Y);
inherited;
end;
procedure TbsListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseUp(Button, Shift, X, Y);
inherited;
end;
procedure TbsListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseMove(Shift, X, Y);
inherited;
end;
procedure TbsListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyDown(Key, Shift);
if (Key = VK_LEFT) and (SkinListBox.HScrollBar <> nil)
then
with SkinListBox.HScrollBar do
begin
Position := Position - SmallChange;
Key := 0;
end
else
if (Key = VK_RIGHT) and (SkinListBox.HScrollBar <> nil)
then
with SkinListBox.HScrollBar do
begin
Position := Position + SmallChange;
Key := 0;
end;
inherited;
end;
procedure TbsListBox.KeyPress(var Key: Char);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyPress(Key);
inherited;
end;
procedure TbsListBox.Click;
begin
if SkinListBox <> nil then SkinListBox.ListBoxClick;
inherited;
end;
procedure TbsListBox.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 TbsListBox.GetState;
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 TbsListBox.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
Brush.Color := clWindow;
FillRect(Rect(0, 0, Width, Height));
end;
C.Handle := 0;
C.Free;
end;
procedure TbsListBox.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
DrawSkinItem(C, i, IR, GetState(i))
else
DrawDefaultItem(C, i, IR, GetState(i));
end;
C.Free;
end;
procedure TbsListBox.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
DrawSkinItem(C, i, IR, GetState(i))
else
DrawDefaultItem(C, i, IR, GetState(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 TbsListBox.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 TbsListBox.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TbsListBox.WMEraseBkgnd;
begin
if (Width > 0) and (Height > 0) then PaintBG(Message.DC);
Message.Result := 1;
end;
procedure TbsListBox.DrawDefaultItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
var
Buffer: TBitMap;
R, R1: TRect;
IIndex, IX, IY, Off: Integer;
begin
if (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(rcItem);
Buffer.Height := RectHeight(rcItem);
R := Rect(0, 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 odSelected in State
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);
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R1, State)
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 - FHorizontalExtentValue, IY, IIndex);
end;
Off := SkinListBox.Images.Width + 2
end
else
Off := 0;
Buffer.Canvas.Brush.Style := bsClear;
SPDrawText3(Buffer.Canvas, Items[ItemID], R1, - FHorizontalExtentValue + Off);
end;
if odFocused in State then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TbsListBox.DrawSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
var
Buffer: TBitMap;
R: TRect;
W, H: Integer;
IX, IY, IIndex, Off: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
if odSelected in State
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
Inc(R.Right, W - RectWidth(SItemRect));
end;
with Buffer.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
Font.CharSet := SkinListBox.DefaultFont.CharSet;
end
else
Font.Assign(SkinListBox.DefaultFont);
if odFocused in State
then
Font.Color := SkinListBox.FocusFontColor
else
if odSelected in State
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, State)
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 - FHorizontalExtentValue, IY, IIndex);
end;
Off := SkinListBox.Images.Width + 2;
end
else
Off := 0;
SPDrawText3(Buffer.Canvas, Items[ItemID], R, -FHorizontalExtentValue + Off);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TbsListBox.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 TbsListBox.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
DrawSkinItem(Canvas, itemID, rcItem, State)
else
DrawDefaultItem(Canvas, itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TbsListBox.WndProc;
var
LParam, WParam: Integer;
Handled: Boolean;
begin
if SkinListBox <> nil then SkinListBox.ListBoxWProc(Message, Handled);
if not Handled then Exit;
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
else
if (SkinListBox <> nil) and (SkinListBox.HScrollBar <> nil)
then
begin
with SkinListBox.HScrollBar do
if Message.WParam > 0
then
Position := Position - SmallChange
else
Position := Position + SmallChange;
end;
WM_ERASEBKGND:
SkinListBox.UpDateScrollBar;
LB_ADDSTRING, LB_INSERTSTRING,
LB_DELETESTRING:
begin
if SkinListBox <> nil
then
SkinListBox.UpDateScrollBar;
end;
end;
end;
constructor TbsSkinCustomListBox.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csClickEvents,
csReplicatable, csOpaque, csDoubleClicks];
ControlStyle := ControlStyle + [csAcceptsControls];
FRowCount := 0;
FImageIndex := -1;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FSpacing := 2;
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;
HScrollBar := nil;
ListBox := TbsListBox.Create(Self);
ListBox.SkinListBox := Self;
ListBox.Style := lbOwnerDrawFixed;
ListBox.ItemHeight := FDefaultItemHeight;
ListBox.Parent := Self;
ListBox.Visible := True;
Height := 120;
Width := 120;
FSkinDataName := 'listbox';
FHorizontalExtent := False;
FStopUpDateHScrollBar := False;
end;
procedure TbsSkinCustomListBox.SetHorizontalExtent(Value: Boolean);
begin
FHorizontalExtent := Value;
UpdateScrollBar;
end;
procedure TbsSkinCustomListBox.ListBoxCreateWnd;
begin
end;
function TbsSkinCustomListBox.GetColumns;
begin
Result := ListBox.Columns;
end;
procedure TbsSkinCustomListBox.SetColumns;
begin
ListBox.Columns := Value;
UpDateScrollBar;
end;
procedure TbsSkinCustomListBox.SetRowCount;
begin
FRowCount := Value;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
end;
procedure TbsSkinCustomListBox.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinCustomListBox.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinCustomListBox.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TbsSkinCustomListBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
ListBox.RePaint;
end;
procedure TbsSkinCustomListBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
ListBox.RePaint;
end;
procedure TbsSkinCustomListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TbsSkinCustomListBox.ListBoxWProc(var Message: TMessage; var Handled: Boolean);
begin
Handled := True;
end;
procedure TbsSkinCustomListBox.DefaultFontChange;
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomListBox.OnDefaultCaptionFontChange;
begin
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TbsSkinCustomListBox.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
CalcRects;
RePaint;
end;
end;
procedure TbsSkinCustomListBox.SetDefaultCaptionFont;
begin
FDefaultCaptionFont.Assign(Value);
end;
procedure TbsSkinCustomListBox.SetDefaultItemHeight;
begin
FDefaultItemHeight := Value;
if FIndex = -1
then
ListBox.ItemHeight := FDefaultItemHeight;
end;
procedure TbsSkinCustomListBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TbsSkinCustomListBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinCustomListBox.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 TbsSkinCustomListBox.CMMouseEnter;
begin
inherited;
if FCaptionMode
then
TestActive(-1, -1);
end;
procedure TbsSkinCustomListBox.CMMouseLeave;
var
i: Integer;
begin
inherited;
if FCaptionMode
then
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCustomListBox.MouseDown;
begin
if FCaptionMode
then
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
end;
inherited;
end;
procedure TbsSkinCustomListBox.MouseUp;
begin
if FCaptionMode
then
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
inherited;
end;
procedure TbsSkinCustomListBox.MouseMove;
begin
inherited;
if FCaptionMode then TestActive(X, Y);
end;
procedure TbsSkinCustomListBox.TestActive(X, Y: Integer);
var
i, j: Integer;
begin
if (FIndex <> -1) and IsNullRect(UpButtonRect) and IsNullRect(DownButtonRect)
then Exit;
j := -1;
OldActiveButton := ActiveButton;
for i := 0 to 2 do
begin
if PtInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
ActiveButton := j;
if (CaptureButton <> -1) and
(ActiveButton <> CaptureButton) and (ActiveButton <> -1)
then
ActiveButton := -1;
if (OldActiveButton <> ActiveButton)
then
begin
if OldActiveButton <> - 1
then
ButtonLeave(OldActiveButton);
if ActiveButton <> -1
then
ButtonEnter(ActiveButton);
end;
end;
procedure TbsSkinCustomListBox.ButtonDown;
begin
Buttons[i].MouseIn := True;
Buttons[i].Down := True;
DrawButton(Canvas, i);
case i of
0: if Assigned(FOnUpButtonClick) then Exit;
1: if Assigned(FOnDownButtonClick) then Exit;
2: if Assigned(FOnCheckButtonClick) then Exit;
end;
TimerMode := 0;
case i of
0: TimerMode := 1;
1: TimerMode := 2;
end;
if TimerMode <> 0
then
begin
WaitMode := True;
SetTimer(Handle, 1, 500, nil);
end;
end;
procedure TbsSkinCustomListBox.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if Buttons[i].MouseIn
then
case i of
0:
if Assigned(FOnUpButtonClick)
then
begin
FOnUpButtonClick(Self);
Exit;
end;
1:
if Assigned(FOnDownButtonClick)
then
begin
FOnDownButtonClick(Self);
Exit;
end;
2:
if Assigned(FOnCheckButtonClick)
then
begin
FOnCheckButtonClick(Self);
Exit;
end;
end;
case i of
1: ItemIndex := ItemIndex + 1;
0: if ItemIndex > 0 then ItemIndex := ItemIndex - 1;
2: ListBox.Click;
end;
if TimerMode <> 0 then StopTimer;
end;
procedure TbsSkinCustomListBox.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then SetTimer(Handle, 1, 50, nil);
end;
procedure TbsSkinCustomListBox.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then KillTimer(Handle, 1);
end;
procedure TbsSkinCustomListBox.CMTextChanged;
begin
inherited;
if FCaptionMode then RePaint;
end;
procedure TbsSkinCustomListBox.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
if FCaptionMode then RePaint;
end;
end;
procedure TbsSkinCustomListBox.DrawButton;
var
C: TColor;
kf: Double;
R1: TRect;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;
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;
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);
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
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;
Parent := Self;
Visible := True;
//
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;
//
CalcRects;
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
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);
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];
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.OnMouseDown := ListBoxMouseDown;
FListBox.ListBox.OnMouseMove := ListBoxMouseMove;
FListBox.ListBox.OnMouseUp := ListBoxMouseUp;
FListBoxWindowProc := FlistBox.ListBox.WindowProc;
FlistBox.ListBox.WindowProc := ListBoxWindowProcHook;
FListBox.OnCheckButtonClick := CheckButtonClick;
FLBDown := False;
FDropDownCount := 8;
//
CalcRects;
FSkinDataName := 'combobox';
end;
destructor TbsSkinCustomComboBox.Destroy;
begin
if FEdit <> nil then FEdit.Free;
FlistBox.Free;
inherited;
end;
procedure TbsSkinCustomComboBox.CMEnabledChanged;
begin
inherited;
RePaint;
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
Result := FListBox.Images;
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;
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);
var
FOld: Boolean;
Index: Integer;
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_CHAR:
case TWMCHAR(Message).CharCode of
VK_RETURN, VK_ESCAPE:
begin
FOLD := False;
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);
FOld := False;
end;
VK_ESCAPE:
begin
if FListBox.Visible then CloseUp(False);
FOld := 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.ListBoxWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONUP:
begin
CloseUp(True);
FOLD := False;
end;
WM_RBUTTONDOWN, WM_RBUTTONUP,
WM_MBUTTONDOWN, WM_MBUTTONUP,
WM_LBUTTONDOWN:
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.ListBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FLBDown := True;
end;
procedure TbsSkinCustomComboBox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Index: Integer;
begin
if not FLBDown
then
begin
Index := FListBox.ItemAtPos(Point (X, Y), True);
if (Index >= 0) and (Index < Items.Count)
then
FListBox.ItemIndex := Index;
end;
end;
procedure TbsSkinCustomComboBox.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FLBDown := False;
CloseUp(True);
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 DropDown;
end
else
if FListBox.Visible then CloseUp(False);
end;
procedure TbsSkinCustomComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
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 PtInRect(Button.R, Point(X, Y)) and not Button.MouseIn