Changeset 77 for trunk/UMenu.pas


Ignore:
Timestamp:
May 19, 2021, 11:30:41 AM (3 years ago)
Author:
chronos
Message:
  • Added: Control icons for Pause, Play and Fast forward.
  • Modified: Image buttons changed to custom TImage control with Enabled property supported.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UMenu.pas

    r76 r77  
    66
    77uses
    8   Classes, SysUtils, Graphics, Controls, fgl;
     8  Classes, SysUtils, Graphics, Controls, fgl, UControls;
    99
    1010type
    … …  
    1313  { TMenuItem }
    1414
    15   TMenuItem = class
     15  TMenuItem = class(TControl)
    1616    BackgroundColor: TColor;
    1717    BackgroundSelectedColor: TColor;
    1818    Kind: TMenuItemKind;
    1919    Text: string;
    20     Bounds: TRect;
    2120    Selected: Boolean;
    2221    FontSize: Integer;
    2322    FontColor: Integer;
    24     Enabled: Boolean;
    25     procedure Paint(Canvas: TCanvas; P: TPoint); virtual;
    2623    function GetOutputText: string; virtual;
    27     constructor Create; virtual;
     24    constructor Create; override;
    2825  end;
    2926
    … …  
    3532  public
    3633    Checked: Boolean;
    37     procedure Paint(Canvas: TCanvas; P: TPoint); override;
     34    procedure Paint; override;
    3835    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    3936  end;
    … …  
    4946    constructor Create; override;
    5047    destructor Destroy; override;
    51     procedure Paint(Canvas: TCanvas; P: TPoint); override;
     48    procedure Paint; override;
    5249    function GetOutputText: string; override;
    5350    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    … …  
    5754
    5855  TMenuItemButton = class(TMenuItem)
    59   private
    60     FOnClick: TNotifyEvent;
    6156  public
    62     procedure Paint(Canvas: TCanvas; P: TPoint); override;
    63     property OnClick: TNotifyEvent read FOnClick write FOnClick;
    64   end;
    65 
    66   { TMenuItemImage }
    67 
    68   TMenuItemImage = class(TMenuItem)
    69   private
    70     FOnClick: TNotifyEvent;
    71   public
    72     Bitmap: TBitmap;
    73     procedure Paint(Canvas: TCanvas; P: TPoint); override;
    74     property OnClick: TNotifyEvent read FOnClick write FOnClick;
    75     constructor Create; override;
    76     destructor Destroy; override;
     57    procedure Paint; override;
    7758  end;
    7859
    … …  
    11899implementation
    119100
    120 { TMenuItemImage }
    121 
    122 procedure TMenuItemImage.Paint(Canvas: TCanvas; P: TPoint);
    123 begin
    124   if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    125     else Canvas.Brush.Color := BackgroundColor;
    126   if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
    127     else Canvas.Brush.Style := bsSolid;
    128   Canvas.StretchDraw(Bounds, Bitmap);
    129 end;
    130 
    131 constructor TMenuItemImage.Create;
    132 begin
    133   inherited;
    134   Bitmap := TBitmap.Create;
    135 end;
    136 
    137 destructor TMenuItemImage.Destroy;
    138 begin
    139   FreeAndNil(Bitmap);
    140   inherited;
    141 end;
    142 
    143101{ TMenuItemButton }
    144102
    145 procedure TMenuItemButton.Paint(Canvas: TCanvas; P: TPoint);
    146 begin
     103procedure TMenuItemButton.Paint;
     104var
     105  P: TPoint;
     106begin
     107  P := Point(Bounds.Left, Bounds.Top);
    147108  if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    148109    else Canvas.Brush.Color := BackgroundColor;
    … …  
    155116{ TMenuItemCheckBox }
    156117
    157 procedure TMenuItemCheckBox.Paint(Canvas: TCanvas; P: TPoint);
     118procedure TMenuItemCheckBox.Paint;
    158119var
    159120  OutputText: string;
    160 begin
     121  P: TPoint;
     122begin
     123  P := Point(Bounds.Left, Bounds.Top);
    161124  OutputText := Text;
    162125  if Checked then OutputText := '✓' + OutputText;
    … …  
    171134{ TMenuItem }
    172135
    173 procedure TMenuItem.Paint(Canvas: TCanvas; P: TPoint);
    174 begin
    175 end;
    176 
    177136function TMenuItem.GetOutputText: string;
    178137begin
    … …  
    201160end;
    202161
    203 procedure TMenuItemComboBox.Paint(Canvas: TCanvas; P: TPoint);
    204 begin
     162procedure TMenuItemComboBox.Paint;
     163var
     164  P: TPoint;
     165begin
     166  P := Point(Bounds.Left, Bounds.Top);
    205167  if Selected then Canvas.Brush.Color := BackgroundSelectedColor
    206168    else Canvas.Brush.Color := BackgroundColor;
    … …  
    235197    if Items[I].Bounds.Contains(Position) then begin
    236198      if (Items[I] is TMenuItemButton) then begin
    237         if Assigned(TMenuItemButton(Items[I]).FOnClick) then
    238           TMenuItemButton(Items[I]).FOnClick(Items[I]);
     199        if Assigned(TMenuItemButton(Items[I]).OnClick) then
     200          TMenuItemButton(Items[I]).OnClick(Items[I]);
    239201      end else
    240202      if (Items[I] is TMenuItemCheckBox) then begin
    … …  
    286248      Font.Size := Items[I].FontSize;
    287249      Font.Color := Items[I].FontColor;
    288       Items[I].Paint(Canvas, Point(X, Y));
     250      Items[I].Bounds.Left := X;
     251      Items[I].Bounds.Top := Y;
     252      Items[I].Canvas := Canvas;
     253      Items[I].Paint;
    289254      LineHeight := Round(TextHeight('I') * 1.1);
    290255      Inc(Y, LineHeight);
Note: See TracChangeset for help on using the changeset viewer.