sskinmenus.pas

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

  else begin
    Result := Maxi(Round(ACanvas.TextHeight('W') * 1.25), GlyphSize(Item, False).cy) + 2 * Margin;
  end;
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;
  end;
end;

function TsSkinableMenus.IsTopLine(Item: TMenuItem): boolean;
var
  i : integer;
  m : TMenu;
begin
  Result := False;
  m := Item.GetParentMenu;
  if m is TMainMenu then for i := 0 to m.Items.Count - 1 do if m.Items[i] = Item then begin
    Result := True;
    Exit;
  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;
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; MenuBmp : TBitmap);
var
  i, SkinIndex, BorderIndex : integer;
  nRect : TRect;
  s : string;
  CI : TCacheInfo;
  TempBmp : TBitmap;
begin
  i := 1;

  s := s_DIVIDERV;
  SkinIndex := TsSkinManager(FOwner).GetSkinIndex(s);
  if SkinIndex < 0 then begin // DEPRECATED in v5
    s := s_TRACKBAR;
    SkinIndex := TsSkinManager(FOwner).GetSkinIndex(s);
    BorderIndex := TsSkinManager(FOwner).GetMaskIndex(SkinIndex, s, s_SliderChannelMask);
  end
  else BorderIndex := TsSkinManager(FOwner).GetMaskIndex(SkinIndex, s, s_BordersMask);

  if BorderIndex > -1 then begin
    TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
    if MenuBmp <> nil
      then BitBlt(TempBmp.Canvas.Handle, 0, 0, WidthOf(aRect), HeightOf(aRect), MenuBmp.Canvas.Handle, aRect.Left + 3, aRect.Top + 3, SRCCOPY);

    CI := MakeCacheInfo(TempBmp);
    nRect := aRect;
    OffsetRect(nRect, -nRect.Left + Margin + ExtraWidth + Spacing, -nRect.Top);
    dec(nRect.Right, Margin + Margin + ExtraWidth + Spacing);
    if nRect.Left < (IcoLineWidth + ExtraWidth) then nRect.Left := IcoLineWidth + ExtraWidth + 2;

    DrawSkinRect(TempBmp, nRect, True, CI, TsSkinManager(FOwner).ma[BorderIndex], 0, True, TsSkinManager(FOwner));
    BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect), TempBmp.Canvas.Handle, 0, 0, SRCCOPY);

    FreeAndnil(TempBmp);
  end
  else DrawRectangleOnDC(aCanvas.Handle, aRect, ColorToRGB(clGray), ColorToRGB(clWhite), i);
end;

procedure TsSkinableMenus.PaintCaption(aCanvas: TCanvas; aRect: TRect; Item : TMenuItem);
var
  i : integer;
  ItemBmp : TBitmap;
  s, SkinSection : string;
  Flags : integer;
  R : TRect;
begin
  ItemBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
  R := Rect(ExtraWidth + 1, 1, ItemBmp.Width - 1, ItemBmp.Height - 1);
  SkinSection := s_ToolBAr;

  i := TsSkinManager(FOwner).GetSkinIndex(SkinSection);

  if ExtraWidth > 0 then
    BitBlt(ItemBmp.Canvas.Handle, 0, 0, ExtraWidth + 1, ItemBmp.Height,
          MenuBGBmp.Canvas.Handle, aRect.Left + 3, aRect.Top + 3, SRCCOPY);

  BitBltBorder(ItemBmp.Canvas.Handle, 0, 0, ItemBmp.Width, ItemBmp.Height,
          MenuBGBmp.Canvas.Handle, aRect.Left + 3, aRect.Top + 3, 1);

  if TsSkinManager(FOwner).IsValidSkinIndex(i) then begin
    GlobalCacheInfo := MakeCacheInfo(MenuBGBmp, 3, 3);
    PaintItem(i, SkinSection, GlobalCacheInfo, True, 0,
            R, Point(aRect.Left + ExtraWidth, aRect.Top), ItemBmp.Canvas.Handle, FOwner);
    GlobalCacheInfo.Ready := False;
  end;

  if Assigned(FCaptionFont) then ItemBmp.Canvas.Font.Assign(FCaptionFont);
  s := ExtractWord(1, Item.Caption, ['-']);
  Flags := DT_SINGLELINE or DT_VCENTER or DT_CENTER;
  R := Rect(ExtraWidth, 0, ItemBmp.Width, ItemBmp.Height);
  WriteTextEx(ItemBmp.Canvas, PChar(s), True, R, Flags, i, False);

  BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, ItemBmp.Width, ItemBmp.Height,
          ItemBmp.Canvas.Handle, 0, 0, SrcCopy);

  FreeAndNil(ItemBmp);
end;

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

{$IFDEF TNTUNICODE}
//type
//  TAccessTntMenuItem = class(TTntMenuItem);
{$ENDIF}

