sskinmenus.pas

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

    if csDestroying in Menu.ComponentState then Exit;
    Menu.OwnerDraw := A;
  finally
  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;
  if Active then Menu.MenuAnimation := Menu.MenuAnimation + [maNone] else Menu.MenuAnimation := Menu.MenuAnimation - [maNone];
  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;

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

function TsSkinableMenus.IsPopupItem(Item: TMenuItem): boolean;
var
  mi : TMenu;
begin
  mi := Item.GetParentMenu;
  Result := mi is TPopupMenu;
end;

procedure ClearCache;
begin
  CurrentFirstItem := nil;
  if Assigned(MenuBGBmp) then FreeAndNil(MenuBGBmp);
  ExtraVisible := False;
  ExtraDefined := False;
end;

function MenuWindowProc(Wnd: HWND; uMsg: integer; WParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  R : TRect;
begin
  case uMsg of
    WM_NCPAINT : begin
      GetWindowRect(Wnd, R);
      if (Win32MajorVersion >= 6) and (MenuBGBmp <> nil) and (MenuBGBmp.Width = WidthOf(R)) and (MenuBGBmp.Height = HeightOf(R)) then begin
      end
      else CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), wnd, uMsg, wParam, lParam);
      Result := 1;
    end;
    WM_ERASEBKGND : begin
      Result := 1;
    end;
    WM_DESTROY : begin
      ClearCache;
      Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), wnd, uMsg, wParam, lParam);
    end
    else Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), wnd, uMsg, wParam, lParam);
  end;
end;

procedure TsSkinableMenus.DrawWndBorder(Wnd : hWnd; MenuBmp : TBitmap);
var
  l, i : integer;
  rgn, subRgn : hrgn;
begin
{$IFDEF LOGGED}
//LogLines.Add('!!!');
{$ENDIF}
  if BorderDrawing then Exit;
  if GetWindowLong(Wnd, GWL_WNDPROC) <> integer(@MenuWindowProc) then begin
    SetWindowLong(Wnd, GWL_USERDATA, DWord(GetWindowLong(Wnd, GWL_WNDPROC)));
    SetWindowLong(Wnd, GWL_WNDPROC, integer(@MenuWindowProc));
  end;
  if IsNT and (MenuBmp <> nil) and (SendMessage(Wnd, SM_ALPHACMD, MakeWParam(0, AC_UPDATING), 0) = 0) then begin
    SendMessage(Wnd, SM_ALPHACMD, MakeWParam(0, AC_DROPPEDDOWN), 0);
    BorderDrawing := True;
    l := Length(ArOR);
    rgn := CreateRectRgn(0, 0, MenuBmp.Width, MenuBmp.Height);
    if (l > 0) then begin
      for i := 0 to l - 1 do begin
        subrgn := CreateRectRgn(ArOR[i].Left, ArOR[i].Top, ArOR[i].Right, ArOR[i].Bottom);
        CombineRgn(rgn, rgn, subrgn, RGN_DIFF);
        DeleteObject(subrgn);
      end;
    end
    else begin
      subrgn := CreateRectRgn(0, 0, 1, 1);
      CombineRgn(rgn, rgn, subrgn, RGN_DIFF);
      DeleteObject(subrgn);
    end;
    SetWindowRgn(Wnd, rgn, True);
  end;
  BorderDrawing := False;
end;

function TsSkinableMenus.GetSkinBorderWidth: integer;
var
  i : integer;
begin
  if FSkinBorderWidth < 0 then begin
    i := TsSkinManager(FOwner).GetMaskIndex(s_MainMenu, s_BordersMask);
    if i > -1 then begin
      FSkinBorderWidth := TsSkinManager(FOwner).ma[i].BorderWidth;
      if FSkinBorderWidth < 1 then FSkinBorderWidth := 3;
    end
    else FSkinBorderWidth := 0;
  end;
  Result := FSkinBorderWidth;
end;

function TsSkinableMenus.ExtraWidth(Update : boolean = False): integer;
begin
  if TsSkinManager(FOwner).MenuSupport.UseExtraLine and ExtraVisible then begin
    Result := TsSkinManager(FOwner).MenuSupport.ExtraLineWidth;
//    if Update and (SkinBorderWidth < BorderWidth) then dec(Result, BorderWidth - SkinBorderWidth); v5.31
  end
  else Result := 0;
