📄 skinmenus.pas
字号:
procedure TspSkinPopupWindow.WMTimer;
begin
inherited;
case ScrollCode of
1: if CanScroll(1) then ScrollUp(False) else StopScroll;
2: if CanScroll(2) then ScrollDown(False) else StopScroll;
end;
end;
procedure TspSkinPopupWindow.DrawUpMarker;
var
R: TRect;
C: TColor;
begin
if PW <> nil
then
begin
R := Rect(NewItemsRect.Left, NewItemsRect.Top,
NewItemsRect.Right, NewItemsRect.Top + MarkerItemHeight);
if ScrollCode = 1
then C := PW.ScrollMarkerActiveColor
else C := PW.ScrollMarkerColor;
end
else
begin
R := Rect(3, 3, Width - 3, 3 + MarkerItemHeight);
if ScrollCode = 1
then C := clBtnText
else C := clBtnShadow;
end;
DrawArrowImage(Cnvs, R, C, 3);
end;
procedure TspSkinPopupWindow.DrawDownMarker;
var
R: TRect;
C: TColor;
begin
if PW <> nil
then
begin
R := Rect(NewItemsRect.Left, NewItemsRect.Bottom - MarkerItemHeight,
NewItemsRect.Right, NewItemsRect.Bottom);
if ScrollCode = 2
then C := PW.ScrollMarkerActiveColor
else C := PW.ScrollMarkerColor;
end
else
begin
R := Rect(3, Height - MarkerItemHeight, Width - 3, Height - 3);
if ScrollCode = 2
then C := clBtnText
else C := clBtnShadow;
end;
DrawArrowImage(Cnvs, R, C, 4);
end;
procedure TspSkinPopupWindow.StartScroll;
var
i: Integer;
begin
i := ParentMenu.GetPWIndex(Self);
WT.Enabled := False;
ParentMenu.CloseMenu(i + 1);
KillTimer(Handle, 1);
SetTimer(Handle, 1, ScrollTimerInterval, nil);
end;
procedure TspSkinPopupWindow.StopScroll;
begin
ScrollCode := 0;
DrawUpMarker(Canvas);
DrawDownMarker(Canvas);
KillTimer(Handle, 1);
end;
procedure TspSkinPopupWindow.ScrollUp;
begin
if VisibleStartIndex > 0
then
begin
VisibleStartIndex := VisibleStartIndex - 1;
CalcItemRects;
RePaint;
end
else
if Cycle
then
begin
VisibleStartIndex := GetEndStartVisibleIndex;
CalcItemRects;
RePaint;
end;
end;
procedure TspSkinPopupWindow.ScrollDown(Cycle: Boolean);
begin
if VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1
then
begin
VisibleStartIndex := VisibleStartIndex + 1;
CalcItemRects;
RePaint;
end
else
if Cycle
then
begin
VisibleStartIndex := 0;
CalcItemRects;
RePaint;
end;
end;
procedure TspSkinPopupWindow.PopupKeyDown(CharCode: Integer);
var
PW: TspSkinPopupWindow;
procedure NextItem;
var
i, j: Integer;
begin
if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex + VisibleCount - 1)
then ScrollDown(True);
OldActiveItem := ActiveItem;
if ActiveItem < 0 then j := 0 else j := ActiveItem + 1;
if j = ItemList.Count then j := 0;
for i := j to ItemList.Count - 1 do
with TspSkinMenuItem(ItemList.Items[i]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
begin
ActiveItem := i;
Break;
end
else
begin
if Scroll and (ScrollCode = 0) and (i = VisibleStartIndex + VisibleCount - 1)
then ScrollDown(True);
end;
end;
if OldActiveItem <> ActiveItem
then
begin
if ActiveItem > -1 then
with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseEnter(True);
end;
if OldActiveItem > -1 then
with TspSkinMenuItem(ItemList.Items[OldActiveItem]) do
begin
MouseLeave;
end;
end;
end;
procedure PriorItem;
var
i, j: Integer;
begin
if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex)
then ScrollUp(True);
OldActiveItem := ActiveItem;
if ActiveItem < 0 then j := ItemList.Count - 1 else j := ActiveItem - 1;
if (j = -1) then j := ItemList.Count - 1;
for i := j downto 0 do
with TspSkinMenuItem(ItemList.Items[i]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
begin
ActiveItem := i;
Break;
end
else
begin
if Scroll and (ScrollCode = 0) and (i = VisibleStartIndex)
then ScrollUp(True);
end;
end;
if OldActiveItem <> ActiveItem
then
begin
if ActiveItem > -1 then
with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseEnter(True);
end;
if OldActiveItem > -1 then
with TspSkinMenuItem(ItemList.Items[OldActiveItem]) do
begin
MouseLeave;
end;
end;
end;
function FindHotKeyItem: Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to ItemList.Count - 1 do
with TspSkinMenuItem(ItemList.Items[i]) do
begin
if Enabled and IsAccel(CharCode, MenuItem.Caption)
then
begin
MouseEnter(False);
OldActiveItem := ActiveItem;
ActiveItem := i;
if OldActiveItem <> -1
then
TspSkinMenuItem(ItemList.Items[OldActiveItem]).MouseLeave;
MouseDown(0, 0);
Result := True;
Break;
end;
end
end;
begin
if not Visible then Exit;
if not FindHotKeyItem
then
case CharCode of
VK_DOWN:
NextItem;
VK_UP:
PriorItem;
VK_RIGHT:
begin
if ActiveItem <> -1
then
with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
if MenuItem.Count <> 0 then MouseDown(0, 0);
end;
end;
VK_RETURN:
begin
if ActiveItem <> -1
then
with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseDown(0, 0);
end;
end;
VK_LEFT:
begin
if ParentMenu.FPopupList.Count > 1
then
begin
ParentMenu.CloseMenu(ParentMenu.FPopupList.Count - 1);
PW := TspSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
if PW.ActiveItem <> -1
then
TspSkinMenuItem(PW.ItemList.Items[PW.ActiveItem]).Down := False;
end
end;
VK_ESCAPE:
begin
ParentMenu.CloseMenu(ParentMenu.FPopupList.Count - 1);
if ParentMenu.FPopupList.Count > 0
then
begin
PW := TspSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
if PW.ActiveItem <> -1
then
TspSkinMenuItem(PW.ItemList.Items[PW.ActiveItem]).Down := False;
end;
end;
end;
end;
procedure TspSkinPopupWindow.WTProc;
begin
Sc.Width := Width + 1;
Sc.Height := Height + 1;
GetScreenImage(ShowX, ShowY, Sc);
ESc := TspEffectBMP.CreateFromhWnd(Sc.Handle);
//
if (PW <> nil) and (PW.CursorIndex <> -1)
then
Cursor := SD.StartCursorIndex + PW.CursorIndex;
//
SetWindowPos(Handle, HWND_TOPMOST, ShowX, ShowY, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
MouseTimer.Enabled := True;
if ItemList.Count > 0
then
begin
ActiveItem := 0;
TspSkinMenuItem(ItemList.Items[0]).MouseEnter(True);
end;
WT.Enabled := False;
end;
procedure TspSkinPopupWindow.UpDatePW;
var
i: Integer;
j: Integer;
begin
j := ParentMenu.GetPWIndex(Self);
if j + 1 < ParentMenu.FPopupList.Count
then ParentMenu.CloseMenu(j + 1);
for i := 0 to ItemList.Count - 1 do
if TspSkinMenuItem(ItemList.Items[i]).Down
then
with TspSkinMenuItem(ItemList.Items[i]) do
begin
Down := False;
ReDraw;
end;
end;
procedure TspSkinPopupWindow.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
if PW = nil then Exit;
StopMorph := True;
for i := 0 to ItemList.Count - 1 do
with TspSkinMenuItem(ItemList.Items[i]) do
begin
if EnableMorphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end;
end;
if StopMorph then MorphTimer.Enabled := False;
end;
procedure TspSkinPopupWindow.SetMenuWindowRegion;
var
TempRgn: HRgn;
begin
if PW = nil then Exit;
TempRgn := FRgn;
CreateSkinRegion
(FRgn, PW.LTPoint, PW.RTPoint, PW.LBPoint, PW.RBPoint, PW.ItemsRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewItemsRect,
MaskPicture, Width, Height);
SetWindowRgn(Handle, FRgn, True);
if TempRgn <> 0 then DeleteObject(TempRgn);
end;
procedure TspSkinPopupWindow.CreateRealImage;
var
EB1: TspEffectBmp;
Kf: Double;
R: TRect;
TextOffset: Integer;
begin
if PW <> nil
then
CreateSkinImageBS(PW.LTPoint, PW.RTPoint, PW.LBPoint, PW.RBPoint,
PW.ItemsRect, NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint,
NewItemsRect, B, WindowPicture,
Rect(0, 0, WindowPicture.Width, WindowPicture.Height),
Width, Height, Scroll,
PW.LeftStretch, PW.TopStretch,
PW.RightStretch, PW.BottomStretch)
else
begin
B.Width := Width;
B.Height := Height;
with B.Canvas do
begin
if ImgL = nil
then TextOffset := 22
else TextOffset := GlyphWidth + 3;
R := Rect(0, 0, TextOffset, Height);
Brush.Color := clBtnFace;
FillRect(R);
R := Rect(TextOffset, 0, Width, Height);
Brush.Color := clWindow;
FillRect(R);
end;
R := Rect(0, 0, Width, Height);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clWindow, clWindow, 1);
end;
if AlphaBlend and not CheckW2KWXP
then
begin
EB1 := TspEffectBmp.CreateFromhWnd(B.Handle);
kf := 1 - AlphaBlendValue / 255;
EB1.MorphRect(ESc, kf, Rect(0, 0, B.Width, B.Height), 0, 0);
EB1.Draw(B.Canvas.Handle, 0, 0);
EB1.Free;
end;
end;
procedure TspSkinPopupWindow.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 TspSkinMenuItem(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 + 6;
Result := Result + MarkerItemHeight * 2;
Self.Scroll := True;
Self.Scroll2 := True;
end
else
begin
if PW <> nil
then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -