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

Pascal/Delphi Source File | 2001-09-29 | 10.4 KB | 382 lines

unit Jwfshpn;

{
        **   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 FlashClick shares a lot of code with the flash panel.  The difference is
     that the FlashClick is inherited from a TLabel, and therefore does not have a
     canvas of it's own, which can save on memory.  Since there isn't a default MouseExit
     and MouseEnter events (I got use to those programming in XWindows...) I had to make
     my own.  But in essence, you now have a lowmemory Web-like button.

}

//  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,
     Stdctrls, extctrls;

type
{Windows Messaging is rather nasty.  Since I want to add user-defined methods to
something that delphi hasn't already defined, namely OnMouseExit and OnMouseEnter,
I will have to do it myself.  First, I need to redefine the message record.  In
this case I literally took it from the TWMMouse message, repeated twice under two
names.  (I Might want to change that later).}

  TWMMouseExit = record
    Msg: Cardinal;
    Keys: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMMouseEnter = record
    Msg: Cardinal;
    Keys: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;


  {The next thing to do is define a new custom "TNotify" event.  Once again,
  even though I am repeating myself, I'm going to use the same thing twice
  just in case I want to change things.}
  TMouseExit = procedure(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer) of object;
  TMouseEnter = procedure(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer) of object;

  TJwFlashPanel = class(TPanel)
    private
      { Private fields of TJwFlashClick }

        {The TNotifyEvent objects to use on the specific events}
        FOnEnter: TMouseEnter;
        FOnExit: TMouseExit;

        procedure WMSize(var Message: TWMSize); message WM_SIZE;
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;

        {FINALLY.. we have a 3-stage event.  The CMMouseEnter and CMMouseLeave are the functions
        that actually look for the CM_MOUSEENTER and CM_MOUSELEAVE in the WinMain command loop.
        Once it hits, it will call the corresponding "Do" method which will call the "Mouse..."
        and that will call the TNotfy event if it is assigned.}
        procedure CMMouseEnter({var msg: TMessage}var Message: TWMMouseEnter); message CM_MOUSEENTER;
        procedure CMMouseLeave({var msg: TMessage}var Message: TWMMouseExit); message CM_MOUSELEAVE;
        procedure MouseEnter(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure DoMouseEnter(var Message: TWMMouseEnter; Button: TMouseButton;
                    Shift: TShiftState);
        procedure DoMouseExit(var Message: TWMMouseExit; Button: TMouseButton;
                    Shift: TShiftState);
        procedure MouseExit(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

        Procedure SetFlareFont( Value: TFont );
        Procedure SetBaseFont( Value: TFont );
        Procedure SetClickFont( Value: TFont );
        Procedure SetCommonFont( Value: TFont );
    protected
        FCheckEffect: Boolean;
        FFlareMode: Byte;
        FBaseFont: TFont;
        FFlareFont: TFont;
        FClickFont: TFont;

      { Protected methods of TJwFlashClick }
        procedure Click; override;
        procedure Loaded; override;
        procedure Paint; override;

        Procedure SetCheckedValue( Value: Boolean );
        Function GetCheckValue: Boolean;

    public
      { Public fields and properties of TJwFlashClick }

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

    published
      { Published properties of TJwFlashClick }
        Property BaseFont: TFont Read FBaseFont Write SetBaseFont;
        Property FlareFont: TFont Read FFlareFont Write SetFlareFont;
        Property ClickFont: TFont Read FClickFont Write SetClickFont;
        Property CommonFont: TFont Read FBaseFont Write SetCommonFont;

        Property CheckEffect: Boolean Read FCheckEffect Write FCheckEffect;
        Property Anchors;
        Property Alignment;
        Property Align;
        Property BevelInner;
        Property BevelOuter;
        Property BevelWidth;
        Property BorderStyle;
        {$IFDEF WIN32}
        Property FullRepaint;
        Property Locked;
        {$ENDIF}
        Property Ctl3D;
        Property Color;
        Property Cursor;
        Property Height;
        Property Hint;
        Property Left;
        Property Name;
        Property ParentColor;
        Property ShowHint;
        Property Top;
        Property Visible;
        Property Width;
        Property Caption;
        Property Tag;

        Property OnEnter: TMouseEnter Read FOnEnter Write FOnEnter;
        Property OnExit: TMouseExit Read FOnExit Write FOnExit;

        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;

  end;

procedure Register;

implementation

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

Procedure TJwFlashPanel.SetCheckedValue( Value: Boolean );
begin
  if ( FCheckEffect ) then
    begin
      if Value then
        FFlareMode := 3
      else
        FFlareMode := 0;
      InValidate;
    end;
end;

Function TJwFlashPanel.GetCheckValue: Boolean;
begin
  Result := ( FFlareMode = 3 );
end;

Procedure TJwFlashPanel.SetCommonFont( Value: TFont );
begin
  {if Value <> FClickFont then
    begin}
      FClickFont.Assign( Value );
      FBaseFont.Assign( Value );
      FFlareFont.Assign( Value );
      Invalidate;
    {end;}
end;

Procedure TJwFlashPanel.SetClickFont( Value: TFont );
begin
  {if Value <> FClickFont then
    begin}
      FClickFont.Assign( Value );
      Invalidate;
    {end;}
end;

Procedure TJwFlashPanel.SetBaseFont( Value: TFont );
begin
  {if Value <> FBaseFont then
    begin}
      FBaseFont.Assign( Value );
      Invalidate;
    {end;}
end;

Procedure TJwFlashPanel.SetFlareFont( Value: TFont );
begin
  {if Value <> FFlareFont then
    begin}
      FFlareFont.Assign( Value );
      Invalidate;
    {end;}
end;

{ Override OnClick handler from TLabel }
procedure TJwFlashPanel.Click;
begin
     inherited Click;

end;


constructor TJwFlashPanel.Create(AOwner: TComponent);
begin
     { Call the Create method of the parent class }
  inherited Create(AOwner);

  FBaseFont := TFont.Create;
  FFlareFont := TFont.Create;
  FClickFont := TFont.Create;

  FFlareMode := 0;
  FBaseFont.Assign( Self.Font );
  FBaseFont.Color := clWhite;
  FFlareFont.Assign( Self.Font );
  FFlareFont.Size := FFlareFont.Size + 2;
  FFlareFont.Color := clYellow;
  FClickFont.Assign( Self.Font );
  FClickFont.Size := ClickFont.Size + 2;
  FClickFont.Color := clRed;
end;

destructor TJwFlashPanel.Destroy;
begin
  FBaseFont.Free;
  FFlareFont.Free;
  FClickFont.Free;
  inherited Destroy;
end;

procedure TJwFlashPanel.Loaded;
begin
     inherited Loaded;
end;

procedure TJwFlashPanel.Paint;
begin
     case FFlareMode of
       0: begin
            Self.Font := FBaseFont;
          end;
       1: begin
            Self.Font := FFlareFont;
          end;
     2,3: begin
            Self.Font := FClickFont;
          end;
     else
       Self.Font := FBaseFont;
     end;

     inherited Paint;
end;

procedure TJwFlashPanel.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;

procedure TJwFlashPanel.CMMouseEnter(var Message: TWMMouseEnter);
begin
  if ( FFlareMode <> 3 ) then
    begin
      FFlareMode := 1;
      Invalidate;
    end;
  Inherited;
  DoMouseEnter(Message, mbLeft, []);
end;

procedure TJwFlashPanel.CMMouseLeave(var Message: TWMMouseExit);
begin
  if ( FFlareMode <> 3 ) then
    begin
      FFlareMode := 0;
      Invalidate;
    end;
  Inherited;
  DoMouseExit(Message, mbLeft, []);
end;

procedure TJwFlashPanel.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if ( FCheckEffect ) and ( FFlareMode <> 3 ) then
    FFlareMode := 3
  else
    FFlareMode := 2;
  Invalidate;
  Inherited;
end;

procedure TJwFlashPanel.WMLButtonUp(var Message: TWMLButtonUp);
begin
  if ( FFlareMode <> 3 ) then
    begin
      FFlareMode := 1;
      Invalidate;
    end;
  Inherited;
end;

procedure TJwFlashPanel.DoMouseEnter(var Message: TWMMouseEnter; Button: TMouseButton;
  Shift: TShiftState);
begin
  with Message do
    MouseEnter(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
end;

procedure TJwFlashPanel.MouseEnter(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnEnter) then FOnEnter(Self, Button, Shift, X, Y);
end;

procedure TJwFlashPanel.DoMouseExit(var Message: TWMMouseExit; Button: TMouseButton;
  Shift: TShiftState);
begin
  with Message do
    MouseExit(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
end;

procedure TJwFlashPanel.MouseExit(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnExit) then FOnExit(Self, Button, Shift, X, Y);
end;

end.