scustommenumanager.pas

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

  FActive := Value;
end;

procedure TsCustomMenuManager.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
        Item.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
        Item.Items[i].OnMeasureItem := sMeasureItem;
      end
      else begin
        if addr(Item.Items[i].OnAdvancedDrawItem) = addr(TsCustomMenuManager.sAdvancedDrawItem) then
          Item.Items[i].OnAdvancedDrawItem := nil;
        if addr(Item.Items[i].OnMeasureItem) = addr(TsCustomMenuManager.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
        MenuItem.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
        MenuItem.Items[i].OnMeasureItem := sMeasureItem;
      end;
    end
    else begin
      if addr(MenuItem.Items[i].OnAdvancedDrawItem) = addr(TsCustomMenuManager.sAdvancedDrawItem) then
        MenuItem.Items[i].OnAdvancedDrawItem := nil;
      if addr(MenuItem.Items[i].OnMeasureItem) = addr(TsCustomMenuManager.sMeasureItem) then
        MenuItem.Items[i].OnMeasureItem := nil;
    end;
    HookSubItems(MenuItem.Items[i]);
  end;
end;

procedure TsCustomMenuManager.HookMenu(MainMenu: TMainMenu; 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
        Item.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
        Item.Items[i].OnMeasureItem := sMeasureItem;
      end
      else begin
        if addr(Item.Items[i].OnAdvancedDrawItem) = addr(TsCustomMenuManager.sAdvancedDrawItem) then
          Item.Items[i].OnAdvancedDrawItem := nil;
        if addr(Item.Items[i].OnMeasureItem) = addr(TsCustomMenuManager.sMeasureItem) then
          Item.Items[i].OnMeasureItem := nil;
      end;
      HookSubItems(Item.Items[i]);
    end;
  end;
begin
  if MainMenu.Items = nil then Exit;
  for i := 0 to MainMenu.Items.Count - 1 do begin
    if FActive then begin
      MainMenu.Items[i].OnAdvancedDrawItem := sAdvancedDrawItem;
      MainMenu.Items[i].OnMeasureItem := sMeasureItem;
    end
    else begin
      if addr(MainMenu.Items[i].OnAdvancedDrawItem) = addr(TsCustomMenuManager.sAdvancedDrawItem) then
        MainMenu.Items[i].OnAdvancedDrawItem := nil;
      if addr(MainMenu.Items[i].OnMeasureItem) = addr(TsCustomMenuManager.sMeasureItem) then
        MainMenu.Items[i].OnMeasureItem := nil;
    end;
    HookSubItems(MainMenu.Items[i]);
  end;
  MainMenu.OwnerDraw := FActive;
end;

procedure TsCustomMenuManager.sMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
var
  Text: string;
//  Divider: boolean;
  Item: TMenuItem;
//  i: integer;
begin
  Item := TMenuItem(Sender);
  if IsTopLine(Item) then begin
    it := smTopLine;
  end
  else if Item.Caption = '-' then begin
    it := smDivider;
  end
  else if IsdivText(Item) then begin
    it := smCaption;
  end
  else begin
    it := smNormal;
  end;

  if Assigned(FFont) then ACanvas.Font.Assign(FFont);

  case it of
    smDivider : begin
      Text := '';
      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, it = smTopLine).cx * 2;
    end;
    smCaption : begin
      Text := '-' + Item.Caption + '-';
      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, it = smTopLine).cx * 2;
    end;
    smTopLine : begin
      Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
      Width := ACanvas.TextWidth(Text) + GlyphSize(Item, it = smTopLine).cx + Margin + Margin * integer(Item.ImageIndex >= 0);
//      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, it = smTopLine).cx * 2;
    end
    else begin
      Text := Item.Caption + iff(ShortCutToText(Item.ShortCut) = '', '', ShortCutToText(Item.ShortCut));
      Width := Margin * 3 + ACanvas.TextWidth(Text) + GlyphSize(Item, it = smTopLine).cx * 2;
//      Width := 280;
    end;
  end;

  Height := GetItemHeight(aCanvas, Item);
  Width := Width + 2 * CursorMarginH;
end;

destructor TsCustomMenuManager.Destroy;
begin
  Active := False;
  FForm := nil;
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  FreeAndNil(FFont);
  inherited;
end;

{ TsMainMenuManager }

constructor TsMenuManager.Create(AOwner: TComponent);
begin
  inherited;
  sStyle.COC := COC_TsMenuManager;
end;

procedure TsCustomMenuManager.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

{$IFDEF SINGLE}
procedure Register;
begin
  RegisterComponents('sTools', [TsMenuManager]);
end;
{$ENDIF}

// Refresh list of all MenuItems on project
procedure TsCustomMenuManager.UpdateMenus;
begin
  Active := FActive;
end;

// Return height of the menu panel
function TsCustomMenuManager.ParentHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  i{, h} : integer;
begin
  Result := 0;
  for i := 0 to Item.Parent.Count - 1 do begin
    inc(Result, GetItemHeight(aCanvas, Item.Parent.Items[i]));
  end;
//  inc(Result, 2 * BevelWidth * integer(FsStyle.Painting.Bevel <> cbNone));
end;

// Return height of the current MenuItem
function TsCustomMenuManager.GetItemHeight(aCanvas: TCanvas; Item: TMenuItem): integer;
var
  Text: string;
  IsDivider : boolean;
  T: boolean;
  i: integer;
begin
  t := False;
  if Item.Parent.GetParentMenu is TMainMenu then begin
    for i := 0 to Item.GetParentMenu.Items.Count - 1 do begin
      if Item.GetParentMenu.Items[i] = Item then begin
        t := True;
        break;
      end;
    end;
  end;

  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(FFont) then ACanvas.Font.Assign(FFont);

  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, t).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 TsCustomMenuManager.IsDivText(Item: TMenuItem): boolean;
begin
  Result := (copy(Item.Caption, 1, 1) = '-') and (copy(Item.Caption, length(Item.Caption), 1) = '-');
end;

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

function TsCustomMenuManager.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 TsCustomMenuManager.SetBevelWidth(const Value: integer);
begin
  FBevelWidth := Value;
end;

procedure TsCustomMenuManager.PaintBorder(Bmp : TBitmap; aRect: TsRect; Hot: boolean);
var
  R: TRect;
begin
  R := aRect;
  if Hot then begin
    PaintBevel(Bmp, aRect, FsStyle.HotStyle.HotPainting.BevelWidth, FsStyle.HotStyle.HotPainting.Bevel, True);
  end
  else begin
    PaintBevel(Bmp, aRect, BevelWidth, FsStyle.Painting.Bevel, True);
  end;
end;

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

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

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

function TsCustomMenuManager.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 TsCustomMenuManager.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(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 TsCustomMenuManager.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 TsCustomMenuManager.SetCaptionFont(const Value: TFont);
begin
  FCaptionFont.Assign(Value);
end;

end.