⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bsskinmenus.pas

📁 一套非常好用的delphi控件,方便程序员工作
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  B.Width := RectWidth(ObjectRect);
  B.Height := RectHeight(ObjectRect);

  if Parent.ImgL = nil
  then TextOffset := 19
  else TextOffset := Parent.GlyphWidth;

  with B.Canvas do
  begin
    R := Rect(0, 0, B.Width, B.Height);
    Font.Assign(Parent.ParentMenu.FDefaultMenuItemFont);
    if (Parent.ParentMenu.SkinData <> nil) and
       (Parent.ParentMenu.SkinData.ResourceStrData <> nil)
    then
      Font.CharSet := Self.Parent.ParentMenu.SkinData.ResourceStrData.Charset;
    if (Active or Down) and (MenuItem.Caption <> '-')
    then
      begin
        Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
        Brush.Color := BS_XP_BTNACTIVECOLOR;
        Font.Color := clWindowText;
        FillRect(R);
      end
    else
      begin
        R := Rect(0, 0, TextOffset, B.Height);
        Brush.Color := clBtnFace;
        FillRect(R);
        R := Rect(TextOffset, 0, B.Width, B.Height);
        Brush.Color := clWindow;
        if MenuItem.Enabled
        then
          Font.Color := clWindowText
        else
          Font.Color := clBtnShadow;
        FillRect(R);
      end;
  end;

  if MenuItem.Caption = '-'
  then
    begin
      R.Left := TextOffset;
      R.Top := B.Height div 2;
      R.Right := B.Width;
      R.Bottom := B.Height div 2 + 1;
      Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
      Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, B);
      B.Free;
      Exit;
    end;

  TR := Rect(2, 2, B.Width - 2, B.Height - 2);
  // text
  R := Rect(TR.Left + TextOffset, 0, TR.Right - 19, 0);
  BSDrawSkinText(B.Canvas, MenuItem.Caption, R,
             DT_CALCRECT);
  OffsetRect(R, 0, TR.Top + RectHeight(TR) div 2 - R.Bottom div 2);
  Inc(R.Right, 2);
  BSDrawSkinText(B.Canvas, MenuItem.Caption, R,
    Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(DT_CENTER or DT_VCENTER));
  // short cut
  if MIShortCut <> ''
  then
    begin
      SR := Rect(0, 0, 0, 0);
      BSDrawSkinText(B.Canvas, MIShortCut, SR, DT_CALCRECT);
      SR := Rect(TR.Right - SR.Right - 19, R.Top, TR.Right - 19, R.Bottom);
      BSDrawSkinText(B.Canvas, MIShortCut, SR,
       Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(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 := (not MenuItem.Bitmap.Empty) or  ((Parent.ImgL <> nil) and (MenuItem.ImageIndex > -1) and
       (MenuItem.ImageIndex < Parent.ImgL.Count));

  if DrawGlyph
  then
    begin
      if not MenuItem.Bitmap.Empty
        then
          begin
            GX := TR.Left + 2;
            GY := TR.Top + RectHeight(TR) div 2 - MenuItem.Bitmap.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 + MenuItem.Bitmap.Width + 1,
                          GY + MenuItem.Bitmap.Height + 1);
             end;
          end
        else
          begin
            GX := TR.Left + 2;
            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;
    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
    if not MenuItem.Bitmap.Empty
    then
      B.Canvas.Draw(GX, GY, MenuItem.BitMap)
    else
      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;
  SpecRect: TRect;

procedure CreateItemImage(B: TBitMap; AActive: Boolean; FromSpecRect: Boolean);
var
  R, TR, SR, Rct: TRect;
  TextOffset: Integer;
  MIShortCut: WideString;
  IX, IY: Integer;
  SE: Boolean;
begin

  if MenuItem.ShortCut <> 0
  then
    MIShortCut := ShortCutToText(MenuItem.ShortCut)
  else
    MIShortCut := '';

  if AActive
  then
    begin
      Rct := MI.ActiveSkinRect;
      SE := MI.StretchEffect;
    end
  else
    begin
      Rct := MI.SkinRect;
      SE := MI.InActiveStretchEffect;
      if not MI.InActiveStretchEffect and MI.StretchEffect
      then
        SE := MI.StretchEffect and FromSpecRect;
    end;

  if FromSpecRect then Rct := SpecRect;

  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);
    BSDrawSkinText(B.Canvas, MenuItem.Caption, R, DT_CALCRECT);
    OffsetRect(R, 0, TR.Top + RectHeight(TR) div 2 - R.Bottom div 2);
    Inc(R.Right, 2);
    BSDrawSkinText(B.Canvas, MenuItem.Caption, R,
      Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(DT_CENTER or DT_VCENTER));
    // shortcut
    if MIShortCut <> ''
    then
      begin
        SR := Rect(0, 0, 0, 0);
        BSDrawSkinText(B.Canvas, MIShortCut, SR, DT_CALCRECT);
        SR := Rect(TR.Right - SR.Right - 16, R.Top, TR.Right - 16, R.Bottom);
        BSDrawSkinText(B.Canvas,  MIShortCut, SR,
         Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(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 := (not MenuItem.Bitmap.Empty) or  ((Parent.ImgL <> nil) and (MenuItem.ImageIndex > -1) and
       (MenuItem.ImageIndex < Parent.ImgL.Count));

    if DrawGlyph
    then
      begin
        if not MenuItem.Bitmap.Empty
        then
          begin
            GX := TR.Left + 2;
            GY := TR.Top + RectHeight(TR) div 2 - MenuItem.Bitmap.Height div 2;
            if MenuItem.Checked
            then
              begin
                Brush.Style := bsClear;
                Pen.Color := Font.Color;
                Rectangle(GX - 1, GY - 1,
                          GX + MenuItem.Bitmap.Width + 1,
                          GY + MenuItem.Bitmap.Height + 1);
             end;
          end
        else
          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;
      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
    if not MenuItem.Bitmap.Empty
    then
      B.Canvas.Draw(GX, GY, MenuItem.BitMap)
    else
      Parent.ImgL.Draw(B.Canvas, GX, GY,
        MenuItem.ImageIndex, MenuItem.Enabled);
end;


function GetAnimationFrameRect: TRect;
var
  fs: Integer;
begin
  if RectHeight(MI.AnimateSkinRect) > RectHeight(MI.SkinRect)
  then
    begin
      fs := RectHeight(MI.AnimateSkinRect) div MI.FrameCount;
      Result := Rect(MI.AnimateSkinRect.Left,
                     MI.AnimateSkinRect.Top + (CurrentFrame - 1) * fs,
                     MI.AnimateSkinRect.Right,
                     MI.AnimateSkinRect.Top + CurrentFrame * fs);
    end
  else
    begin
      fs := RectWidth(MI.AnimateSkinRect) div MI.FrameCount;
      Result := Rect(MI.AnimateSkinRect.Left + (CurrentFrame - 1) * fs,
                 MI.AnimateSkinRect.Top,
                 MI.AnimateSkinRect.Left + CurrentFrame * fs,
                 MI.AnimateSkinRect.Bottom);
    end;
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 EnableAnimation and  
      (CurrentFrame >= 1) and (CurrentFrame <= MI.FrameCount)
      then
        begin
          SpecRect := GetAnimationFrameRect;
          CreateItemImage(B, AD, True);
        end
      else
      if not EnableMorphing or
      ((AD and (MorphKf = 1)) or (not AD and (MorphKf  = 0)))
      then
        CreateItemImage(B, AD, False)
      else
        begin
          CreateItemImage(B, False, False);
          AB := TBitMap.Create;
          CreateItemImage(AB, True, False);
          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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -