bsskinmenus.pas

布林电话收费管理系统

    VK_LEFT:
      begin
        if ParentMenu.FPopupList.Count > 1
        then
          begin
            ParentMenu.CloseMenu(ParentMenu.FPopupList.Count - 1);
            PW := TbsSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
            if PW.ActiveItem <> -1
            then
              TbsSkinMenuItem(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 := TbsSkinPopupWindow(ParentMenu.FPopupList.Items[ParentMenu.FPopupList.Count - 1]);
            if PW.ActiveItem <> -1
            then
              TbsSkinMenuItem(PW.ItemList.Items[PW.ActiveItem]).Down := False;
          end;   
      end;
  end;
end;

procedure TbsSkinPopupWindow.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 TbsSkinMenuItem(ItemList.Items[i]).Down
    then
      with TbsSkinMenuItem(ItemList.Items[i]) do
      begin
        Down := False;
        ReDraw;
      end;
end;

procedure TbsSkinPopupWindow.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 TbsSkinPopupWindow.CreateRealImage;
var
  R: TRect;
  TextOffset: Integer;
begin
  if PW <> nil
  then
    CreateSkinImage(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, Scroll)
  else
    begin
      B.Width := Width;
      B.Height := Height;
      with B.Canvas do
      begin
        if ImgL = nil
        then TextOffset := 21
        else TextOffset := GlyphWidth + 2;
        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;
end;

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

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

  function GetMenuWindowHeight: Integer;
  var
    i, j, ih: integer;
  begin
    j := 0;
    for i := VisibleStartIndex to VisibleCount - 1 do
    with TbsSkinMenuItem(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);
    end;
    if PW <> nil
    then
      Result := j + PW.ItemsRect.Top + (WindowPicture.Height - PW.ItemsRect.Bottom)
    else
      Result := j + 4;
  end;

  function GetMenuWindowWidth: Integer;
  var
    i, iw: Integer;
  begin
    iw := 0;
    for i := 0 to ItemList.Count - 1 do
    begin
      j := CalcItemTextWidth(TbsSkinMenuItem(ItemList.Items[i]).MenuItem);
      if j > iw then iw := j;
    end;
    inc(iw, 19);
    if ImgL <> nil
    then
      GlyphWidth := ImgL.Width + 5
    else
      GlyphWidth := 19;
    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;
  W := GetMenuWindowWidth;
  H := GetMenuWindowHeight;
  Scroll := False;
  //
  if H > RectHeight(ParentMenu.WorkArea)
  then
    begin
      H := RectHeight(ParentMenu.WorkArea);
      Scroll := True;
    end;  
  //
  Width := W;
  Height := H;
end;

function GetMenuItemData: TbsDataSkinMenuItem;
var
  i: Integer;
begin
  Result := nil;
  if (SD <> nil) and not SD.Empty
  then 
    for i := 0 to SD.ObjectList.Count - 1 do
    if TbsDataSkinObject(SD.ObjectList.Items[i]) is TbsDataSkinMenuItem
    then
      begin
        Result := TbsDataSkinMenuItem(SD.ObjectList.Items[i]);
        Break;
      end;
end;

begin
  DSMI := GetMenuItemData;
  if (PW <> nil) and (DSMI <> nil)
  then
    begin
      with Canvas.Font do
      begin
        Height := DSMI.FontHeight;
        Style := DSMI.FontStyle;
        Name := DSMI.FontName;
        CharSet := ParentMenu.FDefaultMenuItemFont.Charset;
      end;
    end;

  Menu := Item.GetParentMenu;
  ImgL := Menu.Images;
  j := Item.Count;
  for i := StartIndex to  j - 1 do
   if TMenuItem(Item.Items[i]).Visible
   then
    ItemList.Add(TbsSkinMenuItem.Create(Self, TMenuItem(Item.Items[i]), DSMI));
  //

  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(2, 2, Width - 2, Height - 2);
  CalcItemRects;
  if MaskPicture <> nil then SetMenuWindowRegion;
end;

function TbsSkinPopupWindow.GetEndStartVisibleIndex: Integer;
var
  i, j, k, ih, H: Integer;
begin
  j := NewItemsRect.Bottom - MarkerItemHeight;
  H := MarkerItemHeight;
  k := 0;
  for i := ItemList.Count - 1 downto 0 do
  begin
    with TbsSkinMenuItem(ItemList.Items[i]) do
     begin
       if DSMI <> 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;
       j := j - ih;
       if j >= H
       then
         inc(k)
       else
         Break;
     end;
  end;
  Result := ItemList.Count - k;
end;

procedure TbsSkinPopupWindow.CalcItemRects;
var
  i, j, ih, H: Integer;
begin
  j := NewItemsRect.Top;
  H := NewItemsRect.Bottom;
  if Scroll
  then
    begin
      H := H - MarkerItemHeight;
      j := j + MarkerItemHeight;
    end;
  VisibleCount := 0;
  for i := VisibleStartIndex to ItemList.Count - 1 do
    with TbsSkinMenuItem(ItemList.Items[i]) do
     begin
      if DSMI <> 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;
      ObjectRect.Left := NewItemsRect.Left;
      ObjectRect.Right := NewItemsRect.Right;
      ObjectRect.Top := j;
      ObjectRect.Bottom :=  j + ih;
      if ObjectRect.Bottom <= H
      then
        begin
          FVisible := True;
          Inc(VisibleCount)
        end
      else
        Break;
      inc(j, ih);
    end;

  if Scroll
  then
    begin
      if VisibleStartIndex > 0
      then
        for i := 0 to VisibleStartIndex - 1 do
          TbsSkinMenuItem(ItemList.Items[i]).FVisible := False;
      if VisibleCount + VisibleStartIndex <= ItemList.Count - 1
      then
        for i := VisibleCount + VisibleStartIndex to ItemList.Count - 1 do
          TbsSkinMenuItem(ItemList.Items[i]).FVisible := False;
    end;

end;

procedure TbsSkinPopupWindow.CMMouseEnter;
begin
  inherited;
end;

procedure TbsSkinPopupWindow.CMMouseLeave;
begin
  inherited;
end;

procedure TbsSkinPopupWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP;
    ExStyle := WS_EX_TOOLWINDOW;
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  end;
end;

procedure TbsSkinPopupWindow.WMMouseActivate(var Message: TMessage);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TbsSkinPopupWindow.Hide;
begin
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  MorphTimer.Enabled := False;
  MouseTimer.Enabled := False;
  Visible := False;
end;

procedure TbsSkinPopupWindow.Show;

procedure CalcMenuPos(var X, Y: Integer; R: TRect);
var
  WA: TRect;
  ChangeY: Boolean;

  function GetY: Integer;
  var
    Offset: Integer;
  begin
    if Scroll
    then
      Result := WA.Top
    else
      begin
        if PopupByItem
        then
          begin
            Offset := R.Top + Height - NewItemsRect.Top - WA.Bottom;
            if Offset > 0
            then
              begin
                if R.Top < WA.Top + RectHeight(WA) div 2
                then
                  Result := WA.Bottom - Height
                else
                  begin
                    Result := R.Bottom - Height + NewItemsRect.Top;
                    if Result  < WA.Top then Result := WA.Top;
                  end
              end
            else
              Result := R.Top - NewItemsRect.Top;
          end
        else
          begin
            if PopupUp
            then
              begin
                if R.Top - Height < WA.Top
                then
                  begin
                    if R.Top < WA.Top + RectHeight(WA) div 2
                    then
                      begin
                        Result := R.Bottom;
                        Offset := Result + Height - WA.Bottom;
                        if Offset > 0
                        then
                          begin
                            Result  := Result - Offset;
                            ChangeY := True;
                          end;
                       end
                     else
                       begin
                         Result := WA.Top;
                         ChangeY := True;
                       end;
                  end
                else
                  Result  := R.Top - Height;
              end
            else
              begin
                Offset := R.Bottom + Height - WA.Bottom;
                if Offset > 0
                then
                  begin
                    if R.Top < WA.Top + RectHeight(WA) div 2
                    then
                      begin
                        Result := R.Bottom - Offset;
                        ChangeY := True
                      end
                    else
                      begin
                        if R.Top - Height < WA.Top
                        then
                          begin
                            Result := WA.Top;
                            ChangeY := True;
                          end
                        else
                          Result := R.Top - Height;
                      end
                  end
                else
                  Result := R.Bottom;
              end;
          end;
      end;
  end;

  function GetX: Integer;
  begin
    if PopupByItem or Scroll or ChangeY
    then
      begin
        if R.Right + Width + 1 > WA.Right
        then Result := R.Left - Width - 1 else Result := R.Right + 1;
      end
    else
      begin
        if R.Left + Width > WA.Right
        then Result := WA.Right - Width else
        if R.Left < WA.Left then Result := WA.Left else Result := R.Left;
      end;
  end;

begin
  WA := ParentMenu.WorkArea;
  ChangeY := False;
  Y := GetY;
  X := GetX;
end;

const
  WS_EX_LAYERED = $80000;
  AnimationStep = 2;
var
  i: Integer;
  ABV: Integer;
begin
  if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
     ParentMenu.First
  then
    Application.ProcessMessages;
    
  CreateMenu(AItem, StartIndex);
  CalcMenuPos(ShowX, ShowY, R);
  //
  if CheckW2KWXP and ParentMenu.AlphaBlend
  then
    begin
      SetWindowLong(Handle, GWL_EXSTYLE,
                    GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
      if ParentMenu.First and ParentMenu.AlphaBlendAnimation
      then SetAlphaBlendTransparent(Handle, 0)
      else SetAlphaBlendTransparent(Handle, ParentMenu.AlphaBlendValue);
    end;
  //
  SetWindowPos(Handle, HWND_TOPMOST, ShowX, ShowY, 0, 0,
               SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
  Visible := True;
  if CheckW2KWXP and ParentMenu.AlphaBlend and ParentMenu.AlphaBlendAnimation and
     ParentMenu.First
  then
    begin
      i := 0;
      ABV := ParentMenu.AlphaBlendValue;
      repeat
        Inc(i, AnimationStep);
        if i > ABV then i := ABV;
        SetAlphaBlendTransparent(Handle, i);