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

📄 skinmenus.pas

📁 DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      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);


  if Parent.AlphaBlend and not CheckW2KWXP
  then
    begin
      EB1 := TspEffectBmp.CreateFromhWnd(B.Handle);
      kf := 1 - Parent.AlphaBlendValue / 255;
      EB1.MorphRect(Parent.ESc, kf, Rect(0, 0, B.Width, B.Height),
       ObjectRect.Left, ObjectRect.Top);
      EB1.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
      EB1.Free;
    end
  else
    Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, B);
  B.Free;
end;


procedure TspSkinMenuItem.Draw;
var
  GX, GY: Integer;
  DrawGlyph: Boolean;
  EB1: TspEffectBmp;
  kf: Double;
  SpecRect: TRect;


procedure DrawGroupCaptionItem(Cnvs: TCanvas; R: TRect; Caption: WideString);
var
  LData: TspDataSkinLabelControl;
  I: Integer;
  Buffer: TBitmap;
  Picture: TBitMap;
  LO, RO: Integer;
  R1: TRect;
begin
  if (Parent.PW <> nil)
  then
    begin
      I := Parent.SD.GetControlIndex('menuheader');
      if I = -1
      then
        I := Parent.SD.GetControlIndex('label');
      if I <> -1
      then
        begin
          LData := TspDataSkinLabelControl(Parent.SD.CtrlList[I]);
          Picture := Parent.SD.FActivePictures[LData.PictureIndex];
          Buffer := TBitMap.Create;
          with LData do
          CreateHSkinImage(LTPoint.X, RectWidth(SkinRect) - RTPoint.X,
            Buffer, Picture, SkinRect, RectWidth(R), RectHeight(SkinRect), StretchEffect);
          // caption
          with Buffer.Canvas do
          begin
            Font.Color := LData.FontColor;
            Font.Name := LData.FontName;
            Font.Height := LData.FontHeight;
            Font.Charset := Cnvs.Font.Charset;
            Brush.Style := bsClear;
            Delete(Caption, 1, 1);
            Delete(Caption, Length(Caption), 1);
          end;
          R1 := Rect(0, LData.ClRect.Top, Buffer.Width,
                     Buffer.Height);
          SPDrawSkinText(Buffer.Canvas, Caption, R1,
            Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(DT_CENTER or DT_VCENTER));
          //
          Cnvs.Draw(R.Left, R.Top + RectHeight(R) div 2 - Buffer.Height div 2,
                    Buffer);
          Buffer.Free;
        end;
    end;
end;

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

  {$IFDEF TNTUNICODE}
  if MenuItem is TTNTMenuItem
  then
    begin
      if MenuItem.ShortCut <> 0
      then
        MIShortCut := ShortCutToText(TTNTMenuItem(MenuItem).ShortCut)
      else
        MIShortCut := '';
     end
  else
    begin
      if MenuItem.ShortCut <> 0
      then
        MIShortCut := ShortCutToText(MenuItem.ShortCut)
      else
        MIShortCut := '';
    end;
  {$ELSE}
  if MenuItem.ShortCut <> 0
  then
    MIShortCut := ShortCutToText(MenuItem.ShortCut)
  else
    MIShortCut := '';
  {$ENDIF}


  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;


  if not AACtive and MI.InActiveTransparent and
     (Parent.FPaintBuffer <> nil)
  then
    begin
      B.Width := RectWidth(ObjectRect);
      B.Height := RectHeight(ObjectRect);
      B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height),
      Parent.FPaintBuffer.Canvas, ObjectRect);
    end
  else
   CreateHSkinImage(MI.ItemLO, MI.ItemRO,
     B, ActivePicture, Rct,
     RectWidth(ObjectRect), RectHeight(ObjectRect), SE);


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

  if not IsNullRect(MI.ImageRct) then TextOffset := 0; 

  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;
        Font.CharSet := Self.Parent.ParentMenu.FDefaultMenuItemFont.Charset;
      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;
    //
    {$IFDEF TNTUNICODE}
    if MenuItem is TTntMenuItem
    then
      S := TTntMenuItem(MenuItem).Caption
    else
      S := MenuItem.Caption;
    {$ELSE}
     S := MenuItem.Caption;
    {$ENDIF}
    //
    if (S[1] = '-') and (S[Length(S)] = '-') and not MenuItem.Enabled
    then
      begin
        DrawGroupCaptionItem(B.Canvas, Rect(0, 0, B.Width, B.Height), S);
        Exit;
      end;
    //
    R := Rect(TR.Left + TextOffset, 0, TR.Right - 16, 0);
    SPDrawSkinText(B.Canvas, S, R, DT_CALCRECT);
    OffsetRect(R, 0, TR.Top + RectHeight(TR) div 2 - R.Bottom div 2);
    Inc(R.Right, 2);
    SPDrawSkinText(B.Canvas, S, R,
      Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(DT_CENTER or DT_VCENTER));
    // shortcut
    if MIShortCut <> ''
    then
      begin
        SR := Rect(0, 0, 0, 0);
        SPDrawSkinText(B.Canvas, MIShortCut, SR, DT_CALCRECT);
        SR := Rect(TR.Right - SR.Right - 16, R.Top, TR.Right - 16, R.Bottom);
        SPDrawSkinText(B.Canvas,  MIShortCut, SR,
         Parent.ParentMenu.FForm.DrawTextBiDiModeFlags(DT_CENTER or DT_VCENTER));
      end;
    //
    if MenuItem.Count <> 0
    then
      begin
        if IsNullRect(MI.ArrowImageRect)
        then
          DrawSubImage(B.Canvas,
                     TR.Right - 7, TR.Top + RectHeight(TR) div 2 - 4,
                     B.Canvas.Font.Color)
        else
          DrawSkinArrowImage(B.Canvas,
                             Rect(TR.Right - RectWidth(MI.ArrowImageRect) - 5,
                             TR.Top, TR.Right, TR.Bottom),
                             AActive);
      end;
    //
    DrawGlyph := (not MenuItem.Bitmap.Empty) or
       ((Parent.ImgL <> nil) and (MenuItem.ImageIndex > -1) and
       (MenuItem.ImageIndex < Parent.ImgL.Count));

    if MI.UseImageColor
    then
    begin
      if AActive
      then
        Font.Color := MI.ActiveImageColor
      else
        Font.Color := MI.ImageColor;
    end;

    if DrawGlyph
    then
      begin
        if not MenuItem.Bitmap.Empty
        then
          begin
            if IsNullRect(MI.ImageRct)
            then
              begin
                GX := TR.Left + 2;
                GY := TR.Top + RectHeight(TR) div 2 - MenuItem.Bitmap.Height div 2;
              end
            else
              begin
                GX := MI.ImageRct.Left + RectWidth(MI.ImageRct) div 2 -
                      MenuItem.Bitmap.Width div 2;
                GY := MI.ImageRct.Top + RectHeight(MI.ImageRct) div 2 - MenuItem.Bitmap.Height div 2;
              end;

            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
             if IsNullRect(MI.ImageRct)
            then
              begin
                GX := TR.Left + 2;
                GY := TR.Top + RectHeight(TR) div 2 - Parent.ImgL.Height div 2;
              end
            else
              begin
                GX := MI.ImageRct.Left + RectWidth(MI.ImageRct) div 2 -
                       Parent.ImgL.Width div 2;
                GY := MI.ImageRct.Top + RectHeight(MI.ImageRct) div 2 - Parent.ImgL.Height div 2;
              end;
            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
        if IsNullRect(MI.ImageRct)
        then
          begin
            IY := TR.Top + RectHeight(TR) div 2 - 4;
            IX := TR.Left + 2;
          end
        else
          begin
            IY := MI.ImageRct.Top + RectHeight(MI.ImageRct) div 2 - 4;
            IX := MI.ImageRct.Left + RectWidth(MI.ImageRct) div 2 - 4
          end;
        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
            begin
              if IsNullRect(MI.RadioImageRect)
              then
                DrawRadioImage(B.Canvas,
                               IX, IY + 1,
                               B.Canvas.Font.Color)
              else
                begin
                  if not IsNullRect(MI.ImageRct)
                  then
                    DR := MI.ImageRct
                  else
                    DR := Rect(MI.TextRct.Left + 2, MI.TextRct.Top, MI.TextRct.Left + 16,
                      MI.ImageRct.Bottom);
                  DrawSkinRadioImage(B.Canvas, DR,  AActive);
                end;

            end
          else
            begin
              if IsNullRect(MI.RadioImageRect)
              then
                DrawCheckImage(B.Canvas,
                              IX, IY,
                               B.Canvas.Font.Color)
              else
                begin
                  if not IsNullRect(MI.ImageRct)
                  then
                    DR := MI.ImageRct
                  else
                    DR := Rect(MI.TextRct.Left + 2, MI.TextRct.Top, MI.TextRct.Left + 16,
                      MI.ImageRct.Bottom);
                   DrawSkinCheckImage(B.Canvas, DR, AActive);
                end;  
            end;
      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: TspEffectBmp;
  AD: Boolean;
begin
  if not FVisible then Exit;
  if MI = nil
  then
    begin

⌨️ 快捷键说明

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