Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d345/JWTOOL.ZIP/jwtool/JwPopBtn.PAS

Pascal/Delphi Source File | 2001-09-29 | 12.9 KB | 481 lines

unit JwPopbtn;

{
        **   VERSION History   **
   Version     Date     Notes
    v1.00  - 01APR99    Original Release
}

{
     Three stage buttons:
           The idea is that you want one "look" in an "unfocused" state, another
     when you are in a "mouseover" state, and a third when you are clicking.  This
     idea is taken in the FlashClick, FlashPanel, and PopButton.

          The JwPopButton was the first of the three stage buttons. I can't say
     how many times I have seen installer programs that had a really neat button
     on the surface that acted differently if you even hovered over it.   This
     of course uses three different bitmaps to create the effect.

}

//  Created By:
//    Joseph Wilcock
//    [e-mail]
//    http://msnhomepages.talkcity.com/RedmondAve/coockoo/

interface

uses {$IFDEF WIN32} Windows, {$ELSE} WinProcs, WinTypes, {$ENDIF}
     Messages, SysUtils, Classes, Controls, Forms, Graphics, Extctrls;

type
  TActiveModeState = ( amNone, amDown, amUp, amJump );

  TJwPopButton = class(TCustomPanel)
    private
      { Private fields of TJwPopButton }

        {Bitmap Info}
        FActive : TBitmap;
        FJump : TBitmap;
        FDeactive : TBitmap;
        FBitOffsetX : Integer; {Offset of the Bitmap from top left corner, in logical points}
        FBitOffsetY : Integer;

        {General Attributes}
        FDrawBitmap: Boolean;
        FWordWrap: Boolean;

        {button colors, if normal drawing}
        FButtonBevelWidth: Integer;
        FButtonFace: TColor;
        FHighLight: TColor;
        FButtonShadow: TColor;
        FWindowFrame: TColor;

        FTotalFrameColor: TColor;
        FActMode: TActiveModeState;

        procedure SetFActive(Value : TBitmap);
        procedure SetFDeactive(Value : TBitmap);
        procedure SetFJump( Value : TBitmap );
        Procedure SetBevelWidth( Value: Integer );
        procedure SetButtonFace( Value: TColor );
        procedure SetHightLight( Value: TColor );
        procedure SetButtonShadow( Value: TColor );
        procedure SetWindowFrame( Value: TColor );
        Procedure SetDrawBitmap( Value: Boolean );
        procedure SetWordWrap( Value: Boolean );
        procedure SetTotalFrameColor( Value: TColor );
    protected
      { Protected fields of TJwPopButton }

      { Protected methods of TJwPopButton }
        procedure Click; override;
        procedure DoEnter; override;
        procedure DoExit; override;
        procedure KeyPress(var Key : Char); override;
        procedure Loaded; override;
        procedure Paint; override;

        function DrawButtonFace( const Client: TRect; BevelWidth: Integer ): TRect;
        procedure DoDrawText( var Rect: TRect; Flags: Word );
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
        procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
    public
      { Public fields and properties of TJwPopButton }

      { Public methods of TJwPopButton }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

    published
      { Published properties of TJwPopButton }
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        { Picture for active occurances... }
        property Active : TBitmap read FActive write SetFActive;
        property Jump : TBitmap read FJump write SetFJump;
        property Deactive : TBitmap read FDeactive write SetFDeactive;
        property BitOffsetX : Integer read FBitOffsetX write FBitOffsetX default 0;
        property BitOffsetY : Integer read FBitOffsetY write FBitOffsetY default 0;
        Property Anchors;
        property Caption;
        property Font;
        property Align;
        property Enabled;
        property BorderWidth;
        property BorderStyle;
        property Locked;
        property Alignment;
        property DrawBitmap: Boolean Read FDrawBitmap Write SetDrawBitmap
                 default True;
        property WordWrap: Boolean Read FWordWrap Write SetWordWrap
                 default False;

        property ButtonBevelWidth: Integer Read FButtonBevelWidth Write SetBevelWidth
                 default 2;
        property ButtonFace: TColor Read FButtonFace Write SetButtonFace
                 default clbtnFace;
        property HighLight: TColor Read FHighLight Write SetHightLight
                 default clBtnHighlight;
        property ButtonShadow: TColor Read FButtonShadow Write SetButtonShadow
                 default clBtnShadow;
        property WindowFrame: TColor Read FWindowFrame Write SetWindowFrame
                 default clWindowFrame;
        property TotalFrameColor: TColor Read FTotalFrameColor Write SetTotalFrameColor
                 default clBtnFace;
  end;

procedure Register;

implementation

procedure Register;
begin
  { Register TJwPopButton with Standard as its
    default page on the Delphi component palette }
  RegisterComponents('JwTools', [TJwPopButton]);
end;

procedure TJwPopButton.SetWordWrap( Value: Boolean );
begin
  if Value <> FWordWrap then
    begin
      FWordWrap := Value;
      InValidate;
    end;
end;

procedure TJwPopButton.SetButtonFace( Value: TColor );
begin
  if Value <> FButtonFace then
  begin
    FButtonFace := Value;
    Invalidate;
  end;
end;

procedure TJwPopButton.SetHightLight( Value: TColor );
begin
  if Value <> FHighLight then
  begin
    FHighLight := Value;
    Invalidate;
  end;
end;

procedure TJwPopButton.SetTotalFrameColor( Value: TColor );
begin
  if Value <> FTotalFrameColor then
  begin
    FTotalFrameColor := Value;
    Invalidate;
  end;
end;

procedure TJwPopButton.SetButtonShadow( Value: TColor );
begin
  if Value <> FButtonShadow then
  begin
    FButtonShadow := Value;
    Invalidate;
  end;
end;

procedure TJwPopButton.SetWindowFrame( Value: TColor );
begin
  if Value <> FWindowFrame then
  begin
    FWindowFrame := Value;
    Invalidate;
  end;
end;

Procedure TJwPopButton.SetDrawBitmap( Value: Boolean );
begin
  if Value <> FDrawBitmap then
    begin
      FDrawBitmap := Value;
      InValidate;
    end;
end;

Procedure TJwPopButton.SetBevelWidth( Value: Integer );
begin
  if Value <> FButtonBevelWidth then
    begin
      FButtonBevelWidth := Value;
      InValidate;
    end;
end;

{ Write method for property FActive }
procedure TJwPopButton.SetFActive( Value : TBitmap );
begin
  { Use Assign method because TBitmap is an object type }
  FActive.Assign(Value);
  if FActMode = amUp then
    Invalidate;
end;

procedure TJwPopButton.SetFJump( Value : TBitmap );
begin
  { Use Assign method because TBitmap is an object type }
  FJump.Assign(Value);
  if FActMode = amJump then
    Invalidate;
end;

{ Write method for property FDeactive }
procedure TJwPopButton.SetFDeactive( Value : TBitmap );
begin
  { Use Assign method because TBitmap is an object type }
  FDeactive.Assign( Value );
  if FActMode = amDown then
    Invalidate;
end;

{ Override OnClick handler from TCustomPanel }
procedure TJwPopButton.Click;
{var
  OldMode: Byte;}
begin
  { Activate click behavior of parent }
{  OldMode := FActMode;
  try
    FActMode := 2;
    Invalidate;}
    inherited Click;
  {finally
    FActMode := OldMode;
    Invalidate;
  end;}
end;

{ Override OnEnter handler from TCustomPanel }
procedure TJwPopButton.DoEnter;
begin
  inherited DoEnter;
  FActMode := amUP;
  InValidate;
end;

{ Override OnExit handler from TCustomPanel }
procedure TJwPopButton.DoExit;
begin
  inherited DoExit;
  FActMode := amDown;
  InValidate;
end;

{ Override OnKeyPress handler from TCustomPanel }
procedure TJwPopButton.KeyPress(var Key : Char);
const
  TabKey = Char( VK_TAB );
  EnterKey = Char( VK_RETURN );
  SpaceKey = Char( VK_SPACE );
begin
  { Key contains the character produced by the keypress.
    It can be tested or assigned a new value before the
    call to the inherited KeyPress method.  Setting Key
    to #0 before call to the inherited KeyPress method
    terminates any further processing of the character. }

  { Activate KeyPress behavior of parent }
  if Key = EnterKey then
    Self.Click;
  if Key = SpaceKey then
    Self.Click;
  inherited KeyPress(Key);

  { Code to execute after KeyPress behavior of parent }

end;

constructor TJwPopButton.Create(AOwner: TComponent);
begin
  { Call the Create method of the container's parent class       }
  inherited Create(AOwner);

  FActive := TBitmap.Create;
  FDeactive := TBitmap.Create;
  FJump := TBitMap.Create;
  FActMode := amDown;
  FButtonFace := clBtnFace;
  FHighLight := clBtnHighLight;
  FButtonShadow := clBtnShadow;
  FWindowFrame := clBtnFace;
  FTotalFrameColor := clBtnFace;
  FDrawBitmap := True;
  FWordWrap := False;
  BorderWidth := 0;

        {button colors, if normal drawing}
  FButtonBevelWidth := 5;
  Width := 50;
  Height := 20;

end;

destructor TJwPopButton.Destroy;
begin
  FActive.Free;
  FDeactive.Free;
  FJump.Free;
  inherited Destroy;
end;

procedure TJwPopButton.Loaded;
begin
  inherited Loaded;

  { Perform any component setup that depends on the property
    values having been set }

end;

procedure TJwPopButton.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  PaintRect: TRect;
  TextBounds: TRect;
  OldStyle: TPenStyle;
begin
  Canvas.Font := Self.Font;
  Canvas.Brush.Color := Self.ButtonFace;
  OldStyle := Canvas.Pen.Style;
  try
    Canvas.Pen.Style := psClear;
    Canvas.Rectangle( 0, 0, Width, Height );
  finally
    Canvas.Pen.Style := OldStyle;
  end;

  if FDrawBitmap then
    begin
      PaintRect := Rect( FBitOffsetX, FBitOffsetY, Width, Height );
      case FActMode of
        amDown: Canvas.Draw( FBitOffsetX, FBitOffsetY, FDeactive );
        amUp: Canvas.Draw( FBitOffsetX, FBitOffsetY, FActive );
        amJump: Canvas.Draw( FBitOffsetX, FBitOffsetY, FJump );
      end;
    end
  else
    begin
      PaintRect := DrawButtonFace( Rect(0, 0, Width, Height), FButtonBevelWidth );
      PaintRect.Top := PaintRect.Top + FButtonBevelWidth;
      PaintRect.Left := PaintRect.Left + FButtonBevelWidth;
      PaintRect.Bottom := PaintRect.Bottom - FButtonBevelWidth;
      PaintRect.Right := PaintRect.Right - FButtonBevelWidth;
    end;

  DoDrawText(PaintRect, (DT_EXPANDTABS or DT_WORDBREAK) or
      Alignments[Self.Alignment]);
end;

function TJwPopButton.DrawButtonFace( const Client: TRect; BevelWidth: Integer ): TRect;
var
  R: TRect;
begin
  R := Client;
  with Canvas do
  begin
      Brush.Style := bsSolid;
      FillRect(R);

      if FActMode = amJump then
        begin
          Frame3D(Canvas, R, FButtonShadow, FHighLight, 1);
          Frame3D(Canvas, R, FWindowFrame, FButtonShadow, 1);
        end
      else if FActMode = amUP then
        begin
          Frame3D(Canvas, R, FButtonShadow, FWindowFrame, 1);
          Frame3D(Canvas, R, FHighLight, FButtonShadow, 1);
        end;
  end;

  Result := Client;
  InflateRect(Result, -BevelWidth, -BevelWidth);
  if FActMode <> amUp then OffsetRect(Result, 2, 2);
end;

procedure TJwPopButton.DoDrawText( var Rect: TRect; Flags: Word );
var
  Text: array[0..255] of Char;
begin
  GetTextBuf( Text, SizeOf(Text) );

  if FWordWrap then
    Flags := Flags or dt_WordBreak;

  if (Flags and DT_CALCRECT <> 0) and ((Text[0] = #0) and
    (Text[0] = '&') and (Text[1] = #0)) then StrCopy(Text, ' ');

  Canvas.Font := Font;
  if not Enabled then Canvas.Font.Color := clGrayText;
  DrawText(Canvas.Handle, Text, StrLen(Text), Rect, Flags);
end;

procedure TJwPopButton.CMMouseEnter(var msg: TMessage);
begin
  FActMode := amUp;
  Invalidate;
  Inherited;
end;

procedure TJwPopButton.CMMouseLeave(var msg: TMessage);
begin
  FActMode := amDown;
  Invalidate;
  Inherited;
end;

procedure TJwPopButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FActMode := amJump;
  Invalidate;
  Inherited;
end;

procedure TJwPopButton.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FActMode := amUp;
  Invalidate;
  Inherited;
end;

procedure TJwPopButton.WMSize(var Message: TWMSize);
var
     W, H: Integer;
begin
     inherited;

     W := Width;
     H := Height;

     if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H);

     Message.Result := 0;
end;

end.