?? bsskinmenus.pas
字號:
Width - (sw - PW.ItemsRect.Right),
Height - (sh - PW.ItemsRect.Bottom));
end
else
NewItemsRect := Rect(2, 2, Width - 2, Height - 2);
CalcItemRects;
if MaskPicture <> nil then SetMenuWindowRegion;
end;
procedure TbsSkinPopupWindow.CreateMenu;
var
sw, sh: Integer;
i, j: Integer;
Menu: TMenu;
function CalcItemTextWidth(Item: TMenuItem): Integer;
var
R: TRect;
MICaption: String;
begin
if Item.ShortCut <> 0
then
MICaption := Item.Caption + ' ' + ShortCutToText(Item.ShortCut)
else
MICaption := Item.Caption;
R := Rect(0, 0, 0, 0);
DrawText(Canvas.Handle, PChar(MICaption), Length(MICaption), R,
DT_CALCRECT);
Result := R.Right + 2;
end;
function GetMenuWindowHeight: Integer;
var
i, j, k, ih: integer;
begin
j := 0;
k := 0;
for i := VisibleStartIndex to VisibleCount - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if PW <> nil
then
begin
if MenuItem.Caption = '-'
then ih := RectHeight(DSMI.DividerRect)
else ih := RectHeight(DSMI.SkinRect);
end
else
begin
if MenuItem.Caption = '-'
then ih := 4
else ih := ParentMenu.DefaultMenuItemHeight;
end;
inc(j, ih);
inc(k);
end;
if (ParentMenu.MaxMenuItemsInWindow <> 0) and (ParentMenu.MaxMenuItemsInWindow < k)
then
begin
if PW <> nil
then
ih := RectHeight(DSMI.SkinRect)
else
ih := ParentMenu.DefaultMenuItemHeight;
j := ParentMenu.MaxMenuItemsInWindow * ih;
if PW <> nil
then
Result := j + PW.ItemsRect.Top + (WindowPicture.Height - PW.ItemsRect.Bottom)
else
Result := j + 4;
Result := Result + MarkerItemHeight * 2;
Self.Scroll := True;
Self.Scroll2 := True;
end
else
begin
if PW <> nil
then
Result := j + PW.ItemsRect.Top + (WindowPicture.Height - PW.ItemsRect.Bottom)
else
Result := j + 4;
end;
end;
function GetMenuWindowWidth: Integer;
var
i, iw: Integer;
begin
iw := 0;
for i := 0 to ItemList.Count - 1 do
begin
j := CalcItemTextWidth(TbsSkinMenuItem(ItemList.Items[i]).MenuItem);
if j > iw then iw := j;
end;
inc(iw, 19);
if ImgL <> nil
then
GlyphWidth := ImgL.Width + 5
else
GlyphWidth := 19;
Inc(iw, GlyphWidth);
if PW <> nil
then
begin
Inc(iw, DSMI.TextRct.Left);
Inc(iw, RectWidth(DSMI.SkinRect) - DSMI.TextRct.Right);
Result := iw + PW.ItemsRect.Left + (WindowPicture.Width - PW.ItemsRect.Right);
end
else
Result := iw + 10;
end;
procedure CalcSizes;
var
W, H: Integer;
begin
//
VisibleStartIndex := 0;
VisibleCount := ItemList.Count;
Scroll := False;
Scroll2 := False;
W := GetMenuWindowWidth;
H := GetMenuWindowHeight;
//
if H > RectHeight(ParentMenu.WorkArea)
then
begin
H := RectHeight(ParentMenu.WorkArea);
Scroll := True;
end;
//
Width := W;
Height := H;
end;
function GetMenuItemData: TbsDataSkinMenuItem;
var
i: Integer;
begin
Result := nil;
if (SD <> nil) and not SD.Empty
then
for i := 0 to SD.ObjectList.Count - 1 do
if TbsDataSkinObject(SD.ObjectList.Items[i]) is TbsDataSkinMenuItem
then
begin
Result := TbsDataSkinMenuItem(SD.ObjectList.Items[i]);
Break;
end;
end;
begin
DSMI := GetMenuItemData;
if (PW <> nil) and (DSMI <> nil) and ParentMenu.UseSkinFont
then
begin
with Canvas.Font do
begin
Height := DSMI.FontHeight;
Style := DSMI.FontStyle;
Name := DSMI.FontName;
end;
end
else
Canvas.Font.Assign(Self.ParentMenu.FDefaultMenuItemFont);
if (ParentMenu.SkinData <> nil) and
(ParentMenu.SkinData.ResourceStrData <> nil)
then
Canvas.Font.CharSet := ParentMenu.SkinData.ResourceStrData.Charset
else
Canvas.Font.CharSet := ParentMenu.FDefaultMenuItemFont.Charset;
Menu := Item.GetParentMenu;
if Menu <> nil
then
ImgL := Menu.Images
else
ImgL := nil;
j := Item.Count;
for i := StartIndex to j - 1 do
if TMenuItem(Item.Items[i]).Visible
then
begin
if TMenuItem(Item.Items[i]).Action <> nil
then
TMenuItem(Item.Items[i]).Action.Update;
ItemList.Add(TbsSkinMenuItem.Create(Self, TMenuItem(Item.Items[i]), DSMI));
end;
//
CalcSizes;
if PW <> nil
then
begin
sw := WindowPicture.Width;
sh := WindowPicture.Height;
NewLTPoint := PW.LTPoint;
NewRTPoint := Point(Width - (sw - PW.RTPoint.X), PW.RTPoint.Y);
NewLBPoint := Point(PW.LBPoint.X, Height - (sh - PW.LBPoint.Y));
NewRBPoint := Point(Width - (sw - PW.RBPoint.X),
Height - (sh - PW.RBPoint.Y));
NewItemsRect := Rect(PW.ItemsRect.Left, PW.ItemsRect.Top,
Width - (sw - PW.ItemsRect.Right),
Height - (sh - PW.ItemsRect.Bottom));
end
else
NewItemsRect := Rect(2, 2, Width - 2, Height - 2);
CalcItemRects;
if MaskPicture <> nil then SetMenuWindowRegion;
end;
function TbsSkinPopupWindow.GetEndStartVisibleIndex: Integer;
var
i, j, k, ih, H: Integer;
begin
j := NewItemsRect.Bottom - MarkerItemHeight;
H := MarkerItemHeight;
k := 0;
for i := ItemList.Count - 1 downto 0 do
begin
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if DSMI <> nil
then
begin
if MenuItem.Caption = '-'
then ih := RectHeight(DSMI.DividerRect)
else ih := RectHeight(DSMI.SkinRect);
end
else
begin
if MenuItem.Caption = '-'
then ih := 4
else ih := ParentMenu.DefaultMenuItemHeight;
end;
j := j - ih;
if j >= H
then
inc(k)
else
Break;
end;
end;
Result := ItemList.Count - k;
end;
procedure TbsSkinPopupWindow.CalcItemRects;
var
i, j, ih, H: Integer;
begin
j := NewItemsRect.Top;
H := NewItemsRect.Bottom;
if Scroll
then
begin
H := H - MarkerItemHeight;
j := j + MarkerItemHeight;
end;
VisibleCount := 0;
for i := VisibleStartIndex to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if DSMI <> nil
then
begin
if MenuItem.Caption = '-'
then ih := RectHeight(DSMI.DividerRect)
else ih := RectHeight(DSMI.SkinRect)
end
else
begin
if MenuItem.Caption = '-'
then ih := 4
else ih := ParentMenu.DefaultMenuItemHeight;
end;
ObjectRect.Left := NewItemsRect.Left;
ObjectRect.Right := NewItemsRect.Right;
ObjectRect.Top := j;
ObjectRect.Bottom := j + ih;
if ObjectRect.Bottom <= H
then
begin
FVisible := True;
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,
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -