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

Pascal/Delphi Source File | 2001-09-29 | 11.2 KB | 386 lines

unit JwSmile;

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

{    TJwSmile....  This is just one of those things that HAD to be done.  I set myself out to
create the ultimate in useless components, mainly to practice making the darling little things.
This component is free... such as it is... and is open to total use without any warrentee whatsoever.
If you actually use this, please send me a note at [e-mail] ... I'm trying to become famous
here!
                    -Joseph, aka The Admiral}

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


interface

uses SysUtils, Classes, Graphics, Controls;

type
    TJwSmileEyes = ( jseSolid, jseOpenEyed, jseBoggled );
    TJwSmileMouth = ( jsmBigOpen, jsmSmallOpen, jsmBigSmile, jsmSmallSmile,
                      jsmWimpySmile, jsmFrown, jsmLine, jsmCocky );

    TJwSmile = Class( TGraphicControl )
      private
        FSmileKind: TJwSmileMouth;
        FEyeKind: TJwSmileEyes;

        {Many of these attributes were there just so I could play with the image in
        design-time.  They really don't change the overall effect that much, but
        they do give it a little varations...}
        FEyeWidth: Integer;
        FBorderSize: Byte;
        FSmileSize: Byte;
        FEyeSize: Byte;

        FBackColor: TColor;
        FBackBrushStyle: TBrushStyle;
        FEyeBackColor: TColor;
        FEyeBackBrushStyle: TBrushStyle;
        FMouthBackColor: TColor;
        FMouthBackBrushStyle: TBrushStyle;
        FMouthForeColor: TColor;

        Function MinInt( Value1, Value2: LongInt ): LongInt;
        Procedure Paint; override;

        Procedure SetSmileKind( Value: TJwSmileMouth );
        Procedure SetEyeKind( Value: TJwSmileEyes );
        Procedure SetBorderSize( Value: Byte );
        Procedure SetSmileSize( Value: Byte );
        Procedure SetEyeSize( Value: Byte );
        Procedure SetBackColor( Value: TColor );
        Procedure SetBackBrushStyle( Value: TBrushStyle );
        Procedure SetEyeBackColor( Value: TColor );
        Procedure SetEyeBackBrushStyle( Value: TBrushStyle );
        Procedure SetMouthBackColor( Value: TColor );
        Procedure SetMouthBackBrushStyle( Value: TBrushStyle );
        Procedure SetMouthForeColor( Value: TColor );
        Procedure SetEyeWidth( Value: Integer );
      protected

      public
        Constructor Create( AOwner: TComponent ); override;
      published
        Property SmileKind: TJwSmileMouth
          Read FSmileKind
          Write SetSmileKind
          default jsmBigSmile;
        Property EyeKind: TJwSmileEyes
          Read FEyeKind
          Write SetEyeKind
          default jseSolid;

        Property BorderSize: Byte
          Read FBorderSize
          Write SetBorderSize
          default 5;
        Property SmileBorderSize: Byte
          Read FSmileSize
          Write SetSmileSize
          default 7;
        Property EyeBorderSize: Byte
          Read FEyeSize
          Write SetEyeSize
          default 1;
        Property EyeWidth: Integer
          Read FEyeWidth
          Write SetEyeWidth
          default 25;

        Property Background: TColor
          Read FBackColor
          Write SetBackColor
          default clYellow;
        Property BackgroundBrush: TBrushStyle
          Read FBackBrushStyle
          Write SetBackBrushStyle
          default bsSolid;
        Property EyeBackgroundColor: TColor
          Read FEyeBackColor
          Write SetEyeBackColor
          default clWhite;
        Property EyeBackgroundBrushStyle: TBrushStyle
          Read FEyeBackBrushStyle
          Write SetEyeBackBrushStyle
          default bsSolid;
        Property MouthBackgroundColor: TColor
          Read FMouthBackColor
          Write SetMouthBackColor
          default clBlack;
        Property MouthBackgroundBrushStyle: TBrushStyle
          Read FMouthBackBrushStyle
          Write SetMouthBackBrushStyle
          default bsSolid;
        Property MouthForegroundColor: TColor
          Read FMouthForeColor
          Write SetMouthForeColor
          default clBlack;

        Property Align;
        Property ShowHint;
        Property ParentShowHint;
        Property Visible;
        Property OnClick;
        Property OnDblClick;
        Property OnMouseDown;
        Property OnMouseMove;
        Property OnMouseUp;
        Property Anchors;
      end;

procedure Register;

implementation

Procedure Register;
begin
  RegisterComponents( 'JwTools', [TJwSmile] );
end;

Constructor TJwSmile.Create( AOwner: TComponent );
begin
  Inherited Create( AOwner );
  Width := 100;
  Height := 100;

  FSmileKind := jsmBigSmile;;
  FEyeKind := jseSolid;

  FEyeWidth := 25;
  FBorderSize := 5;
  FSmileSize := 7;
  FEyeSize := 1;

  FBackColor := clYellow;
  FBackBrushStyle := bsSolid;
  FEyeBackColor := clBlack;
  FEyeBackBrushStyle := bsSolid;
  FMouthBackColor := clBlack;
  FMouthBackBrushStyle := bsSolid;
  FMouthForeColor := clBlack;

end;

Function TJwSmile.MinInt( Value1, Value2: LongInt ): LongInt;
begin
  if Value1 < Value2 then
    Result := Value1
  else
    Result := Value2;
end;

Procedure TJwSmile.Paint;
var
  MWidth, Quarter, Half, Fifth, Sixth: LongInt;
begin
  MWidth := MinInt( Width, Height );
{  Width := MWidth;
  Height := MWidth; This causes some problems with Align:Client!!!}
  Half := MWidth div 2;
  Quarter := MWidth div 4;
  Fifth := MWidth div 5;
  Sixth := MWidth div 6;
  with Canvas do
    begin
      {Main "body"}
      Brush.Style := FBackBrushStyle;
      Brush.Color := FBackColor;
      Ellipse( FBorderSize, FBorderSize, MWidth-FBorderSize, MWidth-FBorderSize );
      Brush.Style := bsClear;
      Pen.Width := FBorderSize;
      Pen.Color := FMouthBackColor;
      {Outline}
      Ellipse( FBorderSize, FBorderSize, MWidth-FBorderSize, MWidth-FBorderSize );

      {Draw the Mouth}
      Pen.Width := FSmileSize;
      Pen.Color := FMouthForeColor;
      Brush.Style := FMouthBackBrushStyle;
      Brush.Color := FMouthBackColor;
      Case FSmileKind of
         jsmBigOpen: Ellipse( Sixth, Half, MWidth-Sixth, MWidth-Sixth );
       jsmSmallOpen: Ellipse( Half-Fifth, Half, Half+Fifth, MWidth-Sixth );
        jsmBigSmile: Arc( Fifth, Fifth, MWidth-Fifth, MWidth-Fifth,
                          Quarter, Half, MWidth-Quarter, Half );
      jsmSmallSmile: Arc( Fifth, Fifth, MWidth-Fifth, MWidth-Fifth,
                          fifth, MWidth-Fifth, MWidth-Fifth, MWidth-Fifth );
      jsmWimpySmile: Arc( Quarter, Quarter, MWidth-Quarter, MWidth-Quarter,
                          Quarter, MWidth-Quarter, MWidth-Quarter, MWidth-Quarter );
           jsmFrown: begin
                     MoveTo( Fifth, MWidth-Fifth );
                     LineTo( MWidth-Fifth, MWidth-Fifth );
                     end;
            jsmLine: begin
                     MoveTo( Quarter, MWidth-Quarter );
                     LineTo( MWidth-Quarter, MWidth-Quarter );
                     end;
           jsmCocky: begin
                     MoveTo( Quarter, MWidth-Fifth );
                     LineTo( MWidth-Quarter, MWidth-Quarter );
                     end;
      end;

      {Now the eyes}
      Pen.Width := FEyeSize;
      Brush.Style := FEyeBackBrushStyle;
      Brush.Color := FEyeBackColor;
      Case FEyeKind of
         jseSolid: begin
             Ellipse( Quarter, Quarter, Quarter+FEyeWidth, Quarter+FEyeWidth );
             Ellipse( MWidth-Quarter-FEyeWidth, Quarter,
                      MWidth-Quarter, Quarter+FEyeWidth );
                   end;
       jseOpenEyed: begin
             Ellipse( Quarter, Quarter, Quarter+FEyeWidth, Quarter+FEyeWidth );
             Ellipse( MWidth-Quarter-FEyeWidth, Quarter,
                      MWidth-Quarter, Quarter+FEyeWidth );
             Brush.Color := clBlack;
             Ellipse( Quarter+FEyeWidth div 4, Quarter+FEyeWidth div 4,
                      Quarter+FEyeWidth-FEyeWidth div 4, Quarter+FEyeWidth-FEyeWidth div 4 );
             Ellipse( MWidth-Quarter-FEyeWidth+FEyeWidth div 4, Quarter+FEyeWidth div 4,
                      MWidth-Quarter-FEyeWidth div 4, Quarter+FEyeWidth-FEyeWidth div 4 );
                   end;
        jseBoggled: begin
             Ellipse( Quarter, Quarter, Quarter+FEyeWidth, Quarter+FEyeWidth );
             Ellipse( MWidth-Quarter-FEyeWidth, Quarter,
                      MWidth-Quarter, Quarter+FEyeWidth );
             Brush.Color := clBlack;
             Ellipse( Quarter+FEyeWidth div 8, Quarter+FEyeWidth div 8,
                      Quarter+FEyeWidth div 2, Quarter+FEyeWidth div 2 );
             Ellipse( MWidth-Quarter-FEyeWidth div 2, Quarter+FEyeWidth div 2,
                      MWidth-Quarter-FEyeWidth div 8, Quarter+FEyeWidth-FEyeWidth div 8 );
                   end;
      end;
    end;
end;

Procedure TJwSmile.SetSmileKind( Value: TJwSmileMouth );
begin
  if FSmileKind <> Value then
    begin
      FSmileKind := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetEyeKind( Value: TJwSmileEyes );
begin
  if FEyeKind <> Value then
    begin
      FEyeKind := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetBorderSize( Value: Byte );
begin
  if FBorderSize <> Value then
    begin
      FBorderSize := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetSmileSize( Value: Byte );
begin
  if FSmileSize <> Value then
    begin
      FSmileSize := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetEyeSize( Value: Byte );
begin
  if FEyeSize <> Value then
    begin
      FEyeSize := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetBackColor( Value: TColor );
begin
  if FBackColor <> Value then
    begin
      FBackColor := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetBackBrushStyle( Value: TBrushStyle );
begin
  if FBackBrushStyle <> Value then
    begin
      FBackBrushStyle := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetEyeBackColor( Value: TColor );
begin
  if FEyeBackColor <> Value then
    begin
      FEyeBackColor := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetEyeBackBrushStyle( Value: TBrushStyle );
begin
  if FEyeBackBrushStyle <> Value then
    begin
      FEyeBackBrushStyle := Value;
      Invalidate;
    end;
end;

Procedure TJwSmile.SetMouthBackColor( Value: TColor );
begin
  if FMouthBackColor <> Value then
    begin
      FMouthBackColor := Value;
      InValidate;
    end;
end;

Procedure TJwSmile.SetMouthBackBrushStyle( Value: TBrushStyle );
begin
  if FMouthBackBrushStyle <> Value then
    begin
      FMouthBackBrushStyle := Value;
      InValidate;
    end;
end;

Procedure TJwSmile.SetMouthForeColor( Value: TColor );
begin
  if FMouthForeColor <> Value then
    begin
      FMouthForeColor := Value;
      InValidate;
    end;
end;

Procedure TJwSmile.SetEyeWidth( Value: Integer );
begin
  if FEyeWidth <> Value then
    begin
      FEyeWidth := Value;
      Invalidate;
    end;
end;

end.