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

Pascal/Delphi Source File | 2001-09-29 | 27.8 KB | 871 lines

unit Jwrtfsh;

{
        **   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.

          This incarnation of the FlashClick uses the JwLabel as a model.  The idea
     is that I want this to have TOTAL control over the font, just like with the
     JwLabel.  Since I wanted to have each component illistrate something, I've taken
     the move to create a new structure that will hold all of the information that
     was in the JwLabel seperatly.

}

//  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, JwLabel, JwFshCl;

type
  {  what?  where did this record come from?  Well, if you look at the JwLabel
  everything is jumbled together.  But here we want to place it all into a big
  record. }
  EApiFontError = Class( Exception );

  TApiFontRec = Class( TGraphicsObject )
    private
      FOverFontColor: TColor;
      FFontHeight: Integer;
      FFontWidth: Integer;
      FEscapement: Integer;
      FOrientation: Integer;
      FFontWeight: TExpFontWeight;
      FItalic: Integer;
      FUnderline: Integer;
      FStrikeOut: Integer;
      FCharSet: TExpCharSet;
      FOutputPrecision: TExpOutputPrecision;
      FClipPrecision: TExpClipPrecision;
      FFontQuality: TExpFontQuality;
      FFontPitch: TExpFontPitch;
      FFontFamily: TExpFontFamily;
      FFacename: array[0..255] of char;

      {FChanged: TNotifyEvent;}

      {NOTE ON NAMING:  True story!  For some reason I had made the name of a
      private member the same as the published property!  AND whenever it was
      updated, invalidate was called, and got caught into a total loop.  Moral:
      BE CAREFULL WITH THOSE NAMES!}
      FApiFontWeight: Integer;
      FApiFontCharSet: Word;
      FApiFontOutPrecision: Word;
      FApiFontClipPrecision: Word;
      FApiFontQuality: Word;
      FApiFontPitchAndFamily: Word;
      Procedure SetFaceName( Value: String );
      Function GetFaceName: String;
      Procedure SetFontWeight( Value: TExpFontWeight );
      Procedure SetCharSet( Value: TExpCharSet );
      Procedure SetOutputPrecision( Value: TExpOutputPrecision );
      Procedure SetClipPrecision( Value: TExpClipPrecision );
      Procedure SetFontQuality( Value: TExpFontQuality );
      Procedure SetFontPitch( Value: TExpFontPitch );
      Procedure SetFontFamily( Value: TExpFontFamily );

      Procedure SetOverFontColor( Value: TColor );
      Procedure SetFontHeight( Value: Integer );
      Procedure SetFontWidth( Value: Integer );
      Procedure SetEscapement( Value: Integer );
      Procedure SetOrientation( Value: Integer );
      Procedure SetItalic( Value: Integer );
      Procedure SetUnderline( Value: Integer );
      Procedure SetStrikeOut( Value: Integer );
    public
      Constructor Create;

      Procedure Assign( ObjRef: TApiFontRec );

      Property ApiFontWeight: Integer Read FApiFontWeight;
      Property ApiFontCharSet: Word Read FApiFontCharSet;
      Property ApiFontOutPrecision: Word Read FApiFontOutPrecision;
      Property ApiFontClipPrecision: Word Read FApiFontClipPrecision;
      Property ApiFontQuality: Word Read FApiFontQuality;
      Property ApiFontPitchAndFamily: Word Read FApiFontPitchAndFamily;

      {Property Changed: TNotifyEvent Read FChanged Write FChanged;}
    published
      Property OverFontColor: TColor Read FOverFontColor Write SetOverFontColor;
      Property FontHeight: Integer Read FFontHeight Write SetFontHeight;
      Property FontWidth: Integer Read FFontWidth Write SetFontWidth;
      Property Escapement: Integer Read FEscapement Write SetEscapement;
      Property Orientation: Integer Read FOrientation Write SetOrientation;
      Property FontWeight: TExpFontWeight Read FFontWeight Write SetFontWeight;
      Property Italic: Integer Read FItalic Write SetItalic;
      Property Underline: Integer Read FUnderline Write SetUnderline;
      Property StrikeOut: Integer Read FStrikeOut Write SetStrikeOut;
      Property CharSet: TExpCharSet Read FCharSet Write SetCharSet;
      Property OutputPrecision: TExpOutputPrecision Read FOutputPrecision Write SetOutputPrecision;
      Property ClipPrecision: TExpClipPrecision Read FClipPrecision Write SetClipPrecision;
      Property FontQuality: TExpFontQuality Read FFontQuality Write SetFontQuality;
      Property FontPitch: TExpFontPitch Read FFontPitch Write SetFontPitch;
      Property FontFamily: TExpFontFamily Read FFontFamily Write SetFontFamily;
      Property FaceName: String Read GetFaceName Write SetFaceName;
    end;

  TJwRotateFlashClick = class( TLabel )
    private
      { Private fields of TJwRotateFlashClick }

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

        {Our new font properties}
        FFontAttributes: TApiFontRec;

        {For a nice change of pace, I thought I might want a border for my label
        and throw in a few extra options as well.}
        FBorder: Boolean;
        FBorderStyle: TPenStyle;
        FBorderWidth: Integer;
        FBorderColor: TColor;

        {Yes I know there's a better way of doing this, but I'd rather not worry about
        the "perfect" algorythm to autosize a rotated font.  Maybe someday... but for
        now, this is the best I'M goint to do... unless someone else wants to do it
        for me?}
        FLeftOffset: LongInt;
        FTopOffset: LongInt;
        FRightOffset: LongInt;
        FBottomOffset: LongInt;

      { Private methods of TJwRotateFlashClick }
        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: TApiFontRec );
        Procedure SetBaseFont( Value: TApiFontRec );
        Procedure SetClickFont( Value: TApiFontRec );
        Procedure SetCommonFont( Value: TApiFontRec );
    protected
      { Protected fields of TJwRotateFlashClick }
        FFlareMode: Byte;
        FBaseFont: TApiFontRec;
        FFlareFont: TApiFontRec;
        FClickFont: TApiFontRec;

      { Protected methods of TJwRotateFlashClick }
        procedure Click; override;
        procedure Loaded; override;
        procedure Paint; override;
        procedure ExpDoDrawText(var Rect: TRect; Flags: Word);


        Procedure SetBorder( Value: Boolean );
        Procedure SetBorderStyle( Value: TPenStyle );
        Procedure SetBorderWidth( Value: Integer );
        Procedure SetBorderColor( Value: TColor );
        Procedure SetLeftOffset( Value: LongInt );
        Procedure SetTopOffset( Value: LongInt );
        Procedure SetRightOffset( Value: LongInt );
        Procedure SetBottomOffset( Value: LongInt );

        Procedure OnChangeFont( Sender: TObject );
    public
      { Public fields and properties of TJwRotateFlashClick }

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

    published
      { Published properties of TJwRotateFlashClick }

        Property Anchors;
        Property BaseFont: TApiFontRec Read FBaseFont Write SetBaseFont;
        Property FlareFont: TApiFontRec Read FFlareFont Write SetFlareFont;
        Property ClickFont: TApiFontRec Read FClickFont Write SetClickFont;
        Property CommonFont: TApiFontRec Read FBaseFont Write SetCommonFont;

        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 Border: Boolean Read FBorder Write SetBorder
          default False;
        Property BorderStyle: TPenStyle Read FBorderStyle Write SetBorderStyle
          default psSolid;
        Property BorderWidth: Integer Read FBorderWidth Write SetBorderWidth
          default 1;
        Property BorderColor: TColor Read FBorderColor Write SetBorderColor
          default clBlack;
        Property OffsetLeft: LongInt Read FLeftOffset Write SetLeftOffset
          Default 0;
        Property OffsetTop: LongInt Read FTopOffset Write SetTopOffset
          Default 0;
        Property OffsetRight: LongInt Read FRightOffset Write SetRightOffset
          Default 0;
        Property OffsetBottom: LongInt Read FBottomOffset Write SetBottomOffset
          Default 0;
  end;

