sskinmenus.pas

AlphaControls是一个Delphi标准控件的集合

      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, False).cx * 2;
    end;
  end;

  Height := GetItemHeight(aCanvas, Item);
end;

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

// Refresh list of all MenuItems on project
procedure TsSkinableMenus.UpdateMenus;
begin
  InitItems(sSkinData.Active);
end;

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

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

  if IsDivider then begin
    Text := '';
  end
  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(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  if IsDivider then begin
    Result := 2
  end
  else if IsDivText(Item) then begin
    Result := Round(ACanvas.TextHeight('W') * 1.25) + 2 * Margin;
  end
  else begin
    Result := Maxi(Round(ACanvas.TextHeight('W') * 1.25), GlyphSize(Item, False).cy) + 2 * Margin;
  end;
//  if Item.Parent.Items[0] = Item then inc(Result, max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth));
//  if Item.Parent.Items[Item.Parent.Count - 1] = Item then inc(Result, max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth));
end;

function TsSkinableMenus.IsDivText(Item: TMenuItem): boolean;
begin
  Result := (copy(Item.Caption, 1, 1) = '-') and (copy(Item.Caption, length(Item.Caption), 1) = '-');
end;

procedure TsSkinableMenus.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
//    invalidate;
  end;
end;

function TsSkinableMenus.IsTopLine(Item: TMenuItem): boolean;
var
  i : integer;
  m : TMenu;
begin
  Result := False;
  m := Item.GetParentMenu;
  if m is TMainMenu then begin
    for i := 0 to m.Items.Count - 1 do begin
      if m.Items[i].Name = Item.Name then begin
        Result := True;
      end;
    end;
  end;
end;

procedure TsSkinableMenus.SetBevelWidth(const Value: integer);
begin
  FBevelWidth := Value;
end;

procedure TsSkinableMenus.SetBorderWidth(const Value: integer);
begin
  FBorderWidth := Value;
end;

function TsSkinableMenus.CursorMarginH: integer;
begin
  Result := BorderWidth;
end;

function TsSkinableMenus.CursorMarginV: integer;
begin
  Result := 0;
//  Result := Max(BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone), BorderWidth)
end;

function TsSkinableMenus.ItemRect(Item : TMenuItem; aRect: TRect): TRect;
begin
  Result := aRect;
  if Item.Parent.Items[0] = Item then Result.Top := Result.Top + CursorMarginV;
  if Item.Parent.Items[Item.Parent.Count - 1] = Item then Result.Bottom := Result.Bottom - CursorMarginV;
  Result.Left := Result.Left + CursorMarginH;
  Result.Right := Result.Right - CursorMarginH;
end;

procedure TsSkinableMenus.PaintDivider(aCanvas : TCanvas; aRect : TRect; Item: TMenuItem);
var
  i : integer;
  r : TRect;
begin
  i := 1;
  r := ItemRect(Item, aRect);
  inc(r.Left, Margin);
  dec(r.Right, Margin);

  DrawRectangleOnDC(aCanvas.Handle,
                    r,
                    ColorToRGB(clGray), ColorToRGB(clWhite), i);
end;

procedure TsSkinableMenus.PaintCaption(aCanvas: TCanvas; aRect: TRect; Item : TMenuItem);
//var
//  R, cRect : TRect;
//  s : string;
//  i : integer;
begin

{
  R := ItemRect(Item, aRect);
  if Assigned(FCaptionFont) then sStyle.FCacheBmp.Canvas.Font.Assign(FCaptionFont);
  s := ExtractWord(1, Item.Caption, ['-']);
  sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(s), Item.Enabled, R, DT_VCENTER or DT_CENTER);
  cRect := r;


  r :=  Rect(aRect.Left + Margin + CursorMarginH,
             aRect.Top + HeightOf(aRect) div 2 - 1,
             cRect.Left - Margin - CursorMarginH,
             aRect.Top + HeightOf(aRect) div 2 + 1);

  i := 1;
  DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle,
                    r,
                    ColorToRGB(clGray),
                    ColorToRGB(clWhite),
                    i);

  r :=  Rect(cRect.Right + Margin + CursorMarginH,
             aRect.Top + HeightOf(aRect) div 2 - 1,
             aRect.Right - Margin - CursorMarginH,
             aRect.Top + HeightOf(aRect) div 2 + 1);
  i := 1;
  DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle,
                    r,
                    ColorToRGB(clGray),
                    ColorToRGB(clWhite),
                    i);

  BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
          sStyle.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, SrcCopy);
}
end;

procedure TsSkinableMenus.SetCaptionFont(const Value: TFont);
begin
  FCaptionFont.Assign(Value);
end;

{
procedure TsSkinableMenus.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;
}
procedure TsSkinableMenus.sAdvancedDrawLineItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
{const
  aStates : array [odSelected..odComboBoxEdit] of string = ('odSelected', 'odGrayed', 'odDisabled', 'odChecked',
    'odFocused', 'odDefault', 'odHotLight', 'odInactive', 'odNoAccel', 'odNoFocusRect',
    'odReserved1', 'odReserved2', 'odComboBoxEdit');}
var
  R, gRect : TRect;
  i: integer;
  ci : TCacheInfo;
  Item : TMenuItem;
  Text: string;
  h : integer;
  sp : TsSkinProvider;
  function TextRect: TRect; begin
    Result := aRect;
    inc(Result.Left, Margin);
    dec(Result.Right, Margin);
  end;
  function ShortCutRect: TRect; begin
    Result := aRect;
    Result.Left := WidthOf(TextRect);
  end;
begin
  if (TMenuItem(Sender).Name = 'sMDICII') then Exit
  else if LastItem(TMenuItem(Sender)) then dec(ARect.Right, 40);
  
  Item := TMenuItem(Sender);

  if MDISkinProvider <> nil then begin
    sp := TsSkinProvider(MDISkinProvider);
  end
  else begin
    sp := GetSkinProvider(TComponent(Sender));
  end;

  if sp = nil then inherited
  else begin
    gRect := aRect;

    try
      ci.Bmp := sp.MenuLineBmp;
      ci.X := 0;
      ci.Y := 0;
      ci.Ready := True;

      i := GetSkinIndex(MenuItem);
      h := sp.CaptionHeight + sp.BorderHeight;

      if IsValidSkinIndex(i) then
        PaintItem(i, MenuItem, ci, True, integer((odSelected in State) or (odHotLight in State)), aRect, Point(aRect.Left, aRect.Top - h), ACanvas.Handle)
    finally
    end;

    // Text writing
    if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

    if odDefault in State then begin
      ACanvas.Font.Style := [fsBold];
    end
    else begin
      ACanvas.Font.Style := [];
    end;

    R := TextRect;

    i := GetSkinIndex(MenuLine);
    sGraphUtils.WriteTextEx(ACanvas, PChar(Item.Caption), Item.Enabled, R, DT_VCENTER or AlignToInt[Alignment], i, ((odSelected in State) or (odHotLight in State)));
    Text := ShortCutToText(TMenuItem(Sender).ShortCut);
    if Text <> '' then begin
      r := ShortCutRect;
      dec(r.Right, 8);
      sGraphUtils.WriteTextEx(ACanvas, PChar(Text), Item.Enabled, R, DT_VCENTER or DT_RIGHT, i, ((odSelected in State) or (odHotLight in State)));
    end;

    if Assigned(FOnDrawItem) then FOnDrawItem(Item, ACanvas, ARect, State, smTopLine);
  end;
end;


procedure TsSkinableMenus.sMeasureLineItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
var
  Text: string;
  Item: TMenuItem;
  W : integer;
  c : string;
