📄 bsskinmenus.pas
字号:
Inc(VisibleCount)
end
else
Break;
inc(j, ih);
end;
if Scroll
then
begin
if VisibleStartIndex > 0
then
for i := 0 to VisibleStartIndex - 1 do
TbsSkinMenuItem(ItemList.Items[i]).FVisible := False;
if VisibleCount + VisibleStartIndex <= ItemList.Count - 1
then
for i := VisibleCount + VisibleStartIndex to ItemList.Count - 1 do
TbsSkinMenuItem(ItemList.Items[i]).FVisible := False;
end;
end;
procedure TbsSkinPopupWindow.CMMouseEnter;
begin
inherited;
end;
procedure TbsSkinPopupWindow.CMMouseLeave;
begin
inherited;
end;
procedure TbsSkinPopupWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
if CheckWXP then
WindowClass.Style := WindowClass.style or CS_DROPSHADOW_ ;
end;
end;
procedure TbsSkinPopupWindow.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TbsSkinPopupWindow.Hide;
begin
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
MorphTimer.Enabled := False;
MouseTimer.Enabled := False;
Visible := False;
end;
procedure TbsSkinPopupWindow.Show;
procedure CalcMenuPos(var X, Y: Integer; R: TRect);
var
WA: TRect;
ChangeY: Boolean;
function GetY: Integer;
var
Offset: Integer;
begin
if Scroll and not Scroll2
then
Result := WA.Top
else
begin
if PopupByItem
then
begin
Offset := R.Top + Height - NewItemsRect.Top - WA.Bottom;
if Offset > 0
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
Result := WA.Bottom - Height
else
begin
Result := R.Bottom - Height + NewItemsRect.Top;
if Result < WA.Top then Result := WA.Top;
end
end
else
Result := R.Top - NewItemsRect.Top;
end
else
begin
if PopupUp
then
begin
if R.Top - Height < WA.Top
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
begin
Result := R.Bottom;
Offset := Result + Height - WA.Bottom;
if Offset > 0
then
begin
Result := Result - Offset;
ChangeY := True;
end;
end
else
begin
Result := WA.Top;
ChangeY := True;
end;
end
else
Result := R.Top - Height;
end
else
begin
Offset := R.Bottom + Height - WA.Bottom;
if Offset > 0
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
begin
Result := R.Bottom - Offset;
ChangeY := True
end
else
begin
if R.Top - Height < WA.Top
then
begin
Result := WA.Top;
ChangeY := True;
end
else
Result := R.Top - Height;
end
end
else
Result := R.Bottom;
end;
end;
end;
end;
function GetX: Integer;
begin
if PopupByItem or (Scroll and not Scroll2) or ChangeY
then
begin
if R.Right + Width + 1 > WA.Right
then Result := R.Left - Width - 1 else Result := R.Right + 1;
end
else
begin
if R.Left + Width > WA.Right
then Result := WA.Right - Width else
if R.Left < WA.Left then Result := WA.Left else Result := R.Left;
end;
end;
begin
WA := ParentMenu.WorkArea;
ChangeY := False;
Y := GetY;
X := GetX;
end;
const
WS_EX_LAYERED = $80000;
AnimationStep = 3;
var
i: Integer;
ABV: Integer;
begin
if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
ParentMenu.First
then
Application.ProcessMessages;
CreateMenu(AItem, StartIndex);
CalcMenuPos(ShowX, ShowY, R);
//
if CheckW2KWXP and ParentMenu.AlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
if ParentMenu.First and ParentMenu.AlphaBlendAnimation
then SetAlphaBlendTransparent(Handle, 0)
else SetAlphaBlendTransparent(Handle, ParentMenu.AlphaBlendValue);
end;
//
SetWindowPos(Handle, HWND_TOPMOST, ShowX, ShowY, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
ParentMenu.First
then
begin
i := 0;
ABV := ParentMenu.AlphaBlendValue;
repeat
Inc(i, AnimationStep);
if i > ABV then i := ABV;
SetAlphaBlendTransparent(Handle, i);
until i >= ABV;
end;
//
MouseTimer.Enabled := True;
ActiveItem := -1;
if ItemList.Count > 0
then
for i := 0 to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if (MenuItem.Enabled) and (MenuItem.Caption <> '-')
then
begin
WaitCommand := True;
ActiveItem := i;
MouseEnter(True);
Break;
end;
end;
end;
procedure TbsSkinPopupWindow.Show2;
procedure CalcMenuPos(var X, Y: Integer; R: TRect);
var
WA: TRect;
ChangeY: Boolean;
function GetY: Integer;
var
Offset: Integer;
begin
if Scroll and not Scroll2
then
Result := WA.Top
else
begin
if PopupByItem
then
begin
Offset := R.Top + Height - NewItemsRect.Top - WA.Bottom;
if Offset > 0
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
Result := WA.Bottom - Height
else
begin
Result := R.Bottom - Height + NewItemsRect.Top;
if Result < WA.Top then Result := WA.Top;
end
end
else
Result := R.Top - NewItemsRect.Top;
end
else
begin
if PopupUp
then
begin
if R.Top - Height < WA.Top
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
begin
Result := R.Bottom;
Offset := Result + Height - WA.Bottom;
if Offset > 0
then
begin
Result := Result - Offset;
ChangeY := True;
end;
end
else
begin
Result := WA.Top;
ChangeY := True;
end;
end
else
Result := R.Top - Height;
end
else
begin
Offset := R.Bottom + Height - WA.Bottom;
if Offset > 0
then
begin
if R.Top < WA.Top + RectHeight(WA) div 2
then
begin
Result := R.Bottom - Offset;
ChangeY := True
end
else
begin
if R.Top - Height < WA.Top
then
begin
Result := WA.Top;
ChangeY := True;
end
else
Result := R.Top - Height;
end
end
else
Result := R.Bottom;
end;
end;
end;
end;
function GetX: Integer;
begin
if PopupByItem or (Scroll and not Scroll2) or ChangeY
then
begin
if R.Right + Width + 1 > WA.Right
then Result := R.Left - Width - 1 else Result := R.Right + 1;
end
else
begin
if R.Left + Width > WA.Right
then Result := WA.Right - Width else
if R.Left < WA.Left then Result := WA.Left else Result := R.Left;
end;
end;
begin
WA := ParentMenu.WorkArea;
ChangeY := False;
Y := GetY;
X := GetX;
end;
const
WS_EX_LAYERED = $80000;
AnimationStep = 3;
var
i: Integer;
ABV: Integer;
begin
if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
ParentMenu.First
then
Application.ProcessMessages;
CreateMenu2(AItem, AItem2, StartIndex);
CalcMenuPos(ShowX, ShowY, R);
//
if CheckW2KWXP and ParentMenu.AlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
if ParentMenu.First and ParentMenu.AlphaBlendAnimation
then SetAlphaBlendTransparent(Handle, 0)
else SetAlphaBlendTransparent(Handle, ParentMenu.AlphaBlendValue);
end;
//
SetWindowPos(Handle, HWND_TOPMOST, ShowX, ShowY, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
ParentMenu.First
then
begin
i := 0;
ABV := ParentMenu.AlphaBlendValue;
repeat
Inc(i, AnimationStep);
if i > ABV then i := ABV;
SetAlphaBlendTransparent(Handle, i);
until i >= ABV;
end;
//
MouseTimer.Enabled := True;
ActiveItem := -1;
if ItemList.Count > 0
then
for i := 0 to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
begin
WaitCommand := True;
ActiveItem := i;
MouseEnter(True);
Break;
end;
end;
end;
procedure TbsSkinPopupWindow.PaintMenu;
var
C: TCanvas;
i: Integer;
B: TBitMap;
begin
C := TCanvas.Create;
C.Handle := DC;
B := TBitMap.Create;
CreateRealImage(B);
// Draw items
for i := VisibleStartIndex to VisibleStartIndex + VisibleCount - 1 do
TbsSkinMenuItem(ItemList.Items[i]).Draw(B.Canvas);
// markers
if Scroll
then
begin
DrawUpMarker(B.Canvas);
DrawDownMarker(B.Canvas);
end;
C.Draw(0, 0, B);
B.Free;
C.Free;
end;
procedure TbsSkinPopupWindow.WMEraseBkgrnd;
begin
PaintMenu(Message.WParam);
end;
procedure TbsSkinPopupWindow.MouseUp;
begin
TestActive(X, Y);
if (ActiveItem <> -1) and (Button = mbleft) and GetActive(X, Y)
then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
if MenuItem.Caption <> '-' then MouseDown(X, Y);
end;
procedure TbsSkinPopupWindow.TestMouse;
var
P, P1: TPoint;
begin
GetCursorPos(P1);
P := ScreenToClient(P1);
if (OMX <> P.X) or (OMY <> P.Y)
then
if InWindow(P1)
then
TestActive(P.X, P.Y)
else
if Scroll
then
begin
ScrollCode := 0;
DrawUpMarker(Canvas);
DrawDownMarker(Canvas);
end;
OMX := P.X;
OMY := P.Y;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -