📄 dynamicskinform.pas
字号:
else
if MouseDownChangeValue and (Button = mbLeft)
then
case TrackKind of
tkHorizontal:
begin
if X1 < BeginPoint.X then X1 := BeginPoint.X;
if X1 > EndPoint.X then X1 := EndPoint.X;
ButtonPos := Point(X1, BeginPoint.Y);
end;
tkVertical:
begin
if Y1 < EndPoint.Y then Y1 := EndPoint.Y;
if Y1 > BeginPoint.Y then Y1 := BeginPoint.Y;
ButtonPos := Point(BeginPoint.X, Y1);
end;
end;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinTrackBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
if MoveActive and (Button = mbLeft)
then
begin
MoveActive := False;
if not IsNullRect(ActiveButtonRect)
then
Parent.DrawSkinObject(Self);
end;
inherited MouseUp(X, Y, Button);
end;
procedure TspSkinTrackBarObject.MouseMove(X, Y: Integer);
var
X1, Y1: Integer;
TestPos: Integer;
begin
X1 := X - ObjectRect.Left;
Y1 := Y - ObjectRect.Top;
if MoveActive
then
case TrackKind of
tkHorizontal:
begin
TestPos := FButtonPos.X + X1 - FOldMPoint.X;
if (TestPos >= BeginPoint.X) and (TestPos <= EndPoint.X)
then
ButtonPos := Point(TestPos, FButtonPos.Y);
end;
tkVertical:
begin
TestPos := FButtonPos.Y + Y1 - FOldMPoint.Y;
if (TestPos >= EndPoint.Y) and (TestPos <= BeginPoint.Y)
then ButtonPos := Point(FButtonPos.X, TestPos);
end;
end;
FOldMPoint := Point(X1, Y1);
inherited MouseMove(X, Y);
end;
//============= TspSkinSwitchObject ==============//
constructor TspSkinSwitchObject.Create;
begin
inherited Create(AParent, AData);
FState := swsOff;
end;
procedure TspSkinSwitchObject.SetState;
begin
FState := Value;
if FState = swsOn then Active := True else Active := False;
ReDraw;
Parent.SwitchChangeStateEvent(IDName, FState);
end;
procedure TspSkinSwitchObject.SimpleSetState(Value: TSwitchState);
begin
FState := Value;
Active := FState = swsOn;
if Active then FMorphKf := 1;
end;
procedure TspSkinSwitchObject.MouseDown;
begin
if Button = mbLeft
then
if State = swsOff then State := swsOn else State := swsOff;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinSwitchObject.MouseEnter;
begin
FMouseIn := True;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinSwitchObject.MouseLeave;
begin
FMouseIn := False;
Parent.MouseLeaveEvent(IDName);
end;
//============= TspSkinButtonObject ============= //
constructor TspSkinButtonObject.Create;
begin
inherited Create(AParent, AData);
GroupIndex := -1;
if AData <> nil
then
with TspDataSkinButton(AData) do
begin
Self.DownRect := DownRect;
Self.DisableSkinRect := DisableSkinRect;
Self.GroupIndex := GroupIndex;
end;
MenuItem := nil;
FPopupUp := False;
end;
procedure TspSkinButtonObject.Draw;
begin
if not Enabled and not IsNullRect(DisableSkinRect)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DisableSkinRect)
else
if (FDown and not IsNullRect(DownRect)) and
((GroupIndex <> -1) or FMouseIn)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownRect)
else
inherited Draw(Cnvs, UpDate);
end;
procedure TspSkinButtonObject.SetDown;
procedure DoAllUp;
var
i, j: Integer;
begin
j := GroupIndex;
if j <> -1 then
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinButtonObject) and
(TspActiveSkinObject(Parent.ObjectList.Items[i]).IDName <> IDName)
then
with TspSkinButtonObject(Parent.ObjectList.Items[i]) do
if (j = GroupIndex) and FDown
then
begin
SetDown(False);
Break;
end;
end;
begin
FDown := Value;
if IsNullRect(DownRect) and not FDown then Exit;
if IsNullRect(DownRect) and FDown
then
begin
DoAllUp;
Exit;
end
else
if FDown
then
begin
if Morphing then MorphKf := 1;
Parent.DrawSkinObject(Self);
DoAllUp;
end
else
begin
if (GroupIndex <> -1) or (MenuItem <> nil) then Active := False;
if Morphing and not IsNullRect(DownRect)
then
Parent.DrawSkinObject(Self);
ReDraw;
end;
end;
procedure TspSkinButtonObject.TrackMenu;
var
R: TRect;
Menu: TMenu;
P: TPoint;
begin
if MenuItem = nil then Exit;
if MenuItem.Count = 0 then Exit;
R := ObjectRect;
if Parent.FForm.FormStyle = fsMDIChild
then
begin
if Parent.FSkinSupport
then
P := Point(-Parent.NewClRect.Left, -Parent.NewClRect.Top)
else
P := Point(- 3, -Parent.GetDefCaptionHeight - 3);
P := Parent.FForm.ClientToScreen(P);
OffsetRect(R, P.X, P.Y);
end
else
OffsetRect(R, Parent.FForm.Left, Parent.FForm.Top);
Menu := MenuItem.GetParentMenu;
if Menu is TspSkinPopupMenu
then
TspSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
else
begin
Parent.SkinMenuOpen;
if Menu is TspSkinMainMenu
then
Parent.SkinMenu.Popup(nil, TspSkinMainMenu(Menu).SkinData, 0, R, MenuItem, FPopupUp)
else
if Parent.MenusSkinData = nil
then
Parent.SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, FPopupUp)
else
Parent.SkinMenu.Popup(nil, Parent.MenusSkinData, 0, R, MenuItem, FPopupUp);
end;
end;
procedure TspSkinButtonObject.MouseDown;
begin
if not Enabled then Exit;
if (Button = mbLeft) and not FDown
then
begin
SetDown(True);
TrackMenu;
end;
inherited MouseDown(X, Y, Button);
end;
procedure TspSkinButtonObject.MouseUp;
begin
if not Enabled then Exit;
if (Button <> mbLeft)
then
begin
inherited MouseUp(X, Y, Button);
Exit;
end;
if (MenuItem = nil) and FDown and (GroupIndex = -1)
then
SetDown(False);
inherited MouseUp(X, Y, Button);
end;
procedure TspSkinButtonObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
if IsNullRect(DownRect) or not FDown
then
begin
if not IsNullRect(ActiveSkinRect) then ReDraw;
end
else
if not (FDown and (GroupIndex <> -1))
then
begin
if FDown
then
Parent.DrawSkinObject(Self)
else
if not IsNullRect(ActiveSkinRect) and (GroupIndex = -1) then ReDraw;
end;
Parent.MouseEnterEvent(IDName);
end;
procedure TspSkinButtonObject.MouseLeave;
begin
FMouseIn := False;
if not (FDown and not IsNullRect(DownRect) and
((MenuItem <> nil) or (GroupIndex <> -1)))
then
begin
Active := False;
if Morphing and FDown then Morphkf := 1;
if (not IsNullRect(ActiveSkinRect)) or
(not IsNullRect(DownRect) and (GroupIndex = -1)) then Redraw;
end;
Parent.MouseLeaveEvent(IDName);
end;
//============= TspSkinStdButtonObject =================//
constructor TspSkinStdButtonObject.Create;
begin
inherited Create(AParent, AData);
if AData <> nil
then
with TspDataSkinStdButton(AData) do
begin
Self.Command := Command;
Self.RestoreRect := RestoreRect;
Self.RestoreActiveRect := RestoreActiveRect;
Self.RestoreDownRect := RestoreDownRect;
FSkinSupport := True;
end
else
FSkinSupport := False;
end;
procedure TspSkinStdButtonObject.DefaultDraw(Cnvs: TCanvas);
var
Buffer: TBitMap;
R: TRect;
IX, IY: Integer;
IC: TColor;
begin
if (Command = cmSysMenu) and Parent.FShowIcon
then
begin
Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
Exit;
end;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(ObjectRect);
Buffer.Height := RectHeight(ObjectRect);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
if FDown and FMouseIn
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FMouseIn
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNACTIVECOLOR;
FillRect(R);
end
else
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
IX := Buffer.Width div 2 - 5;
IY := Buffer.Height div 2 - 4;
if FDown and FMouseIn
then
begin
Inc(IX);
Inc(IY);
end;
if Enabled
then
IC := clBtnText
else
IC := clBtnShadow;
case Command of
cmClose:
DrawCloseImage(Buffer.Canvas, IX, IY, IC);
cmMaximize:
if Parent.WindowState = wsMaximized
then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
else DrawMaximizeImage(Buffer.Canvas, IX, IY, IC);
cmMinimize:
if Parent.WindowState = wsMinimized
then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
else DrawMinimizeImage(Buffer.Canvas, IX, IY, IC);
cmRollUp:
if Parent.RollUpState
then
DrawRestoreRollUpImage(Buffer.Canvas, IX, IY, IC)
else
DrawRollUpImage(Buffer.Canvas, IX, IY, IC);
cmSysMenu:
DrawSysMenuImage(Buffer.Canvas, IX, IY, IC);
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
function TspSkinStdButtonObject.CanMorphing: Boolean;
begin
if (Command = cmSysMenu) and Parent.ShowIcon and
(SkinRectInAPicture)
then
Result := False
else
Result := inherited CanMorphing;
end;
proc
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -