skinmenus.pas

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

          end;
      end;
    VK_RETURN:
      begin
        if ActiveItem <> -1
        then
          with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
          begin
            MouseDown(0, 0);
          end;
      end;
    VK_LEFT:
      begin
        if ParentMenu.FPopupList.Count > 1
        then
          begin
            ParentMenu.CloseMenu(ParentMenu.FPopupList.Count - 1);
            PW := TspSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
            if PW.ActiveItem <> -1
            then
              TspSkinMenuItem(PW.ItemList.Items[PW.ActiveItem]).Down := False;
          end
      end;
    VK_ESCAPE:
      begin
        ParentMenu.CloseMenu(ParentMenu.FPopupList.Count - 1);
        if ParentMenu.FPopupList.Count > 0
        then
          begin
            PW := TspSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
            if PW.ActiveItem <> -1
            then
              TspSkinMenuItem(PW.ItemList.Items[PW.ActiveItem]).Down := False;
          end;   
      end;
  end;
end;

procedure TspSkinPopupWindow.WTProc;
begin
  Sc.Width := Width + 1;
  Sc.Height := Height + 1;

  GetScreenImage(ShowX, ShowY, Sc);
  ESc := TspEffectBMP.CreateFromhWnd(Sc.Handle);

  //
  if (PW <> nil) and (PW.CursorIndex <> -1)
  then
    Cursor := SD.StartCursorIndex + PW.CursorIndex;
  //

  SetWindowPos(Handle, HWND_TOPMOST, ShowX, ShowY, 0, 0,
      SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);

  Visible := True;

  MouseTimer.Enabled := True;
  if ItemList.Count > 0
  then
    begin
      ActiveItem := 0;
      TspSkinMenuItem(ItemList.Items[0]).MouseEnter(True);
    end;

  WT.Enabled := False;
end;

procedure TspSkinPopupWindow.UpDatePW;
var
  i: Integer;
  j: Integer;
begin
  j := ParentMenu.GetPWIndex(Self);
  if j + 1 < ParentMenu.FPopupList.Count
  then ParentMenu.CloseMenu(j + 1);
  for i := 0 to ItemList.Count - 1 do
    if TspSkinMenuItem(ItemList.Items[i]).Down
    then
      with TspSkinMenuItem(ItemList.Items[i]) do
      begin
        Down := False;
        if EnableAnimation and not MI.InActiveAnimation
        then
          begin
            CurrentFrame := 0;
            Draw(Canvas);
          end
        else
          ReDraw;
      end;
end;

procedure TspSkinPopupWindow.DrawScrollArea(Cnvs: TCanvas; R: TRect);
var
  Buffer, Buffer2: TBitMap;
  MI: TspDataSkinMenuItem;
  I: Integer;
  ActivePicture: TBitMap;
begin
  I := SD.GetIndex('menuitem');
  if I = -1 then SD.GetIndex('MENUITEM');
  if I = -1 then Exit;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(R);
  Buffer.Height := RectHeight(R);
  MI := TspDataSkinMenuItem(SD.ObjectList[I]);
  ActivePicture := TBitMap(SD.FActivePictures.Items[MI.ActivePictureIndex]);
  if DSMI.InActiveTransparent and (FPaintBuffer <> nil)
  then
    begin
      Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
       FPaintBuffer.Canvas, R);
    end
  else
  CreateHSkinImage(MI.ItemLO, MI.ItemRO,
    Buffer, ActivePicture, MI.SkinRect,
   RectWidth(R), RectHeight(MI.SkinRect), MI.InActiveStretchEffect);
  Buffer.Height := RectHeight(R);
  Cnvs.Draw(R.Left, R.Top, Buffer);
  Buffer.Free;
end;


procedure TspSkinPopupWindow.TestMorph;
var
  i: Integer;
  StopMorph: Boolean;
begin
  if PW = nil then Exit;
  StopMorph := True;
  for i := 0 to ItemList.Count  - 1 do
    with TspSkinMenuItem(ItemList.Items[i]) do
    begin
      if EnableMorphing and CanMorphing
      then
        begin
          DoMorphing;
          StopMorph := False;
        end
      else
      if EnableAnimation
      then
        begin
          if Active and (CurrentFrame <= MI.FrameCount)
            then
              begin
                Inc(CurrentFrame);
                Draw(Canvas);
                StopMorph := False;
              end
            else
            if not Active and (CurrentFrame > 0)
            then
              begin
                Dec(CurrentFrame);
                Draw(Canvas);
                StopMorph := False;
              end;
        end;
    end;
  if StopMorph then MorphTimer.Enabled := False;
end;

procedure TspSkinPopupWindow.SetMenuWindowRegion;
var
  TempRgn: HRgn;
begin
  if PW = nil then Exit;
  TempRgn := FRgn;
  CreateSkinRegion
    (FRgn, PW.LTPoint, PW.RTPoint, PW.LBPoint, PW.RBPoint, PW.ItemsRect,
     NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewItemsRect,
     MaskPicture, Width, Height);
  SetWindowRgn(Handle, FRgn, True);
  if TempRgn <> 0 then DeleteObject(TempRgn);
end;

procedure TspSkinPopupWindow.CreateRealImage;
var
  EB1: TspEffectBmp;
  Kf: Double;
  R: TRect;
  TextOffset: Integer;
begin
  if PW <> nil
  then
    CreateSkinImageBS(PW.LTPoint, PW.RTPoint, PW.LBPoint, PW.RBPoint,
      PW.ItemsRect, NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint,
      NewItemsRect, B, WindowPicture,
      Rect(0, 0, WindowPicture.Width, WindowPicture.Height),
      Width, Height, ADrawClient,
      PW.LeftStretch, PW.TopStretch,
      PW.RightStretch, PW.BottomStretch, PW.StretchEffect, PW.StretchType)
  else
    begin
      B.Width := Width;
      B.Height := Height;
      with B.Canvas do
      begin
        if ImgL = nil
        then TextOffset := 22
        else TextOffset := GlyphWidth + 3;
        R := Rect(0, 0, TextOffset, Height);
        Brush.Color := clBtnFace;
        FillRect(R);
        R := Rect(TextOffset, 0, Width, Height);
        Brush.Color := clWindow;
        FillRect(R);
      end;
      R := Rect(0, 0, Width, Height);
      Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
      Frame3D(B.Canvas, R, clWindow, clWindow, 1);
    end;

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

procedure TspSkinPopupWindow.CreateMenu;
var
  sw, sh: Integer;
  i, j: Integer;
  Menu: TMenu;

  function CalcItemTextWidth(Item: TMenuItem): Integer;
  var
    R: TRect;
    MICaption: WideString;
  begin
   if Item.ShortCut <> 0
   then
     MICaption := Item.Caption + '  ' + ShortCutToText(Item.ShortCut)
   else
     MICaption := Item.Caption;
    R := Rect(0, 0, 0, 0);
    SPDrawSkinText(Canvas, MICaption, R, DT_CALCRECT);
    Result := R.Right + 2;
  end;

  function GetMenuWindowHeight: Integer;
  var
    i, j, k, ih: integer;
  begin
    j := 0;
    k := 0;
    for i := VisibleStartIndex to VisibleCount - 1 do
    with TspSkinMenuItem(ItemList.Items[i]) do
     begin
      if PW <> nil
      then
        begin
          if MenuItem.Caption = '-'
          then ih := RectHeight(DSMI.DividerRect)
          else ih := RectHeight(DSMI.SkinRect);
        end
      else
        begin
          if MenuItem.Caption = '-'
          then ih := 4
          else ih := ParentMenu.DefaultMenuItemHeight;
        end;
      inc(j, ih);
      inc(k);
    end;

    if (ParentMenu.MaxMenuItemsInWindow <> 0) and (ParentMenu.MaxMenuItemsInWindow < k)
    then
      begin
        if PW <> nil
        then
          ih := RectHeight(DSMI.SkinRect)
        else
          ih := ParentMenu.DefaultMenuItemHeight;
        j := ParentMenu.MaxMenuItemsInWindow * ih;
        if PW <> nil
        then
          Result := j + PW.ItemsRect.Top + (WindowPicture.Height - PW.ItemsRect.Bottom)
        else
          Result := j + 6;
        Result := Result + MarkerItemHeight * 2;
        Self.Scroll := True;
        Self.Scroll2 := True;
      end
    else
      begin
        if PW <> nil
        then
          Result := j + PW.ItemsRect.Top + (WindowPicture.Height - PW.ItemsRect.Bottom)
        else
          Result := j + 6;
      end;
      
  end;

  function GetMenuWindowWidth: Integer;
  var
    i, iw: Integer;
  begin
    iw := 0;
    for i := 0 to ItemList.Count - 1 do
    begin
      j := CalcItemTextWidth(TspSkinMenuItem(ItemList.Items[i]).MenuItem);
      if j > iw then iw := j;
    end;
    inc(iw, 16);
    if ImgL <> nil
    then
      GlyphWidth := ImgL.Width + 5
    else
      GlyphWidth := 16;
    Inc(iw, GlyphWidth);
    if (PW <> nil)
    then
      begin
        Inc(iw, DSMI.TextRct.Left);
        Inc(iw, RectWidth(DSMI.SkinRect) - DSMI.TextRct.Right);
        Result := iw + PW.ItemsRect.Left + (WindowPicture.Width - PW.ItemsRect.Right);
      end
    else
      Result := iw + 10;
  end;


procedure CalcSizes;
var
  W, H: Integer;
begin
  //
  VisibleStartIndex := 0;
  VisibleCount := ItemList.Count;
  Scroll := False;
  Scroll2 := False;
  W := GetMenuWindowWidth;
  H := GetMenuWindowHeight;
  //
  if H > RectHeight(ParentMenu.WorkArea)
  then
    begin
      H := RectHeight(ParentMenu.WorkArea);
      Scroll := True;
    end;  
  //
  Width := W;
  Height := H;
end;

begin
  if SD <> nil
  then
    begin
      i := SD.GetIndex('MENUITEM');
      if i = -1 then i := SD.GetIndex('menuitem');
    end
  else
    i := -1;

  if (PW <> nil) and (i <> - 1) and ParentMenu.UseSkinFont
  then
    begin
      // init menu
      DSMI := TspDataSkinMenuItem(SD.ObjectList.Items[i]);
      with Canvas.Font do
      begin
        Height := DSMI.FontHeight;
        Style := DSMI.FontStyle;
        Name := DSMI.FontName;
        CharSet := ParentMenu.FDefaultMenuItemFont.Charset;
      end;
    end
  else
    begin
      if (i <> -1)
      then
        DSMI := TspDataSkinMenuItem(SD.ObjectList.Items[i])
      else
        DSMI := nil;
      Canvas.Font.Assign(Self.ParentMenu.FDefaultMenuItemFont);
    end;

  Menu := Item.GetParentMenu;

  if (Menu <> nil) and (Menu.AutoLineReduction = maAutomatic)
  then
    Item.RethinkLines;

  if Menu <> nil
  then
    ImgL := Menu.Images
  else
    ImgL := nil;

  j := Item.Count;
  for i := StartIndex to  j - 1 do
   if TMenuItem(Item.Items[i]).Visible
   then
     begin
       if TMenuItem(Item.Items[i]).Action <> nil
       then
         TMenuItem(Item.Items[i]).Action.Update;
       ItemList.Add(TspSkinMenuItem.Create(Self, TMenuItem(Item.Items[i]), DSMI));
     end;
  //

  CalcSizes;

  if PW <> nil
  then
    begin
      sw := WindowPicture.Width;
      sh := WindowPicture.Height;
      NewLTPoint := PW.LTPoint;
      NewRTPoint := Point(Width - (sw - PW.RTPoint.X), PW.RTPoint.Y);
      NewLBPoint := Point(PW.LBPoint.X, Height - (sh - PW.LBPoint.Y));
      NewRBPoint := Point(Width - (sw - PW.RBPoint.X),
                          Height - (sh - PW.RBPoint.Y));

      NewItemsRect := Rect(PW.ItemsRect.Left, PW.ItemsRect.Top,
                           Width - (sw - PW.ItemsRect.Right),
                           Height - (sh - PW.ItemsRect.Bottom));

    end
  else
    NewItemsRect := Rect(3, 3, Width - 3, Height - 3);
  CalcItemRects;
  if MaskPicture <> nil then SetMenuWindowRegion;
end;

procedure TspSkinPopupWindow.CreateMenu2;
var
  sw, sh: Integer;
  i, j: Integer;
  Menu: TMenu;

  function CalcItemTextWidth(Item: