lazarus-ccr/components/spktoolbar/SpkPopupMenu/spkpopup.pas

unit SpkPopup;

{$mode objfpc}{$H+}

interface

uses
  LCLType, Types, Classes, Controls, SysUtils, Graphics, Menus,
  spkt_Const, SpkGUITools, SpkMath, SpkGraphTools, spkt_Appearance;

type
  TSpkPopupMenu = class(TPopupMenu)
  private
    FAppearance: TSpkToolbarAppearance;
    procedure SetAppearance(AValue: TSpkToolbarAppearance);
    function GetIconSize: TSize;
    function GetPPI: Integer;

  protected
    procedure DrawItemHandler(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; AState: TOwnerDrawState); virtual;
    procedure MeasureItemHandler(Sender: TObject; ACanvas: TCanvas;
      var AWidth, AHeight: Integer); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    //constructor Create(AOwner: TComponent); override;
    property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
  end;

implementation

procedure TSpkPopupMenu.DrawItemHandler(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; AState: TOwnerDrawState);
var
  menuItem: TMenuItem;
  FrameColor: TColor = clNone;
  ColorFrom: TColor;
  ColorTo: TColor;
  TextColor: TColor;
  GradientType: TBackgroundKind;
  P: T2DIntPoint;
  R, Rgutter: T2DIntRect;
  Radius: Integer;
  x, y, wGutter, hText: Integer;
  iconSize: TSize;
  isHot: Boolean;
begin
  if FAppearance = nil then
    exit;

  if (Sender is TMenuItem) then
  begin
    menuItem := TMenuItem(Sender);

    {$IFDEF EnhancedRecordSupport}
    R := T2DIntRect.Create(
    {$ELSE}
    R := Create2DIntRect(
    {$ENDIF}
      ARect.Left,
      ARect.Top,
      ARect.Right,
      ARect.Bottom
    );
    isHot := AState * [odSelected, odHotLight] <>[];
    if not menuItem.Enabled then isHot := false;

    // Draw background
    if isHot then
    begin
      FrameColor := FAppearance.Popup.HotTrackFrameColor;
      ColorFrom := FAppearance.Popup.HotTrackGradientFromColor;
      ColorTo := FAppearance.Popup.HotTrackGradientToColor;
      GradientType := FAppearance.Popup.HotTrackGradientType;
      Radius := 0;  // maybe to be changed...
    end else
    begin
      ColorFrom := FAppearance.Popup.IdleGradientFromColor;
      ColorTo := FAppearance.Popup.IdleGradientToColor;
      GradientType := FAppearance.Popup.IdleGradientType;
      Radius := 0;
    end;
    TGUITools.DrawPopupItemRect(ACanvas, R, Radius, ColorFrom, ColorTo, GradientType);
    if isHot and (FrameColor <> clNone) then
    begin
      TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Top, FrameColor);
      TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Bottom-1, FrameColor);
      TGUITools.DrawVLine(ACanvas, R.Left, R.Top, R.Bottom-1, FrameColor);
      TGUITools.DrawVLine(ACanvas, R.Right-1, R.Top, R.Bottom-1, FrameColor);
    end;

    iconSize := GetIconSize;
    wGutter := iconSize.CX + 2*DropdownMenuMargin;
    {$IFDEF EnhancedRecordSupport}
    Rgutter := T2DIntRect.Create(
    {$ELSE}
    Rgutter := Create2DIntRect(
    {$ENDIF}
      ARect.Left,
      ARect.Top,
      ARect.Left + wGutter - 1,
      ARect.Bottom
    );

    if not IsHot and (FAppearance.Popup.Style = psGutter) then
    begin
      ColorFrom := FAppearance.Popup.GutterGradientFromColor;
      ColorTo := FAppearance.Popup.GutterGradientToColor;
      GradientType := FAppearance.Popup.GutterGradientType;
      TGUITools.DrawPopupItemRect(ACanvas, Rgutter, 0, ColorFrom, ColorTo, GradientType);
      FrameColor := FAppearance.Popup.GutterLineColor;
      if FrameColor <> clNone then
        TGUITools.DrawVLine(ACanvas, Rgutter.Right+1, R.Top, R.Bottom, FrameColor);
    end;

    // Draw icon
    if Assigned(Images) and (menuItem.ImageIndex > -1) then
    begin
      P := {$IFDEF EnhancedRecordSupport}T2DIntPoint.Create{$ELSE}Create2DIntPoint{$ENDIF}(
        ARect.Left + DropdownMenuMargin,
        (ARect.Top + ARect.Bottom - iconSize.CY) div 2
      );
      TGUITools.DrawImage(ACanvas, Images, menuItem.ImageIndex, P, RGutter, ImagesWidth, GetPPI, 1.0, menuItem.Enabled);
    end;

    // Draw text
    if menuItem.Enabled then
    begin
      if isHot then
        TextColor := FAppearance.Popup.HotTrackCaptionColor
      else
        TextColor := FAppearance.Popup.IdleCaptionColor;
    end else
      TextColor := FAppearance.Popup.DisabledCaptionColor;

    ACanvas.Font.Assign(FAppearance.Popup.CaptionFont);
    ACanvas.Font.Color := TextColor;
    hText := ACanvas.TextHeight('Tg');

    x := wGutter;
    inc(x, DropdownMenuMargin*2);

    if (menuItem.Caption = '-') or (menuItem.Caption = '|') then
    begin
      if FAppearance.Popup.Style <> psGutter then
        x := DropDownMenuMargin;
      y := (ARect.Top + ARect.Bottom) div 2;
      TGUITools.DrawHLine(ACanvas, x, ARect.Right-DropdownMenuMargin, y, TextColor);
    end else
    begin
      y := (ARect.Top + ARect.Bottom - hText) div 2;
      TGUITools.DrawText(ACanvas, x, y, menuItem.Caption, TextColor);
    end;
  end;
end;

function TSpkPopupMenu.GetIconSize: TSize;
begin
  if Assigned(Images) then
    Result := Images.SizeForPPI[ImagesWidth, GetPPI]
  else
  begin
    Result.CX := ScaleX(16, 96);
    Result.CY := Result.CY;
  end;
end;

function TSpkPopupMenu.GetPPI: Integer;
begin
  if Parent is TControl then
    Result := TControl(Parent).Font.PixelsPerInch
  else
    Result := ScreenInfo.PixelsPerInchX;
end;

procedure TSpkPopupMenu.MeasureItemHandler(Sender: TObject; ACanvas: TCanvas;
  var AWidth, AHeight: Integer);
begin
  //
end;

procedure TSpkPopupMenu.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    (*    FAppearance does not inherit from TComponent !!!!!!!!!!!
    if AComponent = FAppearance then
      FAppearance := nil;
      *)
  end;
end;

procedure TSpkPopupMenu.SetAppearance(AValue: TSpkToolbarAppearance);
var
  i: Integer;
begin
//  if FAppearance = AValue then
//    exit;
  FAppearance := AValue;
  OwnerDraw := FAppearance <> nil;
  OnDrawItem := @DrawItemHandler;
  //OnMeasureItem := @MeasureItemHandler;

  for i := 0 to Items.Count-1 do
  begin
    Items[i].OnDrawItem := @DrawItemHandler;
    //Items[i].OnMeasureItem := @MeasureItemHandler;
  end;
end;

end.