end;

function TsSkinableMenus.GetItemWidth(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  Text : string;
  R : TRect;
begin
  if Assigned(CustomMenuFont) then ACanvas.Font.Assign(CustomMenuFont) else if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  case it of
    smDivider : begin
      Text := '';
      Result := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, False).cx * 2 + Spacing;
    end;
    smCaption : begin
      Text := cLineCaption + Item.Caption + cLineCaption;
      Result := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, False).cx * 2 + Spacing;
    end
    else begin
      Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));

      R := Rect(0, 0, 1, 0);
      DrawText(ACanvas.Handle, PChar(Text), Length(Text), R, DT_EXPANDTABS or DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT);
      Result := WidthOf(R) + Margin * 3 + GlyphSize(Item, False).cx * 2 + Spacing;
    end;
  end;
  if ExtraVisible then inc(Result, ExtraWidth);
end;

function TsSkinableMenus.ParentWidth(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  i, OldRes, w, h : integer;
  it : TMenuItem;
begin
  Result := 0;
  OldRes := 0;
  for i := 0 to Item.Parent.Count - 1 do if Item.Parent.Items[i].Visible then begin
    it := Item.Parent.Items[i];
    if it.Break <> mbNone then begin
      inc(OldRes, Result + 4{?});
      Result := 0;
    end;
    w := 0;
    h := 0;
    sMeasureItem(it, aCanvas, w, h);
    Result := max(Result, w + 12{?});
  end;
  inc(Result, OldRes);
end;

procedure TsSkinableMenus.PrepareMenuBG(Item: TMenuItem; Width, Height : integer; Wnd : hwnd = 0);
var
  R, gRect : TRect;
  i, j, w, Marg : integer;
  CI : TCacheInfo;
  ItemBmp : TBitmap;
  VertFont : TLogFont;
  pFont : PLogFontA;
  f : TCustomForm;
  procedure MakeVertFont(Orient : integer);
  begin
    ItemBmp.Canvas.Font.Assign(TsSkinManager(FOwner).MenuSupport.ExtraLineFont);
    f := GetOwnerForm(Item.GetParentMenu);
    if f <> nil then ItemBmp.Canvas.Font.Charset := f.Font.Charset;
    pFont := @VertFont;
    StrPCopy(VertFont.lfFaceName, TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Name);
    GetObject(ItemBmp.Canvas.Handle, SizeOf(TLogFont), pFont);
    VertFont.lfEscapement := Orient;
    VertFont.lfHeight := TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Size;
    VertFont.lfStrikeOut := integer(fsStrikeOut in TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Style);
    VertFont.lfItalic := integer(fsItalic in TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Style);
    VertFont.lfUnderline := integer(fsUnderline	in TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Style);
    VertFont.lfWeight := FW_NORMAL;
    VertFont.lfCharSet := TsSkinManager(FOwner).MenuSupport.ExtraLineFont.Charset;

    VertFont.lfWidth := 0;
    Vertfont.lfOutPrecision := OUT_DEFAULT_PRECIS;
    VertFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
    VertFont.lfOrientation := VertFont.lfEscapement;
    VertFont.lfPitchAndFamily := Default_Pitch;
    VertFont.lfQuality := Default_Quality;
    ItemBmp.Canvas.Font.Handle := CreateFontIndirect(VertFont);
    ItemBmp.Canvas.Font.Color := TsSkinManager(FOwner).gd[j].FontColor[1];
  end;
begin
  if (MenuBGBmp = nil) or (Item.Parent.Items[0] <> CurrentFirstItem) then begin
{$IFDEF LOGGED}
    LogLines.Add('PrepareMenuBG');
{$ENDIF}
    if not ExtraDefined then begin
      if (Item.Parent.Items[0].Name <> s_SkinSelectItemName) then begin
        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;
      end
      else ExtraVisible := False;
    end;

    CurrentFirstItem := Item.Parent.Items[0];
    gRect := Rect(0, 0, Width, Height);
//    gRect := Rect(0, 0, Width + BorderWidth * 2, Height + BorderWidth * 2);

    i := TsSkinManager(FOwner).GetSkinIndex(s_MainMenu);
    if (MenuBGBmp <> nil) then FreeAndnil(MenuBGBmp);
    MenuBGBmp := CreateBmp24(gRect.Right, gRect.Bottom);
    // Draw Menu
    GlyphSizeCX := GlyphSize(Item, false).cx;
    IcoLineWidth := GlyphSizeCX + Margin + Spacing;
    if TsSkinManager(FOwner).IsValidSkinIndex(i) then begin
      PaintItem(i, s_MainMenu, EmptyCI, False, 0, gRect, Point(0, 0), MenuBGBmp, FOwner);
      ci := MakeCacheInfo(MenuBGBmp);
      if TsSkinManager(FOwner).MenuSupport.UseExtraLine and ExtraVisible then begin
        j := TsSkinManager(FOwner).GetSkinIndex(ExtraSection);
        if j > -1 then begin // Extra line
          ItemBmp := CreateBmp24(TsSkinManager(FOwner).MenuSupport.ExtraLineWidth, MenuBGBmp.Height - SkinBorderWidth * 2);
          R := Rect(0, 0, ItemBmp.Width, ItemBmp.Height);
          PaintItem(j, ExtraSection, ci, True, 0, R, Point(SkinBorderWidth, SkinBorderWidth), ItemBmp, FOwner);
          Marg := 12;
          if ExtraGlyph <> nil then begin
            inc(Marg, ExtraGlyph.Height + 8);
            ItemBmp.Canvas.Draw((ItemBmp.Width - ExtraGlyph.Width) div 2, ItemBmp.Height - 12 - ExtraGlyph.Height, ExtraGlyph);
          end;
          if ExtraCaption <> '' then begin
            MakeVertFont(-2700);

            w := ItemBmp.Canvas.TextHeight(ExtraCaption);

            ItemBmp.Canvas.Brush.Style := bsClear;
            ItemBmp.Canvas.TextRect(R, R.Left + (WidthOf(R) - w) div 2, ItemBmp.Height - Marg, ExtraCaption);
          end;
          BitBlt(MenuBGBmp.Canvas.Handle, SkinBorderWidth, SkinBorderWidth, ItemBmp.Width, ItemBmp.Height, ItemBmp.Canvas.Handle, 0, 0, SrcCopy);
          FreeAndNil(ItemBmp);
        end;
        if Assigned(ExtraGlyph) then FreeAndNil(ExtraGlyph);
      end;
      j := TsSkinManager(FOwner).GetSkinIndex(TsSkinManager(FOwner).MenuSupport.IcoLineSkin);
      if j > -1 then begin // Ico line
        ItemBmp := CreateBmp24(IcoLineWidth, MenuBGBmp.Height - SkinBorderWidth * 2);
        PaintItem(j, TsSkinManager(FOwner).MenuSupport.IcoLineSkin, ci, True, 0, Rect(0, 0, ItemBmp.Width, ItemBmp.Height), Point(SkinBorderWidth + ExtraWidth, SkinBorderWidth), ITemBmp, FOwner);
        BitBlt(MenuBGBmp.Canvas.Handle, SkinBorderWidth + ExtraWidth, SkinBorderWidth, ItemBmp.Width, ItemBmp.Height, ItemBmp.Canvas.Handle, 0, 0, SrcCopy);
        FreeAndNil(ItemBmp);
      end;

      // Prepare array of trans. px
      SetLength(ArOR, 0);
      i := TsSkinManager(FOwner).GetMaskIndex(i, s_MAINMENU, s_BORDERSMASK);
      if TsSkinManager(FOwner).IsValidImgIndex(i) then begin
        AddRgn(ArOR, MenuBGBmp.Width, TsSkinManager(FOwner).ma[i], 0, False);
        AddRgn(ArOR, MenuBGBmp.Width, TsSkinManager(FOwner).ma[i],
               MenuBGBmp.Height - TsSkinManager(FOwner).ma[i].WB, True);
      end;
      if Wnd <> 0 then DrawWndBorder(Wnd, MenuBGBmp);
    end;
  end;
end;

{ TacMenuSupport }

constructor TacMenuSupport.Create;
begin
  FUseExtraLine := False;
  FExtraLineWidth := 32;
  FExtraLineFont := TFont.Create;
end;

destructor TacMenuSupport.Destroy;
begin
  FreeAndNil(FExtraLineFont);
  inherited;
end;

procedure TacMenuSupport.SetExtraLineFont(const Value: TFont);
begin
  FExtraLineFont.Assign(Value);
end;

initialization

finalization
  ClearCache;

end.