home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / units / smiley.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  2.4 KB  |  112 lines
  1. unit Smiley;
  2.  
  3. {$R Smiley.res}
  4.  
  5. interface
  6.  
  7. uses
  8.   SysUtils, WinTypes, WinProcs,
  9.   Messages, Classes, Graphics, Controls,
  10.   Forms, StdCtrls, ExtCtrls;
  11.  
  12. procedure Register;
  13.  
  14. type
  15.     tMood = (smHappy, smSad, smShades,
  16.                  smTongue, smIndifferent, smOoh);
  17.  
  18. type
  19.   TSmiley = class(TImage)
  20.   private
  21.     { Private declarations }
  22.     Face      : TBitmap;
  23.     FMood      : TMood;
  24.     procedure SetBitmap;
  25.     procedure SetMood(NewMood: TMood);
  26.     function GetMood: TMood;
  27.   public
  28.     { Public declarations }
  29.       constructor Create(AOwner: TComponent); override;
  30.       destructor Destroy; override;
  31.       procedure Toggle;
  32.       {procedure WMSize(var Message: TMessage); message wm_size;
  33.       procedure WMWindowPosChanging(var Message: TWMWindowPosMsg); message wm_WindowPosChanging; }
  34.   published
  35.       property Mood: TMood read GetMood write SetMood;
  36.  
  37.   end;
  38.  
  39. implementation
  40.  
  41. constructor TSmiley.Create(AOwner: TComponent);
  42. begin
  43.      inherited Create(AOwner);
  44.      FMood := smHappy;
  45.      Face := TBitmap.Create;
  46.      Face.Handle := LoadBitmap(hInstance, 'Happy');
  47.      Self.Height := 26;
  48.      Self.Width := 26;
  49.      SetBitmap;
  50. end;
  51.  
  52. destructor TSmiley.Destroy;
  53. begin
  54.      Face.Free;
  55.      inherited Destroy;
  56. end;
  57.  
  58. {procedure TSmiley.WMSize(var Message: TMessage);
  59. begin
  60.   inherited;
  61.   if (Width <> 26) or (Height <> 26) then SetBounds(Left, Top, 26, 26);
  62. end;
  63.  
  64. procedure TSmiley.WMWindowPosChanging(var Message: TWMWindowPosMsg);
  65. begin
  66.   Message.WindowPos^.cx := 26;
  67.   Message.WindowPos^.cy := 26;
  68. end;}
  69.  
  70. procedure TSmiley.Toggle;
  71. begin
  72.      try
  73.         Inc(FMood);
  74.      except
  75.         on ERangeError do fMood := smHappy;
  76.      end;
  77.      SetBitmap;
  78. end;
  79.  
  80. procedure TSmiley.SetBitmap;
  81. begin
  82.      Case FMood of
  83.          smHappy           : Face.Handle := LoadBitmap(hInstance, 'Happy');
  84.          smSad             : Face.Handle := LoadBitmap(hInstance, 'Sad');
  85.          smShades          : Face.Handle := LoadBitmap(hInstance, 'Shades');
  86.          smOoh             : Face.Handle := LoadBitmap(hInstance, 'Ooh');
  87.          smIndifferent     : Face.Handle := LoadBitmap(hInstance, 'Indifferent');
  88.          smTongue          : Face.Handle := LoadBitmap(hInstance, 'Tongue');
  89.      end;
  90.  
  91.      Self.Picture.Graphic := Face as TGraphic;
  92. end;
  93.  
  94. procedure TSmiley.SetMood(NewMood: TMood);
  95. begin
  96.      FMood := NewMood;
  97.      SetBitmap;
  98. end;
  99.  
  100. function TSmiley.GetMood: TMood;
  101. begin
  102.      Result := FMood;
  103. end;
  104.  
  105. procedure Register;
  106. begin
  107.   RegisterComponents('Custom', [TSmiley]);
  108. end;
  109.  
  110. end.
  111.  
  112.