skinmenus.pas

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

      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);
      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);
     end
  else
    begin
      AD := Active or Down;
      if EnableAnimation and
      (CurrentFrame >= 1) and (CurrentFrame <= MI.FrameCount)
      then
        begin
          SpecRect := GetAnimationFrameRect;
          CreateItemImage(B, AD, True);
          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);
        end
      else
      if not EnableMorphing or
      ((AD and (MorphKf = 1)) or (not AD and (MorphKf  = 0)))
      then
        begin
          CreateItemImage(B, AD, False);
          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);
        end
      else
        begin
          CreateItemImage(B, False, False);
          AB := TBitMap.Create;
          CreateItemImage(AB, True, False);
          EffB := TspEffectBmp.CreateFromhWnd(B.Handle);
          EffAB := TspEffectBmp.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;
          if Parent.AlphaBlend and not CheckW2KWXP
          then
            begin
              kf := 1 - Parent.AlphaBlendValue / 255;
              EffB.MorphRect(Parent.ESc, kf, Rect(0, 0, B.Width, B.Height),
                ObjectRect.Left, ObjectRect.Top);
            end;
          EffB.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
          AB.Free;
          EffB.Free;
          EffAB.Free;
        end;
    end;
  B.Free;
end;

//================TspSkinPopupWindow======================//
constructor TspSkinPopupWindow.CreateEx;
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
                  csAcceptsControls];

  ParentMenu := AParentMenu;

  FPaintBuffer := nil;

  AlphaBlend := ParentMenu.AlphaBlend;
  AlphaBlendValue := ParentMenu.AlphaBlendValue;
  AlphaBlendAnimation := ParentMenu.AlphaBlendAnimation;

  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;

  Sc := TBitMap.Create;
  Esc := nil;

  WT := TTimer.Create(Self);
  WT.Enabled := False;
  WT.OnTimer := WTProc;
  WT.Interval := 100;

  DSMI := nil;
  ScrollCode := 0;
  Scroll2 := False;
end;

destructor TspSkinPopupWindow.Destroy;
var
  i: Integer;
begin
  for i := 0 to ItemList.Count - 1 do
    TspSkinMenuItem(ItemList.Items[i]).Free;
  ItemList.Clear;
  ItemList.Free;
  MouseTimer.Free;
  MorphTimer.Free;
  Sc.Free;
  if Esc <> nil then Esc.Free;
  if FPaintBuffer <> nil then FPaintBuffer.Free;
  inherited Destroy;
  if FRgn <> 0 then DeleteObject(FRgn);
end;

function TspSkinPopupWindow.CanScroll;
begin
  Result := False;
  case AScrollCode of
    1: Result := VisibleStartIndex > 0;
    2: Result := VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1;
  end;
end;

procedure TspSkinPopupWindow.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 TspSkinPopupWindow.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;
  if PW <> nil then DrawScrollArea(Cnvs, R);
  DrawArrowImage(Cnvs, R, C, 3);
end;

procedure TspSkinPopupWindow.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;
  if PW <> nil then DrawScrollArea(Cnvs, R);
  DrawArrowImage(Cnvs, R, C, 4);
end;

procedure TspSkinPopupWindow.StartScroll;
var
  i: Integer;
begin
  i := ParentMenu.GetPWIndex(Self);
  WT.Enabled := False;
  ParentMenu.CloseMenu(i + 1);
  KillTimer(Handle, 1);
  SetTimer(Handle, 1, ScrollTimerInterval, nil);
end;

procedure TspSkinPopupWindow.StopScroll;
begin
  ScrollCode := 0;
  DrawUpMarker(Canvas);
  DrawDownMarker(Canvas);
  KillTimer(Handle, 1);
end;

procedure TspSkinPopupWindow.ScrollUp;
begin
  if VisibleStartIndex > 0
  then
    begin
      VisibleStartIndex := VisibleStartIndex - 1;
      CalcItemRects;
      RePaint;
    end
  else
    if Cycle
    then
      begin
        VisibleStartIndex := GetEndStartVisibleIndex;
        CalcItemRects;
        RePaint;
      end;
end;

procedure TspSkinPopupWindow.ScrollDown(Cycle: Boolean);
begin
  if VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1
  then
    begin
      VisibleStartIndex := VisibleStartIndex + 1;
      CalcItemRects;
      RePaint;
    end
  else
    if Cycle
    then
      begin
        VisibleStartIndex := 0;
        CalcItemRects;
        RePaint;
      end;
end;

procedure TspSkinPopupWindow.PopupKeyDown(CharCode: Integer);
var
  PW: TspSkinPopupWindow;

 procedure NextItem;
 var
   i, j: Integer;
 begin
   if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex + VisibleCount - 1)
   then ScrollDown(True);
   OldActiveItem := ActiveItem;
   if ActiveItem < 0 then j := 0 else j := ActiveItem + 1;
   if j = ItemList.Count then j := 0;
   for i := j to ItemList.Count - 1 do
     with TspSkinMenuItem(ItemList.Items[i]) do
     begin
       if MenuItem.Enabled and (MenuItem.Caption <> '-')
       then
         begin
           ActiveItem := i;
           Break;
         end
       else
         begin
           if Scroll and (ScrollCode = 0) and (i = VisibleStartIndex + VisibleCount - 1)
           then ScrollDown(True);
         end;
     end;

   if OldActiveItem <> ActiveItem
   then
     begin
       if ActiveItem > -1 then
       with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
       begin
         MouseEnter(True);
       end;
       if OldActiveItem > -1 then
       with TspSkinMenuItem(ItemList.Items[OldActiveItem]) do
        begin
          MouseLeave;
        end;
     end;
 end;

 procedure PriorItem;
 var
   i, j: Integer;
 begin
   if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex)
   then ScrollUp(True);
   OldActiveItem := ActiveItem;
   if ActiveItem < 0 then j := ItemList.Count - 1 else j := ActiveItem - 1;
   if (j = -1) then j := ItemList.Count - 1;
   for i := j downto 0 do
     with TspSkinMenuItem(ItemList.Items[i]) do
     begin
       if MenuItem.Enabled and (MenuItem.Caption <> '-')
       then
         begin
           ActiveItem := i;
           Break;
         end
       else
         begin
           if Scroll and (ScrollCode = 0) and  (i = VisibleStartIndex)
           then ScrollUp(True);
         end;
     end;

   if OldActiveItem <> ActiveItem
   then
     begin
       if ActiveItem > -1 then
       with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
       begin
         MouseEnter(True);
       end;
       if OldActiveItem > -1 then
       with TspSkinMenuItem(ItemList.Items[OldActiveItem]) do
        begin
          MouseLeave;
        end;
     end;
 end;

function FindHotKeyItem: Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to ItemList.Count - 1 do
      with TspSkinMenuItem(ItemList.Items[i]) do
      begin
        if Enabled and IsAccel(CharCode, MenuItem.Caption)
        then
          begin
            MouseEnter(False);
            OldActiveItem := ActiveItem;
            ActiveItem := i;
            if OldActiveItem <> -1
            then
              TspSkinMenuItem(ItemList.Items[OldActiveItem]).MouseLeave;
            MouseDown(0, 0);
            Result := True;
            Break;
          end;
      end
end;

begin
  if not Visible then Exit;
  if not FindHotKeyItem
  then 
  case CharCode of
    VK_DOWN:
      NextItem;
    VK_UP:
      PriorItem;
    VK_RIGHT:
      begin
        if ActiveItem <> -1
        then
          with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
          begin
            if MenuItem.Count <> 0 then MouseDown(0, 0);