procedure TsSkinableMenus.sAdvancedDrawLineItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
{$IFDEF TNTUNICODE}
  ws : WideString;
{$ENDIF}
  R, gRect : TRect;
  i: integer;
  ci : TCacheInfo;
  Item : TMenuItem;
  Text: string;
  h : integer;
  sp : TsSkinProvider;
  LocalCanvas : TCanvas;
  Bmp : TBitmap;
  C : TsColor;
  f : TCustomForm;
  Flags : cardinal;
  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 (Self = nil) or (FOwner = nil) then begin
    inherited;
    Exit;
  end;

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

  if sp = nil then inherited else begin
    gRect := aRect;
    if Item.Enabled then begin
      Bmp := nil;
      LocalCanvas := ACanvas
    end
    else begin
      Bmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
      LocalCanvas := Bmp.Canvas;
      OffsetRect(gRect, -gRect.Left, -gRect.Top);
    end;

    try
      CI := MakeCacheInfo(sp.MenuLineBmp);

      i := TsSkinManager(FOwner).GetSkinIndex(s_MenuItem);
      h := sp.CaptionHeight + sp.SysBorderHeight;

      if TsSkinManager(FOwner).IsValidSkinIndex(i) then begin
        if Bmp = nil
          then PaintItem(i, s_MenuItem, ci, True,
            integer(Item.Enabled and (odSelected in State) or (odHotLight in State)),
            aRect, Point(gRect.Left, gRect.Top - h), LocalCanvas.Handle, FOwner)
          else PaintItem(i, s_MenuItem, ci, True, integer(Item.Enabled and (odSelected in State) or (odHotLight in State)),
            gRect, Point(aRect.Left, aRect.Top - h), Bmp, FOwner)
      end;
    finally
    end;

    gRect.Left := 0;
    gRect.Right := 0;
    if not Item.Bitmap.Empty then begin
      gRect.Top := (HeightOf(ARect) - GlyphSize(Item, False).cy) div 2 + aRect.Top;
      if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft)
        then gRect.Left := aRect.Right - 3 - GlyphSize(Item, False).cx
        else gRect.Left := aRect.Left + 3;
      gRect.Right := gRect.Left + GlyphSize(Item, False).cx - 1;
      LocalCanvas.Draw(gRect.Left, gRect.Top, Item.Bitmap);
    end
    else if (Item.GetImageList <> nil) and (Item.ImageIndex >= 0) then begin
      gRect.Top := (HeightOf(ARect) - Item.GetImageList.Height) div 2 + aRect.Top;
      if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft)
        then gRect.Left := aRect.Right - 3 - Item.GetImageList.Width
        else gRect.Left := aRect.Left + 3;
      gRect.Right := gRect.Left + Item.GetImageList.Width - 1;
      Item.GetImageList.Draw(LocalCanvas, gRect.Left, gRect.Top, Item.ImageIndex, True);
    end;

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

    if odDefault in State then LocalCanvas.Font.Style := [fsBold] else LocalCanvas.Font.Style := [];

    R := TextRect;
    if SysLocale.MiddleEast and (Item.GetParentMenu.BiDiMode = bdRightToLeft)
      then R.Left := R.Left - WidthOf(gRect)
      else R.Left := R.Left + WidthOf(gRect);
    if Bmp <> nil then OffsetRect(R, -R.Left + sp.BorderWidth, -R.Top);

    i := TsSkinManager(FOwner).GetSkinIndex(s_MenuLine);
    Flags := DT_CENTER or DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER;
    if odNoAccel in State then Flags := Flags + DT_HIDEPREFIX;
{$IFDEF TNTUNICODE}
    if Sender is TTntMenuItem then begin
      ws := WideString(TTntMenuItem(Sender).Caption);
      sGraphUtils.WriteTextExW(LocalCanvas, PWideChar(ws),
        True, R, Flags or AlignToInt[Alignment], i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    end
    else
{$ENDIF}
      sGraphUtils.WriteTextEx(LocalCanvas, PChar(Item.Caption), True, R, Flags or AlignToInt[Alignment], i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    Text := ShortCutToText(TMenuItem(Sender).ShortCut);
    if Text <> '' then begin
      r := ShortCutRect;
      if Bmp <> nil then OffsetRect(R, -R.Left + sp.BorderWidth, -R.Top);
      dec(r.Right, 8);
      sGraphUtils.WriteTextEx(LocalCanvas, PChar(Text), True, R, DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER or DT_RIGHT, i, (Item.Enabled and ((odSelected in State) or (odHotLight in State))), FOwner);
    end;

    if Assigned(FOnDrawItem) then FOnDrawItem(Item, LocalCanvas, gRect, State, smTopLine);
    if Assigned(Bmp) then begin
      C.R := IntToByte(Round(DefDisabledBlend * 255));
      R := aRect;
      OffsetRect(R,  0, -h);
      SumBmpRect(Bmp, sp.MenuLineBmp, C, R, Point(0, 0));

      BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
      FreeAndNil(Bmp);
    end;
  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 Assigned(CustomMenuFont) then ACanvas.Font.Assign(CustomMenuFont) else if Assigned(Screen.MenuFont) then ACanvas.Font.Assign(Screen.MenuFont);

  Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
  W := ACanvas.TextWidth(Text);

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

procedure TsSkinableMenus.InitItem(Item: TMenuItem; A : boolean);
begin
  if Item.GetParentMenu <> nil then Item.GetParentMenu.OwnerDraw := A;
  if A then begin
    if not IsTopLine(Item) then begin
      if not TsSkinManager(FOwner).SkinnedPopups then Exit;
      if not Assigned(Item.OnAdvancedDrawItem)
        then Item.OnAdvancedDrawItem := sAdvancedDrawItem;
      if not Assigned(Item.OnMeasureItem)
        then Item.OnMeasureItem := sMeasureItem;
    end
    else begin
      Item.OnAdvancedDrawItem := sAdvancedDrawLineItem;
      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
  try
    for i := 0 to Menu.Items.Count - 1 do begin
      if A then begin
        if TsSkinManager(FOwner).SkinData.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;