Delphi控件源码

开发平台：

Delphi

SkinCtrls.pas：源码内容

Self.HRollButtonRect := HRollButtonRect;
Self.HRollButtonActiveRect := HRollButtonActiveRect;
if IsNullRect(Self.HRollButtonActiveRect)
then Self.HRollButtonActiveRect := Self.HRollButtonRect;
Self.HRollButtonDownRect := HRollButtonDownRect;
if IsNullRect(Self.HRollButtonDownRect)
then Self.HRollButtonDownRect := Self.HRollButtonActiveRect;
Self.HRestoreButtonRect := HRestoreButtonRect;
Self.HRestoreButtonActiveRect := HRestoreButtonActiveRect;
if IsNullRect(Self.HRestoreButtonActiveRect)
then Self.HRestoreButtonActiveRect := Self.HRestoreButtonRect;
Self.HRestoreButtonDownRect := HRestoreButtonDownRect;
if IsNullRect(Self.HRestoreButtonDownRect)
then Self.HRestoreButtonDownRect := Self.HRestoreButtonActiveRect;
Self.VRollButtonRect := VRollButtonRect;
Self.VRollButtonActiveRect := VRollButtonActiveRect;
if IsNullRect(Self.VRollButtonActiveRect)
then Self.VRollButtonActiveRect := Self.VRollButtonRect;
Self.VRollButtonDownRect := VRollButtonDownRect;
if IsNullRect(Self.VRollButtonDownRect)
then Self.VRollButtonDownRect := Self.VRollButtonActiveRect;
Self.VRestoreButtonRect := VRestoreButtonRect;
Self.VRestoreButtonActiveRect := VRestoreButtonActiveRect;
if IsNullRect(Self.VRestoreButtonActiveRect)
then Self.VRestoreButtonActiveRect := Self.VRestoreButtonRect;
Self.VRestoreButtonDownRect := VRestoreButtonDownRect;
if IsNullRect(Self.VRestoreButtonDownRect)
then Self.VRestoreButtonDownRect := Self.VRestoreButtonActiveRect;
end;
end;
procedure TspSkinExPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if FRollState and not StopCheckSize
then
begin
if (FRollKind = rkRollHorizontal) and (AWidth <> GetRollWidth)
then AWidth := GetRollWidth
else
if (FRollKind = rkRollVertical) and (AHeight <> GetRollHeight)
then AHeight := GetRollHeight
end;
inherited;
end;
procedure TspSkinExPanel.CMTextChanged;
begin
inherited;
RePaint;
end;
procedure TspSkinExPanel.SetShowRollButton(Value: Boolean);
begin
FShowRollButton := Value;
RePaint;
end;
procedure TspSkinExPanel.SetShowCloseButton(Value: Boolean);
begin
FShowCloseButton := Value;
RePaint;
end;
function TspSkinExPanel.GetRollWidth: Integer;
begin
if FIndex = -1
then
Result := FDefaultCaptionHeight
else
Result := RectWidth(RollHSkinRect);
end;
function TspSkinExPanel.GetRollHeight: Integer;
begin
if FIndex = -1
then
Result := FDefaultCaptionHeight
else
Result := RectHeight(RollVSkinRect);
end;
procedure TspSkinExPanel.SetRollKind(Value: TspExPanelRollKind);
begin
FRollKind := Value;
RePaint;
end;
procedure TspSkinExPanel.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end
end;
procedure TspSkinExPanel.CreateControlDefaultImage(B: TBitMap);
var
R, CR: TRect;
BW, CROffset, TX, TY: Integer;
F: TLogFont;
begin
BW := FDefaultCaptionHeight - 6;
R := Rect(0, 0, Width, Height);
if FRollState and (FRollKind = rkRollHorizontal)
then
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
CR := R;
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnHighLight, clBtnFace, 1);
CROffset := 0;
if FShowCloseButton
then
begin
begin
Buttons[0].R := Rect(3, 3, 3 + BW, 3 + BW);
CROffset := CROffset + RectHeight(Buttons[0].R);
end;
end
else
Buttons[0].R := Rect(0, 0, 0, 3);
if FShowRollButton
then
begin
Buttons[1].R := Rect(3, Buttons[0].R.Bottom, 3 + BW, Buttons[0].R.Bottom + BW);
CROffset := CROffset + RectHeight(Buttons[1].R);
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
//
Font := DefaultFont;
GetObject(Font.Handle, SizeOf(F), @F);
F.lfEscapement := round(900);
Font.Handle := CreateFontIndirect(F);
Inc(CR.Top, CROffset + 2);
TX := CR.Left + RectWidth(CR) div 2 - TextHeight(Caption) div 2;
TY := CR.Top + RectHeight(CR) div 2 + TextWidth(Caption) div 2;
if TY > CR.Bottom - 2 then TY := CR.Bottom - 2;
Brush.Style := bsClear;
TextRect(CR, TX, TY, Caption);
//
end
else
with B.Canvas do
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(R);
CR := Rect(0, 0, Width, FDefaultCaptionHeight);
CROffset := 0;
Frame3D(B.Canvas, CR, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, CR, clBtnHighLight, clBtnFace, 1);
if FShowCloseButton
then
begin
Buttons[0].R := Rect(Width - BW - 2, 3, Width - 2, 3 + BW);
CROffset := CROffset + RectWidth(Buttons[1].R);
end
else
Buttons[0].R := Rect(Width - 2, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - BW, 3, Buttons[0].R.Left, 3 + BW);
CROffset := CROffset + RectWidth(Buttons[1].R);
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
//
Inc(CR.Left, 2);
Dec(CR.Right, CROffset + 2);
//
Brush.Style := bsClear;
Font := DefaultFont;
//
SPDrawText2(B.Canvas, Caption, CR);
end;
if FShowCloseButton then DrawButton(B.Canvas, 0);
if FShowRollButton then DrawButton(B.Canvas, 1);
end;
procedure TspSkinExPanel.CreateControlSkinImage(B: TBitMap);
var
CR: TRect;
F: TLogFont;
CROffset, BO, TX, TY: Integer;
begin
with B.Canvas.Font do
begin
Name := FontName;
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
end;
B.Canvas.Brush.Style := bsClear;
if FRollState and (FRollKind = rkRollHorizontal)
then
begin
CreateVSkinImage(RollTopOffset, RollBottomOffset,
B, Picture, RollHSkinRect, GetRollWidth, Height);
CR := RollHCaptionRect;
Inc(CR.Bottom, Height - RectHeight(RollHSkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
begin
Buttons[0].R := Rect(CR.Left, CR.Top,
CR.Left + RectWidth(Self.CloseButtonRect),
CR.Top + RectHeight(Self.CloseButtonRect));
CROffset := CROffset + RectHeight(Buttons[0].R);
BO := 2;
end;
end
else
Buttons[0].R := Rect(0, 0, 0, CR.Top);
if FShowRollButton
then
begin
Buttons[1].R := Rect(CR.Left, Buttons[0].R.Bottom + BO,
CR.Left + RectWidth(Self.HRollButtonRect),
Buttons[0].R.Bottom + RectHeight(Self.HRollButtonRect) + BO);
CROffset := CROffset + RectHeight(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Inc(CR.Top, CROffset);
GetObject(B.Canvas.Font.Handle, SizeOf(F), @F);
F.lfEscapement := round(900);
B.Canvas.Font.Handle := CreateFontIndirect(F);
TX := CR.Left + RectWidth(CR) div 2 - B.Canvas.TextHeight(Caption) div 2;
TY := CR.Top + RectHeight(CR) div 2 + B.Canvas.TextWidth(Caption) div 2;
if TY > CR.Bottom - 2 then TY := CR.Bottom - 2;
B.Canvas.TextRect(CR, TX, TY, Caption);
end
else
if FRollState and (FRollKind = rkRollVertical)
then
begin
CreateHSkinImage(RollLeftOffset, RollRightOffset,
B, Picture, RollVSkinRect, Width, GetRollHeight);
CR := RollVCaptionRect;
Inc(CR.Right, Width - RectWidth(RollVSkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
Buttons[0].R := Rect(CR.Right - RectWidth(CloseButtonRect), CR.Top,
CR.Right, CR.Top + RectHeight(CloseButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R);
BO := 2;
end
else
Buttons[0].R := Rect(CR.Right, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - RectWidth(VRollButtonRect) - BO,
CR.Top, Buttons[0].R.Left - BO, CR.Top + RectHeight(VRollButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Dec(CR.Right, CROffset);
SPDrawText2(B.Canvas, Caption, CR);
end
else
begin
inherited;
CR := CaptionRect;
Inc(CR.Right, Width - RectWidth(SkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
Buttons[0].R := Rect(CR.Right - RectWidth(CloseButtonRect), CR.Top,
CR.Right, CR.Top + RectHeight(CloseButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R);
BO := 2;
end
else
Buttons[0].R := Rect(CR.Right, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - RectWidth(VRollButtonRect) - BO,
CR.Top, Buttons[0].R.Left - BO, CR.Top + RectHeight(VRollButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Dec(CR.Right, CROffset);
SPDrawText2(B.Canvas, Caption, CR);
end;
if FShowCloseButton then DrawButton(B.Canvas, 0);
if FShowRollButton then DrawButton(B.Canvas, 1);
end;
procedure TspSkinExPanel.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
if (FIndex <> -1) and not (csDesigning in ComponentState)
then
Rect := NewClRect
else
begin
Rect.Top := Rect.Top + FDefaultCaptionHeight;
Inc(Rect.Left, 1);
Dec(Rect.Right, 1);
Dec(Rect.Bottom, 1);
end;
end;
procedure TspSkinExPanel.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 TspSkinExPanel.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 TspSkinExPanel.SetRollState;
begin
if FRollState = Value then Exit;
FRollState := Value;
StopCheckSize := True;
if FRollState
then
begin
HideControls;
case FRollKind of
rkRollVertical:
begin
FRealHeight := Height;
Height := GetRollHeight;
end;
rkRollHorizontal:
begin
FRealWidth := Width;
Width := GetRollWidth;
end;
end;
end
else
begin
case FRollKind of
rkRollVertical:
Height := FRealHeight;
rkRollHorizontal:
Width := FRealWidth;
end;
ShowControls;
end;
StopCheckSize := False;
if not (csDesigning in ComponentState) and
Assigned(FOnChangeRollState)
then
FOnChangeRollState(Self);
end;
procedure TspSkinExPanel.CMMouseEnter;
begin
inherited;
TestActive(-1, -1);
end;
procedure TspSkinExPanel.CMMouseLeave;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
end;
end;
procedure TspSkinExPanel.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TspSkinExPanel.MouseUp;
begin
inherited;
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
procedure TspSkinExPanel.MouseMove;
begin
inherited;
TestActive(X, Y);
end;
procedure TspSkinExPanel.TestActive(X, Y: Integer);
var
i, j: Integer;
i1, i2: Integer;
begin
if FShowCloseButton then i1 := 0 else i1 := 1;
if FShowRollButton then i2 := 1 else i2 := 0;
if i1 > i2 then Exit;
j := -1;
OldActiveButton := ActiveButton;
for i := i1 to i2 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 TspSkinExPanel.ButtonDown;
begin
Buttons[i].MouseIn := True;
Buttons[i].Down := True;
DrawButton(Canvas, i);
end;
procedure TspSkinExPanel.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: Close;
1:
begin
RollState := not RollState;
TestActive(X, Y);
RePaint;
end;
end;
end;
procedure TspSkinExPanel.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
DrawButton(Canvas, i);
end;
procedure TspSkinExPanel.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
end;
procedure TspSkinExPanel.DrawButton;
var
C: TColor;
R1: TRect;
SR, AR, DR: TRect;
begin
if FIndex = -1
then
begin
with Buttons[i] do
if not IsNullRect(R) then
begin
R1 := R;
Cnvs.Brush.Color := clBtnface;
Cnvs.FillRect(R);
if Down and MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_XP_BTNACTIVECOLOR;
Cnvs.FillRect(R1);
end
else
begin
Cnvs.Brush.Color := clBtnFace;
Cnvs.FillRect(R1);
end;
C := clBlack;
R1 := R;
if Down and MouseIn
then
begin
Inc(R1.Left, 2);
Inc(R1.Top, 2);
end;
case i of
1:
if FRollKind = rkRollVertical
then
begin
if FRollState
then
DrawArrowImage(Cnvs, R1, C, 4)
else
DrawArrowImage(Cnvs, R1, C, 3);
end
else
begin
if FRollState
then
DrawArrowImage(Cnvs, R1, C, 2)
else
DrawArrowImage(Cnvs, R1, C, 1);
end;
0: DrawRCloseImage(Cnvs, R1, C);
end;
end
end
else
if not IsNullRect(Buttons[i].R)
then
with Buttons[i] do
begin
if i = 0
then
begin
SR := CloseButtonRect;
AR := CloseButtonActiveRect;
DR := CloseButtonDownRect;
end
else
if not FRollState
then
begin
case RollKind of
rkRollHorizontal:
begin
SR := HRollButtonRect;
AR := HRollButtonActiveRect;
DR := HRollButtonDownRect;
end;
rkRollVertical:
begin
SR := VRollButtonRect;
AR := VRollButtonActiveRect;
DR := VRollButtonDownRect;
end;
end;
end
else
begin
case RollKind of
rkRollHorizontal:
begin
SR := HRestoreButtonRect;
AR := HRestoreButtonActiveRect;
DR := HRestoreButtonDownRect;
end;
rkRollVertical:
begin
SR := VRestoreButtonRect;
AR := VRestoreButtonActiveRect;
DR := VRestoreButtonDownRect;
end;
end;
end;
if Down and MouseIn
then
Cnvs.CopyRect(R, Picture.Canvas, DR)
else
if MouseIn
then
Cnvs.CopyRect(R, Picture.Canvas, AR)
else
Cnvs.CopyRect(R, Picture.Canvas, SR);
end;
end;
constructor TspSkinHeaderControl.Create(AOwner: TComponent);
begin
inherited;
FOldActiveSection := -1;
FActiveSection := -1;
FIndex := -1;
FDefaultFont := TFont.Create;
FDefaultHeight := 0;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FSkinDataName := 'resizebutton';
FUseSkinFont := True;
end;
destructor TspSkinHeaderControl.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinHeaderControl.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TspSkinHeaderControl.SetBounds;
var
UpDate: Boolean;
begin
GetSkinData;
UpDate := Height <> AHeight;
if UpDate
then
begin
if (FIndex <> -1) and (LBPt.X = 0) and (LBPt.Y = 0)
then
AHeight := RectHeight(SkinRect)
else
if (FIndex = -1) and (FDefaultHeight <> 0)
then
AHeight := FDefaultHeight;
end;
inherited;
end;
procedure TspSkinHeaderControl.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinHeaderControl.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinButtonControl
then
with TspDataSkinButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
//
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownSkinRect := DownSkinRect;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
if IsNullRect(DownSkinRect) then Self.DownSkinRect := Self.ActiveSkinRect;
end
else
Picture := nil;
end;
procedure TspSkinHeaderControl.ChangeSkinData;
begin
GetSkinData;
if (FIndex <> -1) and (LBPt.X = 0) and (LBPt.Y = 0)
then
Height := RectHeight(SkinRect)
else
if (FIndex = -1) and (FDefaultHeight <> 0)
then
Height := FDefaultHeight;
RePaint;
end;
procedure TspSkinHeaderControl.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinHeaderControl.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
function TspSkinHeaderControl.GetSkinItemRect;
var
SectionOrder: array of Integer;
R: TRect;
begin
if Self.DragReorder
then
begin
SetLength(SectionOrder, Sections.Count);
Header_GetOrderArray(Handle, Sections.Count, PInteger(SectionOrder));
Header_GETITEMRECT(Handle, SectionOrder[Index] , @R);
end
else
Header_GETITEMRECT(Handle, Index, @R);
Result := R;
end;
procedure TspSkinHeaderControl.DrawSkinSectionR;
var
BR, SR: TRect;
S: String;
B: TBitMap;
W, H, TX, TY, GX, GY, XO, YO: Integer;
begin
GetSkinData;
if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;
S := Section.Text;
B := TBitMap.Create;
W := RectWidth(R);
if (LBPt.X = 0) and (LBPt.Y = 0) and (FIndex <> -1)
then
H := RectHeight(SkinRect)
else
H := RectHeight(R);
B.Width := W;
B.Height := H;
BR := Rect(0, 0, B.Width, B.Height);
if FIndex = -1
then
with B.Canvas do
begin
//
if Pressed
then
begin
Frame3D(B.Canvas, BR, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
end
else
if Active
then
begin
Frame3D(B.Canvas, BR, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNACTIVECOLOR;
end
else
begin
Frame3D(B.Canvas, BR, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
end;
//
FillRect(BR);
Font := FDefaultFont;
end
else
with B.Canvas do
begin
if FUseSkinFont
then
with Font do
begin
Name := FontName;
Height := FontHeight;
Style := FontStyle;
CharSet := FDefaultFont.Charset;
end
else
Font := FDefaultFont;
if Pressed
then
begin
SR := DownSkinRect;
Font.Color := DownFontColor;
end
else
if Active
then
begin
SR := ActiveSkinRect;
Font.Color := ActiveFontColor;
end
else
begin
SR := SkinRect;
Font.Color := FontColor;
end;
//
XO := RectWidth(BR) - RectWidth(SkinRect);
if (LBPt.X = 0) and (LBPt.Y = 0)
then
begin
CreateHSkinImage(LTPt.X, RectWidth(SkinRect) - RTPt.X,
B, Picture, SR, B.Width, B.Height);
end
else
begin
YO := RectHeight(BR) - RectHeight(SkinRect);
NewLTPoint := LTPt;
NewRTPoint := Point(RTPt.X + XO, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewRBPoint := Point(RBPt.X + XO, RBPt.Y + YO);
NewClRect := Rect(CLRect.Left, ClRect.Top,
CLRect.Right + XO, ClRect.Bottom + YO);
//
CreateSkinImage(LTPt, RTPt, LBPt, RBPt, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, SR, B.Width, B.Height, True);
end;
end;
if Assigned(FOnDrawSkinSection)
then
begin
FOnDrawSkinSection(Self, Section, BR, Active, Pressed, B.Canvas)
end
else
with B.Canvas do
begin
Brush.Style := bsClear;
Inc(BR.Left, 5); Dec(BR.Right, 5);
if (Images <> nil) and (Section.ImageIndex >= 0) and
(Section.ImageIndex < Images.Count)
then
begin
CorrectTextbyWidth(B.Canvas, S, RectWidth(BR) - 10 - Images.Width);
GX := BR.Left;
if S = Section.Text then
case Section.Alignment of
taRightJustify: GX := BR.Right - TextWidth(S) - Images.Width - 10;
taCenter: GX := BR.Left + RectWidth(BR) div 2 -
(TextWidth(S) + Images.Width + 10) div 2;
end;
TX := GX + Images.Width + 10;
TY := BR.Top + RectHeight(BR) div 2 - TextHeight(S) div 2;
GY := BR.Top + RectHeight(BR) div 2 - Images.Height div 2;
Images.Draw(B.Canvas, GX, GY, Section.ImageIndex, True);
end
else
begin
CorrectTextbyWidth(B.Canvas, S, RectWidth(BR));
TX := BR.Left;
case Section.Alignment of
taRightJustify: TX := BR.Right - TextWidth(S) - 10;
taCenter: TX := BR.Left + RectWidth(BR) div 2 - TextWidth(S) div 2;
end;
TY := BR.Top + RectHeight(BR) div 2 - TextHeight(S) div 2;
end;
TextRect(BR, TX, TY, S);
end;
Cnvs.Draw(R.Left, R.Top, B);
B.Free;
end;
function TspSkinHeaderControl.DrawSkinSection;
var
R: TRect;
begin
R := GetSkinItemRect(Index);
Result := R;
DrawSkinSectionR(Cnvs, Sections[Index], Active, Pressed, R);
end;
procedure TspSkinHeaderControl.PaintWindow(DC: HDC);
var
i, SaveIndex: Integer;
RightOffset, XO, YO: Integer;
R1, BGR: TRect;
B: TBitMap;
begin
GetSkinData;
if not HandleAllocated or (Handle = 0) then Exit;
if (Width <= 0) or (Height <=0) then Exit;
SaveIndex := SaveDC(DC);
try
Canvas.Handle := DC;
RightOffset := 0;
for I := 0 to Sections.Count - 1 do
begin
R1 := DrawSkinSection(Canvas, I, (I = FActiveSection) and not FDown,
(I = FActiveSection) and FDown);
if RightOffset < R1.Right then RightOffset := R1.Right;
end;
BGR := Rect(RightOffset, 0, Width + 1, Height);
if BGR.Left < BGR.Right then
if FIndex = -1
then
with Canvas do
begin
Brush.Color := clBtnFace;
Fillrect(BGR);
Frame3D(Canvas, BGR, clBtnShadow, clBtnShadow, 1);
end
else
begin
//
B := TBitMap.Create;
B.Width := RectWidth(BGR);
if (LBPt.X = 0) and (LBPt.Y = 0)
then
B.Height := RectHeight(SkinRect)
else
B.Height := RectHeight(BGR);
XO := RectWidth(BGR) - RectWidth(SkinRect);
if (LBPt.X = 0) and (LBPt.Y = 0)
then
begin
CreateHSkinImage2(LTPt.X, RectWidth(SkinRect) - RTPt.X,
B, Picture, SkinRect, B.Width, B.Height);
end
else
begin
YO := RectHeight(BGR) - RectHeight(SkinRect);
NewLTPoint := LTPt;
NewRTPoint := Point(RTPt.X + XO, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewRBPoint := Point(RBPt.X + XO, RBPt.Y + YO);
NewClRect := Rect(CLRect.Left, ClRect.Top,
CLRect.Right + XO, ClRect.Bottom + YO);
//
CreateSkinImage2(LTPt, RTPt, LBPt, RBPt, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, SkinRect, B.Width, B.Height, True);
end;
Canvas.Draw(BGR.Left, BGR.Top, B);
B.Free;
end;
Canvas.Handle := 0;
finally
RestoreDC(DC, SaveIndex);
end;
end;
procedure TspSkinHeaderControl.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TspSkinHeaderControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TspSkinHeaderControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
end;
procedure TspSkinHeaderControl.TestActive(X, Y: Integer);
var
i: Integer;
R: TRect;
begin
FOldActiveSection := FActiveSection;
FActiveSection := -1;
for i := 0 to Sections.Count - 1 do
begin
R := GetSkinItemRect(i);
if PtInRect(R, Point(X, Y))
then
begin
FActiveSection := i;
Break;
end;
end;
if (FOldActiveSection <> FActiveSection)
then
begin
if (FOldActiveSection <> - 1) and not FInTracking
then
DrawSkinSection(Canvas, FOldActiveSection, False, False);
if (FActiveSection <> -1) and not FInTracking
then
DrawSkinSection(Canvas, FActiveSection, True, False);
end;
end;
procedure TspSkinHeaderControl.MouseMove;
begin
inherited;
if FDown and DragReOrder then FInTracking := True else FInTracking := False;
if not (csDesigning in ComponentState) and not FInTracking
then
TestActive(X, Y);
end;
procedure TspSkinHeaderControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if (Button = mbLeft) and not InDivider and (Style = hsButtons)
then
begin
FDown := True;
Invalidate;
end;
inherited;
end;
procedure TspSkinHeaderControl.MouseUp;
var
FTempTracking: Boolean;
begin
inherited;
FTempTracking := FInTracking;
FInTracking := False;
FActiveSection := -1;
FOldActiveSection := -1;
if (Button = mbLeft) and not (csDesigning in ComponentState) and (Style = hsButtons)
then
begin
TestActive(X, Y);
Invalidate;
FDown := False;
if (FActiveSection <> -1) and not InDivider and not FTempTracking and
Assigned(FOnSkinSectionClick)
then
FOnSkinSectionClick(Self, Sections[FActiveSection]);
end;
end;
procedure TspSkinHeaderControl.CMMouseEnter;
begin
if not FDown then Invalidate;
end;
procedure TspSkinHeaderControl.CMMouseLeave;
begin
FActiveSection := -1;
FOldActiveSection := -1;
if not FDown then Invalidate;
end;
procedure TspSkinHeaderControl.WndProc;
begin
inherited;
case Message.Msg of
HDM_HITTEST:
begin
if PHDHitTestInfo(Message.LParam)^.Flags = HHT_ONDIVIDER
then
InDivider := True
else
InDivider := False;
end;
end;
end;
procedure TspSkinHeaderControl.CreateWnd;
var
i: Integer;
begin
inherited;
for i := 0 to Sections.Count - 1 do Sections[i].Style := hsOwnerDraw;
end;
procedure TspSkinHeaderControl.DrawSection(Section: THeaderSection; const Rect: TRect;
Pressed: Boolean);
var
SectionOrder: array of Integer;
i, Index: Integer;
begin
inherited;
if Self.DragReorder
then
begin
SetLength(SectionOrder, Sections.Count);
Header_GetOrderArray(Handle, Sections.Count, PInteger(SectionOrder));
for i := 0 to Sections.Count - 1 do
if SectionOrder[i] = Section.Index then Break;
Index := i;
end
else
Index := Section.Index;
Self.DrawSkinSectionR(Canvas, Sections[Index], False, Pressed, Rect);
end;
// ======================== TspSkinCustomSlider ======================= //
constructor TspSkinCustomSlider.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlState := ControlState + [csCreating];
ControlStyle := [csClickEvents, csCaptureMouse, csAcceptsControls,
csDoubleClicks, csOpaque];
Width := 150;
Height := 40;
FNumThumbStates := 2;
FBevelWidth := 1;
FOrientation := soHorizontal;
FOptions := [soShowFocus, soShowPoints, soSmooth];
FEdgeSize := 2;
FMinValue := 0;
FMaxValue := 100;
FIncrement := 10;
TabStop := True;
CreateElements;
FSkinDataName := 'slider';
Picture := nil;
FUseSkinThumb := True;
ControlState := ControlState - [csCreating];
end;
destructor TspSkinCustomSlider.Destroy;
var
I: TspSliderImage;
begin
FOnChange := nil;
FOnChanged := nil;
FOnDrawPoints := nil;
FRuler.Free;
for I := Low(FImages) to High(FImages) do begin
FImages[I].OnChange := nil;
FImages[I].Free;
end;
inherited Destroy;
end;
procedure TspSkinCustomSlider.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinSlider
then
with TspDataSkinSlider(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.HRulerRect := HRulerRect;
Self.HThumbRect := HThumbRect;
Self.VRulerRect := VRulerRect;
Self.VThumbRect := VThumbRect;
Self.SkinEdgeSize := EdgeSize;
Self.BGColor := BGColor;
Self.PointsColor := PointsColor;
end;
end;
procedure TspSkinCustomSlider.ChangeSkinData;
begin
AdjustElements;
end;
procedure TspSkinCustomSlider.WMMOVE(var Msg: TWMMOVE);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinCustomSlider.SetTransparent(Value: Boolean);
begin
FTransparent := Value;
Invalidate;
end;
procedure TspSkinCustomSlider.Loaded;
var
I: TspSliderImage;
begin
inherited Loaded;
for I := Low(FImages) to High(FImages) do
if I in FUserImages then SetImage(Ord(I), FImages[I]);
end;
procedure TspSkinCustomSlider.AlignControls(AControl: TControl; var Rect: TRect);
begin
inherited AlignControls(AControl, Rect);
end;
procedure TspSkinCustomSlider.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if FPaintBuffered then inherited
else begin
Canvas.Lock;
try
MemDC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(MemDC, ClientWidth, ClientHeight);
ReleaseDC(0, MemDC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := Message.DC;
Perform(WM_ERASEBKGND, MemDC, MemDC);
FPaintBuffered := True;
Message.DC := MemDC;
try
WMPaint(Message);
finally
Message.DC := DC;
FPaintBuffered := False;
end;
if DC = 0 then DC := BeginPaint(Handle, PS);
BitBlt(DC, 0, 0, ClientWidth, ClientHeight, MemDC, 0, 0, SRCCOPY);
if Message.DC = 0 then EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
finally
Canvas.Unlock;
end;
end;
end;
procedure TspSkinCustomSlider.Paint;
var
R: TRect;
HighlightThumb: Boolean;
P: TPoint;
Offset: Integer;
Buffer: TBitMap;
begin
GetSkinData;
if csPaintCopy in ControlState then begin
Offset := GetOffsetByValue(GetSliderValue);
P := GetThumbPosition(Offset);
end else
P := Point(FThumbRect.Left, FThumbRect.Top);
R := GetClientRect;
if FTransparent
then
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
GetParentImage2(Self, Buffer.Canvas);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
with Canvas do begin
if FIndex = -1
then
Brush.Color := Color
else
Brush.Color := BGColor;
FillRect(R);
end;
if FRuler.Width > 0 then begin
if (soRulerOpaque in Options) and (FIndex = -1)
then FRuler.Transparent := False else FRuler.Transparent := True;
Canvas.Draw(FRulerOrg.X, FRulerOrg.Y, FRuler);
end;
if (soShowFocus in Options) and FFocused and
not (csDesigning in ComponentState) then
begin
R := SliderRect;
InflateRect(R, -2, -2);
Canvas.DrawFocusRect(R);
end;
if (soShowPoints in Options) then begin
if Assigned(FOnDrawPoints) then FOnDrawPoints(Self)
else InternalDrawPoints(Canvas, Increment, 3, 5);
end;
if csPaintCopy in ControlState then
HighlightThumb := not Enabled else
HighlightThumb := FThumbDown or not Enabled;
if (FIndex = -1) or not FUseSkinThumb
then
DrawThumb(Canvas, P, HighlightThumb)
else
DrawSkinThumb(Canvas, P, HighlightThumb);
end;
function TspSkinCustomSlider.CanModify: Boolean;
begin
Result := True;
end;
function TspSkinCustomSlider.GetSliderValue: Longint;
begin
Result := FValue;
end;
function TspSkinCustomSlider.GetSliderRect: TRect;
begin
Result := Bounds(0, 0, Width, Height);
end;
procedure TspSkinCustomSlider.DrawSkinThumb;
var
Buffer: TBitMap;
R: TRect;
begin
if Orientation = soHorizontal
then R := HThumbRect
else R := VThumbRect;
if Highlight
then R.Left := R.Left + (R.Right - R.Left) div 2
else R.Right := R.Left + (R.Right - R.Left) div 2;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R);
Buffer.Height := RectHeight(R);
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height), Picture.Canvas, R);
Buffer.Transparent := True;
Canvas.Draw(Origin.X, Origin.Y, Buffer);
Buffer.Free;
end;
procedure TspSkinCustomSlider.DrawThumb(Canvas: TCanvas; Origin: TPoint;
Highlight: Boolean);
var
R: TRect;
Image: TBitmap;
Buffer: TBitMap;
begin
if Orientation = soHorizontal then Image := ImageHThumb
else Image := ImageVThumb;
R := Rect(0, 0, Image.Width, Image.Height);
if NumThumbStates = 2 then begin
if Highlight then R.Left := (R.Right - R.Left) div 2
else R.Right := (R.Right - R.Left) div 2;
end;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R);
Buffer.Height := RectHeight(R);
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height), Image.Canvas, R);
if soThumbOpaque in Options
then Buffer.Transparent := False else Buffer.Transparent := True;
Canvas.Draw(Origin.X, Origin.Y, Buffer);
Buffer.Free;
end;
procedure TspSkinCustomSlider.InternalDrawPoints(ACanvas: TCanvas; PointsStep,
PointsHeight, ExtremePointsHeight: Longint);
const
MinInterval = 3;
var
RulerLength: Integer;
Interval, Scale, PointsCnt, I, Val: Longint;
X, H, X1, X2, Y1, Y2: Integer;
Range: Double;
HThumbWidth, VThumbHeight: Integer;
NumStates: Integer;
begin
RulerLength := GetRulerLength;
if (FIndex = -1) or not FUseSkinThumb
then
begin
HThumbWidth := FImages[siHThumb].Width;
VThumbHeight := FImages[siVThumb].Height;
NumStates := NumThumbStates;
end
else
begin
HThumbWidth := RectWidth(HThumbRect);
VThumbHeight := RectHeight(VThumbRect);
NumStates := 2;
end;
if (FIndex = -1)
then
ACanvas.Pen.Color := clWindowText
else
ACanvas.Pen.Color := PointsColor;
Scale := 0;
Range := MaxValue - MinValue;
repeat
Inc(Scale);
PointsCnt := Round(Range / (Scale * PointsStep)) + 1;
if PointsCnt > 1 then
Interval := RulerLength div (PointsCnt - 1)
else Interval := RulerLength;
until (Interval >= MinInterval + 1) or (Interval >= RulerLength);
Val := MinValue;
for I := 1 to PointsCnt do begin
H := PointsHeight;
if I = PointsCnt then Val := MaxValue;
if (Val = MaxValue) or (Val = MinValue) then H := ExtremePointsHeight;
X := GetOffsetByValue(Val);
if Orientation = soHorizontal then begin
X1 := X + (HThumbWidth div NumStates) div 2;
Y1 := FPointsRect.Top;
X2 := X1;
Y2 := Y1 + H;
end
else begin
X1 := FPointsRect.Left;
Y1 := X + VThumbHeight div 2;
X2 := X1 + H;
Y2 := Y1;
end;
with ACanvas do begin
MoveTo(X1, Y1);
LineTo(X2, Y2);
end;
Inc(Val, Scale * PointsStep);
end;
end;
procedure TspSkinCustomSlider.DefaultDrawPoints(PointsStep, PointsHeight,
ExtremePointsHeight: Longint);
begin
InternalDrawPoints(Canvas, PointsStep, PointsHeight, ExtremePointsHeight);
end;
procedure TspSkinCustomSlider.CreateElements;
var
I: TspSliderImage;
begin
FRuler := TBitmap.Create;
for I := Low(FImages) to High(FImages) do SetImage(Ord(I), nil);
AdjustElements;
end;
procedure TspSkinCustomSlider.BuildSkinRuler(R: TRect);
var
TmpBmp: TBitmap;
begin
TmpBmp := TBitmap.Create;
try
if Orientation = soHorizontal
then
begin
TmpBmp.Width := R.Right - R.Left - 2 * Indent;
TmpBmp.Height := RectHeight(HRulerRect);
CreateHSkinImage(SkinEdgeSize, SkinEdgeSize, TmpBmp, Picture, HRulerRect,
TmpBmp.Width, TmpBmp.Height);
end
else
begin
TmpBmp.Height := R.Bottom - R.Top - 2 * Indent;
TmpBmp.Width := RectWidth(HRulerRect);
CreateVSkinImage(SkinEdgeSize, SkinEdgeSize, TmpBmp, Picture, VRulerRect,
TmpBmp.Width, TmpBmp.Height);
end;
FRuler.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
end;
procedure TspSkinCustomSlider.BuildRuler(R: TRect);
var
DstR, BmpR: TRect;
I, L, B, N, C, Offs, Len, RulerWidth: Integer;
TmpBmp: TBitmap;
Index: TspSliderImage;
begin
TmpBmp := TBitmap.Create;
try
if Orientation = soHorizontal then Index := siHRuler
else Index := siVRuler;
if Orientation = soHorizontal then begin
L := R.Right - R.Left - 2 * Indent;
if L < 0 then L := 0;
TmpBmp.Width := L;
TmpBmp.Height := FImages[Index].Height;
L := TmpBmp.Width - 2 * FEdgeSize;
B := FImages[Index].Width - 2 * FEdgeSize;
RulerWidth := FImages[Index].Width;
end
else begin
TmpBmp.Width := FImages[Index].Width;
TmpBmp.Height := R.Bottom - R.Top - 2 * Indent;
L := TmpBmp.Height - 2 * FEdgeSize;
B := FImages[Index].Height - 2 * FEdgeSize;
RulerWidth := FImages[Index].Height;
end;
N := (L div B) + 1;
C := L mod B;
for I := 0 to N - 1 do begin
if I = 0 then begin
Offs := 0;
Len := RulerWidth - FEdgeSize;
end
else begin
Offs := FEdgeSize + I * B;
if I = N - 1 then Len := C + FEdgeSize
else Len := B;
end;
if Orientation = soHorizontal then
DstR := Rect(Offs, 0, Offs + Len, TmpBmp.Height)
else DstR := Rect(0, Offs, TmpBmp.Width, Offs + Len);
if I = 0 then Offs := 0
else
if I = N - 1 then Offs := FEdgeSize + B - C
else Offs := FEdgeSize;
if Orientation = soHorizontal then
BmpR := Rect(Offs, 0, Offs + DstR.Right - DstR.Left, TmpBmp.Height)
else
BmpR := Rect(0, Offs, TmpBmp.Width, Offs + DstR.Bottom - DstR.Top);
TmpBmp.Canvas.CopyRect(DstR, FImages[Index].Canvas, BmpR);
end;
FRuler.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
end;
procedure TspSkinCustomSlider.AdjustElements;
var
SaveValue: Longint;
R: TRect;
HThumbHeight, HThumbWidth,
VThumbHeight, VThumbWidth: Integer;
NumStates: Integer;
begin
GetSkinData;
SaveValue := Value;
R := SliderRect;
if FIndex = -1
then
BuildRuler(R)
else
BuildSkinRuler(R);
if (FIndex = -1) or not FUseSkinThumb
then
begin
HThumbHeight := FImages[siHThumb].Height;
HThumbWidth := FImages[siHThumb].Width;
VThumbHeight := FImages[siVThumb].Height;
VThumbWidth := FImages[siVThumb].Width;
NumStates := NumThumbStates;
end
else
begin
HThumbHeight := RectHeight(HThumbRect);
HThumbWidth := RectWidth(HThumbRect);
VThumbHeight := RectHeight(VThumbRect);
VThumbWidth := RectWidth(VThumbRect);
NumStates := 2;
end;
if Orientation = soHorizontal then begin
if HThumbHeight > FRuler.Height then begin
FThumbRect := Bounds(R.Left + Indent, R.Top + Indent,
HThumbWidth div NumStates, HThumbHeight);
FRulerOrg := Point(R.Left + Indent, R.Top + Indent +
(HThumbHeight - FRuler.Height) div 2);
FPointsRect := Rect(FRulerOrg.X, R.Top + Indent +
HThumbHeight + 1,
FRulerOrg.X + FRuler.Width, R.Bottom - R.Top - 1);
end
else begin
FThumbRect := Bounds(R.Left + Indent, R.Top + Indent +
(FRuler.Height - HThumbHeight) div 2,
HThumbWidth div NumStates, HThumbHeight);
FRulerOrg := Point(R.Left + Indent, R.Top + Indent);
FPointsRect := Rect(FRulerOrg.X, R.Top + Indent + FRuler.Height + 1,
FRulerOrg.X + FRuler.Width, R.Bottom - R.Top - 1);
end;
end
else begin
if VThumbWidth div NumThumbStates > FRuler.Width then
begin
FThumbRect := Bounds(R.Left + Indent, R.Top + Indent,
VThumbWidth div NumStates, VThumbHeight);
FRulerOrg := Point(R.Left + Indent + (VThumbWidth div NumStates -
FRuler.Width) div 2, R.Top + Indent);
FPointsRect := Rect(R.Left + Indent + VThumbWidth div NumStates + 1,
FRulerOrg.Y, R.Right - R.Left - 1, FRulerOrg.Y + FRuler.Height);
end
else begin
FThumbRect := Bounds(R.Left + Indent + (FRuler.Width -
VThumbWidth div NumStates) div 2, R.Top + Indent,
VThumbWidth div NumStates, VThumbHeight);
FRulerOrg := Point(R.Left + Indent, R.Top + Indent);
FPointsRect := Rect(R.Left + Indent + FRuler.Width + 1, FRulerOrg.Y,
R.Right - R.Left - 1, FRulerOrg.Y + FRuler.Height);
end;
end;
Value := SaveValue;
Invalidate;
end;
procedure TspSkinCustomSlider.Sized;
begin
AdjustElements;
end;
procedure TspSkinCustomSlider.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TspSkinCustomSlider.Changed;
begin
if Assigned(FOnChanged) then FOnChanged(Self);
end;
procedure TspSkinCustomSlider.RangeChanged;
begin
end;
procedure TspSkinCustomSlider.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
begin
if Assigned(Filer.Ancestor) then
Result := FUserImages <> TspSkinCustomSlider(Filer.Ancestor).FUserImages
else Result := FUserImages <> [];
end;
begin
if Filer is TReader then inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('UserImages', ReadUserImages, WriteUserImages,
DoWrite);
end;
procedure TspSkinCustomSlider.ReadUserImages(Stream: TStream);
begin
Stream.ReadBuffer(FUserImages, SizeOf(FUserImages));
end;
procedure TspSkinCustomSlider.WriteUserImages(Stream: TStream);
begin
Stream.WriteBuffer(FUserImages, SizeOf(FUserImages));
end;
function TspSkinCustomSlider.StoreImage(Index: Integer): Boolean;
begin
Result := TspSliderImage(Index) in FUserImages;
end;
function TspSkinCustomSlider.GetImage(Index: Integer): TBitmap;
begin
Result := FImages[TspSliderImage(Index)];
end;
procedure TspSkinCustomSlider.SliderImageChanged(Sender: TObject);
begin
if not (csCreating in ControlState) then Sized;
end;
procedure TspSkinCustomSlider.SetImage(Index: Integer; Value: TBitmap);
var
Idx: TspSliderImage;
begin
Idx := TspSliderImage(Index);
if FImages[Idx] = nil then begin
FImages[Idx] := TBitmap.Create;
FImages[Idx].OnChange := SliderImageChanged;
end;
if Value = nil then begin
FImages[Idx].Handle := LoadBitmap(HInstance, ImagesResNames[Idx]);
Exclude(FUserImages, Idx);
if not (csReading in ComponentState) then begin
if Idx in [siHThumb, siVThumb] then Exclude(FOptions, soThumbOpaque)
else Exclude(FOptions, soRulerOpaque);
Invalidate;
end;
end
else begin
FImages[Idx].Assign(Value);
Include(FUserImages, Idx);
end;
end;
procedure TspSkinCustomSlider.SetEdgeSize(Value: Integer);
var
MaxSize: Integer;
begin
if Orientation = soHorizontal then MaxSize := FImages[siHRuler].Width
else MaxSize := FImages[siVRuler].Height;
if Value * 2 < MaxSize then
if Value <> FEdgeSize then begin
FEdgeSize := Value;
Sized;
end;
end;
function TspSkinCustomSlider.GetNumThumbStates: TspNumThumbStates;
begin
Result := FNumThumbStates;
end;
procedure TspSkinCustomSlider.SetNumThumbStates(Value: TspNumThumbStates);
begin
if FNumThumbStates <> Value then begin
FNumThumbStates := Value;
AdjustElements;
end;
end;
procedure TspSkinCustomSlider.SetOrientation(Value: TspSliderOrientation);
begin
if Orientation <> Value then begin
FOrientation := Value;
Sized;
if ComponentState * [csLoading, csUpdating] = [] then
SetBounds(Left, Top, Height, Width);
end;
end;
procedure TspSkinCustomSlider.SetOptions(Value: TspSliderOptions);
begin
if Value <> FOptions then begin
FOptions := Value;
Invalidate;
end;
end;
procedure TspSkinCustomSlider.SetRange(Min, Max: Longint);
begin
if (Min < Max) or (csReading in ComponentState) then begin
FMinValue := Min;
FMaxValue := Max;
if not (csReading in ComponentState) then
if Min + Increment > Max then FIncrement := Max - Min;
if (soShowPoints in Options) then Invalidate;
Self.Value := FValue;
RangeChanged;
end;
end;
procedure TspSkinCustomSlider.SetMinValue(Value: Longint);
begin
if FMinValue <> Value then SetRange(Value, MaxValue);
end;
procedure TspSkinCustomSlider.SetMaxValue(Value: Longint);
begin
if FMaxValue <> Value then SetRange(MinValue, Value);
end;
procedure TspSkinCustomSlider.SetIncrement(Value: Longint);
begin
if (Value > 0) and (FIncrement <> Value) then begin
FIncrement := Value;
Self.Value := FValue;
Invalidate;
end;
end;
function TspSkinCustomSlider.GetValueByOffset(Offset: Integer): Longint;
var
Range: Double;
R: TRect;
VThumbHeight: Integer;
begin
// *
R := SliderRect;
if (FIndex = -1) or not FUseSkinThumb
then
VThumbHeight := FImages[siVThumb].Height
else
VThumbHeight := RectHeight(VThumbRect);
if Orientation = soVertical then
Offset := ClientHeight - Offset - VThumbHeight;
Range := MaxValue - MinValue;
Result := Round((Offset - R.Left - Indent) * Range / GetRulerLength);
if not (soSmooth in Options) then
Result := Round(Result / Increment) * Increment;
Result := Min(MinValue + Max(Result, 0), MaxValue);
end;
function TspSkinCustomSlider.GetOffsetByValue(Value: Longint): Integer;
var
Range: Double;
R: TRect;
MinIndent: Integer;
VThumbHeight: Integer;
begin
if (FIndex = -1) or not FUseSkinThumb
then
VThumbHeight := FImages[siVThumb].Height
else
VThumbHeight := RectHeight(VThumbRect);
R := SliderRect;
Range := MaxValue - MinValue;
if Orientation = soHorizontal then
MinIndent := R.Left + Indent
else
MinIndent := R.Top + Indent;
Result := Round((Value - MinValue) / Range * GetRulerLength) + MinIndent;
if Orientation = soVertical then
Result := R.Top + R.Bottom - Result - VThumbHeight;
Result := Max(Result, MinIndent);
end;
function TspSkinCustomSlider.GetThumbPosition(var Offset: Integer): TPoint;
var
R: TRect;
MinIndent: Integer;
begin
R := SliderRect;
if Orientation = soHorizontal then
MinIndent := R.Left + Indent
else
MinIndent := R.Top + Indent;
Offset := Min(GetOffsetByValue(GetValueByOffset(Min(Max(Offset, MinIndent),
MinIndent + GetRulerLength))), MinIndent + GetRulerLength);
if Orientation = soHorizontal then begin
Result.X := Offset;
Result.Y := FThumbRect.Top;
end
else begin
Result.Y := Offset;
Result.X := FThumbRect.Left;
end;
end;
function TspSkinCustomSlider.GetThumbOffset: Integer;
begin
if Orientation = soHorizontal then Result := FThumbRect.Left
else Result := FThumbRect.Top;
end;
procedure TspSkinCustomSlider.InvalidateThumb;
begin
if HandleAllocated then
InvalidateRect(Handle, @FThumbRect, not (csOpaque in ControlStyle));
end;
procedure TspSkinCustomSlider.SetThumbOffset(Value: Integer);
var
ValueBefore: Longint;
P: TPoint;
begin
ValueBefore := FValue;
P := GetThumbPosition(Value);
InvalidateThumb;
FThumbRect := Bounds(P.X, P.Y, RectWidth(FThumbRect), RectHeight(FThumbRect));
InvalidateThumb;
if FSliding then begin
FValue := GetValueByOffset(Value);
if ValueBefore <> FValue then Change;
end;
end;
function TspSkinCustomSlider.GetRulerLength: Integer;
begin
if (FIndex = -1) or not FUseSkinThumb
then
begin
if Orientation = soHorizontal then begin
Result := FRuler.Width;
Dec(Result, FImages[siHThumb].Width div NumThumbStates);
end
else begin
Result := FRuler.Height;
Dec(Result, FImages[siVThumb].Height);
end;
end
else
begin
if Orientation = soHorizontal then begin
Result := FRuler.Width;
Dec(Result, RectWidth(HThumbRect) div 2);
end
else begin
Result := FRuler.Height;
Dec(Result, RectHeight(VThumbRect));
end;
end;
end;
procedure TspSkinCustomSlider.SetValue(Value: Longint);
var
ValueChanged: Boolean;
begin
if Value > MaxValue then Value := MaxValue;
if Value < MinValue then Value := MinValue;
ValueChanged := FValue <> Value;
FValue := Value;
ThumbOffset := GetOffsetByValue(Value);
if ValueChanged then Change;
end;
procedure TspSkinCustomSlider.SetReadOnly(Value: Boolean);
begin
if FReadOnly <> Value then begin
if Value then begin
StopTracking;
if FSliding then ThumbMouseUp(mbLeft, [], 0, 0);
end;
FReadOnly := Value;
end;
end;
procedure TspSkinCustomSlider.ThumbJump(Jump: TspJumpMode);
var
NewValue: Longint;
begin
if Jump <> jmNone then begin
case Jump of
jmHome: NewValue := MinValue;
jmPrior:
NewValue := (Round(Value / Increment) * Increment) - Increment;
jmNext:
NewValue := (Round(Value / Increment) * Increment) + Increment;
jmEnd: NewValue := MaxValue;
else Exit;
end;
if NewValue >= MaxValue then NewValue := MaxValue
else if NewValue <= MinValue then NewValue := MinValue;
if (NewValue <> Value) then Value := NewValue;
end;
end;
function TspSkinCustomSlider.JumpTo(X, Y: Integer): TspJumpMode;
begin
Result := jmNone;
if Orientation = soHorizontal then begin
if FThumbRect.Left > X then Result := jmPrior
else if FThumbRect.Right < X then Result := jmNext;
end
else if Orientation = soVertical then begin
if FThumbRect.Top > Y then Result := jmNext
else if FThumbRect.Bottom < Y then Result := jmPrior;
end;
end;
procedure TspSkinCustomSlider.WMTimer(var Message: TMessage);
begin
TimerTrack;
end;
procedure TspSkinCustomSlider.CMEnabledChanged(var Message: TMessage);
begin
inherited;
InvalidateThumb;
end;
procedure TspSkinCustomSlider.CMFocusChanged(var Message: TCMFocusChanged);
var
Active: Boolean;
begin
with Message do Active := (Sender = Self);
if Active <> FFocused then begin
FFocused := Active;
if (soShowFocus in Options) then Invalidate;
end;
inherited;
end;
procedure TspSkinCustomSlider.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
Msg.Result := DLGC_WANTARROWS;
end;
procedure TspSkinCustomSlider.WMSize(var Message: TWMSize);
begin
inherited;
if not (csReading in ComponentState) then Sized;
end;
procedure TspSkinCustomSlider.StopTracking;
begin
if FTracking then begin
if FTimerActive then begin
KillTimer(Handle, 1);
FTimerActive := False;
end;
FTracking := False;
MouseCapture := False;
Changed;
end;
end;
procedure TspSkinCustomSlider.TimerTrack;
var
Jump: TspJumpMode;
begin
Jump := JumpTo(FMousePos.X, FMousePos.Y);
if Jump = FStartJump then begin
ThumbJump(Jump);
if not FTimerActive then begin
SetTimer(Handle, 1, JumpInterval, nil);
FTimerActive := True;
end;
end;
end;
procedure TspSkinCustomSlider.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Rect: TRect;
P: TPoint;
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and not (ssDouble in Shift) then begin
if CanFocus then SetFocus;
P := Point(X, Y);
if PtInRect(FThumbRect, P) then
ThumbMouseDown(Button, Shift, X, Y)
else begin
with FRulerOrg, FRuler do
Rect := Bounds(X, Y, Width, Height);
InflateRect(Rect, Ord(Orientation = soVertical) * 3,
Ord(Orientation = soHorizontal) * 3);
if PtInRect(Rect, P) and CanModify and not ReadOnly then begin
MouseCapture := True;
FTracking := True;
FMousePos := P;
FStartJump := JumpTo(X, Y);
TimerTrack;
end;
end;
end;
end;
procedure TspSkinCustomSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if (csLButtonDown in ControlState) and FSliding then
ThumbMouseMove(Shift, X, Y)
else if FTracking then FMousePos := Point(X, Y);
inherited MouseMove(Shift, X, Y);
end;
procedure TspSkinCustomSlider.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
StopTracking;
if FSliding then ThumbMouseUp(Button, Shift, X, Y);
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TspSkinCustomSlider.KeyDown(var Key: Word; Shift: TShiftState);
var
Jump: TspJumpMode;
begin
Jump := jmNone;
if Shift = [] then begin
if Key = VK_HOME then Jump := jmHome
else if Key = VK_END then Jump := jmEnd;
if Orientation = soHorizontal then begin
if Key = VK_LEFT then Jump := jmPrior
else if Key = VK_RIGHT then Jump := jmNext;
end
else begin
if Key = VK_UP then Jump := jmNext
else if Key = VK_DOWN then Jump := jmPrior;
end;
end;
if (Jump <> jmNone) and CanModify and not ReadOnly then begin
Key := 0;
ThumbJump(Jump);
Changed;
end;
inherited KeyDown(Key, Shift);
end;
procedure TspSkinCustomSlider.ThumbMouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if CanFocus then SetFocus;
if (Button = mbLeft) and CanModify and not ReadOnly then begin
FSliding := True;
FThumbDown := True;
if Orientation = soHorizontal then FHit := X - FThumbRect.Left
else FHit := Y - FThumbRect.Top;
InvalidateThumb;
Update;
end;
end;
procedure TspSkinCustomSlider.ThumbMouseMove(Shift: TShiftState; X, Y: Integer);
begin
if (csLButtonDown in ControlState) and CanModify and not ReadOnly then
begin
if Orientation = soHorizontal then ThumbOffset := X - FHit
else ThumbOffset := Y - FHit;
end;
end;
procedure TspSkinCustomSlider.ThumbMouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) then begin
FSliding := False;
FThumbDown := False;
InvalidateThumb;
Update;
if CanModify and not ReadOnly then Changed;
end;
end;
constructor TspSkinLinkImage.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
AutoSize := True;
Cursor := crHandPoint;
end;
procedure TspSkinLinkImage.Click;
begin
inherited Click;
ShellExecute(0, 'open', PChar(FURL), nil, nil, SW_SHOWNORMAL);
end;
constructor TspSkinLinkLabel.Create;
begin
inherited;
FIndex := -1;
Transparent := True;
FSD := nil;
FSkinDataName := 'stdlabel';
FDefaultFont := TFont.Create;
with FDefaultFont do
begin
Name := 'Arial';
Height := 14;
Style := [fsUnderLine];
end;
Font.Assign(FDefaultFont);
Cursor := crHandPoint;
FUseSkinFont := True;
FDefaultActiveFontColor := clBlue;
FURL := '';
end;
destructor TspSkinLinkLabel.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinLinkLabel.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;
Style := Style + [fsUnderLine];
end
else
Canvas.Font := Self.Font;
if FMouseIn
then
Color := ActiveFontColor
else
Color := FontColor;
end
else
begin
if FUseSkinFont
then
Canvas.Font := DefaultFont
else
Canvas.Font := Self.Font;
if FMouseIn then Canvas.Font.Color := FDefaultActiveFontColor;
Canvas.Font.Style := Canvas.Font.Style + [fsUnderLine];
end;
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
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
procedure TspSkinLinkLabel.Click;
begin
inherited;
ShellExecute(0, 'open', PChar(FURL), nil, nil, SW_SHOWNORMAL);
end;
procedure TspSkinLinkLabel.CMMouseEnter;
begin
inherited;
FMouseIn := True;
RePaint;
end;
procedure TspSkinLinkLabel.CMMouseLeave;
begin
inherited;
FMouseIn := False;
RePaint;
end;
procedure TspSkinLinkLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TspSkinLinkLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinLinkLabel.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if (FIndex <> -1)
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinStdLabelControl
then
with TspDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveFontColor := ActiveFontColor;
end
end;
procedure TspSkinLinkLabel.ChangeSkinData;
begin
GetSkinData;
RePaint;
end;
procedure TspSkinLinkLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
constructor TspSkinButtonLabel.Create;
begin
inherited;
FIndex := -1;
ControlStyle := ControlStyle + [csSetCaption] - [csOpaque];
FSkinDataName := 'stdlabel';
FDefaultFont := TFont.Create;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FUseSkinFont := True;
FDefaultActiveFontColor := clBlue;
FNumGlyphs := 2;
FMargin := -1;
FSpacing := 1;
FLayout := blGlyphLeft;
FGlyph := TBitMap.Create;
Width := 100;
Height := 50;
end;
destructor TspSkinButtonLabel.Destroy;
begin
FDefaultFont.Free;
FGlyph.Free;
inherited;
end;
procedure TspSkinButtonLabel.MouseDown;
begin
FDown := True;
RePaint;
inherited;
end;
procedure TspSkinButtonLabel.MouseUp;
begin
FDown := False;
RePaint;
inherited;
end;
procedure TspSkinButtonLabel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinButtonLabel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinButtonLabel.SetLayout;
begin
if FLayout <> Value
then
begin
FLayout := Value;
RePaint;
end;
end;
procedure TspSkinButtonLabel.SetSpacing;
begin
if Value <> FSpacing
then
begin
FSpacing := Value;
RePaint;
end;
end;
procedure TspSkinButtonLabel.SetMargin;
begin
if (Value <> FMargin) and (Value >= -1)
then
begin
FMargin := Value;
RePaint;
end;
end;
procedure TspSkinButtonLabel.CMMouseEnter;
begin
inherited;
FMouseIn := True;
RePaint;
end;
procedure TspSkinButtonLabel.CMMouseLeave;
begin
inherited;
FMouseIn := False;
RePaint;
end;
procedure TspSkinButtonLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
RePaint;
end;
procedure TspSkinButtonLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinButtonLabel.ChangeSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if (FIndex <> -1)
then
begin
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinStdLabelControl
then
with TspDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontHeight := FontHeight;
Self.ActiveFontColor := ActiveFontColor;
Self.FontStyle := FontStyle;
end
end;
RePaint;
end;
procedure TspSkinButtonLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
procedure TspSkinButtonLabel.Paint;
function GetGlyphNum: Integer;
begin
if FDown and FMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if FMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
begin
if FIndex <> -1
then
with Canvas.Font do
begin
if FUseSkinFont
then
begin
Name := FontName;
Height := FontHeight;
Style := FontStyle;
end
else
Canvas.Font := FDefaultFont;
if FMouseIn
then
Color := ActiveFontColor
else
Color := FontColor;
end
else
begin
Canvas.Font := FDefaultFont;
if FMouseIn
then
Canvas.Font.Color := FDefaultActiveFontColor;
end;
DrawGlyphAndText(Canvas,
ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, FDown);
end;
{ TspSkinCustomCheckGroup }
constructor TspSkinCustomCheckGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption, csDoubleClicks];
FButtons := TList.Create;
FItems := TStringList.Create;
TStringList(FItems).OnChange := ItemsChange;
FColumns := 1;
FItemIndex := -1;
FButtonSkinDataName := 'checkbox';
FButtonDefaultFont := TFont.Create;
with FButtonDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
end;
procedure TspSkinCustomCheckGroup.SetButtonDefaultFont;
var
I: Integer;
begin
FButtonDefaultFont.Assign(Value);
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspCheckGroupButton (FButtons[I]) do
DefaultFont.Assign(FButtonDefaultFont);
end;
destructor TspSkinCustomCheckGroup.Destroy;
begin
FButtonDefaultFont.Free;
SetButtonCount(0);
TStringList(FItems).OnChange := nil;
FItems.Free;
FButtons.Free;
inherited Destroy;
end;
function TspSkinCustomCheckGroup.GetCheckedStatus(Index: Integer): Boolean;
begin
if (Index >= 0) and (Index < FButtons.Count)
then
Result := TspCheckGroupButton(FButtons[Index]).Checked
else
Result := False;
end;
procedure TspSkinCustomCheckGroup.SetCheckedStatus(Index: Integer; Value: Boolean);
begin
if (Index >= 0) and (Index < FButtons.Count)
then
TspCheckGroupButton(FButtons[Index]).Checked := Value;
end;
procedure TspSkinCustomCheckGroup.UpdateButtons;
var
I: Integer;
begin
SetButtonCount(FItems.Count);
for I := 0 to FButtons.Count - 1 do
TspGroupButton (FButtons[I]).Caption := FItems[I];
ArrangeButtons;
Invalidate;
end;
procedure TspSkinCustomCheckGroup.ChangeSkinData;
begin
inherited;
Self.ArrangeButtons;
end;
procedure TspSkinCustomCheckGroup.SetSkinData;
var
I: Integer;
begin
inherited;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspCheckGroupButton (FButtons[I]) do
SkinData := Value;
end;
procedure TspSkinCustomCheckGroup.SetButtonSkinDataName;
var
I: Integer;
begin
FButtonSkinDataName := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspCheckGroupButton (FButtons[I]) do
SkinDataName := Value;
end;
procedure TspSkinCustomCheckGroup.FlipChildren(AllLevels: Boolean);
begin
{ The radio buttons are flipped using BiDiMode }
end;
procedure TspSkinCustomCheckGroup.ArrangeButtons;
var
ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
DeferHandle: THandle;
ALeft: Integer;
ButtonsRect: TRect;
begin
if (FButtons.Count <> 0) and not FReading then
begin
ButtonsRect := Rect(0, 0, Width, Height);
AdjustClientRect(ButtonsRect);
ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
ButtonWidth := RectWidth(ButtonsRect) div FColumns - 2;
I := RectHeight(ButtonsRect);
ButtonHeight := I div ButtonsPerCol;
{ if FIndex <> -1
then
if FButtons.Count > 0
then
with TspGroupButton(FButtons[0]) do
begin
GetSkinData;
if FIndex <> -1 then ButtonHeight := RectHeight(SkinRect);
end;}
TopMargin := ButtonsRect.Top;
DeferHandle := BeginDeferWindowPos(FButtons.Count);
try
for I := 0 to FButtons.Count - 1 do
with TspCheckGroupButton(FButtons[I]) do
begin
BiDiMode := Self.BiDiMode;
ALeft := (I div ButtonsPerCol) * ButtonWidth + ButtonsRect.Left + 1;
if UseRightToLeftAlignment then
ALeft := RectWidth(ButtonsRect) - ALeft - ButtonWidth;
DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
ALeft,
(I mod ButtonsPerCol) * ButtonHeight + TopMargin,
ButtonWidth, ButtonHeight,
SWP_NOZORDER or SWP_NOACTIVATE);
Visible := True;
end;
finally
EndDeferWindowPos(DeferHandle);
end;
end;
end;
procedure TspSkinCustomCheckGroup.ButtonClick(Sender: TObject);
begin
if not FUpdating then
begin
FItemIndex := FButtons.IndexOf(Sender);
Changed;
Click;
end;
end;
procedure TspSkinCustomCheckGroup.ItemsChange(Sender: TObject);
begin
if not FReading then
begin
UpdateButtons;
end;
end;
procedure TspSkinCustomCheckGroup.Loaded;
begin
inherited Loaded;
ArrangeButtons;
end;
procedure TspSkinCustomCheckGroup.ReadState(Reader: TReader);
begin
FReading := True;
inherited ReadState(Reader);
FReading := False;
UpdateButtons;
end;
procedure TspSkinCustomCheckGroup.SetButtonCount(Value: Integer);
var
i: Integer;
begin
while FButtons.Count < Value do TspCheckGroupButton .InternalCreate(Self);
while FButtons.Count > Value do TspCheckGroupButton (FButtons.Last).Free;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspCheckGroupButton (FButtons[I]) do
begin
SkinData := Self.SkinData;
SkinDataName := ButtonSkinDataName;
DefaultFont.Assign(FButtonDefaultFont);
end;
end;
procedure TspSkinCustomCheckGroup.SetColumns(Value: Integer);
begin
if Value < 1 then Value := 1;
if Value > 16 then Value := 16;
if FColumns <> Value then
begin
FColumns := Value;
ArrangeButtons;
Invalidate;
end;
end;
procedure TspSkinCustomCheckGroup.SetItems(Value: TStrings);
begin
FItems.Assign(Value);
end;
procedure TspSkinCustomCheckGroup.CMEnabledChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
for I := 0 to FButtons.Count - 1 do
TspCheckGroupButton(FButtons[I]).Enabled := Enabled;
end;
procedure TspSkinCustomCheckGroup.CMFontChanged(var Message: TMessage);
begin
inherited;
ArrangeButtons;
end;
procedure TspSkinCustomCheckGroup.WMSize(var Message: TWMSize);
begin
inherited;
ArrangeButtons;
end;
constructor TspSkinBevel.Create;
begin
inherited;
FSD := nil;
FSkinDataName := 'bevel';
LightColor := clBtnHighLight;
DarkColor := clBtnShadow;
FIndex := -1;
FDividerMode := False;
end;
procedure TspSkinBevel.SetSkinData(Value: TspSkinData);
begin
FSD := Value;
ChangeSkinData;
end;
procedure TspSkinBevel.SetDividerMode(Value: Boolean);
begin
FDividerMode := Value;
RePaint;
end;
procedure TspSkinBevel.ChangeSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex = -1
then
begin
LightColor := clBtnHighLight;
DarkColor := clBtnShadow;
end
else
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinBevel
then
with TspDataSkinBevel(FSD.CtrlList.Items[FIndex]) do
begin
Self.LightColor := LightColor;
Self.DarkColor := DarkColor;
end;
RePaint;
end;
procedure TspSkinBevel.Paint;
const
XorColor = $00FFD8CE;
var
Color1, Color2: TColor;
Temp: TColor;
procedure BevelRect(const R: TRect);
begin
with Canvas do
begin
Pen.Color := Color1;
PolyLine([Point(R.Left, R.Bottom), Point(R.Left, R.Top),
Point(R.Right, R.Top)]);
Pen.Color := Color2;
PolyLine([Point(R.Right, R.Top), Point(R.Right, R.Bottom),
Point(R.Left, R.Bottom)]);
end;
end;
procedure BevelLine(C: TColor; X1, Y1, X2, Y2: Integer);
begin
with Canvas do
begin
Pen.Color := C;
MoveTo(X1, Y1);
LineTo(X2, Y2);
end;
end;
begin
with Canvas do
begin
if (csDesigning in ComponentState) then
begin
if (Shape = bsSpacer) then
begin
Pen.Style := psDot;
Pen.Mode := pmXor;
Pen.Color := XorColor;
Brush.Style := bsClear;
Rectangle(0, 0, ClientWidth, ClientHeight);
Exit;
end
else
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Color := clBlack;
Brush.Style := bsSolid;
end;
end;
Pen.Width := 1;
// must be skin
if Style = bsLowered then
begin
Color1 := DarkColor;
Color2 := LightColor;
end
else
begin
Color1 := LightColor;
Color2 := DarkColor;
end;
//
if FDividerMode
then
begin
case Shape of
bsTopLine, bsBottomLine:
BevelRect(Rect(2, Height div 2 - 1, Width - 2, Height div 2));
bsLeftLine, bsRightLine, bsBox, bsFrame:
BevelRect(Rect(Width div 2 - 1, 2, Width div 2, Height - 2));
end;
end
else
case Shape of
bsBox: BevelRect(Rect(0, 0, Width - 1, Height - 1));
bsFrame:
begin
Temp := Color1;
Color1 := Color2;
BevelRect(Rect(1, 1, Width - 1, Height - 1));
Color2 := Temp;
Color1 := Temp;
BevelRect(Rect(0, 0, Width - 2, Height - 2));
end;
bsTopLine:
begin
BevelLine(Color1, 0, 0, Width, 0);
BevelLine(Color2, 0, 1, Width, 1);
end;
bsBottomLine:
begin
BevelLine(Color1, 0, Height - 2, Width, Height - 2);
BevelLine(Color2, 0, Height - 1, Width, Height - 1);
end;
bsLeftLine:
begin
BevelLine(Color1, 0, 0, 0, Height);
BevelLine(Color2, 1, 0, 1, Height);
end;
bsRightLine:
begin
BevelLine(Color1, Width - 2, 0, Width - 2, Height);
BevelLine(Color2, Width - 1, 0, Width - 1, Height);
end;
end;
end;
end;
// TspSkinButtonsBar
constructor TspButtonBarSection.Create(Collection: TCollection);
begin
inherited Create(Collection);
FItems := TspButtonBarItems.create(self);
end;
procedure TspButtonBarSection.Assign(Source: TPersistent);
begin
if Source is TspButtonBarSection then
begin
Text := TspButtonBarSection(Source).Text;
ImageIndex := TspButtonBarSection(Source).ImageIndex;
end
else inherited Assign(Source);
end;
function TspButtonBarSection.GetDisplayName: string;
begin
Result := Text;
if Result = '' then Result := inherited GetDisplayName;
end;
procedure TspButtonBarSection.SetText(const Value: string);
begin
if FText <> Value then
begin
FText := Value;
Changed(False);
end;
end;
procedure TspButtonBarSection.SetItems(const Value: TspButtonBarItems);
begin
FItems.assign(Value);
end;
destructor TspButtonBarSection.Destroy;
begin
FItems.Free;
inherited;
end;
procedure TspButtonBarSection.SectionClick(const Value: TNotifyEvent);
begin
FonClick := Value;
end;
procedure TspButtonBarSection.Click;
begin
if assigned(onClick) then
onclick(self);
end;
procedure TspButtonBarSection.SetImageIndex(Value: Integer);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
Changed(False);
end;
end;
constructor TspButtonBarSections.Create(ButtonsBar: TspSkinButtonsBar);
begin
inherited Create(TspButtonBarSection);
FButtonsBar := ButtonsBar;
end;
function TspButtonBarSections.GetButtonsBar: TspSkinButtonsBar;
begin
Result := FButtonsBar;
end;
function TspButtonBarSections.Add: TspButtonBarSection;
begin
Result := TspButtonBarSection(inherited Add);
end;
function TspButtonBarSections.GetItem(Index: Integer): TspButtonBarSection;
begin
Result := TspButtonBarSection(inherited GetItem(Index));
end;
function TspButtonBarSections.GetOwner: TPersistent;
begin
Result := FButtonsBar;
end;
procedure TspButtonBarSections.SetItem(Index: Integer; Value: TspButtonBarSection);
begin
inherited SetItem(Index, Value);
end;
procedure TspButtonBarSections.Update(Item: TCollectionItem);
begin
if Item = nil
then FButtonsBar.UpdateSections
else FButtonsBar.UpdateSection(Item.Index);
end;
constructor TspSkinButtonsBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowButtons := True;
FDefaultSectionFont := TFont.Create;
with FDefaultSectionFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FDefaultItemFont := TFont.Create;
with FDefaultItemFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FUpButton := nil;
FDownButton := nil;
FSectionButtonSkinDataName := 'toolbutton';
BorderStyle := bvFrame;
FItemsPanel := TspSkinPanel.Create(Self);
with FItemsPanel do
begin
Parent := Self;
Align := alClient;
BorderStyle := bvNone;
OnResize := OnItemPanelResize;
end;
Width := 150;
FDefaultButtonHeight := 25;
FItemHeight := 60;
FItemsTransparent := True;
Align := alLeft;
FSectionButtons := TList.Create;
FSectionItems := TList.Create ;
FSections := TspButtonBarSections.Create(Self);
end;
destructor TspSkinButtonsBar.Destroy;
begin
FDefaultSectionFont.Free;
FDefaultItemFont.Free;
ClearItems;
ClearSections;
FSectionButtons.Free;
FSectionItems.Free;
FItemsPanel.Free;
FSections.Free;
inherited Destroy;
end;
procedure TspSkinButtonsBar.SetShowButtons;
begin
FShowButtons := Value;
UpdateSections;
end;
procedure TspSkinButtonsBar.OnItemPanelResize(Sender: TObject);
begin
CheckVisibleItems;
end;
procedure TspSkinButtonsBar.SetDefaultButtonHeight(Value: Integer);
begin
FDefaultButtonHeight := Value;
UpDateSectionButtons;
end;
procedure TspSkinButtonsBar.SetDefaultSectionFont;
begin
FDefaultSectionFont.Assign(Value);
end;
procedure TspSkinButtonsBar.SetDefaultItemFont;
begin
FDefaultItemFont.Assign(Value);
end;
procedure TspSkinButtonsBar.ChangeSkinData;
begin
inherited;
CheckVisibleItems;
end;
procedure TspSkinButtonsBar.ShowUpButton;
begin
FUpButton := TspSkinButton.Create(Self);
with FUpButton do
begin
CanFocused := False;
Width := 18;
Height := 18;
Spacing := 0;
SkinDataName := 'resizebutton';
RepeatMode := True;
RepeatInterval := 150;
Caption := '';
NumGlyhps := 1;
Glyph.LoadFromResourceName(HInstance, 'SP_BB_UP');
OnClick := UpButtonClick;
SkinData := Self.SkinData;
Top := - Height;
Parent := FItemsPanel;
end;
end;
procedure TspSkinButtonsBar.ShowDownButton;
begin
FDownButton := TspSkinButton.Create(Self);
with FDownButton do
begin
CanFocused:= False;
Width := 18;
Height := 18;
Spacing := 0;
SkinDataName := 'resizebutton';
RepeatMode := True;
RepeatInterval := 150;
Glyph.LoadFromResourceName(HInstance, 'SP_BB_DOWN');
Caption := '';
NumGlyhps := 1;
OnClick := DownButtonClick;
SkinData := Self.SkinData;
Top := - Height;
Parent := FItemsPanel;
end;
end;
procedure TspSkinButtonsBar.HideUpButton;
begin
FUpButton.Free;
FUpButton := nil;
end;
procedure TspSkinButtonsBar.HideDownButton;
begin
FDownButton.Free;
FDownButton := nil;
end;
procedure TspSkinButtonsBar.UpButtonClick(Sender: TObject);
begin
ScrollUp;
end;
procedure TspSkinButtonsBar.DownButtonClick(Sender: TObject);
begin
ScrollDown;
end;
procedure TspSkinButtonsBar.ArangeItems;
var
I, J: Integer;
begin
if (TopIndex > 0) and (FUpButton = nil)
then
ShowUpButton
else
if (TopIndex = 0) and (FUpButton <> nil) then HideUpButton;
if (TopIndex + VisibleCount < FSectionItems.Count) and (FDownButton = nil)
then
ShowDownButton
else
if (TopIndex + VisibleCount >= FSectionItems.Count) and (FDownButton <> nil)
then
HideDownButton;
if FUpButton <> nil
then
with FUpButton do
SetBounds(FItemsPanel.Width - Width - 5, 5, Width, Height);
if FDownButton <> nil
then
with FDownButton do
SetBounds(FItemsPanel.Width - Width - 5, FItemsPanel.Height - Height - 5, Width, Height);
J := 0;
for I := 0 to FSectionItems.Count - 1 do
with TspSectionItem(FSectionItems.Items[I]) do
if Visible
then
begin
SetBounds(0, J, FItemsPanel.Width, FItemHeight);
Inc(J, FItemHeight);
Parent := FItemsPanel;
end;
end;
procedure TspSkinButtonsBar.CheckVisibleItems;
var
I: Integer;
OldVisibleCount, OldTopIndex: Integer;
CanVisible: Boolean;
begin
OldVisibleCount := VisibleCount;
OldTopIndex := TopIndex;
VisibleCount := FItemsPanel.Height div FItemHeight;
if VisibleCount > FSectionItems.Count
then VisibleCount := FSectionItems.Count;
if VisibleCount = FSectionItems.Count
then
TopIndex := 0
else
if (TopIndex + VisibleCount > FSectionItems.Count) and (TopIndex > 0)
then
begin
TopIndex := TopIndex - (VisibleCount - OldVisibleCount);
if TopIndex < 0 then TopIndex := 0;
end;
for I := 0 to FSectionItems.Count - 1 do
with TspSectionItem(FSectionItems.Items[I]) do
begin
CanVisible := (I >= TopIndex) and (I <= TopIndex + VisibleCount - 1);
if CanVisible and not Visible
then
begin
if I < OldTopIndex
then
begin
Top := 0;
Visible := CanVisible;
end
else
begin
Top := FItemsPanel.Height;
Visible := CanVisible;
end;
end
else
begin
Visible := CanVisible;
if not Visible then Parent := nil;
end;
end;
ArangeItems;
end;
procedure TspSkinButtonsBar.ScrollUp;
begin
if (TopIndex = 0) or (VisibleCount = 0) then Exit;
TspSectionItem(FSectionItems.Items[TopIndex + VisibleCount - 1]).Visible := False;
Dec(TopIndex);
TspSectionItem(FSectionItems.Items[TopIndex]).Visible := True;
ArangeItems;
end;
procedure TspSkinButtonsBar.ScrollDown;
begin
if VisibleCount = 0 then Exit;
if TopIndex + VisibleCount >= FSectionItems.Count then Exit;
TspSectionItem(FSectionItems.Items[TopIndex]).Visible := False;
Inc(TopIndex);
TspSectionItem(FSectionItems.Items[TopIndex + VisibleCount - 1]).Visible := True;
ArangeItems;
end;
procedure TspSkinButtonsBar.SetItemHeight;
begin
FItemHeight := Value;
UpdateItems;
end;
procedure TspSkinButtonsBar.SetItemsTransparent;
begin
FItemsTransparent := Value;
UpdateItems;
end;
procedure TspSkinButtonsBar.UpDateSectionButtons;
var
I: Integer;
begin
if Sections.Count = 0 then Exit;
for I := 0 to Sections.Count - 1 do UpdateSection(I);
end;
procedure TspSkinButtonsBar.OpenSection(Index: Integer);
var
I: Integer;
begin
if FSectionIndex = Index then Exit;
FSectionIndex := Index;
if FShowButtons
then
begin
for I := 0 to FSectionButtons.Count - 1 do
with TspSectionButton(FSectionButtons.Items[I]) do
begin
if (FItemIndex > FSectionIndex) and (Align <> alBottom) then Align := alBottom;
end;
for I := FSectionButtons.Count - 1 downto 0 do
with TspSectionButton(FSectionButtons.Items[I]) do
begin
if (FItemIndex <= FSectionIndex) and (Align <> alTop) then Align := alTop;
end;
end;
UpdateItems;
Sections[Index].Click;
end;
procedure TspSkinButtonsBar.ClearItems;
var
I: Integer;
begin
if FSectionItems = nil then Exit;
if FSectionItems.Count = 0 then Exit;
for I := FSectionItems.Count - 1 downto 0 do
begin
TspSectionItem(FSectionItems.Items[I]).Free;
end;
FSectionItems.Clear;
end;
procedure TspSkinButtonsBar.ClearSections;
var
I: Integer;
begin
if FSectionButtons = nil then Exit;
if FSectionButtons.Count = 0 then Exit;
for I := 0 to FSectionButtons.Count - 1 do
begin
TspSectionButton(FSectionButtons.Items[I]).Free;
end;
FSectionButtons.Clear;
end;
procedure TspSkinButtonsBar.SetSkinData;
begin
inherited;
if FItemsPanel <> nil then FItemsPanel.SkinData := Value;
end;
procedure TspSkinButtonsBar.CreateWnd;
begin
inherited CreateWnd;
UpdateSections;
UpdateItems;
end;
procedure TspSkinButtonsBar.SetSections(Value: TspButtonBarSections);
begin
FSections.Assign(Value);
end;
procedure TspSkinButtonsBar.UpdateSection(Index: Integer);
var
S: TspButtonBarSection;
I: Integer;
B: Boolean;
begin
if not HandleAllocated then Exit;
if FSections.Count = 0 then Exit;
if not FShowButtons
then
begin
UpdateItems;
Exit;
end;
S := TspButtonBarSection(Sections.Items[Index]);
for I := 0 to FSectionButtons.Count - 1 do
with TspSectionButton(FSectionButtons.Items[I]) do
if FItemIndex = Index then
begin
DefaultHeight := DefaultButtonHeight;
B := Caption <> S.Text;
if B then Caption := S.Text;
Glyph.Assign(nil);
if (S.ImageIndex <> -1) and (FSectionImages <> nil) and (S.ImageIndex < FSectionImages.Count)
then
FSectionImages.GetBitmap(S.ImageIndex, Glyph);
RePaint;
if (FSectionIndex = Index) and not B then UpdateItems;
Break;
end;
end;
procedure TspSkinButtonsBar.UpdateSections;
var
I: Integer;
S: TspButtonBarSection;
begin
if not HandleAllocated then Exit;
if FSections.Count = 0 then Exit;
ClearSections;
if not FShowButtons
then
begin
CheckVisibleItems;
Exit;
end;
for I := FSectionIndex downto 0 do
begin
S := TspButtonBarSection(Sections.Items[I]);
FSectionButtons.Add(TspSectionButton.CreateEx(Self, Self, I));
with TspSectionButton(FSectionButtons.Items[FSectionButtons.Count - 1]) do
begin
Align := alTop;
Parent := Self;
DefaultHeight := DefaultButtonHeight;
SkinData := Self.SkinData;
Caption := S.Text;
if (FSectionImages <> nil) and (S.ImageIndex < FSectionImages.Count)
then
begin
FSectionImages.GetBitmap(S.ImageIndex, Glyph);
end;
end;
end;
for I := Sections.Count - 1 downto FSectionIndex + 1 do
begin
S := TspButtonBarSection(Sections.Items[I]);
FSectionButtons.Add(TspSectionButton.CreateEx(Self, Self, I));
with TspSectionButton(FSectionButtons.Items[FSectionButtons.Count - 1]) do
begin
Align := alBottom;
Parent := Self;
DefaultHeight := DefaultButtonHeight;
SkinData := Self.SkinData;
Caption := S.Text;
if (FSectionImages <> nil) and (S.ImageIndex < FSectionImages.Count)
then
begin
FSectionImages.GetBitmap(S.ImageIndex, Glyph);
end;
end;
end;
end;
procedure TspSkinButtonsBar.UpdateItems;
var
I: Integer;
It: TspButtonBarItem;
begin
if not HandleAllocated then Exit;
if FSections.Count = 0 then Exit;
if FShowButtons and (FSectionButtons.Count = 0) then Exit;
ClearItems;
if FUpButton <> nil then HideUpButton;
if FDownButton <> nil then HideDownButton;
if FSections.Items[FSectionIndex].Items.Count = 0 then Exit;
TopIndex := 0;
for I := 0 to FSections.Items[FSectionIndex].Items.Count - 1 do
begin
It := TspButtonBarItem(FSections.Items[FSectionIndex].Items[I]);
FSectionItems.Add(TspSectionItem.CreateEx(FItemsPanel, Self, FSectionIndex, I));
with TspSectionItem(FSectionItems.Items[FSectionItems.Count - 1]) do
begin
DefaultHeight := FItemHeight;
Flat := FItemsTransparent;
SkinData := Self.SkinData;
Caption := It.Text;
if (FItemImages <> nil) and (It.ImageIndex < FitemImages.Count)
then
begin
FItemImages.GetBitmap(It.ImageIndex, Glyph);
end;
end;
end;
CheckVisibleItems;
end;
procedure TspSkinButtonsBar.SetSectionIndex(const Value: integer);
begin
if (Value >= 0) and (Value <> FSectionIndex) and (Value < Sections.Count)
then
begin
OpenSection(Value);
end;
end;
procedure TspSkinButtonsBar.SetItemImages(const Value: TImagelist);
begin
FItemImages := Value;
UpdateItems;
end;
procedure TspSkinButtonsBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if (operation=opremove) and (Acomponent = FItemImages) then
SetItemImages(nil);
if (operation=opremove) and (Acomponent=FSectionImages) then
SetSectionImages(nil);
end;
procedure TspSkinButtonsBar.SetSectionImages(const Value: TImageList);
begin
FSectionImages := Value;
UpDateSectionButtons;
end;
procedure TspButtonBarItem.Assign(Source: TPersistent);
begin
if Source is TspButtonBarItem then
begin
Text := TspButtonBarItem(Source).Text;
ImageIndex:=TspButtonBarItem(source).ImageIndex;
onClick:=TspButtonBarItem(source).onClick;
end
else inherited Assign(Source);
end;
procedure TspButtonBarItem.Click;
begin
if assigned(onClick) then
onClick(self);
end;
constructor TspButtonBarItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
end;
function TspButtonBarItem.GetDisplayName: string;
begin
Result := Text;
if Result = '' then Result := inherited GetDisplayName;
end;
procedure TspButtonBarItem.SetImageIndex(const Value: integer);
begin
if FImageIndex<>value then
begin
FImageIndex := Value;
changed(false)
end;
end;
procedure TspButtonBarItem.ItemClick(const Value: TNotifyEvent);
begin
FOnClick := Value;
end;
procedure TspButtonBarItem.SetText(const Value: string);
begin
if FText <> Value then
begin
FText := Value;
Changed(False);
end;
end;
function TspButtonBarItems.Add: TspButtonBarItem;
begin
Result := TspButtonBarItem(inherited Add);
end;
constructor TspButtonBarItems.Create(Section: TspButtonBarSection);
begin
inherited Create(TspButtonBarItem);
FSection := Section;
end;
function TspButtonBarItems.GetItem(Index: Integer): TspButtonBarItem;
begin
Result := TspButtonBarItem(inherited GetItem(Index));
end;
function TspButtonBarItems.GetOwner: TPersistent;
begin
Result := FSection;
end;
procedure TspButtonBarItems.SetItem(Index: Integer; Value: TspButtonBarItem);
begin
inherited SetItem(Index, Value);
end;
procedure TspButtonBarItems.Update(Item: TCollectionItem);
begin
FSection.Changed(False);
end;
constructor TspSectionButton.CreateEx;
begin
inherited Create(AOwner);
FButtonsBar := AButtonsBar;
FItemIndex := AIndex;
NumGlyhps := 1;
Spacing := 5;
SkinDataName := FButtonsBar.SectionButtonSkinDataName;
DefaultFont := FButtonsBar.DefaultSectionFont;
UseSkinFont := FButtonsBar.UseSkinFont;
end;
procedure TspSectionButton.ButtonClick;
begin
FButtonsBar.OpenSection(FItemIndex);
inherited;
end;
constructor TspSectionItem.CreateEx;
begin
inherited Create(AOwner);
FButtonsBar := AButtonsBar;
FItemIndex := AIndex;
FSectionIndex := ASectionIndex;
Flat := True;
AlphaBlend := False;
SkinDataName := 'resizebutton';
NumGlyhps := 1;
Layout := blGlyphTop;
Spacing := 5;
DefaultFont := FButtonsBar.DefaultItemFont;
UseSkinFont := FButtonsBar.UseSkinFont;
end;
procedure TspSectionItem.ButtonClick;
begin
FButtonsBar.Sections[FSectionIndex].Items[FItemIndex].Click;
inherited;
end;
{TspSkinNoteBook}
{TspSkinNoteBook}
type
TspPageAccess = class(TStrings)
private
PageList: TList;
Notebook: TspSkinNoteBook;
protected
function GetCount: Integer; override;
function Get(Index: Integer): string; override;
procedure Put(Index: Integer; const S: string); override;
function GetObject(Index: Integer): TObject; override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create(APageList: TList; ANotebook: TspSkinNoteBook);
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: string); override;
function Add(const S: string): Integer; override;
procedure Move(CurIndex, NewIndex: Integer); override;
end;
constructor TspPageAccess.Create(APageList: TList; ANotebook: TspSkinNoteBook);
begin
inherited Create;
PageList := APageList;
Notebook := ANotebook;
end;
function TspPageAccess.GetCount: Integer;
begin
Result := PageList.Count;
end;
function TspPageAccess.Get(Index: Integer): string;
begin
Result := TspSkinPage(PageList[Index]).Caption;
end;
procedure TspPageAccess.Put(Index: Integer; const S: string);
var
Form: TCustomForm;
begin
TspSkinPage(PageList[Index]).Caption := S;
if NoteBook.ButtonsMode then NoteBook.UpdateButton(Index, S);
if csDesigning in NoteBook.ComponentState then
begin
Form := GetParentForm(NoteBook);
if (Form <> nil) and (Form.Designer <> nil) then
Form.Designer.Modified;
end;
end;
function TspPageAccess.GetObject(Index: Integer): TObject;
begin
Result := PageList[Index];
end;
procedure TspPageAccess.SetUpdateState(Updating: Boolean);
begin
{ do nothing }
end;
procedure TspPageAccess.Clear;
var
I: Integer;
Form: TCustomForm;
begin
for I := 0 to PageList.Count - 1 do
TspSkinPage(PageList[I]).Free;
PageList.Clear;
if NoteBook.ButtonsMode then NoteBook.UpdateButtons;
if csDesigning in NoteBook.ComponentState then
begin
Form := GetParentForm(NoteBook);
if (Form <> nil) and (Form.Designer <> nil) then
Form.Designer.Modified;
end;
end;
procedure TspPageAccess.Delete(Index: Integer);
var
Form: TCustomForm;
begin
TspSkinPage(PageList[Index]).Free;
PageList.Delete(Index);
NoteBook.PageIndex := 0;
if NoteBook.ButtonsMode then NoteBook.UpdateButtons;
if csDesigning in NoteBook.ComponentState then
begin
Form := GetParentForm(NoteBook);
if (Form <> nil) and (Form.Designer <> nil) then
Form.Designer.Modified;
end;
end;
function TspPageAccess.Add;
var
Page: TspSkinPage;
Form: TCustomForm;
begin
Page := TspSkinPage.Create(Notebook);
with Page do
begin
Parent := Notebook;
Caption := S;
end;
PageList.Add(Page);
NoteBook.PageIndex := PageList.Count - 1;
Result := PageList.Count - 1;
if NoteBook.ButtonsMode then NoteBook.UpdateButtons;
if csDesigning in NoteBook.ComponentState then
begin
Form := GetParentForm(NoteBook);
if (Form <> nil) and (Form.Designer <> nil) then
Form.Designer.Modified;
end;
end;
procedure TspPageAccess.Insert(Index: Integer; const S: string);
var
Page: TspSkinPage;
Form: TCustomForm;
begin
Page := TspSkinPage.Create(Notebook);
with Page do
begin
Parent := Notebook;
Caption := S;
end;
PageList.Insert(Index, Page);
NoteBook.PageIndex := Index;
if NoteBook.ButtonsMode then NoteBook.UpdateButtons;
if csDesigning in NoteBook.ComponentState then
begin
Form := GetParentForm(NoteBook);
if (Form <> nil) and (Form.Designer <> nil) then
Form.Designer.Modified;
end;
end;
procedure TspPageAccess.Move(CurIndex, NewIndex: Integer);
var
AObject: TObject;
begin
if CurIndex <> NewIndex then
begin
AObject := PageList[CurIndex];
PageList[CurIndex] := PageList[NewIndex];
PageList[NewIndex] := AObject;
end;
if NoteBook.ButtonsMode then NoteBook.UpdateButtons;
end;
constructor TspSkinPage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Visible := False;
ControlStyle := ControlStyle + [csNoDesignVisible];
Align := alClient;
BorderStyle := bvNone;
FImageIndex := -1;
end;
procedure TspSkinPage.ReadState(Reader: TReader);
begin
if Reader.Parent is TspSkinNoteBook then
TspSkinNotebook(Reader.Parent).FPageList.Add(Self);
inherited ReadState(Reader);
end;
procedure TspSkinPage.WMNCHitTest(var Message: TWMNCHitTest);
begin
if not (csDesigning in ComponentState) then
Message.Result := HTTRANSPARENT
else
inherited;
end;
constructor TspPageButton.CreateEx;
begin
inherited Create(AOwner);
FNoteBook := ANoteBook;
FPageIndex := APageIndex;
NumGlyhps := 1;
Spacing := 5;
SkinDataName := FNoteBook.ButtonSkinDataName;
end;
procedure TspPageButton.ButtonClick;
begin
FNoteBook.PageIndex := FPageIndex;
inherited;
end;
var
Registered: Boolean = False;
constructor TspSkinNoteBook.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls,
csCaptureMouse, csClickEvents];
FButtonsMode := False;
FButtonSkinDataName := 'toolbutton';
FButtons := TList.Create;
BorderStyle := bvFrame;
Width := 150;
Height := 150;
FPageList := TList.Create;
FAccess := TspPageAccess.Create(FPageList, Self);
FPageIndex := -1;
FAccess.Add('Default');
PageIndex := 0;
Exclude(FComponentStyle, csInheritable);
if not Registered then
begin
Classes.RegisterClasses([TspSkinPage]);
Registered := True;
end;
end;
destructor TspSkinNoteBook.Destroy;
begin
FAccess.Free;
FPageList.Free;
ClearButtons;
FButtons.Free;
inherited Destroy;
end;
procedure TspSkinNoteBook.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (operation=opremove) and (Acomponent = FImages) then
SetImages(nil);
end;
procedure TspSkinNoteBook.SetImages(const Value: TImageList);
begin
FImages := Value;
if FButtonsMode then UpDateButtons;
end;
procedure TspSkinNoteBook.UpdateButton;
var
I: Integer;
P: TspSkinPage;
begin
for I := 0 to FButtons.Count - 1 do
with TspPageButton(FButtons.Items[I]) do
if FPageIndex = APageIndex
then
begin
P := TspSkinPage(FPageList.Items[APageIndex]);
Caption := ACaption;
Glyph.Assign(nil);
if P.ImageIndex <> -1
then
FImages.GetBitmap(P.ImageIndex, Glyph);
RePaint;
end;
end;
procedure TspSkinNoteBook.UpdateButtons;
var
I: Integer;
P: TspSkinPage;
begin
if Pages.Count = 0 then Exit;
ClearButtons;
for I := 0 to Pages.Count - 1 do
begin
FButtons.Add(TspPageButton.CreateEx(Self, Self, I));
P := TspSkinPage(FPageList.Items[I]);
with TspPageButton(FButtons.Items[FButtons.Count - 1]) do
begin
if I <= Self.PageIndex
then
begin
Top := Self.Height;
Align := alTop;
end
else
begin
Top := Self.Height;
Align := alBottom;
end;
Parent := Self;
DefaultHeight := 25;
SkinData := Self.SkinData;
Caption := Pages[I];
Glyph.Assign(nil);
if (P.ImageIndex <> -1) and (FImages <> nil) and (P.ImageIndex < FImages.Count)
then
FImages.GetBitmap(P.ImageIndex, Glyph);
end;
end;
end;
procedure TspSkinNoteBook.ClearButtons;
var
I: Integer;
begin
if FButtons = nil then Exit;
if FButtons.Count = 0 then Exit;
for I := 0 to FButtons.Count - 1 do
begin
TspSkinSpeedButton(FButtons.Items[I]).Free;
end;
FButtons.Clear;
end;
procedure TspSkinNoteBook.SetButtonsMode(Value: Boolean);
begin
FButtonsMode := Value;
if FButtonsMode then UpDateButtons else ClearButtons;
end;
procedure TspSkinNoteBook.Loaded;
begin
inherited;
if (FPageIndex <> -1) and (FPageIndex >= 0) and (FPageIndex < FPageList.Count)
then
with TspSkinPage(FPageList[FPageIndex]) do
SkinData := Self.SkinData;
if FButtonsMode then UpDateButtons;
end;
procedure TspSkinNoteBook.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_CLIPCHILDREN;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
function TspSkinNoteBook.GetChildOwner: TComponent;
begin
Result := Self;
end;
procedure TspSkinNoteBook.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
I: Integer;
begin
for I := 0 to FPageList.Count - 1 do Proc(TControl(FPageList[I]));
end;
procedure TspSkinNoteBook.ReadState(Reader: TReader);
begin
Pages.Clear;
inherited ReadState(Reader);
if (FPageIndex <> -1) and (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
with TspSkinPage(FPageList[FPageIndex]) do
begin
BringToFront;
SkinData := Self.SkinData;
Visible := True;
Align := alClient;
end
else FPageIndex := -1;
end;
procedure TspSkinNoteBook.ShowControl(AControl: TControl);
var
I: Integer;
begin
for I := 0 to FPageList.Count - 1 do
if FPageList[I] = AControl then
begin
SetPageIndex(I);
Exit;
end;
inherited ShowControl(AControl);
end;
procedure TspSkinNoteBook.SetPages(Value: TStrings);
begin
FAccess.Assign(Value);
UpdateButtons;
end;
procedure TspSkinNoteBook.SetPageIndex(Value: Integer);
var
ParentForm: TCustomForm;
I: Integer;
begin
if csLoading in ComponentState then
begin
FPageIndex := Value;
Exit;
end;
if (Value <> FPageIndex) and (Value >= 0) and (Value < FPageList.Count) then
begin
ParentForm := GetParentForm(Self);
if ParentForm <> nil then
if ContainsControl(ParentForm.ActiveControl) then
ParentForm.ActiveControl := Self;
with TspSkinPage(FPageList[Value]) do
begin
BringToFront;
SkinData := Self.SkinData;
Visible := True;
Align := alClient;
end;
if (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
TspSkinPage(FPageList[FPageIndex]).Visible := False;
FPageIndex := Value;
if ParentForm <> nil then
if ParentForm.ActiveControl = Self then SelectFirst;
//
if FButtonsMode
then
begin
for I := FButtons.Count - 1 downto 0 do
with TspPageButton(FButtons.Items[I]) do
begin
if (FPageIndex > Self.PageIndex) and (Align <> alBottom) then Align := alBottom;
end;
for I := 0 to FButtons.Count - 1 do
with TspPageButton(FButtons.Items[I]) do
begin
if (FPageIndex <= Self.PageIndex) and (Align <> alTop) then Align := alTop;
end;
end;
//
if Assigned(FOnPageChanged) then
FOnPageChanged(Self);
end;
end;
procedure TspSkinNoteBook.SetActivePage(const Value: string);
begin
SetPageIndex(FAccess.IndexOf(Value));
end;
function TspSkinNoteBook.GetActivePage: string;
begin
Result := FAccess[FPageIndex];
end;
constructor TspSkinXFormButton.Create(AOwner: TComponent);
begin
inherited;
FDefImage := TBitMap.Create;
FDefActiveImage := TBitMap.Create;
FDefDownImage := TBitMap.Create;
FDefMask := TBitMap.Create;
CanFocused := False;
FDefActiveFontColor := 0;
FDefDownFontColor := 0;
end;
destructor TspSkinXFormButton.Destroy;
begin
FDefImage.Free;
FDefActiveImage.Free;
FDefDownImage.Free;
FDefMask.Free;
inherited;
end;
procedure TspSkinXFormButton.SetControlRegion;
var
TempRgn: HRGN;
begin
if (FIndex = -1) and (FDefImage <> nil) and not FDefImage.Empty
then
begin
TempRgn := FRgn;
if FDefMask.Empty and (FRgn <> 0)
then
begin
SetWindowRgn(Handle, 0, True);
end
else
begin
CreateSkinSimplyRegion(FRgn, FDefMask);
SetWindowRgn(Handle, FRgn, True);
end;
if TempRgn <> 0 then DeleteObject(TempRgn);
end
else
inherited;
end;
procedure TspSkinXFormButton.SetBounds;
begin
inherited;
if (FIndex = -1) and (FDefImage <> nil) and not FDefImage.Empty
then
begin
if Width <> FDefImage.Width then Width := FDefImage.Width;
if Height <> FDefImage.Height then Height := FDefImage.Height;
end;
end;
procedure TspSkinXFormButton.DrawDefaultButton;
var
IsDown: Boolean;
R: TRect;
begin
with C do
begin
R := ClientRect;
Font.Assign(FDefaultFont);
IsDown := FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
(GroupIndex = 0)) or (GroupIndex <> 0));
if IsDown and not FDefDownImage.Empty
then
Draw(0, 0, FDefDownImage)
else
if (FMouseIn or IsFocused) and not FDefActiveImage.Empty
then
Draw(0, 0, FDefActiveImage)
else
Draw(0, 0, FDefImage);
if IsDown
then
Font.Color := FDefDownFontColor
else
if FMouseIn or IsFocused
then
Font.Color := FDefActiveFontColor;
DrawGlyphAndText(C, ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, 1, IsDown);
end;
end;
procedure TspSkinXFormButton.CreateControlDefaultImage;
begin
if (FIndex = -1) and not FDefImage.Empty
then
DrawDefaultButton(B.Canvas)
else
inherited;
end;
procedure TspSkinXFormButton.ChangeSkinData;
begin
GetSkinData;
if (FIndex = -1) and not FDefImage.Empty
then
begin
Width := FDefImage.Width;
Height := FDEfImage.Height;
SetControlRegion;
RePaint;
end
else
inherited;
end;
procedure TspSkinXFormButton.SetDefImage(Value: TBitMap);
begin
FDefImage.Assign(Value);
if not FDefImage.Empty
then
begin
DefaultHeight := FDefImage.Height;
DefaultWidth := FDefImage.Width;
end;
end;
procedure TspSkinXFormButton.SetDefActiveImage(Value: TBitMap);
begin
FDefActiveImage.Assign(Value);
end;
procedure TspSkinXFormButton.SetDefDownImage(Value: TBitMap);
begin
FDefDownImage.Assign(Value);
end;
procedure TspSkinXFormButton.SetDefMask(Value: TBitMap);
begin
FDefMask.Assign(Value);
if not FDefImage.Empty
then
SetControlRegion;
end;
procedure TspSkinXFormButton.Loaded;
begin
inherited;
if (FIndex = -1) and (FDefMask <> nil) and not FDefMask.Empty
then
SetControlRegion;
end;
end.