jvmenus.pas

East make Tray Icon in delphi

  if FParentBiDiMode then
  begin
    AControl := FindPopupControl(FPopupPoint);
    if AControl <> nil then
      BiDiMode := AControl.BiDiMode
    else
      BiDiMode := Application.BiDiMode;
  end;
end;

function TJvPopupMenu.UseRightToLeftAlignment: Boolean;
var
  AControl: TControl;
begin
  Result := False;
  if not SysLocale.MiddleEast then
    Exit;
  if FParentBiDiMode then
  begin
    AControl := FindPopupControl(FPopupPoint);
    if AControl <> nil then
      Result := AControl.UseRightToLeftAlignment
    else
      Result := Application.UseRightToLeftAlignment;
  end
  else
    Result := (BiDiMode = bdRightToLeft);
end;

procedure TJvPopupMenu.Popup(X, Y: Integer);
const
  Flags: array[Boolean, TPopupAlignment] of Word =
  ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
    (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  Buttons: array[TTrackButton] of Word =
  (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
var
  FOnPopup: TNotifyEvent;
begin
  FPopupPoint := Point(X, Y);
  FParentBiDiMode := ParentBiDiMode;
  try
    SetBiDiModeFromPopupControl;
    FOnPopup := OnPopup;
    if Assigned(FOnPopup) then
      FOnPopup(Self);
    if IsOwnerDrawMenu then
      RefreshMenu(True);
    AdjustBiDiBehavior;
    TrackPopupMenu(Items.Handle,
      Flags[UseRightToLeftAlignment, Alignment] or Buttons[TrackButton], X, Y,
      0 { reserved }, PopupList.Window, nil);
  finally
    ParentBiDiMode := FParentBiDiMode;
  end;
end;

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

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

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

procedure TJvPopupMenu.SetStyle(Value: TJvMenuStyle);
begin
  if FStyle <> Value then
  begin
    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 then
    begin
      ItemPainter := nil;
      FStyleItemPainter.Free;
      FStyleItemPainter := CreateMenuItemPainterFromStyle(Value, Self);
    end;

    RefreshMenu(IsOwnerDrawMenu);
  end;
end;

procedure TJvPopupMenu.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 TJvPopupMenu.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 TJvPopupMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
begin
  if Assigned(FOnMeasureItem) then
    FOnMeasureItem(Self, Item, Width, Height)
end;

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

procedure TJvPopupMenu.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 TJvPopupMenu.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 TJvPopupMenu.WMDrawItem(var Msg: TWMDrawItem);
var
  State: TMenuOwnerDrawState;
  SaveIndex: Integer;
  Item: TMenuItem;
  //  MarginRect: TRect;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    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
            IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
          DrawItem(Item, rcItem, State);
          Canvas.Handle := 0;
        finally
          RestoreDC(hDC, SaveIndex);
        end;
      finally
        Canvas.Free;
      end;
    end;
  end;
end;

procedure TJvPopupMenu.WMMeasureItem(var Msg: TWMMeasureItem);
var
  Item: TMenuItem;
  SaveIndex: Integer;
  DC: HDC;
begin
  with Msg.MeasureItemStruct^ do
  begin
    Item := FindItem(itemID, fkCommand);
    if Assigned(Item) then
    begin
      DC := GetWindowDC(0);
      try
        FCanvas := TControlCanvas.Create;
        try
          SaveIndex := SaveDC(DC);
          try
            FCanvas.Handle := DC;
            FCanvas.Font := Screen.MenuFont;
            if Item.Default then
              Canvas.Font.Style := Canvas.Font.Style + [fsBold];
            GetActiveItemPainter.Menu := Self;
            GetActiveItemPainter.Measure(Item, Integer(itemWidth), Integer(itemHeight));
            //MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
          finally
            FCanvas.Handle := 0;
            RestoreDC(DC, SaveIndex);
          end;
        finally
          Canvas.Free;
        end;
      finally
        ReleaseDC(DC, 0);
      end;
    end;
  end;
end;

procedure TJvPopupMenu.Assign(Source: TPersistent);
begin
  if Source is TJvPopupMenu then
  begin
    AutoHotkeys := TJvPopupMenu(Source).AutoHotkeys;
    AutoLineReduction := TJvPopupMenu(Source).AutoLineReduction;
    BiDiMode := TJvPopupMenu(Source).BiDiMode;
    Cursor := TJvPopupMenu(Source).Cursor;
    DisabledImages := TJvPopupMenu(Source).DisabledImages;
    HotImages := TJvPopupMenu(Source).HotImages;
    ImageMargin.Assign(TJvPopupMenu(Source).ImageMargin);
    Images := TJvPopupMenu(Source).Images;
    ImageSize.Assign(TJvPopupMenu(Source).ImageSize);
    ParentBiDiMode := TJvPopupMenu(Source).ParentBiDiMode;
    ShowCheckMarks := TJvPopupMenu(Source).ShowCheckMarks;
    Style := TJvPopupMenu(Source).Style;
    Tag := TJvPopupMenu(Source).Tag;
    TextMargin := TJvPopupMenu(Source).TextMargin;
    TextVAlignment := TJvPopupMenu(Source).TextVAlignment;
  end
  else
  if Source is TJvMainMenu then
  begin
    AutoHotkeys := TJvMainMenu(Source).AutoHotkeys;
    AutoLineReduction := TJvMainMenu(Source).AutoLineReduction;
    BiDiMode := TJvMainMenu(Source).BiDiMode;
    Cursor := TJvMainMenu(Source).Cursor;
    DisabledImages := TJvMainMenu(Source).DisabledImages;
    HotImages := TJvMainMenu(Source).HotImages;
    ImageMargin.Assign(TJvMainMenu(Source).ImageMargin);
    Images := TJvMainMenu(Source).Images;
    ImageSize.Assign(TJvMainMenu(Source).ImageSize);
    ParentBiDiMode := TJvMainMenu(Source).ParentBiDiMode;
    ShowCheckMarks := TJvMainMenu(Source).ShowCheckMarks;
    Style := TJvMainMenu(Source).Style;
    Tag := TJvMainMenu(Source).Tag;
    TextMargin := TJvMainMenu(Source).TextMargin;
    TextVAlignment := TJvMainMenu(Source).TextVAlignment;
  end
  else
    inherited Assign(Source);
end;

procedure TJvPopupMenu.ReadState(Reader: TReader);
begin
  //  Reader.ReadComponent(FJvMenuItemPainter);
  inherited ReadState(Reader);
end;

procedure TJvPopupMenu.WriteState(Writer: TWriter);
begin
  inherited WriteState(Writer);
  //  Writer.WriteComponent(FJvMenuItemPainter);
end;

procedure TJvPopupMenu.SetItemPainter(const Value: TJvCustomMenuItemPainter);
begin
  if Value <> FItemPainter then
  begin
    // Remove menu from current item painter
    if FItemPainter <> nil then
      FItemPainter.Menu := nil;

    // set value and if not nil, setup the painter correctly
    FItemPainter := Value;
    if FItemPainter <> nil then
    begin
      Style := msItemPainter;
      FItemPainter.FreeNotification(Self);
      FItemPainter.Menu := Self;
    end;
    Refresh;
  end;
end;

function TJvPopupMenu.GetActiveItemPainter: TJvCustomMenuItemPainter;
begin
  if (Style = msItemPainter) and (ItemPainter <> nil) then
    Result := ItemPainter
  else
    Result := FStyleItemPainter;
end;

//=== { TJvCustomMenuItemPainter } ===========================================

constructor TJvCustomMenuItemPainter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // affect default values that are not 0
  FImageBackgroundColor := DefaultImageBackgroundColor;

  FImageMargin := TJvImageMargin.Create;
  FImageSize := TJvMenuImageSize.Create;
end;

destructor TJvCustomMenuItemPainter.Destroy;
begin
  FImageSize.Free;
  FImageMargin.Free;
  inherited Destroy;
end;

procedure TJvCustomMenuItemPainter.DrawDisabledBitmap(X, Y: Integer; Bitmap: TBitmap);
var
  Bmp: TBitmap;
  GrayColor, SaveColor: TColor;
  IsHighlight: Boolean;
begin
  if (mdSelected in FState) then
    GrayColor := clGrayText
  else
    GrayColor := clBtnShadow;
  IsHighlight := NewStyleControls and ((not (mdSelected in FState)) or
    (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) =
    GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))));
  if Bitmap.Monochrome then
  begin
    SaveColor := Canvas.Brush.Color;
    try
      if IsHighlight then
      begin
        Canvas.Brush.Color := clBtnHighlight;
        SetTextColor(Canvas.Handle, clWhite);
        SetBkColor(Canvas.Handle, clBlack);
        BitBlt(Canvas.Handle, X + 1, Y + 1, Bitmap.Width, Bitmap.Height,
          Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
      end;
      Canvas.Brush.Color := GrayColor;
      SetTextColor(Canvas.Handle, clWhite);
      SetBkColor(Canvas.Handle, clBlack);
      BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
        Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
    finally
      Canvas.Brush.Color := SaveColor;
    end;
  end
  else
  begin
    Bmp := CreateDisabledBitmapEx(Bitmap, clBlack, clMenu,
      clBtnHighlight, GrayColor, IsHighlight);
    try
      DrawBitmapTransparent(Canvas, X, Y, Bmp, clMenu);
    finally
      Bmp.Free;
    end;
  end;
end;

procedure TJvCustomMenuItemPainter.DrawMenuBitmap(X, Y: Integer; Bitmap: TBitmap);
begin
  if mdDisabled in FState then
    DrawDisabledBitmap(X, Y, Bitmap)
  else
  begin
    if Bitmap.Monochrome and (not FItem.Checked or ShowCheckMarks) then
      BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
        Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
    els