begin
  Item := TMenuItem(Sender);
  c := Item.Caption;

  Height := GetSystemMetrics(SM_CYMENU) - 1;
  // If MDI child icon item
  if Item.Name = 'sMDICII' then begin
    Width := 8;
    Exit;
  end;

  if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
  W := ACanvas.TextWidth(Text) + Margin;
  Inc(W, 5);
  if pos('&', Text) > 0 then
      W := W - ACanvas.TextWidth('&');


  if (Item.Parent.Items[0] = Item) and ChildIconPresent then begin
    inc(W, TsSkinProvider(MDISkinProvider).Form.ActiveMDIChild.Icon.Width);
  end;

  // If last item (for MDIChild buttons drawing
  if LastItem(Item) then begin
    inc(W, 40);
  end;
  if Width < W then Width := W;
end;

procedure TsSkinableMenus.InitItem(Item: TMenuItem; A : boolean);
begin
  if A then begin
    if not IsTopLine(Item) then begin
      if not Assigned(Item.OnAdvancedDrawItem) then
        Item.OnAdvancedDrawItem := sAdvancedDrawItem;
      if not Assigned(Item.OnMeasureItem) then
        Item.OnMeasureItem := sMeasureItem;
    end
    else begin
//      if not Assigned(Item.OnAdvancedDrawItem) then
      Item.OnAdvancedDrawItem := sAdvancedDrawLineItem;
//      if not Assigned(Item.OnMeasureItem) then
      Item.OnMeasureItem := sMeasureLineItem;
    end;
  end
  else begin
    if (addr(Item.OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem)) then
      Item.OnAdvancedDrawItem := nil;
    if (addr(Item.OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem)) then
      Item.OnMeasureItem := nil;
  end;
end;

procedure TsSkinableMenus.InitMenuLine(Menu: TMainMenu; A: boolean);
var
  i : integer;
begin
  Menu.OwnerDraw := A;
  // Menu line drawing initialization
  for i := 0 to Menu.Items.Count - 1 do begin
    if A then begin
      if sSkinData.Active then
        Menu.Items[i].OnAdvancedDrawItem := sAdvancedDrawLineItem;
      Menu.Items[i].OnMeasureItem := sMeasureLineItem;
    end
    else begin
      if addr(Menu.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawLineItem) then
        Menu.Items[i].OnAdvancedDrawItem := nil;
      if addr(Menu.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureLineItem) then
        Menu.Items[i].OnMeasureItem := nil;
    end;
  end;
end;

procedure TsSkinableMenus.HookPopupMenu(Menu: TPopupMenu; Active: boolean);
var
  i : integer;
  procedure HookSubItems(Item: TMenuItem);
  var
    i : integer;
  begin
    for i := 0 to Item.Count - 1 do begin
      if Active 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
      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
  Menu.OwnerDraw := Active;
  for i := 0 to Menu.Items.Count - 1 do begin
    if Active then begin
      if not Assigned(Menu.Items[i].OnAdvancedDrawItem) then
        Menu.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
      if not Assigned(Menu.Items[i].OnMeasureItem) then
        Menu.Items[i].OnMeasureItem := sMeasureItem;
    end
    else begin
      if (addr(Menu.Items[i].OnAdvancedDrawItem) = addr(TsSkinableMenus.sAdvancedDrawItem))
        then Menu.Items[i].OnAdvancedDrawItem := nil;
      if (addr(Menu.Items[i].OnMeasureItem) = addr(TsSkinableMenus.sMeasureItem))
        then Menu.Items[i].OnMeasureItem := nil;
    end;
    HookSubItems(Menu.Items[i]);
  end;
end;

procedure TsSkinableMenus.HookPopups(Cmp: TComponent);
var
  i : integer;
begin
  for i := 0 to Cmp.ComponentCount - 1 do begin
    if (Cmp.Components[i] is TPopupMenu) then begin
      HookPopupMenu(TPopupMenu(Cmp.Components[i]), True);
    end
    else HookPopups(Cmp.Components[i]);
  end;
end;

function TsSkinableMenus.LastItem(Item: TMenuItem): boolean;
begin
  Result := (Item.Parent.Items[Item.Parent.Count - 1] = Item) and ChildIconPresent;
end;

initialization

finalization
  DeleteUnusedBmps(True);

end.