procedure Register;

implementation

{****************************************************************************************}

{****************************************************************************************}

Constructor TApiFontRec.Create;
begin
  Inherited Create;
  FFontHeight := 15;
  FFontWidth := 10;
  FEscapement := 0;
  FOrientation := 0;
  FFontWeight := fwRegular;
  FItalic := 0;
  FUnderline := 0;
  FStrikeOut := 0;
  FCharSet := csDefaultCharSet;
  FOutputPrecision := opOutDefaultPrecis;
  FClipPrecision := cpClipDefaultPrecis;
  FFontQuality := fqDefaultQuality;
  FFontPitch := fpDefaultPitch;
  FFontFamily := ffRoman;
  FOverFontColor := clBlack;
  StrCopy( FFacename, 'Arial' );

  SetFontWeight( FFontWeight );
  SetCharSet( FCharSet );
  SetOutputPrecision( opOutDefaultPrecis );
  SetClipPrecision( cpClipDefaultPrecis );
  SetFontQuality( fqDefaultQuality );
  SetFontPitch( fpDefaultPitch );
  SetFontFamily( ffRoman );
end;

Procedure TApiFontRec.Assign( ObjRef: TApiFontRec );
begin
  FFontHeight := ObjRef.FFontHeight;
  FFontWidth := ObjRef.FFontWidth;
  FEscapement := ObjRef.FEscapement;
  FOrientation := ObjRef.FOrientation;
  FFontWeight := ObjRef.FFontWeight;
  FItalic := ObjRef.FItalic;
  FUnderline := ObjRef.FUnderline;
  FStrikeOut := ObjRef.FStrikeOut;
  FCharSet := ObjRef.FCharSet;
  FOutputPrecision := ObjRef.FOutputPrecision;
  FClipPrecision := ObjRef.FClipPrecision;
  FFontQuality := ObjRef.FFontQuality;
  FFontPitch := ObjRef.FFontPitch;
  FFontFamily := ObjRef.FFontFamily;
  FOverFontColor := ObjRef.FOverFontColor;
  StrCopy( FFacename, ObjRef.FFacename );
end;

Procedure TApiFontRec.SetFaceName( Value: String );
var
  OldName, TmpStr: array[0..255] of Char;
begin
  StrPCopy( TmpStr, Value );
  if StrComp( TmpStr, FFacename ) <> 0 then
    begin
      try
        StrCopy( OldName, FFaceName );
        StrCopy( FFacename, TmpStr );
        {if Assigned( FChanged ) then FChanged( Self );}
        Changed;
      except
        { NOTE:  The possiblity of this happening isn't really big, but I wanted to
        make a point here....}
        StrCopy( FFaceName, OldName );
        Raise EApiFontError.Create( 'Invalid font name' );
      end;
    end;
end;

Function TApiFontRec.GetFaceName: String;
begin
  Result := StrPas( FFacename );
end;

Procedure TApiFontRec.SetFontWeight( Value: TExpFontWeight );
begin
  if FFontWeight <> Value then
    begin
      FFontWeight := Value;
      Case FFontWeight of
        fwDontCare: FApiFontWeight := FW_DONTCARE;
            fwThin: FApiFontWeight := FW_THIN;
      fwExtraLight: FApiFontWeight := FW_EXTRALIGHT;
      fwUltraLight: FApiFontWeight := FW_ULTRALIGHT;
           fwLight: FApiFontWeight := FW_LIGHT;
          fwNormal: FApiFontWeight := FW_NORMAL;
         fwRegular: FApiFontWeight := FW_REGULAR;
          fwMedium: FApiFontWeight := FW_MEDIUM;
        fwSemiBold: FApiFontWeight := FW_SEMIBOLD;
        fwDemiBold: FApiFontWeight := FW_DEMIBOLD;
            fwBold: FApiFontWeight := FW_BOLD;
       fwExtraBold: FApiFontWeight := FW_EXTRABOLD;
       fwUltraBold: FApiFontWeight := FW_ULTRABOLD;
           fwBlack: FApiFontWeight := FW_BLACK;
           fwHeavy: FApiFontWeight := FW_HEAVY;
       end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetCharSet( Value: TExpCharSet );
