sskinmenus.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

    else if IsDivText(Item) then begin
      PaintCaption(aCanvas, aRect, Item);
      Exit;
    end;
    it := smNormal;

    // Check for multi-columned menus...
    if (Item.MenuIndex < Item.Parent.Count - 1) then begin
      if (Item.Parent.Items[Item.MenuIndex + 1].Break <> mbNone)
        then BitBlt(ACanvas.Handle, aRect.Left, aRect.Bottom, WidthOf(aRect), MenuBGBmp.Height - 6 - aRect.Bottom, MenuBGBmp.Canvas.Handle, aRect.Left + 3, aRect.Bottom + 3, SrcCopy);
    end
    else if aRect.Bottom < MenuBGBmp.Height - 6
      then BitBlt(ACanvas.Handle, aRect.Left, aRect.Bottom, WidthOf(aRect), MenuBGBmp.Height - 6 - aRect.Bottom, MenuBGBmp.Canvas.Handle, aRect.Left + 3, aRect.Bottom + 3, SrcCopy);
    if (Item.Break <> mbNone) then begin
      BitBlt(ACanvas.Handle, aRect.Left - 4, aRect.Top, 4, MenuBGBmp.Height - 6, MenuBGBmp.Canvas.Handle, aRect.Left - 1, aRect.Top + 3, SrcCopy);
    end; //

    ItemBmp := CreateBmp24(WidthOf(aRect) - ExtraWidth(True) * Br, HeightOf(aRect));
    // Draw MenuItem
    i := TsSkinManager(FOwner).GetSkinIndex(s_MenuItem);
    if TsSkinManager(FOwner).IsValidSkinIndex(i) then begin
      ci := MakeCacheInfo(MenuBGBmp, 3, 3);
      PaintItem(i, s_MenuItem, ci, True, integer(Item.Enabled and {v4.51} (odSelected in State)),
              Rect(0, 0, ItemBmp.Width, HeightOf(aRect)),
              Point(aRect.Left + ExtraWidth(True) * Br, aRect.Top), ItemBmp.Canvas.Handle, FOwner);
    end;

    if odChecked in State then begin
      if Item.RadioItem
        then j := TsSkinManager(FOwner).GetMaskIndex(s_GlobalInfo, s_RadioButtonChecked)
        else j := TsSkinManager(FOwner).GetMaskIndex(s_GlobalInfo, s_CheckGlyph);
      if j = -1 then j := TsSkinManager(FOwner).GetMaskIndex(s_GlobalInfo, s_CheckBoxChecked);
      if j > -1 then begin
        cRect.Top    := 0;
        cRect.Left   := 0;
        cRect.Right  := WidthOf(TsSkinManager(FOwner).ma[j].R) div TsSkinManager(FOwner).ma[j].ImageCount;
        cRect.Bottom := HeightOf(TsSkinManager(FOwner).ma[j].R) div (1 + TsSkinManager(FOwner).ma[j].MaskType);
        OffsetRect(cRect, Margin, (HeightOf(aRect) - HeightOf(cRect)) div 2);
        DrawSkinGlyph(ItemBmp, cRect.TopLeft, integer(Item.Enabled and {v4.51} (odSelected in State)), 1, TsSkinManager(FOwner).ma[j])
      end
    end;

    if not Item.Bitmap.Empty then begin
      gRect.Top := (ItemBmp.Height - GlyphSize(Item, False).cy) div 2;
      if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft)
        then gRect.Left := ARect.Right - gRect.Top - GlyphSize(Item, False).cx
        else gRect.Left := gRect.Top;

      ItemBmp.Canvas.Draw(gRect.Left, gRect.Top, Item.Bitmap);
    end
    else if (Item.GetImageList <> nil) and (Item.ImageIndex >= 0) then begin
      gRect.Top := (ItemBmp.Height - Item.GetImageList.Height) div 2;
      gRect.Left := gRect.Top;
      gRect.Bottom := gRect.top + Item.GetImageList.Height;

      if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft) then begin
        gRect.Left := ARect.Right - gRect.Top - Item.GetImageList.Width;
      end;
      gRect.Right := gRect.Left + Item.GetImageList.Width; 
      Item.GetImageList.Draw(ItemBmp.Canvas, gRect.Left, gRect.Top, Item.ImageIndex, True);
    end;

    // Text writing
    if Assigned(CustomMenuFont) then ItemBmp.Canvas.Font.Assign(CustomMenuFont) else if Assigned(Screen.MenuFont) then ItemBmp.Canvas.Font.Assign(Screen.MenuFont);
    f := GetOwnerForm(Item.GetParentMenu);
    if f <> nil then ItemBmp.Canvas.Font.Charset := f.Font.Charset;

    if odDefault in State then ItemBmp.Canvas.Font.Style := [fsBold];// else ItemBmp.Canvas.Font.Style := [];
    R := TextRect;

    {$IFDEF TNTUNICODE}
     if Sender is TTntMenuItem then
       Text := TTntMenuItem(Sender).Caption
     else
       Text := TMenuItem(Sender).Caption;
      if (Text <> '') and (Text[1] = #8) then begin
        DeleteW(Text, 1, 1);
        Text := Text + '      ';
        DrawStyle := AlignToInt[taRightJustify];
      end
      else DrawStyle := AlignToInt[Alignment];
    {$ELSE}
    Text := Item.Caption;
    if (Text <> '') and (Text[1] = #8) then begin
      Delete(Text, 1, 1);
      Text := Text + '      ';
      DrawStyle := AlignToInt[taRightJustify];
    end
    else DrawStyle := AlignToInt[Alignment];
    {$ENDIF}
    DrawStyle := DrawStyle or DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER or DT_NOCLIP;
    if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft) then DrawStyle := DrawStyle or DT_RIGHT;
{$IFDEF TNTUNICODE}
//    DrawStyle := DrawStyle or DT_HIDEPREFIX;
    sGraphUtils.WriteTextExW(ItemBmp.Canvas, PWideChar(Text), True, R, DrawStyle, i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    Text := ShortCutToText(TMenuItem(Sender).ShortCut);
{$ELSE}
    sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(Text), True, R, DrawStyle, i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    Text := ShortCutToText(TMenuItem(Sender).ShortCut);
{$ENDIF}

    DrawStyle := DT_SINGLELINE or DT_VCENTER or DT_LEFT;


{$IFDEF TNTUNICODE}
    if Text <> '' then begin
      r := ShortCutRect(Text);
      dec(r.Right, 8);
      OffsetRect(R, -ExtraWidth(True), 0);
      sGraphUtils.WriteTextExW(ItemBmp.Canvas, PWideChar(Text), True, R, DrawStyle, i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    end;
{$ELSE}
    if Text <> '' then begin
      r := ShortCutRect(Text);
      dec(r.Right, 8);
      OffsetRect(R, -ExtraWidth(True), 0);
      sGraphUtils.WriteTextEx(ItemBmp.Canvas, PChar(Text), True, R, DrawStyle, i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    end;
{$ENDIF}

    if Assigned(FOnDrawItem) then FOnDrawItem(Item, ItemBmp.Canvas, Rect(0, 0, ItemBmp.Width, ItemBmp.Height), State, it);

    if not Item.Enabled then begin
      C.C := clFuchsia;
      R := aRect;
      OffsetRect(R, BorderWidth + ExtraWidth(True) * Br, BorderWidth);
      BlendTransRectangle(ItemBmp, 0, 0, CI.Bmp, R, DefDisabledBlend, C);
    end;
    BitBlt(ACanvas.Handle, aRect.Left + ExtraWidth(True) * Br, aRect.Top, ItemBmp.Width, ItemBmp.Height, ItemBmp.Canvas.Handle, 0, 0, SrcCopy);
    if (Item = Item.Parent.Items[0]) and (ExtraWidth > 0) then begin
      if not IsNT then begin
        BitBlt(ACanvas.Handle, 0, 0, ExtraWidth * Br + 3, MenuBGBmp.Height, MenuBGBmp.Canvas.Handle, 3, 3, SRCCOPY); // Left
      end
      else if Win32MajorVersion >= 6 then begin
        BitBlt(ACanvas.Handle, 0, 0, ExtraWidth * Br + 3, MenuBGBmp.Height, MenuBGBmp.Canvas.Handle, 3, 3, SRCCOPY); // Left
//        BitBltBorder(ACanvas.Handle, -3, -3, MenuBGBmp.Width, MenuBGBmp.Height, MenuBGBmp.Canvas.Handle, 0, 0, 3);
      end;
    end;
    FreeAndNil(ItemBmp)
  finally
  end;
end;

procedure TsSkinableMenus.InitItems(A: boolean);
var
  i : integer;
  procedure ProcessComponent(c: TComponent);
  var
    i: integer;
  begin
    if (c <> nil) then begin
      if (c is TMainMenu) then begin
        InitMenuLine(TMainMenu(c), A);
        for i := 0 to TMainMenu(c).Items.Count - 1 do HookItem(TMainMenu(c).Items[i], A);
      end
      else begin
        if (c is TPopupMenu) then begin
          if TsSkinManager(FOwner).SkinnedPopups then begin
            HookPopupMenu(TPopupMenu(c), A);
          end;
        end
        else if (c is TMenuItem) then begin
          if not (TMenuItem(c).GetParentMenu is TMainMenu) and TsSkinManager(FOwner).SkinnedPopups then begin
            HookItem(TMenuItem(c), A);
          end;
        end;
      end;
      for i := 0 to c.ComponentCount - 1 do ProcessComponent(c.Components[i]);
    end;
  end;
begin
  try
    FActive := A;
    if (csDesigning in Fowner.ComponentState) then Exit;
    for i := 0 to Application.ComponentCount - 1 do ProcessComponent(Application.Components[i]);
  except
  end;
end;

procedure TsSkinableMenus.HookItem(MenuItem: TMenuItem; FActive: boolean);
var
  i : integer;
  procedure HookSubItems(Item: TMenuItem);
  var
    i : integer;
  begin
    for i := 0 to Item.Count - 1 do begin
      if FActive then begin
        if not IsTopLine(Item.Items[i]) then begin
          if not Assigned(Item.Items[i].OnAdvancedDrawItem) then 
            Item.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
          if not Assigned(Item.Items[i].OnMeasureItem) then
            Item.Items[i].OnMeasureItem := sMeasureItem;
        end;
      end
      else begin
        if addr(Item.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem) then
          Item.Items[i].OnAdvancedDrawItem := nil;
        if addr(Item.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem) then
          Item.Items[i].OnMeasureItem := nil;
      end;
      HookSubItems(Item.Items[i]);
    end;
  end;
begin
  for i := 0 to MenuItem.Count - 1 do begin
    if FActive then begin
      if not IsTopLine(MenuItem.Items[i]) then begin
        if not Assigned(MenuItem.Items[i].OnAdvancedDrawItem) then
          MenuItem.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
        if not Assigned(MenuItem.Items[i].OnMeasureItem) then
          MenuItem.Items[i].OnMeasureItem := sMeasureItem;
      end;
    end
    else begin
      if (addr(MenuItem.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem)) then
        MenuItem.Items[i].OnAdvancedDrawItem := nil;
      if (addr(MenuItem.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem)) then
        MenuItem.Items[i].OnMeasureItem := nil;
    end;
    HookSubItems(MenuItem.Items[i]);
  end;
end;

procedure TsSkinableMenus.SetActive(const Value: boolean);
begin
  if FActive <> Value then begin
    FActive := Value;
    InitItems(Value);
  end
end;

procedure TsSkinableMenus.sMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
var
  Text : string;
  Item : TMenuItem;
  R : TRect;
  f : TCustomForm;
begin
  if csDestroying in TComponent(Sender).ComponentState then Exit;
  acCanHookMenu := True;
  Item := TMenuItem(Sender);
  if CurrentFirstItem <> Item.Parent.Items[0] then begin
    ClearCache;
    CurrentFirstItem := Item.Parent.Items[0];
  end;

  if Item.Caption = cLineCaption then it := smDivider else if IsdivText(Item) then it := smCaption else it := smNormal;

  if not Measuring and not ExtraDefined then begin
    if (Item.Parent.Items[0].Name <> s_SkinSelectItemName) then begin
      Measuring := True;
      ExtraSection := s_MenuExtraLine;
      if ExtraGlyph <> nil then FreeAndNil(ExtraGlyph); 
      ExtraCaption := DontForget;
      ExtraVisible := True;
      if Assigned(TsSkinManager(FOwner).OnGetMenuExtraLineData) then
        TsSkinManager(FOwner).OnGetMenuExtraLineData(Item.Parent.Items[0], ExtraSection, ExtraCaption, ExtraGlyph, ExtraVisible);
      ExtraCaption := DelChars(ExtraCaption, '&');
      if not ExtraVisible and Assigned(ExtraGlyph) then FreeAndNil(ExtraGlyph);

      ExtraDefined := True;
      Measuring := False;
    end else ExtraVisible := False;
  end;

  if Assigned(CustomMenuFont) then ACanvas.Font.Assign(CustomMenuFont) else if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);
  f := GetOwnerForm(Item.GetParentMenu);
  if f <> nil then ACanvas.Font.Charset := f.Font.Charset;

  case it of
    smDivider : begin
      Text := '';
    end;
    smCaption : begin
      Text := cLineCaption + Item.Caption + cLineCaption;
    end
    else begin
      Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
    end;
  end;
  R := Rect(0, 0, 1, 0);
  AcDrawText(ACanvas.Handle, PacChar(Text), R, DT_EXPANDTABS or DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT);
  Width := Margin * 3 + WidthOf(R) + GlyphSize(Item, False).cx * 2 + Spacing;

  if ExtraVisible and not Breaked(Item) then inc(Width, ExtraWidth);
  Height := GetItemHeight(aCanvas, Item);
end;

destructor TsSkinableMenus.Destroy;
begin
  FOwner := nil;
  if Assigned(FCaptionfont) then FreeAndNil(FCaptionFont);
  inherited Destroy;
end;

// Refresh list of all MenuItems on project
procedure TsSkinableMenus.UpdateMenus;
begin
  SetActive(TsSkinManager(FOwner).SkinData.Active);
end;

// Return height of the menu panel
function TsSkinableMenus.ParentHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  i, ret : integer;
begin
  Result := 0;
  ret := 0;
  for i := 0 to Item.Parent.Count - 1 do if Item.Parent.Items[i].Visible then begin
    if Item.Parent.Items[i].Break <> mbNone then begin
      Result := max(Result, ret);
      ret := GetItemHeight(aCanvas, Item.Parent.Items[i]);
    end
    else inc(ret, GetItemHeight(aCanvas, Item.Parent.Items[i]));
  end;
  Result := max(Result, ret);
end;

// Return height of the current MenuItem
function TsSkinableMenus.GetItemHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  Text: string;
  IsDivider : boolean;
begin
  IsDivider  := Item.Caption = cLineCaption;

  if IsDivider then Text := '' else if IsDivText(Item) then begin
    Text := Item.Caption;
  end
  else begin
    Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
  end;
  if Assigned(CustomMenuFont) then ACanvas.Font.Assign(CustomMenuFont) else if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  if IsDivider then begin
    Result := 2;//integer(SkinBorderWidth > 1) + 1;
  end
  else if IsDivText(Item) then begin
    Result := Round(ACanvas.TextHeight('W') * 1.25) + 2 * Margin;
  end