Delphi控件源码

开发平台：

Delphi

SkinCtrls.pas：源码内容

Result := CorrectResizeRect;
end;
2:
begin
if (R.Left <= LTPt.X) and (R.Right >= RTPt.X)
then
Inc(Result.Right, XO)
else
if (R.Left >= RTPt.X) and (R.Right > RTPt.X)
then
OffsetRect(Result, XO, 0);
end;
3:
begin
if (R.Top <= LTPt.Y) and (R.Bottom >= LBPt.Y)
then
Inc(Result.Bottom, YO)
else
if (R.Top >= LBPt.Y) and (R.Bottom > LBPt.X)
then
OffsetRect(Result, 0, YO);
end;
end;
end;
procedure TspSkinCustomControl.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinCustomControl
then
with TspDataSkinCustomControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
Self.CursorIndex := CursorIndex;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
if (MaskPictureIndex <> -1) and (MaskPictureIndex < FSD.FActivePictures.Count)
then
MaskPicture := TBitMap(FSD.FActivePictures.Items[MaskPictureIndex])
else
MaskPicture := nil;
ResizeMode := GetResizeMode;
end
else
begin
ResizeMode := 0;
Picture := nil;
MaskPicture := nil;
end;
end;
procedure TspSkinCustomControl.CreateControlRegion;
var
TempRgn: HRGN;
Offset: Integer;
begin
TempRgn := FRgn;
case ResizeMode of
0:
CreateSkinSimplyRegion(FRgn, MaskPicture);
1:
CreateSkinRegion
(FRgn, LTPt, RTPt, LBPt, RBPt, ClRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
MaskPicture, Width, Height);
2:
begin
Offset := Width - RectWidth(SkinRect);
CreateSkinRegion(FRgn,
LTPt, RTPt, LTPt, RTPt, ClRect,
LTPt, Point(RTPt.X + Offset, RTPt.Y),
LTPt, Point(RTPt.X + Offset, RTPt.Y), NewClRect,
MaskPicture, Width, Height);
end;
3:
begin
Offset := Height - RectHeight(SkinRect);
CreateSkinRegion(FRgn,
LTPt, LTPt, LBPt, LBPt, ClRect,
LTPt, LTPt,
Point(LBPt.X, LBPt.Y + Offset),
Point(LBPt.X, LBPt.Y + Offset), NewClRect,
MaskPicture, Width, Height);
end;
end;
SetWindowRgn(Handle, FRgn, True);
if TempRgn <> 0 then DeleteObject(TempRgn);
end;
procedure TspSkinCustomControl.SetControlRegion;
begin
if ((MaskPicture = nil) or (FIndex = -1)) and (FRgn <> 0)
then
begin
SetWindowRgn(Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
end
else
if (MaskPicture <> nil) and (FIndex <> -1)
then CreateControlRegion;
end;
//=========== TspSkinButton ===============
constructor TspSkinButton.Create;
begin
inherited;
RepeatTimer := nil;
FRepeatMode := False;
FRepeatInterval := 100;
FActive := False;
FSkinDataName := 'button';
FCanFocused := True;
TabStop := True;
FDown := False;
FMouseDown := False;
FMouseIn := False;
Width := 75;
Height := 25;
FGroupIndex := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 2;
FMargin := -1;
FSpacing := 1;
FLayout := blGlyphLeft;
FMorphKf := 0;
MorphTimer := nil;
Morphing := False;
FMorphKf := 0;
FAllowAllUp := False;
FAllowAllUpCheck := False;
end;
destructor TspSkinButton.Destroy;
begin
FGlyph.Free;
StopMorph;
inherited;
end;
procedure TspSkinButton.RepeatTimerProc;
begin
ButtonClick;
end;
procedure TspSkinButton.StartRepeat;
begin
if RepeatTimer <> nil then RepeatTimer.Free;
RepeatTimer := TTimer.Create(Self);
RepeatTimer.Enabled := False;
RepeatTimer.OnTimer := RepeatTimerProc;
RepeatTimer.Interval := FRepeatInterval;
RepeatTimer.Enabled := True;
end;
procedure TspSkinButton.StopRepeat;
begin
RepeatTimer.Enabled := False;
RepeatTimer.Free;
RepeatTimer := nil;
end;
procedure TspSkinButton.CreateWnd;
begin
inherited CreateWnd;
FActive := FDefault;
end;
procedure TspSkinButton.CMEnabledChanged;
begin
inherited;
if Morphing
then
begin
StopMorph;
FMorphKf := 0;
end;
FMouseIn := False;
RePaint;
end;
procedure TspSkinButton.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TspSkinButton.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TspSkinButton.CMDialogKey(var Message: TCMDialogKey);
begin
with Message do
if FActive and (CharCode = VK_RETURN) and Enabled
then
begin
ButtonClick;
Result := 1;
end
else
if (CharCode = VK_ESCAPE) and FCancel and FCanFocused and
(KeyDataToShiftState(Message.KeyData) = []) and CanFocus
then
begin
ButtonClick;
Result := 1;
end
else
inherited;
end;
procedure TspSkinButton.CMFocusChanged(var Message: TCMFocusChanged);
begin
with Message do
if Sender is TspSkinButton then
FActive := Sender = Self
else
FActive := FDefault;
if FCanFocused and FDefault
then
if (Message.Sender <> Self) and (Message.Sender is TspSkinButton)
then
begin
FMouseIn := False;
ReDrawControl;
end
else
if (Message.Sender <> Self) and not (Message.Sender is TspSkinButton)
then
begin
FMouseIn := True;
if Morphing then FMorphKf := 1;
RePaint;
end;
inherited;
end;
procedure TspSkinButton.ButtonClick;
var
Form: TCustomForm;
begin
if FCanFocused
then
begin
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult;
end;
if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TspSkinButton.SetDefault(Value: Boolean);
var
Form: TCustomForm;
begin
FDefault := Value;
if HandleAllocated and FCanFocused and not (csDesigning in ComponentState)
then
begin
Form := GetParentForm(Self);
if Form <> nil then
Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
end;
end;
procedure TspSkinButton.ChangeSkinData;
begin
StopMorph;
inherited;
if Morphing and (FIndex <> -1) and (IsFocused or FMouseIn)
then
FMorphKf := 1;
end;
procedure TspSkinButton.SetGroupIndex;
begin
FGroupIndex := Value;
if FGroupIndex <> 0 then CanFocused := False;
end;
function TspSkinButton.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TspSkinButton.CMDialogChar;
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
ButtonClick;
Result := 1;
end
else
inherited;
end;
procedure TspSkinButton.SetCanFocused;
begin
FCanFocused := Value;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
TabStop := FCanFocused;
end;
procedure TspSkinButton.WMSETFOCUS;
begin
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TspSkinButton.WMKILLFOCUS;
begin
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TspSkinButton.WndProc(var Message: TMessage);
begin
if FCanFocused then
case Message.Msg of
WM_KEYDOWN:
if TWMKEYDOWN(Message).CharCode = VK_SPACE
then
begin
Down := True;
if FRepeatMode then ButtonClick;
end
else
if TWMKEYDOWN(Message).CharCode = VK_RETURN
then
begin
ButtonClick;
end;
WM_KEYUP:
if TWMKEYUP(Message).CharCode = VK_SPACE
then
begin
Down := False;
ButtonClick;
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 TspSkinButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
begin
with FGlyph do
begin
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clFuchsia;
Canvas.FillRect(Rect(0, 0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index);
end;
end;
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if (FGlyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
begin
CopyImage(ActionList.Images, ImageIndex);
RePaint;
end;
end;
end;
procedure TspSkinButton.ReDrawControl;
begin
if Morphing and (FIndex <> -1)
then StartMorph
else RePaint;
end;
procedure TspSkinButton.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 + 0.1;
RePaint;
end
else
if not (FMouseIn or IsFocused) and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - 0.1;
RePaint;
end
else
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TspSkinButton.SetLayout;
begin
if FLayout <> Value
then
begin
FLayout := Value;
RePaint;
end;
end;
procedure TspSkinButton.SetSpacing;
begin
if Value <> FSpacing
then
begin
FSpacing := Value;
RePaint;
end;
end;
procedure TspSkinButton.SetMargin;
begin
if (Value <> FMargin) and (Value >= -1)
then
begin
FMargin := Value;
RePaint;
end;
end;
procedure TspSkinButton.SetDown;
begin
FDown := Value;
if Morphing
then
begin
FMorphKf := 1;
if not FDown then StartMorph else StopMorph;
end;
RePaint;
if (GroupIndex <> 0) and FDown and not FAllowAllUp then DoAllUp;
end;
procedure TspSkinButton.DoAllUp;
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 TspSkinButton) and
(PC.Controls[i] <> Self)
then
with TspSkinButton(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and FDown
then
Down := False;
end;
procedure TspSkinButton.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinButton.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinButtonControl
then
with TspDataSkinButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownSkinRect := DownSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
if IsNullRect(DownSkinRect) then Self.DownSkinRect := Self.ActiveSkinRect;
Self.DisabledSkinRect := DisabledSkinRect;
Self.DisabledFontColor := DisabledFontColor;
end;
end
else
begin
Morphing := False;
end;
end;
procedure TspSkinButton.CreateButtonImage(B: TBitMap; R: TRect;
ADown, AMouseIn: Boolean);
function GetGlyphNum: Integer;
begin
if ADown and AMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if AMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
begin
CreateSkinControlImage(B, Picture, R);
if not FUseSkinFont
then
B.Canvas.Font.Assign(FDefaultFont)
else
with B.Canvas.Font do
begin
Name := FontName;
Height := FontHeight;
Style := FontStyle;
CharSet := FDefaultFont.Charset;
end;
with B.Canvas.Font do
begin
if not Enabled
then
Color := DisabledFontColor
else
if ADown and AMouseIn
then
Color := DownFontColor
else
if AMouseIn
then Color := ActiveFontColor
else Color := FontColor;
end;
DrawGlyphAndText(B.Canvas,
NewClRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, ADown and AMouseIn);
end;
procedure TspSkinButton.CreateControlDefaultImage;
var
R: TRect;
IsDown: Boolean;
begin
inherited;
IsDown := False;
R := ClientRect;
B.Canvas.Font.Assign(FDefaultFont);
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
if FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
(GroupIndex = 0)) or (GroupIndex <> 0))
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_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;
DrawGlyphAndText(B.Canvas,
ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, 1, IsDown);
end;
procedure TspSkinButton.CreateControlSkinImage;
begin
end;
procedure TspSkinButton.Paint;
var
PBuffer, APBuffer, PIBuffer: TspEffectBmp;
ParentImage, Buffer, ABuffer: TBitMap;
kf: Double;
begin
GetSkinData;
if FIndex = -1
then
inherited
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
ParentImage := nil;
if FAlphaBlend
then
begin
ParentImage := TBitMap.Create;
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage(Self, ParentImage.Canvas);
PIBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
end;
if Morphing and (FMorphKf <> 1) and (FMorphKf <> 0) and Enabled
then
begin
ABuffer := TBitMap.Create;
ABuffer.Width := Width;
ABuffer.Height := Height;
CreateButtonImage(Buffer, SkinRect, False, False);
CreateButtonImage(ABuffer, ActiveSkinRect, False, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.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;
if FAlphaBlend then PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
end
else
begin
if (not Enabled) and not IsNullRect(DisabledSkinRect)
then
CreateButtonImage(Buffer, DisabledSkinRect, False, False)
else
if FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
(GroupIndex = 0)) or (GroupIndex <> 0))
then
CreateButtonImage(Buffer, DownSkinRect, True, True)
else
if (IsFocused or FMouseIn) or (not (IsFocused or FMouseIn) and
Morphing and (FMorphKf = 1))
then
CreateButtonImage(Buffer, ActiveSkinRect, False, True)
else
CreateButtonImage(Buffer, SkinRect, False, False);
if FAlphaBlend
then
begin
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
end
else
Canvas.Draw(0, 0, Buffer);
end;
if FAlphaBlend
then
begin
PIBuffer.Free;
ParentImage.Free;
end;
Buffer.Free;
end;
end;
procedure TspSkinButton.CMTextChanged;
begin
if (FIndex <> -1) or
(csDesigning in ComponentState) or DrawDefault
then
RePaint;
end;
procedure TspSkinButton.CMMouseEnter(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
FMouseIn := True;
if GroupIndex <> 0
then
CanPaint := not FDown
else
CanPaint := not IsFocused or FDown;
if CanPaint
then
begin
if FDown
then
begin
if Morphing then FMorphKf := 1;
RePaint;
end
else
ReDrawControl;
end;
if FDown and FRepeatMode and (GroupIndex = 0) then StartRepeat;
end;
procedure TspSkinButton.CMMouseLeave(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
if not (FCanFocused and FDefault and FActive and not Focused)
then
FMouseIn := False;
if GroupIndex <> 0
then
CanPaint := not FDown
else
CanPaint := not IsFocused or FDown;
if CanPaint
then ReDrawControl;
if FDown and FRepeatMode and (GroupIndex = 0) then StopRepeat;
end;
procedure TspSkinButton.MouseDown;
begin
inherited;
if Button = mbLeft
then
begin
FMouseDown := True;
if not FDown
then
begin
FMouseIn := True;
Down := True;
if FRepeatMode and (GroupIndex = 0)
then
StartRepeat
else
if (GroupIndex <> 0) then ButtonClick;
FAllowAllUpCheck := False;
end
else
if (GroupIndex <> 0) then FAllowAllUpCheck := True;
end;
end;
procedure TspSkinButton.MouseUp;
begin
if Button = mbLeft
then
begin
FMouseDown := False;
if GroupIndex = 0
then
begin
if FMouseIn
then
begin
Down := False;
if FRepeatMode then StopRepeat;
ButtonClick;
end
else
begin
FDown := False;
if FRepeatMode and (RepeatTimer <> nil) then StopRepeat;
end;
end
else
if (GroupIndex <> 0) and FDown and FAllowAllUp and
FAllowAllUpCheck and FMouseIn
then
begin
Down := False;
ButtonClick;
end;
end;
inherited;
end;
//==============TspSkinMenuButton==========//
constructor TspSkinMenuButton.Create;
begin
inherited;
FSkinDataName := 'toolmenubutton';
FTrackButtonMode := False;
FMenuTracked := False;
FSkinPopupMenu := nil;
end;
destructor TspSkinMenuButton.Destroy;
begin
inherited;
end;
procedure TspSkinMenuButton.CreateButtonImage;
begin
if FMenuTracked and FTrackButtonMode and
not IsNullRect(TrackButtonRect) and not IsNullRect(DownSkinRect)
then
begin
inherited CreateButtonImage(B, ActiveSkinRect, False, True);
R := TrackButtonRect;
OffsetRect(R, DownSkinRect.Left, DownSkinRect.Top);
B.Canvas.CopyRect(GetNewTrackButtonRect, Picture.Canvas,
R);
end
else
inherited;
end;
procedure TspSkinMenuButton.CreateControlDefaultImage;
var
R, R1: TRect;
isDown: Boolean;
begin
IsDown := False;
if FTrackButtonMode
then
begin
R := Rect(0, 0, Width - 15, Height);
R1 := Rect(Width - 15, 0, Width, Height);
if FMenuTracked
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
isDown := True;
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R1);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R1);
end;
end;
end
else
begin
R := Rect(0, 0, Width, Height);
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_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;
R := ClientRect;
Dec(R.Right, 15);
B.Canvas.Font.Assign(FDefaultFont);
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
DrawGlyphAndText(B.Canvas, R, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, 1, isDown);
R.Left := Width - 15;
Inc(R.Right, 15);
if (FDown and FMouseIn) or FMenuTracked
then
begin
Inc(R.Top, 2);
Inc(R.Left, 2);
end;
DrawTrackArrowImage(B.Canvas, R, clBtnText);
end;
procedure TspSkinMenuButton.CMDialogChar;
begin
if not FTrackButtonMode and CanMenuTrack(0, 0)
then
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
FMenuTracked := True;
Down := True;
TrackMenu;
Result := 1;
end
else
inherited;
end
else
inherited;
end;
procedure TspSkinMenuButton.WndProc;
var
FOld: Boolean;
begin
FOld := True;
if FCanFocused then
case Message.Msg of
WM_KEYDOWN:
if TWMKEYDOWN(Message).CharCode = VK_SPACE
then
begin
if not FTrackButtonMode and CanMenuTrack(0, 0)
then
begin
FMenuTracked := True;
Down := True;
TrackMenu;
FOld := False;
end;
end;
WM_KEYUP:
if (TWMKEYUP(Message).CharCode = VK_SPACE) and not FMenuTracked
then
begin
Down := False;
if Assigned(FOnClick) then FOnClick(Self);
FOld := False;
end
else
if (TWMKEYUP(Message).CharCode = VK_RETURN) and not FMenuTracked
then
begin
if Assigned(FOnClick) then FOnClick(Self);
end
end;
if FOld then inherited;
end;
function TspSkinMenuButton.GetNewTrackButtonRect;
var
RM, Off: Integer;
R: TRect;
begin
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 TspSkinMenuButton.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 TspSkinMenuButton.WMCLOSESKINMENU;
begin
FMenuTracked := False;
Down := False;
if Assigned(FOnHideTrackMenu) then FOnHideTrackMenu(Self);
end;
procedure TspSkinMenuButton.TrackMenu;
var
R: TRect;
P: TPoint;
begin
if FSkinPopupMenu = nil then Exit;
if Morphing then FMorphKf := 1;
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 TspSkinMenuButton.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSkinPopupMenu)
then FSkinPopupMenu := nil;
end;
procedure TspSkinMenuButton.CMMouseEnter(var Message: TMessage);
begin
if not FMenuTracked then inherited else FMouseIn := True;
end;
procedure TspSkinMenuButton.CMMouseLeave(var Message: TMessage);
begin
if not FMenuTracked then inherited else FMouseIn := False;
end;
procedure TspSkinMenuButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinMenuButtonControl
then
with TspDataSkinMenuButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.TrackButtonRect := TrackButtonRect;
end;
end;
procedure TspSkinMenuButton.SetTrackButtonMode;
begin
FTrackButtonMode := Value;
if FIndex = - 1 then RePaint;
end;
procedure TspSkinMenuButton.MouseDown;
begin
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
FMenuTracked := CanMenuTrack(X, Y);
if FMenuTracked
then
begin
if not FDown then Down := True;
TrackMenu;
end
else
inherited;
end;
procedure TspSkinMenuButton.MouseUp;
begin
if not FMenuTracked then inherited;
end;
//=========== TspSkinPanel ================
constructor TspSkinPanel.Create;
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
FGlyph := TBitMap.Create;
FSpacing := 2;
FNumGlyphs := 1;
Width := 185;
Height := 41;
NewClRect := NullRect;
FRollUpMode := False;
FCaptionMode := False;
FOldHeight := -1;
FSkinDataName := 'panel';
BGPictureIndex := -1;
FDefaultCaptionHeight := 22;
FAutoEnabledControls := True;
FCheckedMode := False;
end;
destructor TspSkinPanel.Destroy;
begin
FGlyph.Free;
inherited;
end;
procedure TspSkinPanel.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 TspSkinPanel.SetCheckedMode;
begin
FCheckedMode := Value;
RePaint;
end;
procedure TspSkinPanel.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 TspSkinPanel.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 TspSkinPanel.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 TspSkinPanel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinPanel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinPanel.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TspSkinPanel.SetDefaultAlignment(Value: TAlignment);
begin
FDefaultAlignment := Value;
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TspSkinPanel.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
RePaint;
ReAlign;
end
end;
procedure TspSkinPanel.SetBorderStyle;
begin
FBorderStyle := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end;
end;
procedure TspSkinPanel.SetRollUpMode(Value: Boolean);
begin
FRollUpMode := Value;
if (FIndex = -1) and CaptionMode then RePaint;
end;
procedure TsPSkinPanel.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);
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 TspSkinPanel.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 TspSkinPanel.DoRollUp(ARollUp: Boolean);
begin
if FIndex <> -1
then
begin
if ARollUp
then
begin
FOldHeight := Height;
HideControls;
Height := NewClRect.Top + (Height - NewClRect.Bottom);
end
else
if FOldHeight <> -1
then
begin
Height := FOldHeight;
ShowControls;
end;
end
else
begin
if ARollUp
then
begin
FOldHeight := Height;
HideControls;
Height := FDEfaultCaptionHeight + 1;
ShowControls;
end
else
if FOldHeight <> -1
then
begin
Height := FOldHeight;
ShowControls;
end;
end;
end;
procedure TspSkinPanel.SetRollUpState;
begin
if FRollUpMode
then
begin
FRollUpState := Value;
DoRollUp(FRollUpState);
end
else
FRollUpState := False;
end;
procedure TspSkinPanel.SetCaptionMode;
begin
FCaptionMode := Value;
RePaint;
ReAlign;
end;
procedure TspSkinPanel.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
procedure TspSkinPanel.SetAlphaBlend;
begin
FAlphaBlend := AValue;
RePaint;
end;
procedure TspSkinPanel.SetAlphaBlendValue;
begin
FAlphaBlendValue := AValue;
RePaint;
end;
procedure TspSkinPanel.GetSkinData;
begin
inherited;
BGPictureIndex := -1;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinPanelControl
then
with TspDataSkinPanelControl(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.RollUpMarkerRect := RollUpMarkerRect;
Self.RestoreMarkerRect := RestoreMarkerRect;
Self.BGPictureIndex := BGPictureIndex;
Self.CheckImageRect := CheckImageRect;
Self.UnCheckImageRect := UnCheckImageRect;
end;
end;
procedure TspSkinPanel.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
if (FIndex <> -1) and not (csDesigning in ComponentState)
then
begin
if BGPictureIndex = -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 TspSkinPanel.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: TRect;
begin
CapRect := NewCaptionRect;
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;
Font.CharSet := FDefaultFont.Charset;
end
else
Font.Assign(FDefaultFont);
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;
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;
if not IsNullRect(RollUpMarkerRect) and FRollUpMode
then
begin
if ResizeMode > 0
then NewRollUpMarkerRect := GetNewRect(RollUpMarkerRect)
else NewRollUpMarkerRect := RollUpMarkerRect;
if FRollUpState and not IsNullRect(RestoreMarkerRect) then
B.Canvas.CopyRect(NewRollUpMarkerRect, Picture.Canvas,
RestoreMarkerRect);
end;
end;
end;
procedure TspSkinPanel.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 TspSkinPanel.ChangeSkinData;
var
TempOldHeight: Integer;
begin
inherited;
if FRollUpState
then
begin
TempOldHeight := FOldHeight;
DoRollUp(True);
FOldHeight := TempOldHeight;
end
else
ReAlign;
end;
procedure TspSkinPanel.CMTextChanged;
begin
if FCaptionMode then RePaint;
end;
procedure TspSkinPanel.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 TspSkinGroupBox.Create;
begin
inherited;
FSkinDataName := 'groupbox';
CaptionMode := True;
end;
//=========== TspSkinCheckRadioBox ===============
constructor TspSkinCheckRadioBox.Create;
begin
inherited;
FCanFocused := False;
TabStop := False;
FMouseIn := False;
Width := 150;
Height := 25;
FGroupIndex := 0;
FMorphKf := 0;
MorphTimer := nil;
FSkinDataName := 'checkbox';
FFlat := False;
end;
destructor TspSkinCheckRadioBox.Destroy;
begin
StopMorph;
inherited;
end;
procedure TspSkinCheckRadioBox.WMMOVE;
begin
inherited;
Invalidate;
end;
procedure TspSkinCheckRadioBox.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 TspSkinCheckRadioBox.SetFlat;
begin
FFlat := Value;
RePaint;
end;
procedure TspSkinCheckRadioBox.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TspSkinCheckRadioBox.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Enabled := False;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TspSkinCheckRadioBox.Paint;
var
PBuffer, APBuffer, PIBuffer: TspEffectBmp;
ParentImage, Buffer, ABuffer: TBitMap;
kf: Double;
TR, IR: TRect;
IX, IY: Integer;
C: TColor;
begin
GetSkinData;
if FFlat
then
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
GetParentImage2(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 not Enabled then Font.Color := clBtnShadow;
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;
SPDrawText(Buffer.Canvas, Caption, TR);
// draw glyph
if FMouseIn
then
Frame3D(Buffer.Canvas, IR, SP_XP_BTNFRAMECOLOR, SP_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 DrawFocusRect(TR);
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;
Font.CharSet := FDefaultFont.Charset;
end
else
Font.Assign(FDefaultFont);
if not Enabled
then Font.Color := UnEnabledFontColor
else Font.Color := FrameFontColor;
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;
Brush.Style := bsClear;
SPDrawText(Buffer.Canvas, Caption, TR);
// drawfocus
InflateRect(TR, 2, 1);
Inc(TR.Right, 1 );
Brush.Style := bsSolid;
if IsFocused then DrawFocusRect(TR);
end;
Self.Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
if FIndex = -1
then
inherited
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if FAlphaBlend
then
begin
ParentImage := TBitMap.Create;
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage(Self, ParentImage.Canvas);
PIBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
end;
if Morphing and (FMorphKf <> 1) and (FMorphKf <> 0)
then
begin
ABuffer := TBitMap.Create;
CreateImage(Buffer, SkinRect, False);
CreateImage(ABuffer, ActiveSkinRect, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.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;
if FAlphaBlend then PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
end
else
begin
if FMouseIn or IsFocused
then CreateImage(Buffer, ActiveSkinRect, FMouseIn or IsFocused)
else CreateImage(Buffer, SkinRect, FMouseIn or IsFocused);
if FAlphaBlend
then
begin
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
end
else
Canvas.Draw(0, 0, Buffer);
end;
if FAlphaBlend
then
begin
PIBuffer.Free;
ParentImage.Free;
end;
Buffer.Free;
end;
end;
function TspSkinCheckRadioBox.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TspSkinCheckRadioBox.SetCheckState;
begin
if FRadio
then
begin
if not Checked
then
Checked := True
end
else
Checked := not FChecked;
end;
procedure TspSkinCheckRadioBox.CMDialogChar;
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
SetCheckState;
Result := 1;
end
else
inherited;
end;
procedure TspSkinCheckRadioBox.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TspSkinCheckRadioBox.WMSETFOCUS;
begin
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TspSkinCheckRadioBox.WMKILLFOCUS;
begin
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TspSkinCheckRadioBox.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 TspSkinCheckRadioBox.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 TspSkinCheckRadioBox.SetRadio;
begin
FRadio := Value;
if ((FIndex = -1) and FDrawDefault) or
(csDesigning in ComponentState)
then
RePaint;
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;
end;
procedure TspSkinCheckRadioBox.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 TspSkinCheckRadioBox.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 TspSkinCheckRadioBox.ReDrawControl;
begin
if Morphing and (FIndex <> -1)
then StartMorph
else RePaint;
end;
procedure TspSkinCheckRadioBox.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 + 0.1;
RePaint;
end
else
if (not FMouseIn and not IsFocused) and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - 0.1;
RePaint;
end
else
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TspSkinCheckRadioBox.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 TspSkinCheckRadioBox) and
(PC.Controls[i] <> Self)
then
with TspSkinCheckRadioBox(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and Checked
then
Checked := False;
end;
procedure TspSkinCheckRadioBox.ChangeSkinData;
begin
if FFlat
then
begin
GetSkinData;
RePaint;
end
else
begin
StopMorph;
inherited;
if Morphing and (FIndex <> -1) and (IsFocused or FMouseIn)
then
FMorphKf := 1;
end;
end;
procedure TspSkinCheckRadioBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinCheckRadioControl
then
with TspDataSkinCheckRadioControl(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;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
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
else
begin
Morphing := False;
FMorphKf := 0;
end;
end;
procedure TspSkinCheckRadioBox.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;
Font.CharSet := FDefaultFont.Charset;
end
else
Font.Assign(FDefaultFont);
if AMouseIn
then Font.Color := ActiveFontColor
else Font.Color := FontColor;
if not Self.Enabled then Font.Color := UnEnabledFontColor;
Brush.Style := bsClear;
end;
SPDrawText(B.Canvas, Caption, NewTextArea);
end;
procedure TspSkinCheckRadioBox.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 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);
SPDrawText(B.Canvas, Caption, TR);
end;
if FMouseIn
then
Frame3D(B.Canvas, IR, SP_XP_BTNFRAMECOLOR, SP_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 TspSkinCheckRadioBox.CMTextChanged;
begin
if (FIndex <> -1) or
(csDesigning in ComponentState) or DrawDefault
then
RePaint;
end;
procedure TspSkinCheckRadioBox.CMMouseEnter(var Message: TMessage);
begin
inherited;
FMouseIn := True;
ReDrawControl;
end;
procedure TspSkinCheckRadioBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
FMouseIn := False;
ReDrawControl;
end;
procedure TspSkinCheckRadioBox.MouseDown;
begin
if not FMouseIn
then
begin
FMouseIn := True;
RedrawControl;
end;
inherited;
end;
procedure TspSkinCheckRadioBox.MouseUp;
begin
inherited;
if (Button = mbLeft) and FMouseIn then SetCheckState;
end;
constructor TspSkinGauge.Create;
begin
inherited;
FMinValue := 0;
FMaxValue := 100;
FValue := 50;
FVertical := False;
Width := 100;
Height := 20;
BeginOffset := 0;
EndOffset := 0;
FProgressText := '';
FShowPercent := False;
FShowProgressText := False;
FTextAlphaBlend := False;
FTextAlphaBlendValue := 200;
FSkinDataName := 'gauge';
end;
procedure TspSkinGauge.SetTextAlphaBlendValue;
begin
FTextAlphaBlendValue := Value;
if (FIndex <> -1) and FTextAlphaBlend and
(FShowProgressText or FShowPercent)
then
RePaint;
end;
procedure TspSkinGauge.SetTextAlphaBlend;
begin
FTextAlphaBlend := Value;
if (FIndex <> -1) and (FShowProgressText or FShowPercent)
then
RePaint;
end;
procedure TspSkinGauge.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;
Font.CharSet := FDefaultFont.Charset;
end;
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 TspSkinGauge.SetShowProgressText;
begin
FShowProgressText := Value;
RePaint;
end;
procedure TspSkinGauge.SetShowPercent;
begin
FShowPercent := Value;
RePaint;
end;
procedure TspSkinGauge.SetProgressText;
begin
FProgressText := Value;
RePaint;
end;
function TspSkinGauge.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 TspSkinGauge.CalcSize;
var
Offset: Integer;
begin
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;
end;
procedure TspSkinGauge.CreateControlSkinImage;
var
PR, PR1, PR2: TRect;
i, Cnt, Off: Integer;
w1, w2: Integer;
B1: TBitMap;
EB1, EB2: TspEffectBmp;
kf: Double;
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 FTextAlphaBlend and (FShowProgressText or FShowPercent)
then
begin
B1 := TBitMap.Create;
B1.Width := B.Width;
B1.Height := B.Height;
B1.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), B.Canvas,
Rect(0, 0, B.Width, B.Height));
DrawProgressText(B.Canvas);
EB1 := TspEffectBmp.CreateFromhWnd(B.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(B1.Handle);
kf := 1 - FTextAlphaBlendValue / 255;
EB1.Morph(EB2, kf);
EB1.Draw(B.Canvas.Handle, 0, 0);
EB1.Free;
EB2.Free;
B1.Free;
end
else
DrawProgressText(B.Canvas);
end;
procedure TspSkinGauge.CreateImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TspSkinGauge.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 := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(PR);
end;
DrawProgressText(B.Canvas);
end;
procedure TspSkinGauge.SetVertical;
begin
FVertical:= AValue;
RePaint;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FVertical
then FSkinDataName := 'vgauge'
else FSkinDataName := 'gauge';
end;
end;
procedure TspSkinGauge.SetMinValue;
begin
FMinValue := AValue;
if FValue < FMinValue then FValue := FMinValue;
RePaint;
end;
procedure TspSkinGauge.SetMaxValue;
begin
FMaxValue := AValue;
if FValue > FMaxValue then FValue := FMaxValue;
RePaint;
end;
procedure TspSkinGauge.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 TspSkinGauge.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinGaugeControl
then
with TspDataSkinGaugeControl(FSD.CtrlList.Items[FIndex]) do
begin
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 TspSkinTrackBar.Create;
begin
inherited;
FCanFocused := False;
TabStop := False;
FMinValue := 0;
FMaxValue := 100;
FValue := 50;
FVertical := False;
Width := 100;
Height := 20;
FMouseSupport := True;
FDown := False;
FSkinDataName := 'htrackbar';
end;
procedure TspSkinTrackBar.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 TspSkinTrackBar.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 TspSkinTrackBar.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 TspSkinTrackBar.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TspSkinTrackBar.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TspSkinTrackBar.WMSETFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TspSkinTrackBar.WMKILLFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TspSkinTrackBar.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 TspSkinTrackBar.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 TspSkinTrackBar.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 TspSkinTrackBar.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 TspSkinTrackBar.CreateControlSkinImage;
var
B1, B2: TBitMap;
EB1, EB2: TspEffectBmp;
kf: Double;
begin
inherited;
BR := CalcButtonRect(NewTrackArea, FVertical);
if FAlphaBlend
then
begin
//
B1 := TBitMap.Create;
B1.Width := RectWidth(BR);
B1.Height := RectHeight(BR);
with B1.Canvas do
if FDown or IsFocused
then
CopyRect(Rect(0, 0, B1.Width, B1.Height),
Picture.Canvas, ActiveButtonRect)
else
CopyRect(Rect(0, 0, B1.Width, B1.Height),
Picture.Canvas, ButtonRect);
//
B2 := TBitMap.Create;
B2.Width := RectWidth(BR);
B2.Height := RectHeight(BR);
B2.Canvas.CopyRect(Rect(0, 0, B2.Width, B2.Height), B.Canvas, BR);
//
EB1 := TspEffectBmp.CreateFromhWnd(B1.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(B2.Handle);
kf := 1 - FAlphaBlendValue / 255;
EB1.Morph(EB2, Kf);
EB1.Draw(B1.Canvas.Handle, 0, 0);
B.Canvas.Draw(BR.Left, BR.Top, B1);
//
EB1.Free;
EB2.Free;
B1.Free;
B2.Free;
end
else
with B.Canvas do
begin
if FDown or IsFocused
then
CopyRect(BR, Picture.Canvas, ActiveButtonRect)
else
CopyRect(BR, Picture.Canvas, ButtonRect);
end;
end;
procedure TspSkinTrackBar.CreateImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TspSkinTrackBar.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 TspSkinTrackBar.MouseUp;
begin
inherited;
if FMouseSupport and FDown
then
begin
FDown := False;
RePaint;
end;
end;
procedure TspSkinTrackBar.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 TspSkinTrackBar.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, FVertical);
Frame3D(B.Canvas, LR, clbtnShadow, clBtnHighLight, 1);
with B.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBtnFace;
FillRect(BR);
end;
BR1 := BR;
with B.Canvas do
begin
Brush.Style := bsSolid;
if FDown
then
begin
Frame3D(B.Canvas, BR1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(BR1);
end
else
if IsFocused
then
begin
Frame3D(B.Canvas, BR1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNACTIVECOLOR;
FillRect(BR1);
end
else
begin
Frame3D(B.Canvas, BR1, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(BR1);
end;
end;
end;
procedure TspSkinTrackBar.SetVertical;
begin
FVertical:= AValue;
RePaint;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FVertical
then FSkinDataName := 'trackbar'
else FSkinDataName := 'htrackbar';
end;
end;
procedure TspSkinTrackBar.SetMinValue;
begin
FMinValue := AValue;
if FValue < FMinValue then FValue := FMinValue;
RePaint;
end;
procedure TspSkinTrackBar.SetMaxValue;
begin
FMaxValue := AValue;
if FValue > FMaxValue then FValue := FMaxValue;
RePaint;
end;
procedure TspSkinTrackBar.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 TspSkinTrackBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinTrackBarControl
then
with TspDataSkinTrackBarControl(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 TspSkinStdLabel.Create;
begin
inherited;
Transparent := True;
FSD := nil;
FSkinDataName := 'stdlabel';
FDefaultFont := TFont.Create;
FUseSkinFont := True;
end;
destructor TspSkinStdLabel.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinStdLabel.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 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 TspSkinStdLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TspSkinStdLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinStdLabel.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;
end
end;
procedure TspSkinStdLabel.ChangeSkinData;
begin
GetSkinData;
RePaint;
end;
procedure TspSkinStdLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
constructor TspSkinBitLabel.Create;
begin
inherited;
Symbols := nil;
Width := 100;
Height := 20;
FSkinDataName := 'bitlabel';
end;
function TspSkinBitLabel.GetFixWidth;
var
LO, RO: Integer;
begin
LO := ClRect.Left;
RO := RectWidth(SkinRect) - ClRect.Right;
Result := SymbolWidth * FFixLength + LO + RO;
end;
procedure TspSkinBitLabel.SetFixLength;
begin
FFixLength := Value;
if FFixLength > 0
then
begin
FAutoSize := False;
if FIndex <> -1
then
Width := GetFixWidth;
end;
end;
procedure TspSkinBitLabel.CMTextChanged(var Message: TMessage);
begin
if FAutoSize then AdjustBounds;
RePaint;
end;
procedure TspSkinBitLabel.AdjustBounds;
var
Offset: Integer;
begin
if Align <> alNone then Exit;
if FIndex = -1
then Offset := 0
else Offset := Length(Caption) * SymbolWidth - RectWidth(NewClRect);
if Offset <> 0 then Width := Width + Offset;
end;
procedure TspSkinBitLabel.CalcSize;
var
Offset: Integer;
begin
inherited;
if FFixLength > 0
then
begin
if FIndex <> -1
then
W := GetFixWidth;
end
else
begin
if FIndex = -1
then Offset := 0
else Offset := Length(Caption) * SymbolWidth - RectWidth(NewClRect);
if (Offset > 0) or FAutoSize then W := W + Offset;
end;
end;
procedure TspSkinBitLabel.CreateControlDefaultImage;
begin
inherited;
with B.Canvas do
begin
Brush.Style := bsClear;
TextRect(Rect(1, 1, Width - 1, Height - 1), 2,
Height div 2 - TextHeight(Caption) div 2,
Caption);
end;
end;
procedure TspSkinBitLabel.PaintLabel;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TspSkinBitLabel.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinBitLabelControl
then
begin
with TspDataSkinBitLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.SkinTextRect := SkinTextRect;
Self.SymbolWidth := SymbolWidth;
Self.SymbolHeight := SymbolHeight;
Self.Symbols := Symbols;
end;
end;
end;
procedure TspSkinBitLabel.CreateControlSkinImage;
var
SymbolX, SymbolY: Integer;
i: Integer;
XO: Integer;
LO, RO: Integer;
procedure GetSymbolPos(Ch: Char);
var
i, j: Integer;
begin
SymbolX := -1;
SymbolY := -1;
for i := 0 to Symbols.Count - 1 do
begin
j := Pos(Ch, Symbols[i]);
if j <> 0
then
begin
SymbolX := j - 1;
SymbolY := i;
Exit;
end;
end;
end;
begin
inherited;
LO := ClRect.Left;
RO := RectWidth(SkinRect) - ClRect.Right;
with B.Canvas do
begin
for i := 1 to Length(Caption) do
begin
if (i * SymbolWidth) > B.Width
then XO := i * SymbolWidth - B.Width - LO - RO
else XO := 0;
GetSymbolPos(Caption[i]);
if SymbolX <> -1
then
begin
CopyRect(
Rect(LO + (i - 1) * SymbolWidth, NewClRect.Top, LO + i * SymbolWidth - XO, NewClRect.Top + SymbolHeight),
Picture.Canvas,
Rect(SkinTextRect.Left + SymbolX * SymbolWidth,
SkinTextRect.Top + SymbolY * SymbolHeight,
SkinTextRect.Left + (SymbolX + 1) * SymbolWidth - XO,
SkinTextRect.Top + (SymbolY + 1) * SymbolHeight));
if XO > 0 then Break;
end;
end;
end;
end;
procedure TspSkinBitLabel.SetAutoSizeX;
begin
FAutoSize := Value;
AdjustBounds;
RePaint;
end;
constructor TspSkinLabel.Create;
begin
inherited;
Width := 75;
Height := 21;
FAutoSize := False;
FSkinDataName := 'label';
end;
procedure TspSkinLabel.SetBorderStyle;
begin
FBorderStyle := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end;
end;
procedure TspSkinLabel.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinLabelControl
then
with TspDataSkinLabelControl(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 TspSkinLabel.DrawLabelText;
var
TX, TY: Integer;
begin
with Cnvs do
begin
if FIndex <> -1
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.Color := FontColor;
end
else
Font.Assign(DefaultFont);
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;
TextOut(TX, TY, Caption);
end;
end;
procedure TspSkinLabel.CreateControlDefaultImage;
var
R: TRect;
begin
inherited;
R := ClientRect;
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;
DrawLabelText(B.Canvas, Rect(2, 2, Width - 2, Height - 2));
end;
procedure TspSkinLabel.CreateControlSkinImage;
begin
inherited;
DrawLabelText(B.Canvas, NewClRect);
end;
procedure TspSkinLabel.PaintLabel;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TspSkinLabel.CalcSize;
var
Offset: Integer;
begin
inherited;
Offset := CalcWidthOffset;
if (Offset > 0) or FAutoSize then W := W + Offset;
end;
function TspSkinLabel.CalcWidthOffset;
begin
with Canvas do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Style := FontStyle;
if ResizeMode = 0
then
Result := 0
else
Result := TextWidth(Caption) - RectWidth(NewClRect);
end;
end;
procedure TspSkinLabel.AdjustBounds;
var
Offset: Integer;
tw: Integer;
begin
if Align <> alNone then Exit;
if FIndex = -1
then
begin
tw := Canvas.TextWidth(Caption);
Offset := tw - (Width - 4);
end
else
Offset := CalcWidthOffset;
if Offset <> 0 then Width := Width + Offset;
end;
procedure TspSkinLabel.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
RePaint;
end;
end;
procedure TspSkinLabel.SetAutoSizeX(Value: Boolean);
begin
FAutoSize := Value;
if FAutoSize then AdjustBounds;
end;
procedure TspSkinLabel.CMTextChanged(var Message: TMessage);
begin
if FAutoSize then AdjustBounds;
RePaint;
end;
//============ TspSkinScrollBar ===============
const
SBUTTONW = 16;
BUTCOUNT = 3;
THUMB = 0;
UPBUTTON = 1;
DOWNBUTTON = 2;
constructor TspSkinScrollBar.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 := 20;
FBothMarkerWidth := 0;
FBothMarkerWidth := 0;
FNormalSkinDataName := '';
FBothSkinDataName := 'bothhscrollbar';
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.CMEnabledChanged;
begin
inherited;
RePaint;
end;
procedure TspSkinScrollBar.SetBothMarkerWidth;
begin
if Value >= 0
then
begin
FBothMarkerWidth := Value;
if FIndex = -1 then RePaint;
end;
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.WMMOUSEWHEEL;
begin
if IsFocused
then
if Message.WParam > 0
then
Position := FPosition - FSmallChange
else
Position := FPosition + FSmallChange;
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TspSkinScrollBar.SetCanFocused;
begin
FCanFocused := Value;
if FCanFocused then TabStop := True else TabStop := False;
end;
procedure TspSkinScrollBar.WMSETFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TspSkinScrollBar.WMKILLFOCUS;
begin
inherited;
if FCanFocused then RePaint;
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinScrollBarControl
then
with TspDataSkinScrollBarControl(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 TspSkinScrollBar.CalcSize;
begin
inherited;
CalcRects;
end;
procedure TspSkinScrollBar.SetPageSize;
begin
if AValue + FPosition <= FMax - FMin + 1
then
FPageSize := AValue;
RePaint;
end;
procedure TspSkinScrollBar.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.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 TspSkinScrollBar.DrawButton;
var
R1, R2: TRect;
C: TColor;
ThumbB: TBitMap;
B1: TBitMap;
EB1, EB2: TspEffectBmp;
kf: Double;
begin
if FIndex = -1
then
with Buttons[i] do
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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_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
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;
//
if FAlphaBlend
then
begin
B1 := TBitMap.Create;
B1.Width := ThumbB.Width;
B1.Height := ThumbB.Height;
B1.Canvas.CopyRect(Rect(0, 0, B1.Width - 1, B1.Height),
Cnvs, R);
EB1 := TspEffectBmp.CreateFromhWnd(ThumbB.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(B1.Handle);
kf := 1 - FAlphaBlendValue / 255;
EB1.Morph(EB2, Kf);
EB1.Draw(ThumbB.Canvas.Handle, 0, 0);
EB1.Free;
EB2.Free;
B1.Free;
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 TspSkinScrollBar.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 := 1;
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 = 0
then
kf := 0
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 TspSkinScrollBar.SetKind;
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 FSkinDataName := 'vscrollbar'
else FSkinDataName := 'hscrollbar';
end;
end;
procedure TspSkinScrollBar.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 TspSkinScrollBar.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 TspSkinScrollBar.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