Delphi控件源码

开发平台：

Delphi

bsSkinCtrls.pas：源码内容

RM := GetResizeMode;
R := TrackButtonRect;
case RM of
2:
begin
Off := Width - RectWidth(SkinRect);
OffsetRect(R, Off, 0);
end;
3:
begin
Off := Height - RectHeight(SkinRect);
OffsetRect(R, 0, Off);
end;
end;
Result := R;
end;
function TbsSkinMenuButton.CanMenuTrack;
var
R: TRect;
begin
if FSkinPopupMenu = nil
then
begin
Result := False;
Exit;
end
else
begin
if not FTrackButtonMode
then
Result := True
else
begin
if FIndex <> -1
then R := GetNewTrackButtonRect
else R := Rect(Width - 15, 0, Width, Height);
Result := PointInRect(R, Point(X, Y));
end;
end
end;
procedure TbsSkinMenuButton.WMCLOSESKINMENU;
begin
FMenuTracked := False;
Down := False;
if Assigned(FOnHideTrackMenu) then FOnHideTrackMenu(Self);
end;
procedure TbsSkinMenuButton.TrackMenu;
var
R: TRect;
P: TPoint;
begin
if FSkinPopupMenu = nil then Exit;
P := ClientToScreen(Point(0, 0));
R := Rect(P.X, P.Y, P.X + Width, P.Y + Height);
FSkinPopupMenu.PopupFromRect2(Self, R, False);
if Assigned(FOnShowTrackMenu) then FOnShowTrackMenu(Self);
end;
procedure TbsSkinMenuButton.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSkinPopupMenu)
then FSkinPopupMenu := nil;
end;
procedure TbsSkinMenuButton.CMMouseEnter(var Message: TMessage);
begin
if (csDesigning in ComponentState) then Exit;
if not FMenuTracked then inherited else FMouseIn := True;
end;
procedure TbsSkinMenuButton.CMMouseLeave(var Message: TMessage);
begin
if (csDesigning in ComponentState) then Exit;
if not FMenuTracked then inherited else FMouseIn := False;
end;
procedure TbsSkinMenuButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMenuButtonControl
then
with TbsDataSkinMenuButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.TrackButtonRect := TrackButtonRect;
end;
end;
procedure TbsSkinMenuButton.SetTrackButtonMode;
begin
FTrackButtonMode := Value;
if FIndex = - 1 then RePaint;
end;
procedure TbsSkinMenuButton.MouseDown;
begin
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
FMenuTracked := CanMenuTrack(X, Y);
FMouseIn := True;
if FMenuTracked
then
begin
if not FDown then Down := True;
TrackMenu;
end
else
inherited;
end;
procedure TbsSkinMenuButton.MouseUp;
begin
if not FMenuTracked then inherited;
end;
//=========== TbsSkinPanel ================
constructor TbsSkinPanel.Create;
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
Width := 150;
Height := 150;
NewClRect := NullRect;
FRollUpMode := False;
FCaptionMode := False;
FRealHeight := -1;
FSkinDataName := 'panel';
BGPictureIndex := -1;
FDefaultCaptionHeight := 22;
FNumGlyphs := 1;
FGlyph := TBitMap.Create;
FSpacing := 2;
VisibleControls := nil;
FAutoEnabledControls := True;
end;
destructor TbsSkinPanel.Destroy;
begin
FGlyph.Free;
inherited;
end;
procedure TbsSkinPanel.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 TbsSkinPanel.SetCheckedMode;
begin
FCheckedMode := Value;
RePaint;
end;
procedure TbsSkinPanel.SetChecked;
var
i: Integer;
begin
FChecked := Value;
if FCheckedMode then RePaint;
if FAutoEnabledControls and FCheckedMode
then
begin
for i := 0 to ControlCount -1 do
Controls[i].Enabled := FChecked;
end;
if Assigned(FOnChecked) then FOnChecked(Self);
end;
procedure TbsSkinPanel.ShowControls;
var
i: Integer;
begin
if VisibleControls = nil then Exit;
for i := 0 to VisibleControls.Count - 1 do
TControl(VisibleControls.Items[i]).Visible := True;
VisibleControls.Clear;
VisibleControls.Free;
VisibleControls := nil;
end;
procedure TbsSkinPanel.HideControls;
var
i: Integer;
begin
if VisibleControls <> nil then VisibleControls.Free;
VisibleControls := TList.Create;
VisibleControls.Clear;
for i := 0 to ControlCount - 1 do
begin
if Controls[i].Visible
then
begin
VisibleControls.Add(Controls[i]);
Controls[i].Visible := False;
end;
end;
end;
procedure TbsSkinPanel.CMEnabledChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinPanel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinPanel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinPanel.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TbsSkinPanel.SetDefaultAlignment(Value: TAlignment);
begin
FDefaultAlignment := Value;
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TbsSkinPanel.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
RePaint;
ReAlign;
end
end;
procedure TbsSkinPanel.SetBorderStyle;
begin
FBorderStyle := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end;
end;
procedure TbsSkinPanel.SetRollUpMode(Value: Boolean);
begin
FRollUpMode := Value;
if (FIndex = -1) and CaptionMode then RePaint;
end;
procedure TbsSkinPanel.CreateControlDefaultImage;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
var
R, CR: TRect;
TX, TY, CS: Integer;
GX, GY: Integer;
GlyphNum: Integer;
begin
inherited;
R := Rect(0, 0, Width, Height);
case FBorderStyle of
bvLowered:
Frame3D(B.Canvas, R, clBtnShadow, clBtnHighLight, 1);
bvRaised:
Frame3D(B.Canvas, R, clBtnHighLight, clBtnShadow, 1);
bvFrame:
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
end;
if FCaptionMode
then
begin
if FBorderStyle = bvFrame
then
begin
R := Rect(0, 0, Width, FDefaultCaptionHeight);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnHighLight, clBtnFace, 1);
end
else
begin
R := Rect(1, 1, Width - 1, FDefaultCaptionHeight);
Frame3D(B.Canvas, R, clBtnShadow, clBtnHighLight, 1);
Frame3D(B.Canvas, R, clBtnHighLight, clBtnShadow, 1);
end;
if FCheckedMode
then
Inc(R.Left, 20);
if RollUpMode
then
Dec(R.Right, 10);
with B.Canvas do
begin
Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
TY := R.Top + RectHeight(R) div 2 - TextHeight(Caption) div 2;
TX := R.Left + 2;
case FDefaultAlignment of
taCenter: TX := TX + RectWidth(R) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := R.Right - GetGlyphTextWidth;
end;
if FCheckedMode
then
begin
CS := 14;
CR.Left := 5;
CR.Top := R.Top + RectHeight(R) div 2 - CS div 2;
CR.Right := CR.Left + CS;
CR.Bottom := CR.Top + CS;
Frame3D(B.Canvas, CR, clBtnShadow, clBtnShadow, 1);
if FChecked then DrawCheckImage(B.Canvas, CR.Left + 3, CR.Top + 2,
clBtnText);
end;
if not FGlyph.Empty
then
begin
GY := R.Top + RectHeight(R) 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;
Brush.Style := bsClear;
TextRect(R, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
end;
if FRollUpMode
then
begin
R.Left := R.Right;
R.Right := R.Left + 10;
if FRollUpState
then DrawArrowImage(B.Canvas, R, clBtnText, 4)
else DrawArrowImage(B.Canvas, R, clBtnText, 3);
end;
end;
end;
procedure TbsSkinPanel.MouseUp;
begin
if (FRollUpMode or FCheckedMode) and FCaptionMode and (Button = mbLeft)
then
begin
if ((FIndex <> -1) and (PointInRect(NewCaptionRect, Point(X, Y)) or
PointInRect(NewRollUpMarkerRect, Point(X, Y))))
or
((FIndex = -1) and PointInRect(Rect(1, 1, Width - 1, FDefaultCaptionHeight),
Point(X, Y)))
then
begin
if CheckedMode
then
Checked := not Checked;
if RollUpMode
then
RollUpState := not FRollUpState;
end;
end;
inherited;
end;
procedure TbsSkinPanel.DoRollUp(ARollUp: Boolean);
begin
if FIndex <> -1
then
begin
if ARollUp and (FRealHeight = -1)
then
begin
FRealHeight := Height;
if VisibleControls = nil then HideControls;
Height := NewClRect.Top + (Height - NewClRect.Bottom);
end
else
if not ARollUp and (FRealHeight <> -1)
then
begin
Height := FRealHeight;
FRealHeight := -1;
if VisibleControls <> nil then ShowControls;
end;
end
else
begin
if ARollUp and (FRealHeight = -1)
then
begin
FRealHeight := Height;
if VisibleControls = nil then HideControls;
Height := FDEfaultCaptionHeight + 1;
end
else
if not ARollUp and (FRealHeight <> -1)
then
begin
Height := FRealHeight;
FRealHeight := -1;
if VisibleControls <> nil then ShowControls;
end;
end;
end;
procedure TbsSkinPanel.SetRollUpState;
begin
if FRollUpState = Value then Exit;
if FRollUpMode
then
begin
FRollUpState := Value;
DoRollUp(FRollUpState);
end
else
FRollUpState := False;
end;
procedure TbsSkinPanel.SetCaptionMode;
begin
FCaptionMode := Value;
RePaint;
ReAlign;
end;
procedure TbsSkinPanel.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
procedure TbsSkinPanel.GetSkinData;
begin
inherited;
BGPictureIndex := -1;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinPanelControl
then
with TbsDataSkinPanelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.CaptionRect := CaptionRect;
Self.Alignment := Alignment;
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.BGPictureIndex := BGPictureIndex;
Self.CheckImageRect := CheckImageRect;
Self.UnCheckImageRect := UnCheckImageRect;
end;
end;
procedure TbsSkinPanel.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
if (FIndex <> -1) and not (csDesigning in ComponentState)
then
begin
if (BGPictureIndex = -1) and not ((BorderStyle = bvNone) and not CaptionMode and
(ResizeMode = 1))
then Rect := NewClRect;
end
else
begin
if FBorderStyle <> bvNone then InflateRect(Rect, -1, -1);
if FCaptionMode then Rect.Top := Rect.Top + FDefaultCaptionHeight;
end;
end;
procedure TbsSkinPanel.CreateControlSkinImage;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
procedure DrawCaption;
var
TX, TY, GX, GY, CW, CH: Integer;
GlyphNum: Integer;
CR, CapRect, R: TRect;
begin
CapRect := NewCaptionRect;
if FRollUpMode then Dec(CapRect.Right, 12);
if FCheckedMode
then
begin
CW := RectWidth(CheckImageRect);
CH := RectHeight(CheckImageRect);
CR.Left := CapRect.Left;
CR.Top := CapRect.Top + RectHeight(CapRect) div 2 - CH div 2;
CR.Right := CR.Left + CW;
CR.Bottom := CR.Top + CH;
if FChecked
then
SkinDrawCheckImage(CR.Left, CR.Top, Picture.Canvas, CheckImageRect, B.Canvas)
else
SkinDrawCheckImage(CR.Left, CR.Top, Picture.Canvas, UnCheckImageRect, B.Canvas);
Inc(CapRect.Left, CW + 2);
end;
with B.Canvas do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
end
else
Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.Charset;
Font.Color := FontColor;
TY := CapRect.Top +
RectHeight(CapRect) div 2 - TextHeight(Caption) div 2;
TX := CapRect.Left;
case Alignment of
taCenter: TX := TX +
RectWidth(CapRect) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := CapRect.Right - GetGlyphTextWidth;
end;
Brush.Style := bsClear;
if not FGlyph.Empty
then
begin
GY := CapRect.Top + RectHeight(CapRect) 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;
if FRollUpMode
then
begin
R := CapRect;
R.Left := R.Right;
R.Right := R.Right + 10;
if FRollUpState
then DrawArrowImage(B.Canvas, R, FontColor, 4)
else DrawArrowImage(B.Canvas, R, FontColor, 3);
end;
TextRect(CapRect, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
end;
end;
var
X, Y, XCnt, YCnt, XO, YO, w, h, w1, h1: Integer;
begin
if (BorderStyle = bvNone) and (ResizeMode = 1) and not CaptionMode
then
with B.Canvas do
begin
w1 := Width;
h1 := Height;
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
else
begin
inherited;
if ResizeMode > 0
then NewCaptionRect := GetNewRect(CaptionRect)
else NewCaptionRect := CaptionRect;
if (Caption <> '') and not IsNullRect(CaptionRect)
then DrawCaption;
end;
end;
procedure TbsSkinPanel.Paint;
var
RealPicture: TBitMap;
X, Y, XCnt, YCnt: Integer;
begin
GetSkinData;
if FIndex =-1
then
inherited
else
if BGPictureIndex <> -1
then
begin
RealPicture := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
if (Width > 0) and (Height > 0)
then
begin
XCnt := Width div RealPicture.Width;
YCnt := Height div RealPicture.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
Canvas.Draw(X * RealPicture.Width, Y * RealPicture.Height, RealPicture);
end;
end
else
inherited;
end;
procedure TbsSkinPanel.ChangeSkinData;
var
TempOldHeight: Integer;
begin
inherited;
if FRollUpState
then
begin
TempOldHeight := FRealHeight;
FRealHeight := -1;
DoRollUp(True);
FRealHeight := TempOldHeight;
end
else
ReAlign;
end;
procedure TbsSkinPanel.CMTextChanged;
begin
if FCaptionMode then RePaint;
end;
procedure TbsSkinPanel.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;
constructor TbsSkinGroupBox.Create;
begin
inherited;
FSkinDataName := 'groupbox';
CaptionMode := True;
end;
constructor TbsSkinToolBar.Create;
begin
inherited;
FSkinDataName := 'toolpanel';
FCanScroll := False;
DefaultHeight := 25;
BorderStyle := bvNone;
FAutoShowHideCaptions := False;
FShowCaptions := False;
FWidthWithCaptions := 0;
FWidthWithoutCaptions := 0;
// scroll
FHotScroll := False;
TimerMode := 0;
ButtonData := nil;
FScrollOffset := 0;
FScrollTimerInterval := 50;
Buttons[0].Visible := False;
Buttons[1].Visible := False;
FHSizeOffset := 0;
SMax := 0;
SPosition := 0;
SOldPosition := 0;
SPage := 0;
//
end;
procedure TbsSkinToolBar.CreateControlSkinImage(B: TBitMap);
begin
if ((Buttons[0].Visible) or (Buttons[1].Visible)) and (ResizeMode = 2)
then
begin
CreateHSkinImage3(LTPt.X, RectWidth(SkinRect) - RTPt.X,
B, Picture, SkinRect, Width, Height);
end
else
inherited;
end;
procedure TbsSkinToolBar.SetBounds;
var
MaxWidth, OldWidth: Integer;
begin
OldWidth := Width;
inherited;
if not FCanScroll then Exit;
if (OldWidth <> Width)
then
begin
if (OldWidth < Width) and (OldWidth <> 0)
then FHSizeOffset := Width - OldWidth
else FHSizeOffset := 0;
end
else
FHSizeOffset := 0;
if Align <> alNone then GetScrollInfo;
end;
procedure TbsSkinToolBar.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, Self.ScrollTimerInterval, nil);
end;
procedure TbsSkinToolBar.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinToolBar.AdjustClientRect(var Rect: TRect);
var
RLeft, RTop, VMax, HMax: Integer;
begin
inherited;
if FCanScroll and (Buttons[0].Visible) or (Buttons[1].Visible)
then
begin
RTop := 0;
RLeft := - SPosition;
HMax := Max(SMax, ClientWidth);
VMax := ClientHeight;
Rect := Bounds(RLeft, RTop, HMax, VMax);
if (FIndex <> -1) and not (csDesigning in ComponentState)
then
begin
Rect.Top := NewClRect.Top;
Rect.Bottom := NewClRect.Bottom;
end
else
begin
Rect.Top := 1;
Rect.Bottom := Rect.Bottom - 1;
end;
end;
end;
procedure TbsSkinToolBar.HScrollControls(AOffset: Integer);
begin
ScrollBy(-AOffset, 0);
end;
procedure TbsSkinToolBar.GetScrollInfo;
begin
GetHRange;
end;
procedure TbsSkinToolBar.GetHRange;
var
i, FMax, W, MaxRight, Offset: Integer;
begin
MaxRight := 0;
if ControlCount > 0
then
for i := 0 to ControlCount - 1 do
with Controls[i] do
begin
if Visible
then
if Left + Width > MaxRight then MaxRight := left + Width;
end;
if MaxRight = 0
then
begin
if Buttons[1].Visible then SetButtonsVisible(False);
Exit;
end;
W := ClientWidth;
FMax := MaxRight + SPosition;
if (FMax > W)
then
begin
if not Buttons[1].Visible then SetButtonsVisible(True);
if (SPosition > 0) and (MaxRight < W) and (FHSizeOffset > 0)
then
begin
if FHSizeOffset > SPosition then FHSizeOffset := SPosition;
SMax := FMax - 1;
SPosition := SPosition - FHSizeOffset;
SPage := W;
HScrollControls(-FHSizeOffset);
SOldPosition := SPosition;
end
else
begin
if (FHSizeOffset = 0) and ((FMax - 1) < SMax) and (SPosition > 0) and
(MaxRight < W)
then
begin
Offset := SMax - (FMax - 1);
Offset := Offset + (SMax - SPage + 1) + SPosition;
if Offset > SPosition then Offset := SPosition;
HScrollControls(-Offset);
SMax := FMax - 1;
SPosition := SPosition - Offset;
SPage := W;
end
else
begin
SMax := FMax - 1;
SPage := W;
end;
FHSizeOffset := 0;
SOldPosition := SPosition;
end;
end
else
begin
if SPosition > 0 then HScrollControls(-SPosition);
FHSizeOffset := 0;
SMax := 0;
SPosition := 0;
SPage := 0;
if Buttons[1].Visible then SetButtonsVisible(False);
end;
end;
procedure TbsSkinToolBar.ButtonUp(I: Integer);
begin
case I of
0:
begin
StopTimer;
TimerMode := 0;
ButtonClick(0);
end;
1:
begin
StopTimer;
TimerMode := 0;
ButtonClick(1);
end;
end;
end;
procedure TbsSkinToolBar.ButtonDown(I: Integer);
begin
case I of
0:
begin
TimerMode := 1;
StartTimer;
end;
1:
begin
TimerMode := 2;
StartTimer;
end;
end;
end;
procedure TbsSkinToolBar.ButtonClick;
var
SOffset: Integer;
begin
if FScrollOffset = 0
then
SOffset := ClientWidth
else
SOffset := FScrollOffset;
case I of
0:
begin
SPosition := SPosition - SOffset;
if SPosition < 0 then SPosition := 0;
if (SPosition - SOldPosition <> 0)
then
HScrollControls(SPosition - SOldPosition)
else
StopTimer;
end;
1:
begin
SPosition := SPosition + SOffset;
if SPosition > SMax - SPage + 1 then SPosition := SMax - SPage + 1;
if (SPosition - SOldPosition <> 0)
then
HScrollControls(SPosition - SOldPosition)
else
StopTimer;
end;
end;
end;
procedure TbsSkinToolBar.SetButtonsVisible;
begin
if Buttons[0].Visible <> AVisible
then
begin
Buttons[0].Visible := AVisible;
Buttons[1].Visible := AVisible;
ReCreateWnd;
end;
end;
procedure TbsSkinToolBar.WndProc;
var
B: Boolean;
P: TPoint;
begin
B := True;
case Message.Msg of
WM_WINDOWPOSCHANGING:
if Self.HandleAllocated and (Align = alNone)
then
GetScrollInfo;
WM_NCHITTEST:
if not (csDesigning in ComponentState) and FCanScroll then
begin
P.X := LoWord(Message.lParam);
P.Y := HiWord(Message.lParam);
P := ScreenToClient(P);
if (P.X < 0) and Buttons[0].Visible
then
begin
Message.Result := HTBUTTON1;
B := False;
end
else
if (P.X > ClientWidth) and Buttons[1].Visible
then
begin
Message.Result := HTBUTTON2;
B := False;
end;
end;
WM_NCLBUTTONDOWN, WM_NCLBUTTONDBLCLK:
if FCanScroll then
begin
if Message.wParam = HTBUTTON1
then
begin
Buttons[0].Down := True;
SendMessage(Handle, WM_NCPAINT, 0, 0);
ButtonDown(0);
end
else
if Message.wParam = HTBUTTON2
then
begin
Buttons[1].Down := True;
SendMessage(Handle, WM_NCPAINT, 0, 0);
ButtonDown(1);
end;
end;
WM_NCLBUTTONUP:
if FCanScroll then
begin
if Message.wParam = HTBUTTON1
then
begin
Buttons[0].Down := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
ButtonUp(0);
end
else
if Message.wParam = HTBUTTON2
then
begin
Buttons[1].Down := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
ButtonUp(1);
end;
end;
WM_NCMOUSEMOVE:
if FCanScroll then
begin
if (Message.wParam = HTBUTTON1) and (not Buttons[0].MouseIn)
then
begin
Buttons[0].MouseIn := True;
Buttons[1].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
if FHotScroll
then
begin
TimerMode := 1;
StartTimer;
end;
end
else
if (Message.wParam = HTBUTTON2) and (not Buttons[1].MouseIn)
then
begin
Buttons[1].MouseIn := True;
Buttons[0].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
if FHotScroll
then
begin
TimerMode := 2;
StartTimer;
end;
end;
end;
WM_MOUSEMOVE:
begin
if Buttons[0].MouseIn and Buttons[0].Visible
then
begin
if TimerMode <> 0 then StopTimer;
Buttons[0].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end
else
if Buttons[1].MouseIn and Buttons[1].Visible
then
begin
if TimerMode <> 0 then StopTimer;
Buttons[1].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
end;
end;
if B then inherited;
end;
procedure TbsSkinToolBar.CMMOUSELEAVE;
var
P: TPoint;
begin
inherited;
if (csDesigning in ComponentState) or not FCanScroll then Exit;
GetCursorPos(P);
if WindowFromPoint(P) <> Handle
then
if Buttons[0].MouseIn and Buttons[0].Visible
then
begin
if TimerMode <> 0 then StopTimer;
Buttons[0].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end
else
if Buttons[1].MouseIn and Buttons[1].Visible
then
begin
if TimerMode <> 0 then StopTimer;
Buttons[1].MouseIn := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
end;
procedure TbsSkinToolBar.WMSIZE;
begin
inherited;
if FCanScroll and (Buttons[0].Visible or Buttons[1].Visible)
then
begin
Buttons[0].R := Rect(0, 0, ButtonSize, Height);
Buttons[1].R := Rect(Width - ButtonSize, 0, Width, Height);
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
end;
procedure TbsSkinToolBar.WMNCPaint;
var
Cnvs: TCanvas;
DC: HDC;
begin
if FCanScroll and (Buttons[0].Visible or Buttons[1].Visible)
then
begin
DC := GetWindowDC(Handle);
Cnvs := TCanvas.Create;
Cnvs.Handle := DC;
if Buttons[0].Visible then DrawButton(Cnvs, 0);
if Buttons[1].Visible then DrawButton(Cnvs, 1);
Cnvs.Handle := 0;
ReleaseDC(Handle, DC);
Cnvs.Free;
end;
end;
procedure TbsSkinToolBar.WMNCCALCSIZE;
begin
if FCanScroll
then
begin
GetSkinData;
with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
begin
if Buttons[0].Visible then Inc(Left, ButtonSize);
if Buttons[1].Visible then Dec(Right, ButtonSize);
end;
end;
end;
procedure TbsSkinToolBar.GetSkinData;
var
CIndex: Integer;
begin
inherited;
ButtonData := nil;
if FIndex <> -1
then
begin
CIndex := FSD.GetControlIndex('resizebutton');
if CIndex <> -1
then
ButtonData := TbsDataSkinButtonControl(FSD.CtrlList[CIndex]);
end;
end;
procedure TbsSkinToolBar.WMTimer;
begin
inherited;
if FCanScroll then
case TimerMode of
1: ButtonClick(0);
2: ButtonClick(1);
end;
end;
procedure TbsSkinToolBar.SetScrollTimerInterval;
begin
if Value > 0 then FScrollTimerInterval := Value;
end;
procedure TbsSkinToolBar.SetScrollOffset;
begin
if Value >= 0 then FScrollOffset := Value;
end;
procedure TbsSkinToolBar.DrawButton;
var
B: TBitMap;
R, NewCLRect: TRect;
FSkinPicture: TBitMap;
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
XO, YO: Integer;
C: TColor;
begin
B := TBitMap.Create;
B.Width := RectWidth(Buttons[i].R);
B.Height := RectHeight(Buttons[i].R);
R := Rect(0, 0, B.Width, B.Height);
GetSkinData;
if ButtonData = nil
then
begin
C := clBtnText;
if ((Buttons[I].Down and Buttons[I].MouseIn)) or
(Buttons[I].MouseIn and HotScroll)
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
end
else
if Buttons[I].MouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
end
else
with ButtonData, Buttons[I] do
begin
//
XO := RectWidth(R) - RectWidth(SkinRect);
YO := RectHeight(R) - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
NewClRect := Rect(CLRect.Left, ClRect.Top,
CLRect.Right + XO, ClRect.Bottom + YO);
FSkinPicture := TBitMap(FSD.FActivePictures.Items[ButtonData.PictureIndex]);
//
if (Down and not IsNullRect(DownSkinRect) and MouseIn) or
(MouseIn and HotScroll and not IsNullRect(DownSkinRect))
then
begin
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, FSkinPicture, DownSkinRect, B.Width, B.Height, True);
C := DownFontColor;
end
else
if MouseIn and not IsNullRect(ActiveSkinRect)
then
begin
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, FSkinPicture, ActiveSkinRect, B.Width, B.Height, True);
C := ActiveFontColor;
end
else
begin
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, FSkinPicture, SkinRect, B.Width, B.Height, True);
C := FontColor;
end;
end;
//
case I of
0: DrawArrowImage(B.Canvas, R, C, 1);
1: DrawArrowImage(B.Canvas, R, C, 2);
end;
//
Cnvs.Draw(Buttons[I].R.Left, Buttons[I].R.Top, B);
B.Free;
end;
procedure TbsSkinToolBar.SetShowCaptions(Value: Boolean);
var
I: Integer;
begin
if FShowCaptions <> Value
then
begin
FShowCaptions := Value;
if FAutoShowHideCaptions
then
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinSpeedButton
then
TbsSkinSpeedButton(Controls[I]).ShowCaption := FShowCaptions;
if (FWidthWithCaptions <> 0) and (FWidthWithoutCaptions <> 0)
then
begin
if FShowCaptions
then Width := FWidthWithCaptions
else Width := FWidthWithoutCaptions;
end;
end;
end;
procedure TbsSkinToolBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImages then Images := nil;
if AComponent = FHotImages then HotImages := nil;
if AComponent = FDisabledImages then DisabledImages := nil;
end;
end;
procedure TbsSkinToolBar.SetSkinDataName(Value: String);
var
I: Integer;
begin
inherited;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinMenuSpeedButton
then
with TbsSkinMenuSpeedButton(Controls[I]) do
begin
if TrackButtonMode
then
begin
if Self.SkinDataName = 'bigtoolpanel'
then
SkinDataName := 'bigtoolmenutrackbutton'
else
SkinDataName := 'toolmenutrackbutton';
end
else
begin
if Self.SkinDataName = 'bigtoolpanel'
then
SkinDataName := 'bigtoolmenubutton'
else
SkinDataName := 'toolmenubutton';
end;
end
else
if Controls[I] is TbsSkinSpeedButton
then
with TbsSkinSpeedButton(Controls[I]) do
begin
if Self.SkinDataName = 'bigtoolpanel'
then
SkinDataName := 'bigtoolbutton'
else
SkinDataName := 'toolbutton';
end;
end;
procedure TbsSkinToolBar.SetSkinData(Value: TbsSkinData);
var
I: Integer;
begin
inherited;
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinSpeedButton
then
TbsSkinSpeedButton(Controls[I]).SkinData := Self.SkinData
else
if Controls[I] is TbsSkinBevel
then
TbsSkinBevel(Controls[I]).SkinData := Self.SkinData
end;
procedure TbsSkinToolBar.SetFlat(Value: Boolean);
var
I: Integer;
begin
FFlat := Value;
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinSpeedButton
then
TbsSkinSpeedButton(Controls[I]).Flat := FFlat;
end;
procedure TbsSkinToolBar.SetDisabledImages(Value: TCustomImageList);
begin
FDisabledImages := Value;
end;
procedure TbsSkinToolBar.SetHotImages(Value: TCustomImageList);
begin
FHotImages := Value;
end;
procedure TbsSkinToolBar.SetImages(Value: TCustomImageList);
var
I: Integer;
begin
FImages := Value;
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinSpeedButton
then
TbsSkinSpeedButton(Controls[I]).RePaint;
end;
constructor TbsSkinStatusBar.Create;
begin
inherited;
FSkinDataName := 'statusbar';
Align := alBottom;
DefaultHeight := 21;
BorderStyle := bvNone;
end;
procedure TbsSkinStatusBar.SetSkinData;
var
I: Integer;
begin
inherited;
for I := 0 to ControlCount - 1 do
if Controls[I] is TbsSkinControl
then
TbsSkinControl(Controls[I]).SkinData := Self.SkinData
end;
//=========== TbsSkinCheckRadioBox ===============
constructor TbsSkinCheckRadioBox.Create;
begin
inherited;
FFlat := True;
FCanFocused := True;
TabStop := False;
FMouseIn := False;
Width := 150;
Height := 25;
FGroupIndex := 0;
FSkinDataName := 'checkbox';
MorphTimer := nil;
FImages := nil;
FImageIndex := 0;
end;
destructor TbsSkinCheckRadioBox.Destroy;
begin
StopMorph;
inherited;
end;
procedure TbsSkinCheckRadioBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImages then Images := nil;
end;
end;
procedure TbsSkinCheckRadioBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
RePaint;
end;
procedure TbsSkinCheckRadioBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
RePaint;
end;
procedure TbsSkinCheckRadioBox.WMMOVE(var Msg: TWMMOVE);
begin
inherited;
if FFlat then Invalidate;
end;
procedure TbsSkinCheckRadioBox.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 TbsSkinCheckRadioBox.SetFlat;
begin
FFlat := Value;
RePaint;
end;
procedure TbsSkinCheckRadioBox.CMEnabledChanged;
begin
inherited;
if Morphing
then
begin
StopMorph;
FMorphKf := 0;
end;
FMouseIn := False;
RePaint;
end;
procedure TbsSkinCheckRadioBox.DoMorph;
begin
if (FIndex = -1) or not Morphing
then
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
end
else
if (FMouseIn or IsFocused) and (FMorphKf < 1)
then
begin
FMorphKf := FMorphKf + MorphInc;
RePaint;
end
else
if (not FMouseIn and not IsFocused) and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - MorphInc;
RePaint;
end
else
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TbsSkinCheckRadioBox.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TbsSkinCheckRadioBox.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TbsSkinCheckRadioBox.Paint;
var
Buffer, ABuffer: TBitMap;
PBuffer, APBuffer: TbsEffectBmp;
IR, TR: TRect;
IX, IY: Integer;
ImX, ImY: Integer;
C: TColor;
begin
GetSkinData;
if FFlat
then
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
GetParentImage(Self, Buffer.Canvas);
if FIndex = -1
then
with Buffer.Canvas do
begin
IR := Rect(3, Height div 2 - 7, 17, Height div 2 + 7);
// draw caption
TR := Rect(0, 0, 0, 0);
Font := DefaultFont;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
Brush.Style := bsClear;
DrawText(Buffer.Canvas.Handle, PChar(Caption), Length(Caption), TR,
DT_CALCRECT);
OffsetRect(TR, 22, Height div 2 - RectHeight(TR) div 2);
if TR.Right > Width - 2 then TR.Right := Width - 2;
if (FImages <> nil) and (ImageIndex >= 0) and (ImageIndex < FImages.Count)
then
begin
ImX := TR.Left;
ImY := Height div 2 - FImages.Height div 2;
FIMages.Draw(Buffer.Canvas, ImX, ImY, FImageIndex, Enabled);
OffsetRect(TR, FImages.Width + 5, 0);
end;
Brush.Style := bsClear;
if not Enabled then Font.Color := clBtnShadow;
BSDrawText(Buffer.Canvas, Caption, TR);
// draw glyph
if FMouseIn
then
Frame3D(Buffer.Canvas, IR, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1)
else
Frame3D(Buffer.Canvas, IR, clbtnShadow, clbtnShadow, 1);
Pen.Color := clBlack;
if FChecked
then
begin
if Enabled then C := clBlack else C := clBtnShadow;
if FRadio
then DrawRadioImage(Buffer.Canvas, 7, Height div 2 - 3, C)
else DrawCheckImage(Buffer.Canvas, 7, Height div 2 - 4, C);
end;
// draw focus
InflateRect(TR, 2, 1);
Inc(TR.Right, 1 );
Brush.Style := bsSolid;
Brush.Color := clBtnFace;
if IsFocused
then
if Caption <> ''
then
DrawFocusRect(TR)
else
if (FImages <> nil) and (ImageIndex >= 0) and (ImageIndex < FImages.Count)
then
DrawFocusRect(Rect(ImX - 1, ImY - 1,
ImX + FImages.Width + 1, ImY + FImages.Height + 1));
end
else
with Buffer.Canvas do
begin
// draw glyph
IX := 3;
IY := Height div 2 - RectHeight(CheckImageRect) div 2;
if not Enabled
then
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnEnabledCheckImageRect, Buffer.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnEnabledUnCheckImageRect, Buffer.Canvas);
end
else
if FMouseIn
then
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, ActiveCheckImageRect, Buffer.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, ActiveUnCheckImageRect, Buffer.Canvas);
end
else
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, CheckImageRect, Buffer.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnCheckImageRect, Buffer.Canvas);
end;
// draw caption
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
end
else
Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.Charset;
TR := Rect(0, 0, 0, 0);
DrawText(Buffer.Canvas.Handle, PChar(Caption), Length(Caption), TR,
DT_CALCRECT);
OffsetRect(TR, IX + RectWidth(CheckIMageRect) + 4, Height div 2 - RectHeight(TR) div 2);
if TR.Right > Width - 2 then TR.Right := Width - 2;
//
if (FImages <> nil) and (ImageIndex >= 0) and (ImageIndex < FImages.Count)
then
begin
ImX := TR.Left;
ImY := Height div 2 - FImages.Height div 2;
FIMages.Draw(Buffer.Canvas, ImX, ImY, FImageIndex, Enabled);
OffsetRect(TR, FImages.Width + 5, 0);
end;
//
Brush.Style := bsClear;
if not Enabled
then Font.Color := UnEnabledFontColor
else Font.Color := FrameFontColor;
BSDrawText(Buffer.Canvas, Caption, TR);
// drawfocus
InflateRect(TR, 2, 1);
Inc(TR.Right, 1 );
Brush.Style := bsSolid;
if IsFocused
then
if Caption <> ''
then
DrawFocusRect(TR)
else
if (FImages <> nil) and (ImageIndex >= 0) and (ImageIndex < FImages.Count)
then
DrawFocusRect(Rect(ImX - 1, ImY - 1,
ImX + FImages.Width + 1, ImY + FImages.Height + 1));
end;
Self.Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
if FIndex = -1
then
inherited
else
if Morphing and (FMorphKf < 1) and (FMorphKf > 0)
then
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
CreateImage(Buffer, SkinRect, False);
CreateImage(ABuffer, ActiveSkinRect, True);
PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, FMorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, FMorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, FMorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, FMorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, FMorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, FMorphKf);
mkPush: PBuffer.MorphPush(APBuffer, FMorphKf);
end;
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if FMouseIn or IsFocused
then CreateImage(Buffer, ActiveSkinRect, FMouseIn or IsFocused)
else CreateImage(Buffer, SkinRect, FMouseIn or IsFocused);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
end;
function TbsSkinCheckRadioBox.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TbsSkinCheckRadioBox.SetCheckState;
begin
if FRadio
then
begin
if not Checked
then
Checked := True;
end
else
Checked := not FChecked;
end;
procedure TbsSkinCheckRadioBox.CMDialogChar;
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
SetCheckState;
Result := 1;
end
else
inherited;
end;
procedure TbsSkinCheckRadioBox.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TbsSkinCheckRadioBox.WMSETFOCUS;
begin
inherited;
if FCanFocused
then
if FFlat then Invalidate else ReDrawControl;
end;
procedure TbsSkinCheckRadioBox.WMKILLFOCUS;
begin
inherited;
if FCanFocused
then
if FFlat then Invalidate else ReDrawControl;
end;
procedure TbsSkinCheckRadioBox.WndProc(var Message: TMessage);
begin
if FCanFocused then
case Message.Msg of
WM_KEYUP:
if IsFocused then
with TWMKeyUp(Message) do
begin
if CharCode = VK_SPACE then SetCheckState;
end;
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if not (csDesigning in ComponentState) and not Focused then
begin
FClicksDisabled := True;
Windows.SetFocus(Handle);
FClicksDisabled := False;
if not Focused then Exit;
end;
CN_COMMAND:
if FClicksDisabled then Exit;
end;
inherited WndProc(Message);
end;
procedure TbsSkinCheckRadioBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Self.Checked = False) then
Self.Checked := Checked;
end;
end;
procedure TbsSkinCheckRadioBox.SetRadio;
begin
FRadio := Value;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FRadio
then
begin
FSkinDataName := 'radiobox';
FGroupIndex := 1;
end
else
begin
FSkinDataName := 'checkbox';
FGroupIndex := 0;
end;
end;
RePaint;
end;
procedure TbsSkinCheckRadioBox.CalcSize;
var
NewCIArea: TRect;
Offset: Integer;
CIW, CIH: Integer;
begin
if FFlat then Exit;
inherited;
Offset := W - RectWidth(SkinRect);
NewTextArea := TextArea;
Inc(NewTextArea.Right, Offset);
NewCIArea := CheckImageArea;
if CheckImageArea.Right > TextArea.Right
then
OffsetRect(NewCIArea, Offset, 0);
CIW := RectWidth(CheckImageRect);
CIH := RectHeight(CheckImageRect);
CIRect.Left := NewCIArea.Left + RectWidth(NewCIArea) div 2 - CIW div 2;
CIRect.Top := NewCIArea.Top + RectHeight(NewCIArea) div 2 - CIH div 2;
CIRect.Right := CIRect.Left + CIW;
CIRect.Bottom := CIRect.Top + CIH;
end;
procedure TbsSkinCheckRadioBox.SetChecked;
begin
FChecked := Value;
RePaint;
if FChecked and (GroupIndex <> 0) then UnCheckAll;
if (FRadio and FChecked) or not FRadio
then
if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TbsSkinCheckRadioBox.ReDrawControl;
begin
if Morphing and (FIndex <> -1)
then StartMorph
else RePaint;
end;
procedure TbsSkinCheckRadioBox.UnCheckAll;
var
PC: TWinControl;
i: Integer;
begin
if Parent = nil then Exit;
PC := TWinControl(Parent);
for i := 0 to PC.ControlCount - 1 do
if (PC.Controls[i] is TbsSkinCheckRadioBox) and
(PC.Controls[i] <> Self)
then
with TbsSkinCheckRadioBox(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and Checked
then
Checked := False;
end;
procedure TbsSkinCheckRadioBox.ChangeSkinData;
begin
if FFlat
then
begin
GetSkinData;
RePaint;
end
else
inherited;
end;
procedure TbsSkinCheckRadioBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinCheckRadioControl
then
with TbsDataSkinCheckRadioControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.FrameFontColor := FrameFontColor;
Self.UnEnabledFontColor := UnEnabledFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
Self.CheckImageArea := CheckImageArea;
Self.TextArea := TextArea;
Self.CheckImageRect := CheckImageRect;
Self.UnCheckImageRect := UnCheckImageRect;
Self.ActiveCheckImageRect := ActiveCheckImageRect;
Self.UnEnabledCheckImageRect := UnEnabledCheckImageRect;
Self.UnEnabledUnCheckImageRect := UnEnabledUnCheckImageRect;
if IsNullRect(UnEnabledCheckImageRect)
then
Self.UnEnabledCheckImageRect := CheckImageRect;
if IsNullRect(UnEnabledUnCheckImageRect)
then
Self.UnEnabledUnCheckImageRect := UnCheckImageRect;
if IsNullRect(ActiveCheckImageRect)
then
Self.ActiveCheckImageRect := CheckImageRect;
Self.ActiveUnCheckImageRect := ActiveUnCheckImageRect;
if IsNullRect(ActiveUnCheckImageRect)
then
Self.ActiveUnCheckImageRect := UnCheckImageRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
if FFlat
then
begin
Self.Morphing := False;
MaskPicture := nil;
end;
end;
end;
end;
procedure TbsSkinCheckRadioBox.CreateImage;
var
IX, IY: Integer;
begin
CreateSkinControlImage(B, Picture, R);
with B.Canvas do
begin
IX := CIRect.Left;
IY := CIRect.Top + RectHeight(CIRect) div 2 - RectHeight(CheckImageRect) div 2;
if not Enabled
then
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnEnabledCheckImageRect, B.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnEnabledUnCheckImageRect, B.Canvas);
end
else
if FMouseIn
then
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, ActiveCheckImageRect, B.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, ActiveUnCheckImageRect, B.Canvas);
end
else
begin
if FChecked
then
SkinDrawCheckImage(IX, IY, Picture.Canvas, CheckImageRect, B.Canvas)
else
SkinDrawCheckImage(IX, IY, Picture.Canvas, UnCheckImageRect, B.Canvas);
end;
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
end
else
Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.Charset;
if AMouseIn
then Font.Color := ActiveFontColor
else Font.Color := FontColor;
if not Enabled then Font.Color := UnEnabledFontColor;
Brush.Style := bsClear;
end;
BSDrawText(B.Canvas, Caption, NewTextArea);
end;
procedure TbsSkinCheckRadioBox.CreateControlDefaultImage(B: TBitMap);
var
R, IR, TR: TRect;
C: TColor;
begin
inherited;
if isFocused or FMouseIn
then
begin
R := ClientRect;
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
end;
with B.Canvas do
begin
Font.Assign(DefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
if not Enabled then Font.Color := clBtnShadow;
Pen.Color := clBlack;
Brush.Style := bsClear;
IR := Rect(3, Height div 2 - 7, 17, Height div 2 + 7);
TR := Rect(19, 0, Width, Height);
BSDrawText(B.Canvas, Caption, TR);
end;
if FMouseIn
then
Frame3D(B.Canvas, IR, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1)
else
Frame3D(B.Canvas, IR, clbtnShadow, clbtnShadow, 1);
if FChecked
then
begin
if Enabled then C := clBlack else C := clBtnShadow;
if FRadio
then DrawRadioImage(B.Canvas, 7, Height div 2 - 3, C)
else DrawCheckImage(B.Canvas, 7, Height div 2 - 4, C);
end;
end;
procedure TbsSkinCheckRadioBox.CMTextChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinCheckRadioBox.CMMouseEnter(var Message: TMessage);
begin
inherited;
if (csDesigning in ComponentState) then Exit;
FMouseIn := True;
ReDrawControl;
end;
procedure TbsSkinCheckRadioBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
if (csDesigning in ComponentState) then Exit;
FMouseIn := False;
ReDrawControl;
end;
procedure TbsSkinCheckRadioBox.MouseDown;
begin
if not FMouseIn
then
begin
FMouseIn := True;
RedrawControl;
end;
inherited;
end;
procedure TbsSkinCheckRadioBox.MouseUp;
begin
inherited;
if (Button = mbLeft) and FMouseIn then SetCheckState;
end;
constructor TbsSkinGauge.Create;
begin
inherited;
FUseSkinSize := True;
FMinValue := 0;
FMaxValue := 100;
FValue := 50;
FVertical := False;
Width := 100;
Height := 20;
BeginOffset := 0;
EndOffset := 0;
FProgressText := '';
FShowPercent := False;
FShowProgressText := False;
FSkinDataName := 'gauge';
end;
procedure TbsSkinGauge.Paint;
var
B1, B2: TBitMap;
begin
if FUseSkinSize or (FIndex = -1)
then
inherited
else
begin
B1 := TBitMap.Create;
B1.Width := Width;
B1.Height := Height;
B2 := TBitMap.Create;
GetSkinData;
CreateControlSkinImage(B2);
B1.Canvas.StretchDraw(Rect(0, 0, B1.Width, B1.Height), B2);
B2.Free;
DrawProgressText(B1.Canvas);
Canvas.Draw(0, 0, B1);
B1.Free;
end;
end;
procedure TbsSkinGauge.DrawProgressText;
var
Percent: Integer;
S: String;
TX, TY: Integer;
F: TLogFont;
begin
if (FIndex = -1)
then
C.Font.Assign(FDefaultFont)
else
if (FIndex <> -1) and not FUseSkinFont
then
begin
C.Font.Assign(FDefaultFont);
C.Font.Color := FontColor;
end
else
with C do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
Font.Color := FontColor;
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
C.Font.Charset := SkinData.ResourceStrData.CharSet
else
C.Font.CharSet := FDefaultFont.Charset;
if MaxValue = MinValue
then
Percent := 0
else
Percent := Round((FValue - FMinValue) / (FMaxValue - FMinValue) * 100);
S := '';
if FShowProgressText then S := S + FProgressText;
if FShowPercent then S := S + IntToStr(Percent) + '%';
if S = '' then Exit;
with C do
begin
if FVertical
then
begin
GetObject(Font.Handle, SizeOf(F), @F);
F.lfEscapement := round(900);
Font.Handle := CreateFontIndirect(F);
TX := Width div 2 - TextHeight(S) div 2;
TY := Height div 2 + TextWidth(S) div 2;
end
else
begin
TX := Width div 2 - TextWidth(S) div 2;
TY := Height div 2 - TextHeight(S) div 2;
end;
Brush.Style := bsClear;
TextOut(TX, TY, S);
end;
end;
procedure TbsSkinGauge.SetShowProgressText;
begin
FShowProgressText := Value;
RePaint;
end;
procedure TbsSkinGauge.SetShowPercent;
begin
FShowPercent := Value;
RePaint;
end;
procedure TbsSkinGauge.SetProgressText;
begin
FProgressText := Value;
RePaint;
end;
function TbsSkinGauge.CalcProgressRect;
var
kf: Double;
Offset: Integer;
begin
if FMinValue = FMaxValue
then
Kf := 0
else
kf := (FValue - FMinValue) / (FMaxValue - FMinValue);
if FVertical
then
begin
Offset := Round(RectHeight(R) * kf);
R.Top := R.Bottom - Offset;
Result := R;
end
else
begin
Offset := Round(RectWidth(R) * kf);
R.Right := R.Left + Offset;
Result := R;
end;
end;
procedure TbsSkinGauge.CalcSize;
var
Offset: Integer;
W1, H1: Integer;
begin
if not FUseSkinSize
then
begin
W1 := W;
H1 := H;
end;
inherited;
if ResizeMode > 0
then
begin
if FVertical
then
begin
Offset := H - RectHeight(SkinRect);
NewProgressArea := ProgressArea;
Inc(NewProgressArea.Bottom, Offset);
end
else
begin
Offset := W - RectWidth(SkinRect);
NewProgressArea := ProgressArea;
Inc(NewProgressArea.Right, Offset);
end
end
else
NewProgressArea := ProgressArea;
if not FUseSkinSize
then
begin
W := W1;
H := H1;
end;
end;
procedure TbsSkinGauge.CreateControlSkinImage;
var
PR, PR1, PR2: TRect;
i, Cnt, Off: Integer;
w1, w2: Integer;
B1: TBitMap;
begin
inherited;
with B.Canvas do
begin
PR := CalcProgressRect(NewProgressArea, FVertical);
if FVertical
then
begin
if RectHeight(PR) - BeginOffset - EndOffset > 0
then
begin
PR1 := PR;
Inc(PR1.Top, BeginOffset);
Dec(PR1.Bottom, EndOffset);
PR2 := ProgressRect;
Inc(PR2.Top, BeginOffset);
Dec(PR2.Bottom, EndOffset);
w1 := RectHeight(PR1);
w2 := RectHeight(PR2);
if w2 = 0 then Exit;
Cnt := w1 div w2;
for i := 0 to Cnt do
begin
if i * w2 + w2 > w1 then Off := i * w2 + w2 - w1 else Off := 0;
CopyRect(Rect(PR1.Left, PR1.Bottom - (i * w2 + w2 - Off),
PR1.Right, PR1.Bottom - i * w2),
Picture.Canvas,
Rect(PR2.Left, PR2.Top + Off,
PR2.Right, PR2.Bottom));
end;
end;
if RectHeight(PR) >= BeginOffset + EndOffset
then
begin
CopyRect(Rect(PR.Left, PR.Top,
PR.Right, PR.Top + BeginOffset),
Picture.Canvas,
Rect(ProgressRect.Left, ProgressRect.Top,
ProgressRect.Right, ProgressRect.Top + BeginOffset));
CopyRect(Rect(PR.Left, PR.Bottom - EndOffset,
PR.Right, PR.Bottom),
Picture.Canvas,
Rect(ProgressRect.Left, ProgressRect.Bottom - EndOffset,
ProgressRect.Right, ProgressRect.Bottom));
end;
end
else
begin
if RectWidth(PR) - BeginOffset - EndOffset > 0
then
begin
PR1 := PR;
Inc(PR1.Left, BeginOffset);
Dec(PR1.Right, EndOffset);
PR2 := ProgressRect;
Inc(PR2.Left, BeginOffset);
Dec(PR2.Right, EndOffset);
w1 := RectWidth(PR1);
w2 := RectWidth(PR2);
if w2 = 0 then Exit;
Cnt := w1 div w2;
for i := 0 to Cnt do
begin
if i * w2 + w2 > w1 then Off := i * w2 + w2 - w1 else Off := 0;
CopyRect(Rect(PR1.Left + i * w2, PR1.Top,
PR1.Left + i * w2 + w2 - Off, PR1.Bottom),
Picture.Canvas,
Rect(PR2.Left, PR2.Top, PR2.Right - Off, PR2.Bottom));
end;
end;
if RectWidth(PR) >= BeginOffset + EndOffset
then
begin
CopyRect(Rect(PR.Left, PR.Top,
PR.Left + BeginOffset, PR.Bottom),
Picture.Canvas,
Rect(ProgressRect.Left, ProgressRect.Top,
ProgressRect.Left + BeginOffset, ProgressRect.Bottom));
CopyRect(Rect(PR.Right - EndOffset, PR.Top,
PR.Right, PR.Bottom),
Picture.Canvas,
Rect(ProgressRect.Right - EndOffset, ProgressRect.Top,
ProgressRect.Right, ProgressRect.Bottom));
end;
end;
end;
if FUseSkinSize then DrawProgressText(B.Canvas);
end;
procedure TbsSkinGauge.CreateImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TbsSkinGauge.CreateControlDefaultImage(B: TBitMap);
var
R, PR: TRect;
begin
R := ClientRect;
B.Canvas.Brush.Color := clWindow;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
R := Rect(1, 1, Width - 1, Height - 1);
PR := CalcProgressRect(R, FVertical);
if not IsNullRect(PR)
then
begin
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(PR);
end;
DrawProgressText(B.Canvas);
end;
procedure TbsSkinGauge.SetVertical;
var
S: Integer;
begin
FVertical:= AValue;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FVertical
then
begin
FSkinDataName := 'vgauge';
if Width > Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultWidth := FDefaultHeight;
FDefaultHeight := 0;
end
else
begin
FSkinDataName := 'gauge';
if Width < Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultHeight := FDefaultWidth;
FDefaultWidth := 0;
end;
end;
end;
procedure TbsSkinGauge.SetMinValue;
begin
FMinValue := AValue;
if FValue < FMinValue then FValue := FMinValue;
RePaint;
end;
procedure TbsSkinGauge.SetMaxValue;
begin
FMaxValue := AValue;
if FValue > FMaxValue then FValue := FMaxValue;
RePaint;
end;
procedure TbsSkinGauge.SetValue;
begin
if AValue > FMaxValue
then AValue := FMaxValue else
if AValue < FMinValue
then AValue := FMinValue;
if AValue <> FValue
then
begin
FValue := AValue;
RePaint;
end;
end;
procedure TbsSkinGauge.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinGaugeControl
then
with TbsDataSkinGaugeControl(FSD.CtrlList.Items[FIndex]) do
begin
if not FUseSkinSize and (MaskPictureIndex <> -1)
then
MaskPicture := nil;
Self.FVertical := Vertical;
Self.ProgressRect := ProgressRect;
Self.ProgressArea := ProgressArea;
Self.BeginOffset := BeginOffset;
Self.EndOffset := EndOffset;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
end;
end;
constructor TbsSkinTrackBar.Create;
begin
inherited;
FJumpWhenClick := False;
FCanFocused := False;
TabStop := False;
FMinValue := 0;
FMaxValue := 100;
FValue := 50;
FVertical := False;
Width := 100;
Height := 20;
FMouseSupport := True;
FDown := False;
FSkinDataName := 'htrackbar';
end;
procedure TbsSkinTrackBar.KeyDown;
begin
inherited KeyDown(Key, Shift);
if FCanFocused then
case Key of
VK_UP, VK_RIGHT: Value := Value + 1;
VK_DOWN, VK_LEFT: Value := Value - 1;
end;
end;
procedure TbsSkinTrackBar.WMMOUSEWHEEL;
begin
if IsFocused
then
if Vertical
then
begin
if Message.WParam > 0
then
Value := Value + 1
else
Value := Value - 1;
end
else
begin
if Message.WParam > 0
then
Value := Value - 1
else
Value := Value + 1;
end;
end;
procedure TbsSkinTrackBar.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
if FCanFocused then
case Msg.CharCode of
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Msg.Result := 1;
end;
end;
function TbsSkinTrackBar.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TbsSkinTrackBar.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TbsSkinTrackBar.WMSETFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TbsSkinTrackBar.WMKILLFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TbsSkinTrackBar.WndProc(var Message: TMessage);
begin
if FCanFocused then
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if not (csDesigning in ComponentState) and not Focused then
begin
FClicksDisabled := True;
Windows.SetFocus(Handle);
FClicksDisabled := False;
if not Focused then Exit;
end;
CN_COMMAND:
if FClicksDisabled then Exit;
end;
inherited WndProc(Message);
end;
function TbsSkinTrackBar.CalcValue;
var
kf: Double;
begin
if (Offset2 - Offset1) <= 0
then kf := 0
else kf := AOffset / (Offset2 - Offset1);
if kf > 1 then kf := 1 else
if kf < 0 then kf := 0;
Result := FMinValue + Round((FMaxValue - FMinValue) * kf);
end;
function TbsSkinTrackBar.CalcButtonRect;
var
kf: Double;
BW, BH: Integer;
begin
if FMinValue = FMaxValue
then
Kf := 0
else
kf := (FValue - FMinValue) / (FMaxValue - FMinValue);
if FIndex = -1
then
begin
if FVertical
then
begin
BW := Width - 4;
BH := BW div 2;
end
else
begin
BH := Height - 4;
BW := BH div 2;
end;
end
else
begin
BW := RectWidth(ButtonRect);
BH := RectHeight(ButtonRect);
end;
if FVertical
then
begin
Offset1 := R.Top + BH div 2;
Offset2 := R.Bottom - BH div 2;
BOffset := Round((Offset2 - Offset1) * Kf);
Result := Rect(R.Left + RectWidth(R) div 2 - BW div 2,
Offset2 - BOffset - BH div 2,
R.Left + RectWidth(R) div 2 - BW div 2 + BW,
Offset2 - BOffset - BH div 2 + BH);
end
else
begin
Offset1 := R.Left + BW div 2;
Offset2 := R.Right - BW div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Result := Rect(Offset1 + BOffset - BW div 2,
R.Top + RectHeight(R) div 2 - BH div 2,
Offset1 + BOffset - BW div 2 + BW,
R.Top + RectHeight(R) div 2 - BH div 2 + BH);
end;
end;
procedure TbsSkinTrackBar.CalcSize;
var
Offset: Integer;
begin
inherited;
if ResizeMode > 0
then
begin
if FVertical
then
begin
Offset := H - RectHeight(SkinRect);
NewTrackArea := TrackArea;
Inc(NewTrackArea.Bottom, Offset);
end
else
begin
Offset := W - RectWidth(SkinRect);
NewTrackArea := TrackArea;
Inc(NewTrackArea.Right, Offset);
end
end
else
NewTrackArea := TrackArea;
end;
procedure TbsSkinTrackBar.CreateControlSkinImage;
begin
inherited;
BR := CalcButtonRect(NewTrackArea);
with B.Canvas do
begin
if FDown or IsFocused
then
CopyRect(BR, Picture.Canvas, ActiveButtonRect)
else
CopyRect(BR, Picture.Canvas, ButtonRect);
end;
end;
procedure TbsSkinTrackBar.CreateImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TbsSkinTrackBar.MouseDown;
begin
inherited;
if FMouseSupport and
PtInRect(Rect(BR.Left, BR.Top, BR.Right + 1, BR.Bottom + 1), Point(X, Y))
then
begin
if FVertical then OMPos := Y else OMPos := X;
OldBOffset := BOffset;
FDown := True;
RePaint;
end;
end;
procedure TbsSkinTrackBar.MouseUp;
var
Off: Integer;
Off2: Integer;
begin
inherited;
if FMouseSupport and FDown
then
begin
FDown := False;
RePaint;
end
else
if FMouseSupport and not FDown and FJumpWhenClick
then
begin
if FIndex <> -1
then
begin
if FVertical
then
Off2 := NewTrackArea.Top
else
Off2 := NewTrackArea.Left;
end
else
Off2 := 2;
if FVertical
then
Off := Height - Y - RectHeight(BR) div 2 - Off2
else
Off := X - RectWidth(BR) div 2 - Off2;
Value := CalcValue(Off);
end;
end;
procedure TbsSkinTrackBar.MouseMove;
var
Off: Integer;
begin
if FMouseSupport and FDown
then
begin
if Vertical
then
begin
Off := OMPos - Y;
Off := OldBOffset + Off;
end
else
begin
Off := X - OMPos;
Off := OldBOffset + Off;
end;
Value := CalcValue(Off);
end;
inherited;
end;
procedure TbsSkinTrackBar.CreateControlDefaultImage;
var
R, LR, BR1: TRect;
begin
inherited;
R := ClientRect;
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
R := Rect(2, 2, Width - 2, Height - 2);
if FVertical
then
LR := Rect(Width div 2 - 1, 4, Width div 2 + 1, Height - 4)
else
LR := Rect(4, Height div 2 - 1, Width - 4, Height div 2 + 1);
BR := CalcButtonRect(R);
Frame3D(B.Canvas, LR, clbtnShadow, clbtnHighLight, 1);
BR1 := BR;
with B.Canvas do
begin
Brush.Style := bsSolid;
if FDown
then
begin
Frame3D(B.Canvas, BR1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNDOWNCOLOR;
FillRect(BR1);
end
else
if IsFocused
then
begin
Frame3D(B.Canvas, BR1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNACTIVECOLOR;
FillRect(BR1);
end
else
begin
Frame3D(B.Canvas, BR1, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(BR1);
end;
end;
end;
procedure TbsSkinTrackBar.SetVertical;
var
S: Integer;
begin
FVertical := AValue;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FVertical
then
begin
FSkinDataName := 'trackbar';
if Width > Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultWidth := FDefaultHeight;
FDefaultHeight := 0;
end
else
begin
FSkinDataName := 'htrackbar';
if Width < Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultHeight := FDefaultWidth;
FDefaultWidth := 0;
end;
end;
end;
procedure TbsSkinTrackBar.SetMinValue;
begin
FMinValue := AValue;
if FValue < FMinValue then FValue := FMinValue;
RePaint;
end;
procedure TbsSkinTrackBar.SetMaxValue;
begin
FMaxValue := AValue;
if FValue > FMaxValue then FValue := FMaxValue;
RePaint;
end;
procedure TbsSkinTrackBar.SetValue;
begin
if AValue > MaxValue then AValue := MaxValue else
if AValue < MinValue then AValue := MinValue;
if AValue <> FValue
then
begin
FValue := AValue;
RePaint;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TbsSkinTrackBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTrackBarControl
then
with TbsDataSkinTrackBarControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FVertical := Vertical;
Self.ButtonRect := ButtonRect;
if IsNullRect(ActiveButtonRect)
then
Self.ActiveButtonRect := ButtonRect
else
Self.ActiveButtonRect := ActiveButtonRect;
Self.TrackArea := TrackArea;
end;
end;
constructor TbsSkinStdLabel.Create;
begin
inherited;
Transparent := True;
FSD := nil;
FSkinDataName := 'stdlabel';
FDefaultFont := TFont.Create;
FUseSkinFont := True;
end;
destructor TbsSkinStdLabel.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinStdLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var
Text: string;
begin
GetSkinData;
Text := GetLabelText;
if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
(Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
Flags := DrawTextBiDiModeFlags(Flags);
if FIndex <> -1
then
with Canvas.Font do
begin
if FUseSkinFont
then
begin
Name := FontName;
Style := FontStyle;
Height := FontHeight;
end
else
Canvas.Font := Self.Font;
Color := FontColor;
end
else
if FUseSkinFont
then
Canvas.Font := DefaultFont
else
Canvas.Font := Self.Font;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then
begin
OffsetRect(Rect, 1, 1);
Canvas.Font.Color := clBtnHighlight;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end
else
begin
Canvas.Font := Self.Font;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
end;
procedure TbsSkinStdLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TbsSkinStdLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinStdLabel.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if (FIndex <> -1)
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinStdLabelControl
then
with TbsDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
end
end;
procedure TbsSkinStdLabel.ChangeSkinData;
begin
GetSkinData;
RePaint;
end;
procedure TbsSkinStdLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
constructor TbsSkinLabel.Create;
begin
inherited;
Width := 75;
Height := 21;
FAutoSize := False;
FSkinDataName := 'label';
end;
procedure TbsSkinLabel.SetBorderStyle;
begin
FBorderStyle := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end;
end;
procedure TbsSkinLabel.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinLabelControl
then
with TbsDataSkinLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
if ResizeMode = 0 then FAutoSize := False;
end;
end;
procedure TbsSkinLabel.DrawLabelText;
var
TX, TY: Integer;
begin
with Cnvs do
begin
if (FIndex <> -1) and UseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.Color := FontColor;
end
else
if (FIndex <> -1) and not UseSkinFont
then
begin
Font.Assign(DefaultFont);
Font.Color := FontColor;
end
else
Font.Assign(DefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.Charset;
TY := R.Top + RectHeight(R) div 2 - TextHeight(Caption) div 2;
TX := R.Left;
case FAlignment of
taRightJustify: TX := R.Right - TextWidth(Caption);
taCenter: TX := R.Left + RectWidth(R) div 2 - TextWidth(Caption) div 2;
end;
Brush.Style := bsClear;
TextRect(R, TX, TY, Caption);
end;
end;
procedure TbsSkinLabel.CreateControlDefaultImage;
var
R: TRect;
begin
inherited;
R := ClientRect;
case FBorderStyle of
bvLowered:
Frm3D(B.Canvas, R, clBtnShadow, clBtnHighLight);
bvRaised:
Frm3D(B.Canvas, R, clBtnHighLight, clBtnShadow);
bvFrame:
Frm3D(B.Canvas, R, clBtnShadow, clBtnShadow);
end;
DrawLabelText(B.Canvas, Rect(3, 3, Width - 3, Height - 3));
end;
procedure TbsSkinLabel.CreateControlSkinImage;
begin
inherited;
DrawLabelText(B.Canvas, NewClRect);
end;
procedure TbsSkinLabel.PaintLabel;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TbsSkinLabel.CalcSize;
var
Offset: Integer;
begin
inherited;
Offset := CalcWidthOffset;
if (Offset > 0) and FAutoSize then W := W + Offset;
end;
function TbsSkinLabel.CalcWidthOffset;
begin
if (FIndex <> -1)
then
begin
with Canvas do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
end
else
Font.Assign(DefaultFont);
if ResizeMode = 0
then
Result := 0
else
Result := TextWidth(Caption) - RectWidth(NewClRect);
end;
end
else
begin
Canvas.Font.Assign(DefaultFont);
Result := Canvas.TextWidth(Caption) - (Width - 4);
end;
end;
procedure TbsSkinLabel.AdjustBounds;
var
Offset: Integer;
begin
if (Align = alTop) or (Align = alBottom) or (Align = alClient) then Exit;
Offset := CalcWidthOffset;
if Offset <> 0 then Width := Width + Offset;
end;
procedure TbsSkinLabel.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
RePaint;
end;
end;
procedure TbsSkinLabel.SetAutoSizeX(Value: Boolean);
begin
FAutoSize := Value;
if FAutoSize then AdjustBounds;
end;
procedure TbsSkinLabel.CMTextChanged(var Message: TMessage);
begin
if FAutoSize then AdjustBounds;
RePaint;
end;
constructor TbsSkinStatusPanel.Create;
begin
inherited;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FSkinDataName := 'statuspanel';
Width := 120;
end;
destructor TbsSkinStatusPanel.Destroy;
begin
FGlyph.Free;
inherited;
end;
function TbsSkinStatusPanel.CalcWidthOffset;
var
X: Integer;
begin
if not FGlyph.Empty
then
X := FGlyph.Width div FNumGlyphs + 3
else
X := 0;
if FIndex <> -1
then
begin
with Canvas do
begin
if UseSkinFont
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
end
else
Font.Assign(DefaultFont);
if ResizeMode = 0
then
Result := 0
else
Result := TextWidth(Caption) + X - RectWidth(NewClRect);
end
end
else
begin
Canvas.Font.Assign(DefaultFont);
Result := Canvas.TextWidth(Caption) + X - (Width - 4);
end;
end;
procedure TbsSkinStatusPanel.CMEnabledChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinStatusPanel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinStatusPanel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinStatusPanel.CreateControlDefaultImage;
var
R: TRect;
GW: Integer;
GlyphNum: Integer;
begin
R := ClientRect;
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
case FBorderStyle of
bvLowered:
Frm3D(B.Canvas, R, clBtnShadow, clBtnHighLight);
bvRaised:
Frm3D(B.Canvas, R, clBtnHighLight, clBtnShadow);
bvFrame:
Frm3D(B.Canvas, R, clBtnShadow, clBtnShadow);
end;
R := Rect(3, 3, Width - 3, Height - 3);
if not FGlyph.Empty
then
begin
GW := FGlyph.Width div FNumGlyphs;
Inc(R.Left, GW + 2);
if Enabled then GlyphNum := 1 else GlyphNum := 2;
DrawGlyph(B.Canvas, 3, B.Height div 2 - FGlyph.Height div 2, Glyph, NumGlyphs, GlyphNum);
end;
DrawLabelText(B.Canvas, R);
end;
procedure TbsSkinStatusPanel.CreateControlSkinImage;
var
R: TRect;
GlyphNum, GX, GY, GW: Integer;
begin
CreateSkinControlImage(B, Picture, SkinRect);
R := NewClRect;
if not FGlyph.Empty
then
begin
GW := FGlyph.Width div FNumGlyphs;
GX := R.Left;
GY := R.Top + RectHeight(R) div 2 - FGlyph.Height div 2;
if Enabled then GlyphNum := 1 else GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, Glyph, NumGlyphs, GlyphNum);
Inc(R.Left, GW + 2);
end;
DrawLabelText(B.Canvas, R);
end;
//============ TbsSkinScrollBar ===============
const
SBUTTONW = 16;
BUTCOUNT = 3;
THUMB = 0;
UPBUTTON = 1;
DOWNBUTTON = 2;
constructor TbsSkinScrollBar.Create;
begin
inherited;
FCanFocused := False;
TabStop := False;
FMin := 0;
FMax := 100;
FPosition := 0;
FSmallChange := 1;
FLargeChange := 1;
FPageSize := 0;
WaitMode := False;
TimerMode := 0;
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FOnChange := nil;
Width := 200;
Height := 19;
FBothMarkerWidth := 19;
FDefaultHeight := 19;
FNormalSkinDataName := '';
FBothSkinDataName := 'bothhscrollbar';
FSkinDataName := 'hscrollbar';
end;
destructor TbsSkinScrollBar.Destroy;
begin
inherited;
end;
procedure TbsSkinScrollBar.SetBoth(Value: Boolean);
begin
if FBoth <> Value
then
begin
FBoth := Value;
if not (csDesigning in ComponentState)
then
if FBoth
then
begin
FNormalSkinDataName := SkinDataName;
SkinDataName := FBothSkinDataName;
end
else
if FNormalSkinDataName <> ''
then
SkinDataName := FNormalSkinDataName;
if FIndex = -1
then
RePaint
else
ChangeSkinData;
end;
end;
procedure TbsSkinScrollBar.CMEnabledChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinScrollBar.SetBothMarkerWidth;
begin
if Value >= 0
then
begin
FBothMarkerWidth := Value;
if FIndex = -1 then RePaint;
end;
end;
procedure TbsSkinScrollBar.KeyDown;
begin
inherited KeyDown(Key, Shift);
if FCanFocused then
case Key of
VK_DOWN, VK_RIGHT: Position := Position + FSmallChange;
VK_UP, VK_LEFT: Position := Position - FSmallChange;
end;
end;
procedure TbsSkinScrollBar.WMMOUSEWHEEL;
begin
if IsFocused
then
if Message.WParam > 0
then
Position := FPosition - FSmallChange
else
Position := FPosition + FSmallChange;
end;
procedure TbsSkinScrollBar.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
if FCanFocused then
case Msg.CharCode of
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Msg.Result := 1;
end;
end;
function TbsSkinScrollBar.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TbsSkinScrollBar.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TbsSkinScrollBar.WMSETFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TbsSkinScrollBar.WMKILLFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TbsSkinScrollBar.WndProc(var Message: TMessage);
begin
if FCanFocused then
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if not (csDesigning in ComponentState) and not Focused then
begin
FClicksDisabled := True;
Windows.SetFocus(Handle);
FClicksDisabled := False;
if not Focused then Exit;
end;
CN_COMMAND:
if FClicksDisabled then Exit;
end;
inherited WndProc(Message);
end;
procedure TbsSkinScrollBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinScrollBarControl
then
with TbsDataSkinScrollBarControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.TrackArea := TrackArea;
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.ThumbRect := ThumbRect;
Self.ActiveThumbRect := ActiveThumbRect;
if IsNullRect(Self.ActiveThumbRect)
then
Self.ActiveThumbRect := Self.ThumbRect;
Self.DownThumbRect := DownThumbRect;
if IsNullRect(Self.DownThumbRect)
then
Self.DownThumbRect := Self.ActiveThumbRect;
Self.ThumbOffset1 := ThumbOffset1;
Self.ThumbOffset2 := ThumbOffset2;
Self.GlyphRect := GlyphRect;
Self.ActiveGlyphRect := ActiveGlyphRect;
if isNullRect(ActiveGlyphRect)
then Self.ActiveGlyphRect := GlyphRect;
Self.DownGlyphRect := DownGlyphRect;
if isNullRect(DownGlyphRect)
then Self.DownGlyphRect := Self.ActiveGlyphRect;
end;
end;
procedure TbsSkinScrollBar.CalcSize;
begin
inherited;
CalcRects;
end;
procedure TbsSkinScrollBar.SetPageSize;
begin
if AValue + FPosition <= FMax - FMin + 1
then
FPageSize := AValue;
RePaint;
end;
procedure TbsSkinScrollBar.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinScrollBar.TestActive(X, Y: Integer);
var
i, j: Integer;
begin
j := -1;
OldActiveButton := ActiveButton;
for i := 0 to BUTCOUNT - 1 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 TbsSkinScrollBar.CreateControlSkinImage;
var
i: Integer;
begin
inherited;
CalcRects;
for i := 1 to BUTCOUNT - 1 do DrawButton(B.Canvas, i);
if Enabled then
DrawButton(B.Canvas, THUMB);
end;
procedure TbsSkinScrollBar.DrawButton;
var
R1, R2: TRect;
C: TColor;
ThumbB: TBitMap;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;
with Cnvs do
begin
if (Down and MouseIn) or ((i = THUMB) and (Down or IsFocused))
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNDOWNCOLOR;
FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNACTIVECOLOR;
FillRect(R1);
end
else
begin
Frame3D(Cnvs, R1, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(R1);
end;
end;
C := clBlack;
case i of
DOWNBUTTON:
case Kind of
sbHorizontal:
DrawArrowImage(Cnvs, R1, C, 1);
sbVertical:
DrawArrowImage(Cnvs, R1, C, 3);
end;
UPBUTTON:
case Kind of
sbHorizontal:
DrawArrowImage(Cnvs, R1, C, 2);
sbVertical:
DrawArrowImage(Cnvs, R1, C, 4);
end;
end;
end
else
begin
if I = THUMB
then
with Buttons[THUMB] do
begin
if Down or IsFocused
then R1 := DownThumbRect
else if MouseIn then R1 := ActiveThumbRect
else R1 := ThumbRect;
ThumbB := TBitMap.Create;
ThumbB.Width := RectWidth(R);
ThumbB.Height := RectHeight(R);
if FPageSize = 0
then
ThumbB.Canvas.CopyRect(Rect(0, 0, ThumbB.Width, ThumbB.Height), Picture.Canvas, R1)
else
case Kind of
sbHorizontal:
CreateHSkinImage(ThumbOffset1, ThumbOffset2, ThumbB, Picture, R1,
ThumbB.Width, ThumbB.Height);
sbVertical:
CreateVSkinImage(ThumbOffset1, ThumbOffset2, ThumbB, Picture, R1,
ThumbB.Width, ThumbB.Height);
end;
// draw glyph
if Down or IsFocused
then R1 := DownGlyphRect
else if MouseIn then R1 := ActiveGlyphRect
else R1 := GlyphRect;
if not IsNullRect(R1)
then
begin
R2 := Rect(ThumbB.Width div 2 - RectWidth(R1) div 2,
ThumbB.Height div 2 - RectHeight(R1) div 2,
ThumbB.Width div 2 - RectWidth(R1) div 2 + RectWidth(R1),
ThumbB.Height div 2 - RectHeight(R1) div 2 + RectHeight(R1));
ThumbB.Canvas.CopyRect(R2, Picture.Canvas, R1)
end;
//
Cnvs.Draw(R.Left, R.Top, ThumbB);
ThumbB.Free;
end
else
begin
R1 := NullRect;
case I of
UPBUTTON:
with Buttons[UPBUTTON] do
begin
if Down and MouseIn
then R1 := DownUpButtonRect
else if MouseIn then R1 := ActiveUpButtonRect;
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Down and MouseIn
then R1 := DownDownButtonRect
else if MouseIn then R1 := ActiveDownButtonRect;
end
end;
if not IsNullRect(R1)
then
Cnvs.CopyRect(Buttons[i].R, Picture.Canvas, R1);
end;
end;
end;
procedure TbsSkinScrollBar.CalcRects;
var
Kf: Double;
i, j, k, XMin, XMax: Integer;
Offset: Integer;
ThumbW, ThumbH: Integer;
NewWidth: Integer;
begin
if FMin = FMax
then Kf := 0
else kf := (FPosition - FMin) / (FMax - FMin);
if FIndex = -1
then
begin
ThumbW := SBUTTONW;
if FBoth
then
NewWidth := Width - BothMarkerWidth
else
NewWidth := Width;
case FKind of
sbHorizontal:
begin
Buttons[DOWNBUTTON].R := Rect(1, 1, 1 + SBUTTONW, Height - 1);
Buttons[UPBUTTON].R := Rect(NewWidth - SBUTTONW - 1, 1, NewWidth - 1, Height - 1);
NewTrackArea := Rect(SBUTTONW + 1, 1, NewWidth - SBUTTONW - 1, Height - 1);
if FPageSize = 0
then
begin
Offset1 := NewTrackArea.Left + ThumbW div 2;
Offset2 := NewTrackArea.Right - ThumbW div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(Offset1 + BOffset - ThumbW div 2, NewTrackArea.Top,
Offset1 + BOffset + ThumbW div 2, NewTrackArea.Bottom);
end
else
begin
i := RectWidth(NewTrackArea);
j := FMax - FMin + 1;
if j = 0 then kf := 0 else kf := FPageSize / j;
j := Round(i * kf);
if j < ThumbW then j := ThumbW;
XMin := FMin;
XMax := FMax - FPageSize + 1;
if XMax > XMin
then
kf := (FPosition - XMin) / (XMax - XMin)
else
kf := 1;
Offset1 := NewTrackArea.Left + j div 2;
Offset2 := NewTrackArea.Right - j div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(Offset1 + BOffset - j div 2, NewTrackArea.Top,
Offset1 + BOffset + j div 2, NewTrackArea.Bottom);
end;
end;
sbVertical:
begin
Buttons[DOWNBUTTON].R := Rect(1, 1, Width - 1, 1 + SBUTTONW);
Buttons[UPBUTTON].R := Rect(1, Height - SBUTTONW - 1, Width - 1, Height - 1);
NewTrackArea := Rect(1, SBUTTONW + 1, Width - 1, Height - SBUTTONW - 1);
if PageSize = 0
then
begin
Offset1 := NewTrackArea.Top + ThumbW div 2;
Offset2 := NewTrackArea.Bottom - ThumbW div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(NewTrackArea.Left, Offset1 + BOffset - ThumbW div 2,
NewTrackArea.Right, Offset1 + BOffset + ThumbW div 2);
end
else
begin
i := RectHeight(NewTrackArea);
j := FMax - FMin + 1;
if j = 0 then kf := 0 else kf := FPageSize / j;
j := Round(i * kf);
if j < ThumbW then j := ThumbW;
XMin := FMin;
XMax := FMax - FPageSize + 1;
if XMax - XMin > 0
then
kf := (FPosition - XMin) / (XMax - XMin)
else
kf := 0;
Offset1 := NewTrackArea.Top + j div 2;
Offset2 := NewTrackArea.Bottom - j div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(NewTrackArea.Left, Offset1 + BOffset - j div 2,
NewTrackArea.Right, Offset1 + BOffset + j div 2);
end;
end;
end;
end
else
begin
ThumbW := RectWidth(ThumbRect);
ThumbH := RectHeight(ThumbRect);
case FKind of
sbHorizontal:
begin
Offset := Width - RectWidth(SkinRect);
NewTrackArea := TrackArea;
Inc(NewTrackArea.Right, Offset);
Buttons[UPBUTTON].R := UpButtonRect;
Buttons[DOWNBUTTON].R := DownButtonRect;
//
if UpButtonRect.Left > RTPt.X
then
OffsetRect(Buttons[UPBUTTON].R, Offset, 0);
if DownButtonRect.Left > RTPt.X
then
OffsetRect(Buttons[DOWNBUTTON].R, Offset, 0);
if FPageSize = 0
then
begin
Offset1 := NewTrackArea.Left + ThumbW div 2;
Offset2 := NewTrackArea.Right - ThumbW div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(Offset1 + BOffset - ThumbW div 2,
NewTrackArea.Top + RectHeight(NewTrackArea) div 2 - ThumbH div 2,
Offset1 + BOffset + ThumbW div 2,
NewTrackArea.Top + RectHeight(NewTrackArea) div 2 - ThumbH div 2 + ThumbH);
end
else
begin
i := RectWidth(NewTrackArea);
j := FMax - FMin + 1;
if j = 0 then kf := 0 else kf := FPageSize / j;
j := Round(i * kf);
if j < ThumbW then j := ThumbW;
XMin := FMin;
XMax := FMax - FPageSize + 1;
if XMax <= XMin
then
kf := 1
else
kf := (FPosition - XMin) / (XMax - XMin);
Offset1 := NewTrackArea.Left + j div 2;
Offset2 := NewTrackArea.Right - j div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(Offset1 + BOffset - j div 2,
NewTrackArea.Top + RectHeight(NewTrackArea) div 2 - ThumbH div 2,
Offset1 + BOffset + j div 2,
NewTrackArea.Top + RectHeight(NewTrackArea) div 2 - ThumbH div 2 +
ThumbH);
end;
end;
sbVertical:
begin
Offset := Height - RectHeight(SkinRect);
NewTrackArea := TrackArea;
Inc(NewTrackArea.Bottom, Offset);
Buttons[UPBUTTON].R := UpButtonRect;
Buttons[DOWNBUTTON].R := DownButtonRect;
if UpButtonRect.Top > LBPt.Y
then
OffsetRect(Buttons[UPBUTTON].R, 0, Offset);
if DownButtonRect.Top > LBPt.Y
then
OffsetRect(Buttons[DOWNBUTTON].R, 0, Offset);
if PageSize = 0
then
begin
Offset1 := NewTrackArea.Top + ThumbH div 2;
Offset2 := NewTrackArea.Bottom - ThumbH div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(NewTrackArea.Left + RectWidth(NewTrackArea) div 2 -
ThumbW div 2,
Offset1 + BOffset - ThumbH div 2,
NewTrackArea.Left + RectWidth(NewTrackArea) div 2 -
ThumbW div 2 + ThumbW,
Offset1 + BOffset + ThumbH div 2);
end
else
begin
i := RectHeight(NewTrackArea);
j := FMax - FMin + 1;
if j = 0 then kf := 0 else kf := FPageSize / j;
j := Round(i * kf);
if j < ThumbH then j := ThumbH;
XMin := FMin;
XMax := FMax - FPageSize + 1;
if XMax - XMin <= 0
then
kf := 0
else
kf := (FPosition - XMin) / (XMax - XMin);
Offset1 := NewTrackArea.Top + j div 2;
Offset2 := NewTrackArea.Bottom - j div 2;
BOffset := Round((Offset2 - Offset1) * kf);
Buttons[THUMB].R :=
Rect(NewTrackArea.Left + RectWidth(NewTrackArea) div 2 -
ThumbW div 2,
Offset1 + BOffset - j div 2,
NewTrackArea.Left + RectWidth(NewTrackArea) div 2 -
ThumbW div 2 + ThumbW,
Offset1 + BOffset + j div 2);
end;
end;
end;
end;
end;
procedure TbsSkinScrollBar.SetKind;
var
S: Integer;
begin
if AValue <> FKind
then
begin
FKind := AValue;
RePaint;
end;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FKind = sbVertical
then
begin
FSkinDataName := 'vscrollbar';
if Width > Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultWidth := FDefaultHeight;
FDefaultHeight := 0;
end
else
begin
FSkinDataName := 'hscrollbar';
if Width < Height
then
begin
S := Width;
Width := Height;
Height := S;
end;
FDefaultHeight := FDefaultWidth;
FDefaultWidth := 0;
end;
end;
end;
procedure TbsSkinScrollBar.SimplySetPosition;
var
TempValue: Integer;
begin
if FPageSize = 0
then
begin
if AValue < FMin then TempValue := FMin else
if AValue > FMax then TempValue := FMax else
TempValue := AValue;
end
else
begin
if AValue < FMin then TempValue := FMin else
if AValue > FMax - FPageSize + 1 then
TempValue := FMax - FPageSize + 1 else
TempValue := AValue;
end;
if TempValue <> FPosition
then
begin
FPosition := TempValue;
RePaint;
end;
end;
procedure TbsSkinScrollBar.SetPosition;
var
TempValue: Integer;
begin
if FPageSize = 0
then
begin
if AValue < FMin then TempValue := FMin else
if AValue > FMax then TempValue := FMax else
TempValue := AValue;
end
else
begin
if AValue < FMin then TempValue := FMin else
if AValue > FMax - FPageSize + 1 then
TempValue := FMax - FPageSize + 1 else
TempValue := AValue;
end;
if TempValue <> FPosition
then
begin
FPosition := TempValue;
RePaint;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TbsSkinScrollBar.SetRange;
begin
FMin := AMin;
FMax := AMax;
FPageSize := APageSize;
if FPageSize = 0
then
begin
if APosition < FMin then FPosition := FMin else
if APosition > FMax then FPosition := FMax else
FPosition := APosition;
end
else
begin
if APosition < FMin then FPosition := FMin else
if APosition > FMax - FPageSize + 1 then
FPosition := FMax - FPageSize + 1 else
FPosition := APosition;
end;
RePaint;
end;
procedure TbsSkinScrollBar.SetMax;
begin
FMax := AValue;
if FPageSize = 0
then
begin
if FPosition > FMax then FPosition := FMax;
end
else
begin
if FPageSize + FPosition > FMax - FMin
then
FPosition := (FMax - FMin) - FPageSize + 1;
if FPosition < FMin then FPosition := FMin;
end;
RePaint;
end;
procedure TbsSkinScrollBar.SetMin;
begin
FMin := AValue;
if FPosition < FMin then FPosition := FMin;
RePaint;
end;
procedure TbsSkinScrollBar.SetSmallChange;
begin
FSmallChange := AValue;
RePaint;
end;
procedure TbsSkinScrollBar.SetLargeChange;
begin
FLargeChange := AValue;
RePaint;
end;
procedure TbsSkinScrollBar.CreateControlDefaultImage;
var
R: TRect;
i: Integer;
j: Integer;
begin
CalcRects;
R := ClientRect;
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
if Enabled then j := 0 else j := 1;
for i := j to BUTCOUNT - 1 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinScrollBar.MouseDown;
var
i: Integer;
j: Integer;
begin
inherited;
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
MouseD := True;
CalcRects;
TimerMode := 0;
WaitMode := True;
j := -1;
for i := 0 to BUTCOUNT - 1 do
begin
if PtInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
if j <> -1
then
begin
CaptureButton := j;
ButtonDown(j, X, Y);
end
else
begin
if PtInRect(NewTrackArea, Point(X, Y))
then
case Kind of
sbHorizontal:
begin
if X < Buttons[THUMB].R.Left
then
begin
Position := Position - LargeChange;
TimerMode := 3;
SetTimer(Handle, 1, 500, nil);
if Assigned(FOnPageUp) then FOnPageUp(Self);
end
else
begin
Position := Position + LargeChange;
TimerMode := 4;
SetTimer(Handle, 1, 500, nil);
if Assigned(FOnPageDown) then FOnPageDown(Self);
end;
end;
sbVertical:
begin
if Y < Buttons[THUMB].R.Top
then
begin
Position := Position - LargeChange;
TimerMode := 3;
SetTimer(Handle, 1, 500, nil);
if Assigned(FOnPageUp) then FOnPageUp(Self);
end
else
begin
Position := Position + LargeChange;
TimerMode := 4;
SetTimer(Handle, 1, 500, nil);
if Assigned(FOnPageDown) then FOnPageDown(Self);
end;
end;
end;
end;
end;
procedure TbsSkinScrollBar.MouseUp;
begin
inherited;
MouseD := False;
if (TimerMode >= 3) then StopTimer;
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
if (Button = mbLeft) and (CaptureButton = 0) and Assigned(FOnLastChange)
then
FOnLastChange(Self);
CaptureButton := -1;
end;
function TbsSkinScrollBar.CalcValue;
var
kf: Double;
TempPos: Integer;
begin
if FPageSize = 0
then
begin
if (Offset2 - Offset1) <= 0
then kf := 0
else kf := AOffset / (Offset2 - Offset1);
if kf > 1 then kf := 1 else
if kf < 0 then kf := 0;
Result := FMin + Round((FMax - FMin) * kf);
end
else
begin
case Kind of
sbVertical:
begin
Offset1 := NewTrackArea.Top + RectHeight(Buttons[THUMB].R) div 2;
Offset2 := NewTrackArea.Bottom - RectHeight(Buttons[THUMB].R) div 2;
end;
sbHorizontal:
begin
Offset1 := NewTrackArea.Left + RectWidth(Buttons[THUMB].R) div 2;
Offset2 := NewTrackArea.Right - RectWidth(Buttons[THUMB].R) div 2;
end;
end;
TempPos := OldBOffset + AOffset;
if (Offset2 - Offset1) <= 0
then kf := 0
else kf := TempPos / (Offset2 - Offset1);
if kf > 1 then kf := 1 else
if kf < 0 then kf := 0;
Result := FMin + Round((FMax - FMin - FPageSize + 1) * kf);
end;
end;
procedure TbsSkinScrollBar.MouseMove;
var
Off: Integer;
begin
MX := X; MY := Y;
TestActive(X, Y);
if FDown
then
case Kind of
sbVertical:
begin
if PageSize = 0
then
begin
Off := Y - OMPos;
Off := OldBOffset + Off;
Position := CalcValue(Off);
end
else
Off := Y - OMPos;
Position := CalcValue(Off);
end;
sbHorizontal:
begin
if PageSize = 0
then
begin
Off := X - OMPos;
Off := OldBOffset + Off;
Position := CalcValue(Off);
end
else
Off := X - OMPos;
Position := CalcValue(Off);
end;
end;
inherited;
end;
procedure TbsSkinScrollBar.ButtonDown;
begin
Buttons[i].Down := True;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
if Kind = sbVertical then OMPos := Y else OMPos := X;
OldBOffset := BOffset;
OldPosition := Position;
case Kind of
sbHorizontal:
begin
FScrollWidth := NewTrackArea.Right - R.Right;
if FScrollWidth <= 0
then FScrollWidth := R.Left - NewTrackArea.Left;
end;
sbVertical:
begin
FScrollWidth := NewTrackArea.Bottom - R.Bottom;
if FScrollWidth <= 0
then FScrollWidth := R.Top - NewTrackArea.Top;
end;
end;
FDown := True;
RePaint;
end;
DOWNBUTTON:
with Buttons[UPBUTTON] do
begin
if Assigned(FOnDownButtonClick)
then
FOnDownButtonClick(Self)
else
Position := Position - SmallChange;
TimerMode := 1;
SetTimer(Handle, 1, 500, nil);
end;
UPBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Assigned(FOnUpButtonClick)
then
FOnUpButtonClick(Self)
else
Position := Position + SmallChange;
TimerMode := 2;
SetTimer(Handle, 1, 500, nil);
end;
end;
end;
procedure TbsSkinScrollBar.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
case i of
THUMB:
begin
FDown := False;
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
StopTimer;
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
StopTimer;
end;
end;
end;
procedure TbsSkinScrollBar.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
if Down then SetTimer(Handle, 1, 50, nil);
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Down then SetTimer(Handle, 1, 50, nil);
end;
end;
end;
procedure TbsSkinScrollBar.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
if Down then KillTimer(Handle, 1);
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Down then KillTimer(Handle, 1);
end;
end;
end;
procedure TbsSkinScrollBar.StartScroll;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 50, nil);
end;
procedure TbsSkinScrollBar.WMTimer;
var
CanScroll: Boolean;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartScroll;
Exit;
end;
case TimerMode of
1:
begin
if Assigned(FOnDownButtonClick)
then
FOnDownButtonClick(Self)
else
Position := Position - SmallChange;
end;
2:
begin
if Assigned(FOnUpButtonClick)
then
FOnUpButtonClick(Self)
else
Position := Position + SmallChange;
end;
3:
begin
TestActive(MX, MY);
case Kind of
sbHorizontal: CanScroll := MX < Buttons[THUMB].R.Left;
sbVertical: CanScroll := MY < Buttons[THUMB].R.Top;
end;
if CanScroll
then
begin
Position := Position - LargeChange;
if Assigned(FOnPageUp) then FOnPageUp(Self);
end
else
StopTimer;
end;
4:
begin
TestActive(MX, MY);
case Kind of
sbHorizontal: CanScroll := MX > Buttons[THUMB].R.Right;
sbVertical: CanScroll := MY > Buttons[THUMB].R.Bottom;
end;
if CanScroll
then
begin
Position := Position + LargeChange;
if Assigned(FOnPageDown) then FOnPageDown(Self);
end
else
StopTimer;
end;
end;
end;
procedure TbsSkinScrollBar.CMMouseLeave;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if (ActiveButton <> -1) and (CaptureButton = -1) and not FDown
then
begin
Buttons[ActiveButton].MouseIn := False;
RePaint;
ActiveButton := -1;
end;
if MouseD and (TimerMode > 3) then StopTimer;
end;
procedure TbsSkinScrollBar.CMMouseEnter;
begin
inherited;
end;
constructor TbsSkinSplitter.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
FSkinPicture := nil;
FIndex := -1;
FDefaultSize := 10;
FSkinDataName := 'vsplitter';
end;
destructor TbsSkinSplitter.Destroy;
begin
inherited;
end;
procedure TbsSkinSplitter.Paint;
var
Buffer: TBitMap;
begin
if (Width <= 0) or (Height <= 0) then Exit;
GetSkinData;
if (FIndex <> -1) and (Align <> alNone) and (Align <> alClient)
then
begin
Buffer := TBitMap.Create;
if (Align = alTop) or (Align = alBottom)
then
CreateHSkinImage(LTPt.X, RectWidth(SkinRect) - RtPt.X,
Buffer, FSkinPicture, SkinRect, Width, RectHeight(SkinRect))
else
CreateVSkinImage(LTPt.Y, RectHeight(SkinRect) - LBPt.Y,
Buffer, FSkinPicture, SkinRect, RectWidth(SkinRect), Height);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
inherited;
end;
procedure TbsSkinSplitter.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinSplitter.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
FSkinPicture := nil;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinSplitterControl
then
with TbsDataSkinSplitterControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
Self.SkinRect := SkinRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
FSkinPicture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
FSkinPicture := nil;
end;
end;
procedure TbsSkinSplitter.ChangeSkinData;
begin
GetSkinData;
if (Align = alTop) or (Align = alBottom)
then
begin
if FIndex = -1
then
MinSize := FDefaultSize
else
MinSize := RectHeight(SkinRect);
Height := MinSize;
end
else
begin
if FIndex = -1
then
MinSize := FDefaultSize
else
MinSize := RectWidth(SkinRect);
Width := MinSize;
end;
RePaint;
end;
procedure TbsSkinSplitter.SetSkinData;
begin
FSD := Value;
ChangeSkinData;
end;
constructor TbsSkinControlBar.Create(AOwner: TComponent);
begin
inherited;
FSkinPicture := nil;
FIndex := -1;
if (csDesigning in ComponentState)
then
begin
AutoSize := True;
AutoDrag := False;
RowSnap := False;
end;
FSkinDataName := 'controlbar';
end;
destructor TbsSkinControlBar.Destroy;
begin
inherited;
end;
procedure TbsSkinControlBar.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;