begin
  if FCharSet <> Value then
    begin
      FCharSet := Value;
      case FCharSet of
            csAnsiCharSet: FApiFontCharSet := ANSI_CHARSET;
         csDefaultCharSet: FApiFontCharSet := DEFAULT_CHARSET;
          csSymbolCharSet: FApiFontCharSet := SYMBOL_CHARSET;
        csShiftJisCharSet: FApiFontCharSet := SHIFTJIS_CHARSET;
             csOemCharSet: FApiFontCharSet := OEM_CHARSET;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetOutputPrecision( Value: TExpOutputPrecision );
begin
  if FOutputPrecision <> Value then
    begin
      FOutputPrecision := Value;
      case FOutputPrecision of
        opOutCharacterPrecis: FApiFontOutPrecision := OUT_CHARACTER_PRECIS;
          opOutDefaultPrecis: FApiFontOutPrecision := OUT_DEFAULT_PRECIS;
           opOutDevicePrecis: FApiFontOutPrecision := OUT_DEVICE_PRECIS;
           opOutRasterPrecis: FApiFontOutPrecision := OUT_RASTER_PRECIS;
           opOutStringPrecis: FApiFontOutPrecision := OUT_STRING_PRECIS;
           opOutStrokePrecis: FApiFontOutPrecision := OUT_STROKE_PRECIS;
               opOutTTPrecis: FApiFontOutPrecision := OUT_TT_PRECIS;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetClipPrecision( Value: TExpClipPrecision );
begin
  if FClipPrecision <> Value then
    begin
      FClipPrecision := Value;
      case FClipPrecision of
        cpClipCharacterPrecis: FApiFontClipPrecision := CLIP_CHARACTER_PRECIS;
          cpClipDefaultPrecis: FApiFontClipPrecision := CLIP_DEFAULT_PRECIS;
            cpClipEncapsulate: FApiFontClipPrecision := CLIP_EMBEDDED;
               cpClipLHAngles: FApiFontClipPrecision := CLIP_LH_ANGLES;
                   cpClipMask: FApiFontClipPrecision := CLIP_MASK;
           cpClipStrokePrecis: FApiFontClipPrecision := CLIP_STROKE_PRECIS;
               cpClipTTAlways: FApiFontClipPrecision := CLIP_TT_ALWAYS;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetFontQuality( Value: TExpFontQuality );
begin
  if FFontQuality <> Value then
    begin
      FFontQuality := Value;
      case FFontQuality of
        fqDefaultQuality: FApiFontQuality := DEFAULT_QUALITY;
          fqDraftQuality: FApiFontQuality := DRAFT_QUALITY;
          fqProofQuality: FApiFontQuality := PROOF_QUALITY;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetFontPitch( Value: TExpFontPitch );
begin
  if FFontPitch <> Value then
    begin
      FFontPitch := Value;
      { We want to clear out the old values before we add a new one. }
      FApiFontPitchAndFamily := FApiFontPitchAndFamily AND $F0;
      case FFontPitch of
         fpDefaultPitch: FApiFontPitchAndFamily := FApiFontPitchAndFamily + DEFAULT_PITCH;
           fpFixedPitch: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FIXED_PITCH;
        fpVariablePitch: FApiFontPitchAndFamily := FApiFontPitchAndFamily + VARIABLE_PITCH;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetFontFamily( Value: TExpFontFamily );
begin
  if FFontFamily <> Value then
    begin
      FFontFamily := Value;
      { We want to clear out the old values before we add a new one. }
      FApiFontPitchAndFamily := FApiFontPitchAndFamily AND $0F;
      Case FFontFamily of
        ffDecorative: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_DECORATIVE;
          ffDontCare: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_DONTCARE;
            ffModern: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_MODERN;
             ffRoman: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_ROMAN;
            ffScript: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_SCRIPT;
             ffSwiss: FApiFontPitchAndFamily := FApiFontPitchAndFamily + FF_SWISS;
      end;
      {if Assigned( FChanged ) then FChanged( Self );}
      Changed;
    end;
end;

Procedure TApiFontRec.SetOverFontColor( Value: TColor );
begin
  if FOverFontColor <> Value then
    begin
      FOverFontColor := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetFontHeight( Value: Integer );
begin
  if FFontHeight <> Value then
    begin
      FFontHeight := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetFontWidth( Value: Integer );
begin
  if FFontWidth <> Value then
    begin
      FFontWidth := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetEscapement( Value: Integer );
begin
  if FEscapement <> Value then
    begin
      FEscapement := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetOrientation( Value: Integer );
begin
  if FOrientation <> Value then
    begin
      FOrientation := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetItalic( Value: Integer );
begin
  if FItalic <> Value then
    begin
      FItalic := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetUnderline( Value: Integer );
begin
  if FUnderline <> Value then
    begin
      FUnderline := Value;
      Changed;
    end;
end;

Procedure TApiFontRec.SetStrikeOut( Value: Integer );
begin
  if FStrikeOut <> Value then
    begin
      FStrikeOut := Value;
      Changed;
    end;
end;

{****************************************************************************************}

{****************************************************************************************}

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

Procedure TJwRotateFlashClick.SetCommonFont( Value: TApiFontRec );
begin
  {if Value <> FClickFont then
    begin}
      FClickFont.Assign( Value );
      FBaseFont.Assign( Value );
      FFlareFont.Assign( Value );
      FBaseFont.OnChange := OnChangeFont;
      FFlareFont.OnChange := OnChangeFont;
      FClickFont.OnChange := ONChangeFont;
      Invalidate;
    {end;}
end;

Procedure TJwRotateFlashClick.SetClickFont( Value: TApiFontRec );
begin
  {if Value <> FClickFont then
    begin}
      FClickFont.Assign( Value );
      FClickFont.OnChange := ONChangeFont;
      Invalidate;
    {end;}
end;

Procedure TJwRotateFlashClick.SetBaseFont( Value: TApiFontRec );
begin
  {if Value <> FBaseFont then
    begin}
      FBaseFont.Assign( Value );
      FBaseFont.OnChange := OnChangeFont;
      Invalidate;
    {end;}
end;

Procedure TJwRotateFlashClick.SetFlareFont( Value: TApiFontRec );
begin
  {if Value <> FFlareFont then
    begin}
      FFlareFont.Assign( Value );
      FFlareFont.OnChange := OnChangeFont;
      Invalidate;
    {end;}
end;

Procedure TJwRotateFlashClick.SetBorder( Value: Boolean );
begin
  if FBorder <> Value then
    begin
      FBorder := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetBorderStyle( Value: TPenStyle );
begin
  if FBorderStyle <> Value then
    begin
      FBorderStyle := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetBorderWidth( Value: Integer );
begin
  if FBorderWidth <> Value then
    begin
      FBorderWidth := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetBorderColor( Value: TColor );
begin
  if FBorderColor <> Value then
    begin
      FBorderColor := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetLeftOffset( Value: LongInt );
begin
  if FLeftOffset <> Value then
    begin
      FLeftOffset := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetTopOffset( Value: LongInt );
begin
  if FTopOffset <> Value then
    begin
      FTopOffset := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetRightOffset( Value: LongInt );
begin
  if FRightOffset <> Value then
    begin
      FRightOffset := Value;
      InValidate;
    end;
end;

Procedure TJwRotateFlashClick.SetBottomOffset( Value: LongInt );
begin
  if FBottomOffset <> Value then
    begin
      FBottomOffset := Value;
      InValidate;
    end;
end;

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


constructor TJwRotateFlashClick.Create(AOwner: TComponent);
begin
     { Call the Create method of the parent class }
  inherited Create(AOwner);
  FBaseFont := TApiFontRec.Create;
  FFlareFont := TApiFontRec.Create;
  FClickFont := TApiFontRec.Create;

  FFlareMode := 0;
  FBaseFont.OverFontColor := clWhite;
  FFlareFont.Assign( FBaseFont );
  FFlareFont.FontHeight := FFlareFont.FontHeight + 2;
  FFlareFont.OverFontColor := clYellow;
  FClickFont.Assign( FBaseFont );
  FClickFont.FontHeight := ClickFont.FontHeight + 2;
  FClickFont.OverFontColor := clRed;

  FBaseFont.OnChange := OnChangeFont;
  FFlareFont.OnChange := OnChangeFont;
  FClickFont.OnChange := ONChangeFont;
end;

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

procedure TJwRotateFlashClick.Loaded;
begin
  inherited Loaded;
end;

procedure TJwRotateFlashClick.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
begin
  with Canvas do
  begin
    Rect := ClientRect;
    Rect.Left := Rect.Left + FLeftOffset;
    Rect.Top := Rect.Top + FTopOffset;
    Rect.Right := Rect.Right - FRightOffset;
    Rect.Bottom := Rect.Bottom - FBottomOffset;
    if not Transparent then
    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      FillRect(ClientRect);
    end;
    Brush.Style := bsClear;
    if FBorder then
      begin
        Pen.Style := FBorderStyle;
        Pen.Width := FBorderWidth;
        Pen.Color := FBorderColor;
        Rectangle( Rect.Left, Rect.Top, Rect.Right, Rect.Bottom );
      end;
    ExpDoDrawText(Rect, (DT_EXPANDTABS or DT_WORDBREAK) or
      Alignments[Alignment]);
  end;
end;

procedure TJwRotateFlashClick.ExpDoDrawText(var Rect: TRect; Flags: Word);
var
  Text: array[0..255] of Char;
  TmpFont: TApiFontRec;
  TmpStr: array[0..255] of Char;
begin
  GetTextBuf(Text, SizeOf(Text));
  if (Flags and DT_CALCRECT <> 0) and ((Text[0] = #0) or ShowAccelChar and
    (Text[0] = '&') and (Text[1] = #0)) then StrCopy(Text, ' ');
  if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;

  {Right here is where we break ranks with the old code.  We want to change the font
  to have the properties that WE set.  We'll do this in a case statement so that
  changes to the API Wont ruin our code.}

  case FFlareMode of
    0: begin
         TmpFont := FBaseFont;
       end;
    1: begin
         TmpFont := FFlareFont;
       end;
    2: begin
         TmpFont := FClickFont;
       end;
  else
    TmpFont := FBaseFont;
  end;

  with TmpFont do begin
      if Escapement > 0 then
        Flags := DT_NOCLIP;
      StrPCopy( TmpStr, FaceName );
      Canvas.Font.Color := FOverFontColor;
      Canvas.Font.Handle := CreateFont(   FontHeight,  {Height}
                                           FontWidth,  {Width}
                                          Escapement,  {Escapement}
                                         Orientation,  {Orientation}
                                ApiFontWeight,          {Weight}
                                              Italic,  {Italic}
                                           Underline,  {Underline}
                                           StrikeOut,  {StrikeOut}
                                ApiFontCharSet,         {CharSet}
                                ApiFontOutPrecision,    {OutputPrecision}
                                ApiFontClipPrecision,   {ClipPrecision}
                                ApiFontQuality,         {Quality}
                                ApiFontPitchAndFamily,  {PitchAndFamily}
                                               TmpStr );{FaceName}
  end; {end of with TmpFont}


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

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

     { Copy the new width and height of the component
       so we can use SetBounds to change both at once }
     W := Width;
     H := Height;

     { Code to check and adjust W and H }

     { Update the component size if we adjusted W or H }
     if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H);

     { Code to update dimensions of any owned sub-components
       by reading their Height and Width properties and updating
       via their SetBounds methods }

     Message.Result := 0;
end;

procedure TJwRotateFlashClick.CMMouseEnter(var Message: TWMMouseEnter);
begin
  FFlareMode := 1;
  Invalidate;
  Inherited;
  DoMouseEnter(Message, mbLeft, []);
end;

procedure TJwRotateFlashClick.CMMouseLeave(var Message: TWMMouseExit);
begin
  FFlareMode := 0;
  Invalidate;
  Inherited;
  DoMouseExit(Message, mbLeft, []);
end;

procedure TJwRotateFlashClick.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FFlareMode := 2;
  Invalidate;
  Inherited;
end;

procedure TJwRotateFlashClick.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FFlareMode := 1;
  Invalidate;
  Inherited;
end;

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

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

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

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

Procedure TJwRotateFlashClick.OnChangeFont( Sender: TObject );
begin
  InValidate;
end;


end.