jvmenus.pas

East make Tray Icon in delphi

procedure MenuWndMessage(Menu: TMenu; var AMsg: TMessage; var Handled: Boolean);
var
  Mesg: TMessage;
  Item: Pointer;
begin
  with AMsg do
    case Msg of
      WM_MEASUREITEM:
        if (TWMMeasureItem(AMsg).MeasureItemStruct^.CtlType = ODT_MENU) then
        begin
          Item := Menu.FindItem(TWMMeasureItem(AMsg).MeasureItemStruct^.itemID, fkCommand);
          if Item <> nil then
          begin
            Mesg := AMsg;
            TWMMeasureItem(Mesg).MeasureItemStruct^.itemData := Longint(Item);
            Menu.Dispatch(Mesg);
            Result := 1;
            Handled := True;
          end;
        end;
      WM_DRAWITEM:
        if (TWMDrawItem(AMsg).DrawItemStruct^.CtlType = ODT_MENU) then
        begin
          Item := Menu.FindItem(TWMDrawItem(AMsg).DrawItemStruct^.itemID, fkCommand);
          if Item <> nil then
          begin
            Mesg := AMsg;
            TWMDrawItem(Mesg).DrawItemStruct^.itemData := Longint(Item);
            Menu.Dispatch(Msg);
            Result := 1;
            Handled := True;
          end;
        end;
      WM_MENUSELECT:
        Menu.Dispatch(AMsg);
      CM_MENUCHANGED:
        Menu.Dispatch(AMsg);
      WM_MENUCHAR:
        begin
          Menu.ProcessMenuChar(TWMMenuChar(AMsg));
        end;
    end;
end;

procedure SetDefaultMenuFont(AFont: TFont);
var
  NCMetrics: TNonCLientMetrics;
begin
  if NewStyleControls then
  begin
    NCMetrics.cbSize := SizeOf(TNonCLientMetrics);
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
    begin
      AFont.Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
      Exit;
    end;
  end;
  with AFont do
  begin
    if NewStyleControls then
      Name := 'MS Sans Serif'
    else
      Name := 'System';
    Size := 8;
    Color := clMenuText;
    Style := [];
  end;
  AFont.Color := clMenuText;
end;

procedure MenuLine(Canvas: TCanvas; C: TColor; X1, Y1, X2, Y2: Integer);
begin
  with Canvas do
  begin
    Pen.Color := C;
    Pen.Style := psSolid;
    MoveTo(X1, Y1);
    LineTo(X2, Y2);
  end;
end;

//=== { TJvMenuChangeLink } ==================================================

procedure TJvMenuChangeLink.Change(Sender: TJvMainMenu; Source: TMenuItem; Rebuild: Boolean);
begin
  if Assigned(FOnChange) then
    FOnChange(Sender, Source, Rebuild);
end;

//=== { TJvMainMenu } ========================================================

constructor TJvMainMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited OwnerDraw := True;
  
  RegisterWndProcHook(FindForm, NewWndProc, hoAfterMsg);
  FStyle := msStandard;
  FStyleItemPainter := CreateMenuItemPainterFromStyle(FStyle, Self);
  FChangeLinks := TObjectList.Create(False);
  FImageMargin := TJvImageMargin.Create;
  FImageSize := TJvMenuImageSize.Create;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FDisabledImageChangeLink := TChangeLink.Create;
  FDisabledImageChangeLink.OnChange := DisabledImageListChange;
  FHotImageChangeLink := TChangeLink.Create;
  FHotImageChangeLink.OnChange := HotImageListChange;

  // set default values that are not 0
  FTextVAlignment := vaMiddle;
end;

destructor TJvMainMenu.Destroy;
begin
  FImageChangeLink.Free;
  FHotImageChangeLink.Free;
  FDisabledImageChangeLink.Free;
  FStyleItemPainter.Free;
  FChangeLinks.Free;
  FImageMargin.Free;
  FImageSize.Free;
  UnregisterWndProcHook(FindForm, NewWndProc, hoAfterMsg);
  inherited Destroy;
end;

procedure TJvMainMenu.Loaded;
begin
  inherited Loaded;
  if IsOwnerDrawMenu then
    RefreshMenu(True);
end;

function TJvMainMenu.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

function TJvMainMenu.IsOwnerDrawMenu: Boolean;
begin
  Result := True; //(FStyle <> msStandard) or (Assigned(FImages) and (FImages.Count > 0));
end;

procedure TJvMainMenu.MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
var
  I: Integer;
begin
  if csLoading in ComponentState then
    Exit;
  for I := 0 to FChangeLinks.Count - 1 do
    TJvMenuChangeLink(FChangeLinks[I]).Change(Self, Source, Rebuild);
  inherited MenuChanged(Sender, Source, Rebuild);
end;

procedure TJvMainMenu.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FImages then
      SetImages(nil);
    if AComponent = FDisabledImages then
      SetDisabledImages(nil);
    if AComponent = FHotImages then
      SetHotImages(nil);
    if AComponent = FItemPainter then
      ItemPainter := nil;
  end;
end;

procedure TJvMainMenu.ImageListChange(Sender: TObject);
begin
  if Sender = FImages then
    RefreshMenu(IsOwnerDrawMenu);
end;

procedure TJvMainMenu.SetImages(Value: TImageList);
var
  OldOwnerDraw: Boolean;
begin
  OldOwnerDraw := IsOwnerDrawMenu;
  if FImages <> nil then
    FImages.UnregisterChanges(FImageChangeLink);
  FImages := Value;
  if Value <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end;
  if IsOwnerDrawMenu <> OldOwnerDraw then
    RefreshMenu(not OldOwnerDraw);
  // to be used in a standard (non JV) toolbar
  inherited Images := Value;
end;

procedure TJvMainMenu.DisabledImageListChange(Sender: TObject);
begin
  if Sender = FDisabledImages then
    RefreshMenu(IsOwnerDrawMenu);
end;

procedure TJvMainMenu.SetDisabledImages(Value: TImageList);
var
  OldOwnerDraw: Boolean;
begin
  OldOwnerDraw := IsOwnerDrawMenu;
  if FDisabledImages <> nil then
    FDisabledImages.UnregisterChanges(FDisabledImageChangeLink);
  FDisabledImages := Value;
  if Value <> nil then
  begin
    FDisabledImages.RegisterChanges(FDisabledImageChangeLink);
    FDisabledImages.FreeNotification(Self);
  end;
  if IsOwnerDrawMenu <> OldOwnerDraw then
    RefreshMenu(not OldOwnerDraw);
end;

procedure TJvMainMenu.HotImageListChange(Sender: TObject);
begin
  if Sender = FHotImages then
    RefreshMenu(IsOwnerDrawMenu);
end;

procedure TJvMainMenu.SetHotImages(Value: TImageList);
var
  OldOwnerDraw: Boolean;
begin
  OldOwnerDraw := IsOwnerDrawMenu;
  if FHotImages <> nil then
    FHotImages.UnregisterChanges(FHotImageChangeLink);
  FHotImages := Value;
  if Value <> nil then
  begin
    FHotImages.RegisterChanges(FHotImageChangeLink);
    FHotImages.FreeNotification(Self);
  end;
  if IsOwnerDrawMenu <> OldOwnerDraw then
    RefreshMenu(not OldOwnerDraw);
end;

procedure TJvMainMenu.SetStyle(Value: TJvMenuStyle);
begin
  if FStyle <> Value then
  begin
    // store the new style
    FStyle := Value;
    // delete the old painter and create a new internal painter
    // according to the style, but only if the style is not
    // msItemPainter
    if (Style <> msItemPainter) or (ItemPainter = nil) then
    begin
      ItemPainter := nil;
      FStyleItemPainter.Free;
      FStyleItemPainter := CreateMenuItemPainterFromStyle(Value, Self);
    end;
    // refresh
    RefreshMenu(IsOwnerDrawMenu);
  end;
end;

function TJvMainMenu.FindForm: TWinControl;
begin
  Result := FindControl(WindowHandle);
  if (Result = nil) and (Owner is TWinControl) then
    Result := TWinControl(Owner);
end;

procedure TJvMainMenu.Refresh;
begin
  RefreshMenu(IsOwnerDrawMenu);
end;

procedure TJvMainMenu.RefreshMenu(AOwnerDraw: Boolean);
begin
  Self.OwnerDraw := AOwnerDraw and not (csDesigning in ComponentState);
end;

procedure TJvMainMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  State: TMenuOwnerDrawState);
begin
  if Canvas.Handle <> 0 then
  begin
    GetActiveItemPainter.Menu := Self;
    GetActiveItemPainter.Paint(Item, Rect, State);
  end;
end;

procedure TJvMainMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  State: TMenuOwnerDrawState);
begin
  if Canvas.Handle <> 0 then
  begin
    GetActiveItemPainter.Menu := Self;
    GetActiveItemPainter.Paint(Item, Rect, State);
  end;
end;

procedure TJvMainMenu.RegisterChanges(ChangeLink: TJvMenuChangeLink);
begin
  FChangeLinks.Add(ChangeLink);
end;

procedure TJvMainMenu.UnregisterChanges(ChangeLink: TJvMenuChangeLink);
begin
  FChangeLinks.Remove(ChangeLink);
end;

procedure TJvMainMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
begin
  if Assigned(FOnMeasureItem) then
    FOnMeasureItem(Self, Item, Width, Height)
end;

{procedure TJvMainMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  var Handled: Boolean);
begin
  if IsOwnerDrawMenu then
    MenuWndMessage(Self, AMsg, Handled);
end;}

function TJvMainMenu.NewWndProc(var Msg: TMessage): Boolean;
var
  Handled: Boolean;
begin
  if IsOwnerDrawMenu then
    MenuWndMessage(Self, Msg, Handled);
  // let others listen in too...
  Result := False; //handled;
end;

procedure TJvMainMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
begin
  if Assigned(FOnGetItemParams) then
    FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  if (Item <> nil) and (Item.Caption = Separator) then
    Graphic := nil;
end;

procedure TJvMainMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  var ImageIndex: Integer);
begin
  if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
    Assigned(FOnGetImageIndex) then
    FOnGetImageIndex(Self, Item, State, ImageIndex);
end;

procedure TJvMainMenu.CMMenuChanged(var Msg: TMessage);
begin
  inherited;
end;

procedure TJvMainMenu.WMDrawItem(var Msg: TWMDrawItem);
var
  State: TMenuOwnerDrawState;
  SaveIndex: Integer;
  Item: TMenuItem;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    {if (mdDisabled in State) then
      State := State - [mdSelected];}
    Item := TMenuItem(Pointer(itemData));
    if Assigned(Item) and
      (FindItem(Item.Command, fkCommand) = Item) then
    begin
      FCanvas := TControlCanvas.Create;
      try
        SaveIndex := SaveDC(hDC);
        try
          Canvas.Handle := hDC;
          SetDefaultMenuFont(Canvas.Font);
          Canvas.Font.Color := clMenuText;
          Canvas.Brush.Color := clMenu;
          if mdDefault in State then
            Canvas.Font.Style := Canvas.Font.Style + [fsBold];
          if (mdSelected in State) and not
            (Style in [msBtnLowered, msBtnRaised]) then
          begin
            Canvas.Brush.Color := clHighlight;
            Canvas.Font.Color := clHighlightText;
          end;
          with rcItem do