skinmenus.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

begin
  Result := R.Bottom - R.Top;
end;

function CanMenuClose;
begin
  Result := False;
  case Msg of
    WM_MOUSEACTIVATE, WM_ACTIVATE,
    WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN,
    WM_NCLBUTTONDOWN, WM_NCMBUTTONDOWN, WM_NCRBUTTONDOWN,
    WM_KILLFOCUS, WM_MOVE, WM_SIZE, WM_CANCELMODE, WM_PARENTNOTIFY:
      Result := True;
  end;
end;

//===============TspSkinMenuItem===================//
constructor TspSkinMenuItem.Create;
begin
  WaitCommand := False;
  Parent := AParent;
  MenuItem := AMenuItem;
  FVisible := True;
  MI := AData;
  if MI <> nil then 
  with AData do
  begin
    if (ActivePictureIndex <> - 1) and
       (ActivePictureIndex < Self.Parent.SD.FActivePictures.Count)
    then
      ActivePicture := Self.Parent.SD.FActivePictures.Items[ActivePictureIndex]
    else
      begin
        ActivePicture := nil;
        SkinRect := NullRect;
        ActiveSkinRect := NullRect;
      end;
  end;
  FMorphKf := 0;
  CurrentFrame := 0;
end;

procedure TspSkinMenuItem.DrawSkinCheckImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
var
  Buffer: TBitMap;
  SR: TRect;
  X, Y: Integer;
begin
  if AActive then SR := MI.ActiveCheckImageRect else SR := MI.CheckImageRect;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(SR);
  Buffer.Height := RectHeight(SR);
  Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
    ActivePicture.Canvas, SR);
  Buffer.Transparent := True;
  X := R.Left + RectWidth(R) div 2 - Buffer.Width div 2;
  if X < R.Left then X := R.Left;
  Y := R.Top + RectHeight(R) div 2 - Buffer.Height div 2;
  if Y < R.Top then Y := R.Top;
  Cnvs.Draw(X, Y, Buffer);
  Buffer.Free;
end;

procedure TspSkinMenuItem.DrawSkinRadioImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
var
  Buffer: TBitMap;
  SR: TRect;
  X, Y: Integer;
begin
  if AActive then SR := MI.ActiveRadioImageRect else SR := MI.RadioImageRect;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(SR);
  Buffer.Height := RectHeight(SR);
  Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
    ActivePicture.Canvas, SR);
  Buffer.Transparent := True;
  X := R.Left + RectWidth(R) div 2 - Buffer.Width div 2;
  if X < R.Left then X := R.Left;
  Y := R.Top + RectHeight(R) div 2 - Buffer.Height div 2;
  if Y < R.Top then Y := R.Top;
  Cnvs.Draw(X, Y, Buffer);
  Buffer.Free;
end;

procedure TspSkinMenuItem.DrawSkinArrowImage(Cnvs: TCanvas; R: TRect; AActive: Boolean);
var
  Buffer: TBitMap;
  SR: TRect;
  X, Y: Integer;
begin
  if AActive then SR := MI.ActiveArrowImageRect else SR := MI.ArrowImageRect;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(SR);
  Buffer.Height := RectHeight(SR);
  Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
    ActivePicture.Canvas, SR);
  Buffer.Transparent := True;
  X := R.Left + RectWidth(R) div 2 - Buffer.Width div 2;
  if X < R.Left then X := R.Left;
  Y := R.Top + RectHeight(R) div 2 - Buffer.Height div 2;
  if Y < R.Top then Y := R.Top;
  Cnvs.Draw(X, Y, Buffer);
  Buffer.Free;
end;

function TspSkinMenuItem.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 TspSkinMenuItem.EnableMorphing: Boolean;
begin
  Result := (MI <> nil) and MI.Morphing and (Parent.SD <> nil) and
             Parent.SD.EnableSkinEffects;
end;

function TspSkinMenuItem.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 TspSkinMenuItem.DoMorphing;
begin
  if Active or Down
  then MorphKf := MorphKf + MorphInc
  else MorphKf := MorphKf - MorphInc;
  Draw(Parent.Canvas);
end;

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

procedure TspSkinMenuItem.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 TspSkinMenuItem.MouseDown(X, Y: Integer);
begin
  WaitCommand := False;
  if not Down and MenuItem.Enabled
  then
    Parent.ParentMenu.CheckItem(Parent, Self, True, False);
end;

procedure TspSkinMenuItem.MouseEnter;
var
  i: Integer;
begin
  Active := True;
  if EnableAnimation then CurrentFrame := 0;   
  for i := 0 to Parent.ItemList.Count - 1 do
    if (TspSkinMenuItem(Parent.ItemList.Items[i]) <> Self)
       and TspSkinMenuItem(Parent.ItemList.Items[i]).Down
    then
      with TspSkinMenuItem(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
        TspSkinPopupWindow(FPopupList.Items[i + 1]).UpDatePW;
    end;
  if Parent.Hint <> MenuItem.Hint then Parent.Hint := MenuItem.Hint;  
end;

procedure TspSkinMenuItem.MouseLeave;
begin
  WaitCommand := False;
  Active := False;
  if EnableAnimation then CurrentFrame := MI.FrameCount + 1;
  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 TspSkinMenuItem.DefaultDraw(Cnvs: TCanvas);
var
  MIShortCut, S: WideString;
  B: TBitMap;
  TextOffset: Integer;
  R, TR, SR: TRect;
  DrawGlyph: Boolean;
  GX, GY, IX, IY: Integer;
  EB1: TspEffectBmp;
  kf: Double;
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}

  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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
        Brush.Color := SP_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);
      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;
      Exit;
    end;

  {$IFDEF TNTUNICODE}
  if MenuItem is TTntMenuItem
  then
    S := TTntMenuItem(MenuItem).Caption
  else
    S := MenuItem.Caption;
  {$ELSE}
  S := MenuItem.Caption;
  {$ENDIF}


  TR := Rect(2, 2, B.Width - 2, B.Height - 2);
  // text
  R := Rect(TR.Left + TextOffset, 0, TR.Right - 19, 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));
  // short cut
  if MIShortCut <> ''
  then
    begin
      SR := Rect(0, 0, 0, 0);
      SPDrawSkinText(B.Canvas, MIShortCut, SR, DT_CALCRECT);
      SR := Rect(TR.Right - SR.Right - 19, R.Top, TR.Right - 19, R.Bottom);
      SPDrawSkinText(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