tntjvspeedbutton.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

  private
    FGlyph: TTntJvxButtonGlyph;
    FButtonSize: TPoint;
    FCaption: TWideCaption;
    function GetNumGlyphs: TJvNumGlyphs;
    procedure SetNumGlyphs(Value: TJvNumGlyphs);
    function GetWordWrap: Boolean;
    procedure SetWordWrap(Value: Boolean);
    function GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Invalidate;
    procedure DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
      Layout: TButtonLayout; AFont: TFont; Images: TCustomImageList;
      ImageIndex: Integer; Flags: Word);
    procedure Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
      Layout: TButtonLayout; AFont: TFont; Flags: Word);
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    property Caption: TWideCaption read FCaption write FCaption;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property NumGlyphs: TJvNumGlyphs read GetNumGlyphs write SetNumGlyphs;
    property ButtonSize: TPoint read FButtonSize write FButtonSize;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap;
  end;

  { (rb) Similar class in JvButtons.pas }
  TTntJvxButtonGlyph = class(TObject)
  private
    FAlignment: TAlignment;
    FGlyphList: TCustomImageList;
    FGrayNewStyle: Boolean;
    FIndexs: array [TJvButtonState] of Integer;
    FNumGlyphs: TJvNumGlyphs;
    FOnChange: TNotifyEvent;
    FOriginal: TBitmap;
    FTransparentColor: TColor;
    FWordWrap: Boolean;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGrayNewStyle(const Value: Boolean);
    procedure SetNumGlyphs(Value: TJvNumGlyphs);
    function MapColor(Color: TColor): TColor;
  protected
    procedure MinimizeCaption(Canvas: TCanvas; const Caption: WideString;
      Buffer: PWideChar; MaxLen, Width: Integer);
    function CreateButtonGlyph(State: TJvButtonState): Integer;
    function CreateImageGlyph(State: TJvButtonState; Images: TCustomImageList;
      Index: Integer): Integer;
    procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      var Caption: WideString; Layout: TButtonLayout; Margin, Spacing: Integer;
      PopupMark: Boolean; var GlyphPos: TPoint; var TextBounds: TRect;
      Flags: Word; Images: TCustomImageList; ImageIndex: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Invalidate;
    function DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
      State: TJvButtonState): TPoint;
    function DrawButtonImage(Canvas: TCanvas; X, Y: Integer; Images: TCustomImageList;
      ImageIndex: Integer; State: TJvButtonState): TPoint;
    function DrawEx(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: WideString; Layout: TButtonLayout; Margin, Spacing: Integer;
      PopupMark: Boolean; Images: TCustomImageList; ImageIndex: Integer;
      State: TJvButtonState; Flags: Word): TRect;
    procedure DrawButtonText(Canvas: TCanvas; const Caption: WideString;
      TextBounds: TRect; State: TJvButtonState; Flags: Word);
    procedure DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
      State: TJvButtonState);
    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: WideString; Layout: TButtonLayout; Margin, Spacing: Integer;
      PopupMark: Boolean; State: TJvButtonState; Flags: Word): TRect;
    property Alignment: TAlignment read FAlignment write FAlignment;
    property Glyph: TBitmap read FOriginal write SetGlyph;
    property GrayNewStyle: Boolean read FGrayNewStyle write SetGrayNewStyle;
    property NumGlyphs: TJvNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property WordWrap: Boolean read FWordWrap write FWordWrap;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

{ DrawButtonFrame - returns the remaining usable area inside the Client rect }

function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
  IsDown, IsFlat: Boolean; Style: TButtonStyle; AColor: TColor): TRect;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvSpeedButton.pas,v $';
    Revision: '$Revision: 1.51 $';
    Date: '$Date: 2005/10/28 08:37:23 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Math,
  TntButtons, TntWindows, TntWideStrUtils, TntJvJCLUtils, TntActnList, TntForms;

type
  TJvGlyphList = class;

  TJvGlyphCache = class(TObject)
  private
    FGlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TJvGlyphList;
    procedure ReturnList(List: TJvGlyphList);
    function Empty: Boolean;
  end;

  TJvGlyphList = class(TCustomImageList)
  private
    FUsed: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize(AWidth, AHeight: Integer);
    destructor Destroy; override;
    function Add(Image, Mask: TBitmap): Integer; {$IFDEF VisualCLX} override; {$ENDIF}
    function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; {$IFDEF VisualCLX} override; {$ENDIF}
    procedure Delete(Index: Integer);
    property Count: Integer read FCount;
  end;

  TWinControlAccess = class(TWinControl);

const
  Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);

var
  // (rom) changed to var
  // (rb) used for?
  ButtonCount: Integer;
  GlyphCache: TJvGlyphCache;
  TempBrushBitmap: TBitmap = nil;
  SaveColor1, SaveColor2: TColor;

//=== Local procedures =======================================================

{ DrawButtonFrame - returns the remaining usable area inside the Client rect }

function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
  IsDown, IsFlat: Boolean; Style: TButtonStyle; AColor: TColor): TRect;
{$IFDEF VisualCLX}
const
  clWindowFrame = cl3DDkShadow; // clWindowFrame is a blue tone
{$ENDIF VisualCLX}
var
  NewStyle: Boolean;
  ShadowColor, HighlightColor: TColor;

  // Honeymic
  function GetHighlightColor(BaseColor: TColor): TColor;
  begin
   Result := RGB(
      Min(GetRValue(ColorToRGB(BaseColor)) + 64, 255),
      Min(GetGValue(ColorToRGB(BaseColor)) + 64, 255),
      Min(GetBValue(ColorToRGB(BaseColor)) + 64, 255));
  end;

  // Honeymic
  function GetShadowColor(BaseColor: TColor): TColor;
  begin
   Result := RGB(
      Max(GetRValue(ColorToRGB(BaseColor)) - 64, 0),
      Max(GetGValue(ColorToRGB(BaseColor)) - 64, 0),
      Max(GetBValue(ColorToRGB(BaseColor)) - 64, 0));
  end;

begin
  Result := Client;
  NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
  ShadowColor := GetShadowColor(AColor);     // Honeymic
  HighlightColor := GetHighlightColor(AColor);  // Honeymic

  if IsDown then
  begin
    if NewStyle then
    begin
      //Polaris
      //Frame3D(Canvas, Result,clBtnShadow{ clWindowFrame}, clBtnHighlight, 1);
      //if not IsFlat then
      //  Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
      if not IsFlat then
      begin
        // Honeymic
        Frame3D(Canvas, Result, clWindowFrame, HighlightColor, 1);
        Frame3D(Canvas, Result, ShadowColor, AColor, 1);
      end
      else
        // Honeymic
        Frame3D(Canvas, Result, ShadowColor, HighlightColor, 1);
    end
    else
    begin
      if IsFlat then
      begin
        // Honeymic
        Frame3D(Canvas, Result, clWindowFrame, HighlightColor, 1);
      end
      else
      begin
        Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
        // Honeymic
        Canvas.Pen.Color := clBtnShadow;
        Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
          Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
      end;
    end;
  end
  else
  begin
    if NewStyle then
    begin
      if IsFlat then
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, ShadowColor, 1)
      else
      begin
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, clWindowFrame, 1);
        Frame3D(Canvas, Result, AColor, ShadowColor, 1);
      end;
    end
    else
    begin
      if IsFlat then
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, clWindowFrame, 1)
      else
      begin
        Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, ShadowColor, 1);
      end;
    end;
  end;
  InflateRect(Result, -1, -1);
end;

function GetBrushPattern(Color1, Color2: TColor): TBitmap;
begin
  if TempBrushBitmap = nil then
    TempBrushBitmap := CreateTwoColorsBrushPattern(Color1, Color2)
  else
  begin
    if (Color1 <> SaveColor1) or (Color2 <> SaveColor2) then
    begin
      FreeAndNil(TempBrushBitmap);
      TempBrushBitmap := CreateTwoColorsBrushPattern(Color1, Color2);
    end;
  end;
  SaveColor1 := Color1;
  SaveColor2 := Color2;

  Result := TempBrushBitmap;
end;

//=== { TTntJvButtonImage } =====================================================

constructor TTntJvButtonImage.Create;
begin
  inherited Create;
  FGlyph := TTntJvxButtonGlyph.Create;
  NumGlyphs := 1;
  FButtonSize := Point(24, 23);
end;

destructor TTntJvButtonImage.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TTntJvButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  Layout: TButtonLayout; AFont: TFont; Flags: Word);
begin
  DrawEx(Canvas, X, Y, Margin, Spacing, Layout, AFont, nil, -1, Flags);
end;

procedure TTntJvButtonImage.DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  Layout: TButtonLayout; AFont: TFont; Images: TCustomImageList; ImageIndex: Integer;
  Flags: Word);
var
  Target: TRect;
  SaveColor: Integer;
  SaveFont: TFont;
  Offset: TPoint;
begin
  SaveColor := Canvas.Brush.Color;
  SaveFont := TFont.Create;
  SaveFont.Assign(Canvas.Font);
  try
    Target := Bounds(X, Y, FButtonSize.X, FButtonSize.Y);
    Offset := Point(0, 0);
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(Target);
    Frame3D(Canvas, Target, clBtnShadow, clWindowFrame, 1);
    Frame3D(Canvas, Target, clBtnHighlight, clBtnShadow, 1);
    if AFont <> nil then
      Canvas.Font := AFont;
    FGlyph.DrawEx(Canvas, Target, Offset, Caption, Layout, Margin,
      Spacing, False, Images, ImageIndex, rbsUp, Flags);
  finally
    Canvas.Font.Assign(SaveFont);
    SaveFont.Free;
    Canvas.Brush.Color := SaveColor;
  end;
end;

function TTntJvButtonImage.GetAlignment: TAlignment;
begin
  Result := FGlyph.Alignment;
end;

function TTntJvButtonImage.GetGlyph: TBitmap;
begin
  Result := FGlyph.Glyph;
end;

function TTntJvButtonImage.GetNumGlyphs: TJvNumGlyphs;
begin
  Result := FGlyph.NumGlyphs;
end;

function TTntJvButtonImage.GetWordWrap: Boolean;
begin
  Result := FGlyph.WordWrap;
end;

procedure TTntJvButtonImage.Invalidate;
begin
  FGlyph.Invalidate;
end;

procedure TTntJvButtonImage.SetAlignment(Value: TAlignment);
begin
  FGlyph.Alignment := Value;
end;

procedure TTntJvButtonImage.SetGlyph(Value: TBitmap);
begin
  FGlyph.Glyph := Value;
end;

procedure TTntJvButtonImage.SetNumGlyphs(Value: TJvNumGlyphs);
begin
  FGlyph.NumGlyphs := Value;
end;

procedure TTntJvButtonImage.SetWordWrap(Value: Boolean);
begin
  FGlyph.WordWrap := Value;
end;

//=== { TTntJvCustomSpeedButton0 } ===============================================

procedure TTntJvCustomSpeedButton0.ButtonClick;
begin
  if FMenuTracking or (not Enabled) or (Assigned(FDropDownMenu) and
    DropDownMenu.AutoPopup) then
    Exit;
  if not FDown then
  begin
    FState := rbsDown;
    Repaint;
  end;
  try
    Sleep(20); // (ahuser) why?
    if FGroupIndex = 0 then
      Click;
  finally
    FState := rbsUp;
    if FGroupIndex = 0 then
      Repaint
    else
    begin
      SetDown(not FDown);
      Click;
    end;
  end;
end;

function TTntJvCustomSpeedButton0.CheckBtnMenuDropDown: Boolean;
begin
  Result := CheckMenuDropDown(PointToSmallPoint(GetDropDownMenuPos), True);
end;

function TTntJvCustomSpeedButton0.CheckMenuDropDown(const Pos: TSmallPoint;
  Manual: Boolean): Boolean;
{$IFDEF VCL}
var
  Form: TCustomForm;
{$ENDIF VCL}
begin
  Result := False;
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FDropDownMenu) and (DropDownMenu.AutoPopup or Manual) then
  begin
    {$IFDEF VCL}
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.SendCancelMode(nil);
    {$ENDIF VCL}
    DropDownMenu.PopupComponent := Self;
    with ClientToScreen(SmallPointToPoint(Pos)) do
      DropDownMenu.Popup(X, Y);
    Result := True;
  end;
end;

procedure TTntJvCustomSpeedButton0.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;
  inherited Click;
end;

procedure TTntJvCustomSpeedButton0.CMButtonPressed(var Msg: TCMButtonPressed);
var
  Sender: TControl;
begin
  if (Msg.Index = FGroupIndex) and Parent.HandleAllocated then
  begin
    Sender := Msg.Control;
    if (Sender <> nil) and (Sender is TTntJvCustomSpeedButton0) then
      if Sender <> Self then
      begin
        if TTntJvCustomSpeedButton0(Sender).Down and FDown then
        begin
          FDown := False;
          FState := rbsUp;
          Repaint;
        end;
        FAllowAllUp := TTntJvCustomSpeedButton0(Sender).AllowAllUp;
      end;
  end;
end;

procedure TTntJvCustomSpeedButton0.CMDialogChar(var Message: TCMDialogChar);