?? bsskinmenus.pas
字號:
Exit;
end;
TR := Rect(2, 2, B.Width - 2, B.Height - 2);
// text
R := Rect(TR.Left + TextOffset, 0, TR.Right - 19, 0);
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption), Length(MenuItem.Caption), R,
DT_CALCRECT);
OffsetRect(R, 0, TR.Top + RectHeight(TR) div 2 - R.Bottom div 2);
Inc(R.Right, 2);
DrawText(B.Canvas.Handle,
PChar(MenuItem.Caption), Length(MenuItem.Caption), R, DT_CENTER or DT_VCENTER);
// short cut
if MIShortCut <> ''
then
begin
SR := Rect(0, 0, 0, 0);
DrawText(B.Canvas.Handle, PChar(MIShortCut), Length(MIShortCut), SR,
DT_CALCRECT);
SR := Rect(TR.Right - SR.Right - 19, R.Top, TR.Right - 19, R.Bottom);
DrawText(B.Canvas.Handle,
PChar(MIShortCut), Length(MIShortCut), SR, DT_CENTER or DT_VCENTER);
end;
//
if MenuItem.Count <> 0
then
DrawSubImage(B.Canvas,
TR.Right - 7, TR.Top + RectHeight(TR) div 2 - 4,
B.Canvas.Font.Color);
//
DrawGlyph := (Parent.ImgL <> nil) and (MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < Parent.ImgL.Count);
if DrawGlyph
then
begin
GX := TR.Left;
GY := TR.Top + RectHeight(TR) div 2 - Parent.ImgL.Height div 2;
if MenuItem.Checked
then
with B.Canvas do
begin
Brush.Style := bsClear;
Pen.Color := Font.Color;
Rectangle(GX - 1, GY - 1,
GX + Parent.ImgL.Width + 1,
GY + Parent.ImgL.Height + 1);
end;
end
else
begin
GX := 0; GY := 0;
IY := TR.Top + RectHeight(TR) div 2 - 4;
IX := TR.Left + 2;
if (MenuItem.Name = MI_CLOSENAME) or (MenuItem.Name = TMI_CLOSENAME)
then DrawCloseImage(B.Canvas, IX, IY, B.Canvas.Font.Color) else
if MenuItem.Name = MI_MINNAME
then DrawMinimizeImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_MAXNAME
then DrawMaximizeImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if (MenuItem.Name = MI_RESTORENAME) or (MenuItem.Name = TMI_RESTORENAME)
then DrawRestoreImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_ROLLUPNAME
then DrawRollUpImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_MINTOTRAYNAME
then DrawMTImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Checked
then
if MenuItem.RadioItem
then
DrawRadioImage(B.Canvas,
TR.Left + 3, TR.Top + RectHeight(TR) div 2 - 3,
B.Canvas.Font.Color)
else
DrawCheckImage(B.Canvas,
TR.Left + 3, TR.Top + RectHeight(TR) div 2 - 4,
B.Canvas.Font.Color);
end;
//
if DrawGlyph
then
Parent.ImgL.Draw(B.Canvas, GX, GY, MenuItem.ImageIndex, MenuItem.Enabled);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, B);
B.Free;
end;
procedure TbsSkinMenuItem.Draw;
var
GX, GY: Integer;
DrawGlyph: Boolean;
kf: Double;
procedure CreateItemImage(B: TBitMap; AActive: Boolean);
var
R, TR, SR, Rct: TRect;
TextOffset: Integer;
MIShortCut: String;
IX, IY: Integer;
SE: Boolean;
begin
if MenuItem.ShortCut <> 0
then
MIShortCut := ShortCutToText(MenuItem.ShortCut)
else
MIShortCut := '';
SE := False;
if AActive
then
begin
Rct := MI.ActiveSkinRect;
SE := MI.StretchEffect;
end
else
Rct := MI.SkinRect;
CreateHSkinImage(MI.ItemLO, MI.ItemRO,
B, ActivePicture, Rct,
RectWidth(ObjectRect), RectHeight(ObjectRect), SE);
if Parent.ImgL = nil
then TextOffset := 16
else TextOffset := Parent.GlyphWidth;
TR := MI.TextRct;
TR.Right := B.Width - (RectWidth(MI.SkinRect) - MI.TextRct.Right);
with B.Canvas do
begin
Brush.Style := bsClear;
if Self.Parent.ParentMenu.UseSkinFont
then
begin
Font.Name := MI.FontName;
Font.Style := MI.FontStyle;
Font.Height := MI.FontHeight;
end
else
Font.Assign(Self.Parent.ParentMenu.DefaultMenuItemFont);
if (Self.Parent.ParentMenu.SkinData <> nil) and
(Self.Parent.ParentMenu.SkinData.ResourceStrData <> nil)
then
Font.CharSet := Self.Parent.ParentMenu.SkinData.ResourceStrData.Charset
else
Font.CharSet := Self.Parent.ParentMenu.FDefaultMenuItemFont.Charset;
if AActive
then
Font.Color := MI.ActiveFontColor
else
if MenuItem.Enabled
then
Font.Color := MI.FontColor
else
Font.Color := MI.UnEnabledFontColor;
//
if Assigned(MenuItem.OnDrawItem)
then
begin
MenuItem.OnDrawItem(Self, B.Canvas, TR, AActive);
Exit;
end;
//
R := Rect(TR.Left + TextOffset, 0, TR.Right - 16, 0);
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption), Length(MenuItem.Caption), R,
DT_CALCRECT);
OffsetRect(R, 0, TR.Top + RectHeight(TR) div 2 - R.Bottom div 2);
Inc(R.Right, 2);
DrawText(B.Canvas.Handle,
PChar(MenuItem.Caption), Length(MenuItem.Caption), R, DT_CENTER or DT_VCENTER);
// shortcut
if MIShortCut <> ''
then
begin
SR := Rect(0, 0, 0, 0);
DrawText(B.Canvas.Handle, PChar(MIShortCut), Length(MIShortCut), SR,
DT_CALCRECT);
SR := Rect(TR.Right - SR.Right - 16, R.Top, TR.Right - 16, R.Bottom);
DrawText(B.Canvas.Handle,
PChar(MIShortCut), Length(MIShortCut), SR, DT_CENTER or DT_VCENTER);
end;
//
if MenuItem.Count <> 0
then
DrawSubImage(B.Canvas,
TR.Right - 7, TR.Top + RectHeight(TR) div 2 - 4,
B.Canvas.Font.Color);
//
DrawGlyph := (Parent.ImgL <> nil) and (MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < Parent.ImgL.Count);
if DrawGlyph
then
begin
GX := TR.Left + 2;
GY := TR.Top + RectHeight(TR) div 2 - Parent.ImgL.Height div 2;
if MenuItem.Checked
then
begin
Brush.Style := bsClear;
Pen.Color := Font.Color;
Rectangle(GX - 1, GY - 1,
GX + Parent.ImgL.Width + 1,
GY + Parent.ImgL.Height + 1);
end;
end
else
begin
IY := TR.Top + RectHeight(TR) div 2 - 4;
IX := TR.Left + 2;
if (MenuItem.Name = MI_CLOSENAME) or (MenuItem.Name = TMI_CLOSENAME)
then DrawCloseImage(B.Canvas, IX, IY, B.Canvas.Font.Color) else
if MenuItem.Name = MI_MINNAME
then DrawMinimizeImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_MAXNAME
then DrawMaximizeImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if (MenuItem.Name = MI_RESTORENAME) or (MenuItem.Name = TMI_RESTORENAME)
then DrawRestoreImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_ROLLUPNAME
then DrawRollUpImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Name = MI_MINTOTRAYNAME
then DrawMTImage(B.Canvas, IX, IY, B.Canvas.Font.Color)
else
if MenuItem.Checked
then
if MenuItem.RadioItem
then
DrawRadioImage(B.Canvas,
TR.Left + 2, TR.Top + RectHeight(TR) div 2 - 3,
B.Canvas.Font.Color)
else
DrawCheckImage(B.Canvas,
TR.Left + 2, TR.Top + RectHeight(TR) div 2 - 4,
B.Canvas.Font.Color);
end;
end;
//
if DrawGlyph
then
Parent.ImgL.Draw(B.Canvas, GX, GY,
MenuItem.ImageIndex, MenuItem.Enabled);
end;
var
B, AB: TBitMap;
EffB, EffAB: TbsEffectBmp;
AD: Boolean;
begin
if not FVisible then Exit;
if MI = nil
then
begin
DefaultDraw(Cnvs);
Exit;
end;
B := TBitMap.Create;
if MenuItem.Caption = '-'
then
begin
CreateHSkinImage(MI.DividerLO, MI.DividerRO,
B, ActivePicture, MI.DividerRect,
RectWidth(ObjectRect), RectHeight(ObjectRect), MI.DividerStretchEffect);
end
else
begin
AD := Active or Down;
if not EnableMorphing or
((AD and (MorphKf = 1)) or (not AD and (MorphKf = 0)))
then
CreateItemImage(B, AD)
else
begin
CreateItemImage(B, False);
AB := TBitMap.Create;
CreateItemImage(AB, True);
EffB := TbsEffectBmp.CreateFromhWnd(B.Handle);
EffAB := TbsEffectBmp.CreateFromhWnd(AB.Handle);
case MI.MorphKind of
mkDefault: EffB.Morph(EffAB, MorphKf);
mkGradient: EffB.MorphGrad(EffAB, MorphKf);
mkLeftGradient: EffB.MorphLeftGrad(EffAB, MorphKf);
mkRightGradient: EffB.MorphRightGrad(EffAB, MorphKf);
mkLeftSlide: EffB.MorphLeftSlide(EffAB, MorphKf);
mkRightSlide: EffB.MorphRightSlide(EffAB, MorphKf);
mkPush: EffB.MorphPush(EffAB, MorphKf);
end;
EffB.Draw(B.Canvas.Handle, 0, 0);
AB.Free;
EffB.Free;
EffAB.Free;
end;
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, B);
B.Free;
end;
//================TbsSkinPopupWindow======================//
constructor TbsSkinPopupWindow.CreateEx;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
ParentMenu := AParentMenu;
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
ItemList := TList.Create;
MouseTimer := TTimer.Create(Self);
MouseTimer.Enabled := False;
MouseTimer.OnTimer := TestMouse;
MouseTimer.Interval := MouseTimerInterval;
MorphTimer := TTimer.Create(Self);
MorphTimer.Enabled := False;
MorphTimer.OnTimer := TestMorph;
MorphTimer.Interval := MorphTimerInterval;
FRgn := 0;
WindowPicture := nil;
MaskPicture := nil;
if (AData = nil) or (AData.WindowPictureIndex = -1)
then
begin
PW := nil;
SD := nil;
end
else
begin
PW := AData;
SD := ParentMenu.SkinData;
with PW do
begin
if (WindowPictureIndex <> - 1) and
(WindowPictureIndex < SD.FActivePictures.Count)
then
WindowPicture := SD.FActivePictures.Items[WindowPictureIndex];
if (MaskPictureIndex <> - 1) and
(MaskPictureIndex < SD.FActivePictures.Count)
then
MaskPicture := SD.FActivePictures.Items[MaskPictureIndex];
end;
end;
ActiveItem := -1;
OldActiveItem := -1;
OMX := -1;
OMY := -1;
DSMI := nil;
ScrollCode := 0;
Scroll2 := False;
end;
destructor TbsSkinPopupWindow.Destroy;
var
i: Integer;
begin
for i := 0 to ItemList.Count - 1 do
TbsSkinMenuItem(ItemList.Items[i]).Free;
ItemList.Clear;
ItemList.Free;
MouseTimer.Free;
MorphTimer.Free;
inherited Destroy;
if FRgn <> 0 then DeleteObject(FRgn);
end;
procedure TbsSkinPopupWindow.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
if PW = nil then Exit;
StopMorph := True;
for i := 0 to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if EnableMorphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end;
end;
if StopMorph then MorphTimer.Enabled := False;
end;
function TbsSkinPopupWindow.CanScroll;
begin
Result := False;
case AScrollCode of
1: Result := VisibleStartIndex > 0;
2: Result := VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1;
end;
end;
procedure TbsSkinPopupWindow.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 TbsSkinPopupWindow.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 TbsSkinPopupWindow.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 TbsSkinPopupWindow.StartScroll;
var
i: Integer;
begin
i := ParentMenu.GetPWIndex(Self);
ParentMenu.CloseMenu(i + 1);
KillTimer(Handle, 1);
SetTimer(Handle, 1, ScrollTimerInterval, nil);
end;
procedure TbsSkinPopupWindow.StopScroll;
begin
ScrollCode := 0;
DrawUpMarker(Canvas);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -