skinmenus.pas

一套及时通讯的原码

  if AlphaBlend and not CheckW2KWXP
  then
    WT.Enabled := True
  else
    begin
      //
      if (PW <> nil) and (PW.CursorIndex <> -1)
      then
        Cursor := SD.StartCursorIndex + PW.CursorIndex;
      //
      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, 2);
            if i > ABV then i := ABV;
            SetAlphaBlendTransparent(Handle, i);
          until i >= ABV;
        end;
      //
      MouseTimer.Enabled := True;
      ActiveItem := -1;
      if ItemList.Count > 0
      then
        for i := 0 to ItemList.Count - 1 do
        with TspSkinMenuItem(ItemList.Items[i]) do
        begin
          if MenuItem.Enabled
          then
            begin
              ActiveItem := i;
              MouseEnter(True);
              Break;
            end;
        end;
      //
    end;
end;

procedure TspSkinPopupWindow.PaintMenu;
var
  C: TCanvas;
  i: Integer;
  B: TBitMap;
begin
  C := TCanvas.Create;
  C.Handle := DC;
  B := TBitMap.Create;
  CreateRealImage(B);
  // Draw items
  for i := VisibleStartIndex to VisibleStartIndex + VisibleCount - 1 do
    TspSkinMenuItem(ItemList.Items[i]).Draw(B.Canvas);
  // markers
  if Scroll
  then
    begin
      DrawUpMarker(B.Canvas);
      DrawDownMarker(B.Canvas);
    end;
  C.Draw(0, 0, B);
  B.Free;
  C.Free;
end;

procedure TspSkinPopupWindow.WMEraseBkgrnd;
begin
  PaintMenu(Message.WParam);
end;

procedure TspSkinPopupWindow.MouseUp;
begin
  TestActive(X, Y);
  if (ActiveItem <> -1) and (Button = mbleft) and GetActive(X, Y)
  then
    with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
     if MenuItem.Caption <> '-' then MouseDown(X, Y);
end;

procedure TspSkinPopupWindow.TestMouse;
var
  P, P1: TPoint;
begin
  GetCursorPos(P1);
  P := ScreenToClient(P1);
  if (OMX <> P.X) or (OMY <> P.Y)
  then 
    if InWindow(P1)
    then
      TestActive(P.X, P.Y)
    else
      if Scroll
      then
        begin
          ScrollCode := 0;
          DrawUpMarker(Canvas);
          DrawDownMarker(Canvas);
        end;
  OMX := P.X;
  OMY := P.Y;
end;

function TspSkinPopupWindow.GetActive;
var
  i: Integer;
begin
  i := -1;
  if ItemList.Count = 0
  then
    Result := False
  else
  repeat
    Inc(i);
    with TspSkinMenuItem(ItemList.Items[i]) do
      Result := FVisible and PtInRect(ObjectRect, Point(X, Y));
  until Result or (i = ItemList.Count - 1);
end;

procedure TspSkinPopupWindow.TestActive;
var
  i: Integer;
  B: Boolean;
  R1, R2: TRect;
begin
  if Scroll
  then
    begin
      R1 := Rect(NewItemsRect.Left, NewItemsRect.Top,
            NewItemsRect.Right, NewItemsRect.Top + MarkerItemHeight);
      R2 := Rect(NewItemsRect.Left, NewItemsRect.Bottom - MarkerItemHeight,
            NewItemsRect.Right, NewItemsRect.Bottom);

      if PtInRect(R1, Point(X, Y)) and (ScrollCode = 0) and CanScroll(1)
      then
        begin
          ScrollCode := 1;
          DrawUpMarker(Canvas);
          StartScroll;
        end
      else
      if PtInRect(R2, Point(X, Y)) and (ScrollCode = 0)  and CanScroll(2)
      then
        begin
          ScrollCode := 2;
          DrawDownMarker(Canvas);
          StartScroll;
        end
      else
        if (ScrollCode <> 0) and not PtInRect(R1, Point(X, Y)) and
                                 not PtInRect(R2, Point(X, Y))
        then
          StopScroll;
     end;

  if (ItemList.Count = 0) then Exit;

  OldActiveItem := ActiveItem;

  i := -1;
  repeat
    Inc(i);
    with TspSkinMenuItem(ItemList.Items[i]) do
    begin
      B := FVisible and PtInRect(ObjectRect, Point(X, Y));
    end;
  until B or (i = ItemList.Count - 1);

  if B then ActiveItem := i;

  if OldActiveItem >= ItemList.Count then OldActiveItem := -1;
  if ActiveItem >= ItemList.Count then ActiveItem := -1;

  if (OldActiveItem <> ActiveItem)
  then
    begin
      if OldActiveItem <> - 1
      then
        with TspSkinMenuItem(ItemList.Items[OldActiveItem]) do
        begin
          if MenuItem.Enabled and (MenuItem.Caption <> '-')
          then
            MouseLeave;
        end;

      if ActiveItem <> - 1
      then
        with TspSkinMenuItem(ItemList.Items[ActiveItem]) do
        begin
          if MenuItem.Enabled and (MenuItem.Caption <> '-')
          then
            MouseEnter(False);
        end;
    end;

end;

function TspSkinPopupWindow.InWindow;
var
  H: HWND;
begin
  H := WindowFromPoint(P);
  Result := H = Handle;
end;

//====================TspSkinMenu===================//
constructor TspSkinMenu.CreateEx;
begin
  inherited Create(AOwner);
  FPopupList := TList.Create;
  WaitTimer := TTimer.Create(Self);
  WaitTimer.Enabled := False;
  WaitTimer.OnTimer := WaitItem;
  WaitTimer.Interval := WaitTimerInterval;
  WItem := nil;
  FVisible := False;
  FForm := AForm;
  AlphaBlend := False;
  AlphaBlendValue := 200;
  PopupCtrl := nil;
  FDefaultMenuItemHeight := 20;
  FDefaultMenuItemFont := TFont.Create;
  with FDefaultMenuItemFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
end;

destructor TspSkinMenu.Destroy;
begin
  CloseMenu(0);
  FPopupList.Free;
  WaitTimer.Free;
  FDefaultMenuItemFont.Free;
  inherited Destroy;
end;

procedure TspSkinMenu.SetDefaultMenuItemFont(Value: TFont);
begin
  FDefaultMenuItemFont.Assign(Value);
end;

function TspSkinMenu.GetWorkArea;
var
  R: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
  Result := R;
end;

procedure TspSkinMenu.WaitItem(Sender: TObject);
begin
  if WItem <> nil then CheckItem(WItem.Parent, WItem, True, False);
  WaitTimer.Enabled := False;
end;

function TspSkinMenu.GetPWIndex;
var
  i: Integer;
begin
  for i := 0 to FPopupList.Count - 1 do
    if PW = TspSkinPopupWindow(FPopupList.Items[i]) then Break;
  Result := i;
end;

procedure TspSkinMenu.CheckItem;
var
  Menu: TMenu;
  MenuI: TMenuItem;
  i: Integer;
  R: TRect;
begin
  if (MI.MenuItem.Count = 0) and not Down
  then
    begin
      WaitTimer.Enabled := False;
      WItem := nil;
      i := GetPWIndex(PW);
      if i < FPopupList.Count - 1 then CloseMenu(i + 1);
    end
  else
  if (MI.MenuItem.Count = 0) and Down
  then
    begin
      WaitTimer.Enabled := False;
      WItem := nil;
      MenuI := MI.MenuItem;
      Hide;
      Menu := MenuI.GetParentMenu;
      Menu.DispatchCommand(MenuI.Command);
    end
  else
  if (MI.MenuItem.Count <> 0) and not Down and not Kb
  then
    begin
      WaitTimer.Enabled := False;
      WItem := nil;
      i := GetPWIndex(PW);
      if i < FPopupList.Count - 1 then CloseMenu(i + 1);
      WItem := MI;
      WaitTimer.Enabled := True;
    end
  else
  if (MI.MenuItem.Count <> 0) and Down
  then
    begin
      //
      MenuI := MI.MenuItem;
      Menu := MenuI.GetParentMenu;
      Menu.DispatchCommand(MenuI.Command);
      //
      WaitTimer.Enabled := False;
      WItem := nil;
      MI.Down := True;
      R.Left := PW.Left + MI.ObjectRect.Left;
      R.Top := PW.Top + MI.ObjectRect.Top;
      R.Right := PW.Left + MI.ObjectRect.Right;
      R.Bottom := PW.Top + MI.ObjectRect.Bottom;
      PopupSub(R, MI.MenuItem, 0, True, False);
    end
end;

procedure TspSkinMenu.Popup;
begin
  FFirst := not FVisible;
  PopupCtrl := APopupCtrl;
  if FPopupList.Count <> 0 then CloseMenu(0);
  WorkArea := GetWorkArea;
  SkinData := ASkinData;
  if (AItem.Count = 0) then Exit;
  FVisible := True;
  PopupSub(R, AItem, StartIndex, False, PopupUp);
  FFirst := False;
end;

procedure TspSkinMenu.PopupSub;
begin
  if (SkinData = nil) or (SkinData.Empty)
  then
    FPopupList.Add(TspSkinPopupWindow.CreateEx(Self, Self, nil))
  else
    FPopupList.Add(TspSkinPopupWindow.CreateEx(Self, Self, SkinData.PopupWindow));
  with TspSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]) do
    Show(R, AItem, StartIndex, PopupByItem, PopupUp);
end;

procedure TspSkinMenu.CloseMenu;
var
  i: Integer;
begin
  for i := FPopupList.Count - 1 downto EndIndex do
  begin
    TspSkinPopupWindow(FPopupList.Items[i]).Free;
    FPopupList.Delete(i);
  end;
  if EndIndex = 0
  then
    begin
      WaitTimer.Enabled := False;
      FVisible := False;
      if PopupCtrl <> nil
      then
        begin
          if PopupCtrl is TWinControl
          then
            SendMessage(TWinControl(PopupCtrl).Handle, WM_CLOSESKINMENU, 0, 0)
          else
            PopupCtrl.Perform(WM_CLOSESKINMENU, 0, 0);
          PopupCtrl := nil;
        end;
    end;
end;

procedure TspSkinMenu.Hide;
begin
  CloseMenu(0);
  WaitTimer.Enabled := False;
  WItem := nil;
  if FForm <> nil then
  SendMessage(FForm.Handle, WM_CLOSESKINMENU, 0, 0);
  if PopupCtrl <> nil
  then
    begin
      if PopupCtrl is TWinControl
      then
        SendMessage(TWinControl(PopupCtrl).Handle, WM_CLOSESKINMENU, 0, 0)
       else
         PopupCtrl.Perform(WM_CLOSESKINMENU, 0, 0);
      PopupCtrl := nil;
    end;
end;

//============= TspSkinPopupMenu =============//
function FindDSFComponent(AForm: TForm): TSpDynamicSkinForm;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to AForm.ComponentCount - 1 do
   if AForm.Components[i] is TspDynamicSkinForm
   then
     begin
       Result := TspDynamicSkinForm(AForm.Components[i]);
       Break;
     end;
end;

constructor TspSkinPopupMenu.Create;
begin
  inherited Create(AOwner);
  FComponentForm := nil;
  FSD := nil;
end;

procedure TspSkinPopupMenu.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;

procedure TspSkinPopupMenu.PopupFromRect;
var
  DSF: TspDynamicSkinForm;
begin
  if Assigned(OnPopup) then OnPopup(Self);
  if FComponentForm = nil
  then
    begin
      //DSF := FindDSFComponent(TForm(Owner))
      if Owner.InheritsFrom(TForm) then
        DSF := FindDSFComponent(TForm(Owner)) else
         if Owner.Owner.InheritsFrom(TForm) then
         DSF := FindDSFComponent(TForm(Owner.Owner)) else
           DSF := nil;
    end
  else
    DSF := FindDSFComponent(FComponentForm);
  if (DSF <> nil) and (FSD = nil)
  then
    if DSF.MenusSkinData = nil
    then
      FSD := DSF.SkinData
    else
      FSD := DSF.MenusSkinData;
  if DSF <> nil
  then
    begin
      DSF.SkinMenuOpen;
      DSF.SkinMenu.Popup(nil, FSD, 0, R, Items, APopupUp);
    end;
end;

procedure TspSkinPopupMenu.Popup;
var
  DSF: TspDynamicSkinForm;
var
  R: TRect;
begin
  if Assigned(OnPopup) then OnPopup(Self);
  if FComponentForm = nil
  then
    begin
      //DSF := FindDSFComponent(TForm(Owner))
      if Owner.InheritsFrom(TForm) then
        DSF := FindDSFComponent(TForm(Owner)) else
         if Owner.Owner.InheritsFrom(TForm) then
         DSF := FindDSFComponent(TForm(Owner.Owner)) else
           DSF := nil;
    end
  else
    DSF := FindDSFComponent(FComponentForm);
  if (DSF <> nil) and (FSD = nil)
  then
    if DSF.MenusSkinData = nil
    then
      FSD := DSF.SkinData
    else
      FSD := DSF.MenusSkinData;
  if DSF <> nil
  then
    begin
      DSF.SkinMenuOpen;
      R := Rect(X, Y, X, Y);
      DSF.SkinMenu.Popup(nil, FSD, 0, R, Items, False);
    end;
end;

procedure TspSkinPopupMenu.PopupFromRect2;
var
  DSF: TspDynamicSkinForm;
begin
  if Assigned(OnPopup) then OnPopup(Self);
  if FComponentForm = nil
  then
    begin
      //DSF := FindDSFComponent(TForm(Owner))
      if Owner.InheritsFrom(TForm) then
        DSF := FindDSFComponent(TForm(Owner)) else
         if Owner.Owner.InheritsFrom(TForm) then
         DSF := FindDSFComponent(TForm(Owner.Owner)) else
           DSF := nil;
    end
  else
    DSF := FindDSFComponent(FComponentForm);
  if (DSF <> nil) and (FSD = nil)
  then
    if DSF.MenusSkinData = nil
    then
      FSD := DSF.SkinData
    else
      FSD := DSF.MenusSkinData;
  if DSF <> nil
  then
    begin
      DSF.SkinMenuOpen;
      DSF.SkinMenu.Popup(ACtrl, FSD, 0, R, Items, APopupUp);
    end;
end;

procedure TspSkinPopupMenu.Popup2;
var
  R: TRect;
  DSF: TspDynamicSkinForm;
begin
  if Assigned(OnPopup) then OnPopup(Self);
  if FComponentForm = nil
  then
    begin
      //DSF := FindDSFComponent(TForm(Owner))
      if Owner.InheritsFrom(TForm) then
        DSF := FindDSFComponent(TForm(Owner)) else
         if Owner.Owner.InheritsFrom(TForm) then
         DSF := FindDSFComponent(TForm(Owner.Owner)) else
           DSF := nil;
    end
  else
    DSF := FindDSFComponent(FComponentForm);
  if (DSF <> nil) and (FSD = nil)
  then
    if DSF.MenusSkinData = nil
    then
      FSD := DSF.SkinData
    else
      FSD := DSF.MenusSkinData;
  if (DSF <> nil) and (FSD <> nil)
  then
    begin
      DSF.SkinMenuOpen;
      R := Rect(X, Y, X, Y);
      DSF.SkinMenu.Popup(ACtrl, FSD, 0, R, Items, False);
    end;
end;

end.