?? bsskinmenus.pas
字號:
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;
function TbsSkinPopupWindow.GetActive;
var
i: Integer;
begin
i := -1;
if ItemList.Count = 0
then
Result := False
else
repeat
Inc(i);
with TbsSkinMenuItem(ItemList.Items[i]) do
Result := FVisible and PtInRect(ObjectRect, Point(X, Y));
until Result or (i = ItemList.Count - 1);
end;
procedure TbsSkinPopupWindow.TestActive;
var
i: Integer;
B: Boolean;
R1, R2: TRect;
begin
if Scroll
then
begin
R1 := Rect(NewItemsRect.Left, NewItemsRect.Top,
NewItemsRect.Right, NewItemsRect.Top + MarkerItemHeight);
R2 := Rect(NewItemsRect.Left, NewItemsRect.Bottom - MarkerItemHeight,
NewItemsRect.Right, NewItemsRect.Bottom);
if PtInRect(R1, Point(X, Y)) and (ScrollCode = 0) and CanScroll(1)
then
begin
ScrollCode := 1;
DrawUpMarker(Canvas);
StartScroll;
end
else
if PtInRect(R2, Point(X, Y)) and (ScrollCode = 0) and CanScroll(2)
then
begin
ScrollCode := 2;
DrawDownMarker(Canvas);
StartScroll;
end
else
if (ScrollCode <> 0) and not PtInRect(R1, Point(X, Y)) and
not PtInRect(R2, Point(X, Y))
then
StopScroll;
end;
if (ItemList.Count = 0) then Exit;
OldActiveItem := ActiveItem;
i := -1;
repeat
Inc(i);
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
B := FVisible and PtInRect(ObjectRect, Point(X, Y));
end;
until B or (i = ItemList.Count - 1);
if B then ActiveItem := i;
if OldActiveItem >= ItemList.Count then OldActiveItem := -1;
if ActiveItem >= ItemList.Count then ActiveItem := -1;
if (OldActiveItem = ActiveItem) and (ActiveItem <> -1)
then
begin
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
if WaitCommand
then
begin
WaitCommand := False;
if MenuItem.Count <> 0
then
MouseEnter(False);
end;
end
else
if (OldActiveItem <> ActiveItem)
then
begin
if OldActiveItem <> - 1
then
with TbsSkinMenuItem(ItemList.Items[OldActiveItem]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
MouseLeave;
end;
if ActiveItem <> - 1
then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
MouseEnter(False);
end;
end;
end;
function TbsSkinPopupWindow.InWindow;
var
H: HWND;
begin
H := WindowFromPoint(P);
Result := H = Handle;
end;
//====================TbsSkinMenu===================//
constructor TbsSkinMenu.CreateEx;
begin
inherited Create(AOwner);
FOnMenuClose := nil;
MaxMenuItemsInWindow := 0;
FUseSkinFont := True;
AlphaBlendAnimation := False;
AlphaBlend := False;
AlphaBlendValue := 150;
FPopupList := TList.Create;
WaitTimer := TTimer.Create(Self);
WaitTimer.Enabled := False;
WaitTimer.OnTimer := WaitItem;
WaitTimer.Interval := WaitTimerInterval;
WItem := nil;
FVisible := False;
FForm := AForm;
PopupCtrl := nil;
DCtrl := nil;
FDefaultMenuItemHeight := 20;
FDefaultMenuItemFont := TFont.Create;
with FDefaultMenuItemFont do
begin
Name := '宋體';
Style := [];
Height := 14;
end;
end;
destructor TbsSkinMenu.Destroy;
begin
CloseMenu(0);
FPopupList.Free;
WaitTimer.Free;
FDefaultMenuItemFont.Free;
inherited Destroy;
end;
procedure TbsSkinMenu.SetDefaultMenuItemFont(Value: TFont);
begin
FDefaultMenuItemFont.Assign(Value);
end;
function TbsSkinMenu.GetWorkArea;
begin
Result := GetMonitorWorkArea(FForm.Handle, True);
end;
procedure TbsSkinMenu.WaitItem(Sender: TObject);
begin
if WItem <> nil then CheckItem(WItem.Parent, WItem, True, False);
WaitTimer.Enabled := False;
end;
function TbsSkinMenu.GetPWIndex;
var
i: Integer;
begin
for i := 0 to FPopupList.Count - 1 do
if PW = TbsSkinPopupWindow(FPopupList.Items[i]) then Break;
Result := i;
end;
procedure TbsSkinMenu.CheckItem;
var
Menu: TMenu;
MenuI: TMenuItem;
i: Integer;
R: TRect;
begin
if (MI.MenuItem.Count = 0) and not Down
then
begin
WaitTimer.Enabled := False;
WItem := nil;
i := GetPWIndex(PW);
if i < FPopupList.Count - 1 then CloseMenu(i + 1);
end
else
if (MI.MenuItem.Count = 0) and Down
then
begin
WaitTimer.Enabled := False;
WItem := nil;
MenuI := MI.MenuItem;
Hide;
//
Menu := MenuI.GetParentMenu;
Menu.DispatchCommand(MenuI.Command);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -