bsskinmenus.pas

BusinessSkinForm.v5.60 网上能找到的最新版。

          SkinRect := NullRect;
          ActiveSkinRect := NullRect;
        end;
    end;
  FMorphKf := 0;
  CurrentFrame := 0;
end;

function TbsSkinMenuItem.EnableMorphing: Boolean;
begin
  Result := (MI <> nil) and MI.Morphing and (Parent.SD <> nil) and
             not (Parent.SD.Empty) and
             Parent.SD.EnableSkinEffects;
end;

function TbsSkinMenuItem.EnableAnimation: Boolean;
begin
  Result := (MI <> nil) and not IsNullRect(MI.AnimateSkinRect) and (Parent.SD <> nil) and
             not (Parent.SD.Empty) and
             Parent.SD.EnableSkinEffects;
end;


function TbsSkinMenuItem.CanMorphing;
var
  AD: Boolean;
begin
  AD := Active or Down;
  Result := FVisible and ((AD and (MorphKf < 1)) or
                         (not AD and (MorphKf > 0)));
  if not FVisible and (FMorphKf <> 0)
  then
    begin
      Active := False;
      Down := False;
      FMorphKf := 0;
    end;
end;

procedure TbsSkinMenuItem.DoMorphing;
begin
  if Active or Down
  then MorphKf := MorphKf + MorphInc
  else MorphKf := MorphKf - MorphInc;
  Draw(Parent.Canvas);
end;

procedure TbsSkinMenuItem.SetMorphKf(Value: Double);
begin
  FMorphKf := Value;
  if FMorphKf < 0 then FMorphKf := 0 else
  if FMorphKf > 1 then FMorphKf := 1;
end;

procedure TbsSkinMenuItem.ReDraw;
begin
  if (MI <> nil) and EnableAnimation
  then
    begin
      if  Parent.MorphTimer.Interval <> MI.AnimateInterval
      then
        Parent.MorphTimer.Interval := MI.AnimateInterval;
       if EnableAnimation and not MI.InActiveAnimation and not Active
       then
        begin
          CurrentFrame := 0;
          Draw(Parent.Canvas);
       end
      else
        Parent.MorphTimer.Enabled := True
    end
  else
  if (MI <> nil) and EnableMorphing
  then
    begin
      if Parent.MorphTimer.Interval <> MorphTimerInterval
      then
        Parent.MorphTimer.Interval := MorphTimerInterval;
      Parent.MorphTimer.Enabled := True
    end
  else
    Draw(Parent.Canvas);
end;

procedure TbsSkinMenuItem.MouseDown(X, Y: Integer);
begin
  WaitCommand := False;
  if not Down and MenuItem.Enabled
  then
    Parent.ParentMenu.CheckItem(Parent, Self, True, False);
end;

procedure TbsSkinMenuItem.MouseEnter;
var
  i: Integer;
begin
  Active := True;
  if EnableAnimation then CurrentFrame := 0;          
  for i := 0 to Parent.ItemList.Count - 1 do
    if (TbsSkinMenuItem(Parent.ItemList.Items[i]) <> Self)
       and TbsSkinMenuItem(Parent.ItemList.Items[i]).Down
    then
      with TbsSkinMenuItem(Parent.ItemList.Items[i]) do
      begin
        Down := False;
        ReDraw;
      end;

  if WaitCommand and not Kb
  then
    begin
      ReDraw;
    end
  else  
  if not Down
  then
    begin
      ReDraw;
      Parent.ParentMenu.CheckItem(Parent, Self, False, Kb);
    end
  else
    with Parent.ParentMenu do
    begin
      i := GetPWIndex(Parent);
      if i + 2 < FPopupList.Count
      then
        TbsSkinPopupWindow(FPopupList.Items[i + 1]).UpDatePW;
    end;

  if Parent.Hint <> MenuItem.Hint then Parent.Hint := MenuItem.Hint;
end;

procedure TbsSkinMenuItem.MouseLeave;
begin
  Active := False;
  if EnableAnimation then CurrentFrame := MI.FrameCount + 1;
  WaitCommand := False;
  if not Down then ReDraw;
  with Parent.ParentMenu do
  begin
    if (WItem <> nil) and (WItem = Self)
    then
      begin
        WaitTimer.Enabled := False;
        WItem := nil;
      end;
  end;
end;

procedure TbsSkinMenuItem.DefaultDraw(Cnvs: TCanvas);
var
  MIShortCut: WideString;
  B: TBitMap;
  TextOffset: Integer;
  R, TR, SR: TRect;
  DrawGlyph: Boolean;
  GX, GY, IX, IY: Integer;
begin
  if MenuItem.ShortCut <> 0
  then
    MIShortCut := ShortCutToText(MenuItem.ShortCut)
  else
    MIShortCut := '';
  B := TBitMap.Create;
  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;

  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;
      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 MI.UseImageColor
    then
      begin
        if AActive
        then
          Font.Color := MI.ActiveImageColor
        else
          Font.Color := MI.ImageColor;
      end;

    if DrawGlyph
    then
      begin