home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / VCL / STYLSPED.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  3KB  |  114 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 1.0                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit StylSped;
  10.  
  11. { New speed button for Delphi-16.
  12.  
  13.   TStyleSpeed is the descendant which overrides Paint to draw a new
  14.   border style over TSpeedButton's border.  There doesn't seem to
  15.   be any noticeable impact on performance.  TStyleSpeed provides
  16.   a new Style property to change between the old TSpeedButton, a
  17.   TBitBtn look and a Windows95-like button.  (but Win95 uses a shade
  18.   of grey which I couldn't find in the 3.1 system palette).
  19. }
  20.  
  21. interface
  22.  
  23. uses
  24.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  25.   Forms, Dialogs, Buttons;
  26.  
  27. type
  28.   TSpeedStyle = (sbSpeed, sbBitBtn, sbWin95);
  29.  
  30.   TStyleSpeed = class(TSpeedButton)
  31.   private
  32.     FStyle : TSpeedStyle;
  33.     procedure SetStyle(Value : TSpeedStyle);
  34.   protected
  35.     procedure Paint; override;
  36.   published
  37.     property Style : TSpeedStyle read FStyle write SetStyle default sbSpeed;
  38.   end;
  39.  
  40. procedure Register;
  41.  
  42. implementation
  43.  
  44. procedure TStyleSpeed.SetStyle(Value : TSpeedStyle);
  45. begin
  46.   if Value <> FStyle then begin
  47.     FStyle := Value;
  48.     Invalidate;
  49.   end;
  50. end;
  51.  
  52.  
  53. procedure TStyleSpeed.Paint;
  54. begin
  55.   inherited Paint;
  56.  
  57.   if Style = sbSpeed then Exit;
  58.  
  59.   if Style = sbBitBtn then
  60.     with Canvas do begin
  61.       Pen.Color := clBtnShadow;
  62.       MoveTo(0, Height-2);
  63.       LineTo(0, 0);
  64.       LineTo(Width-2, 0);
  65.  
  66.       if FState in [bsDown, bsExclusive] then begin
  67.         LineTo(Width-2, Height-2);
  68.         LineTo(0, Height-2);
  69.  
  70.         Pen.Color := clBlack;
  71.         MoveTo(1, Height-2);
  72.         LineTo(1, 1);
  73.         LineTo(Width-2, 1);
  74.  
  75.         Pen.Color := clWhite;
  76.         MoveTo(Width-1, 0);
  77.         LineTo(Width-1, Height-1);
  78.         LineTo(-1, Height-1);
  79.       end
  80.     end
  81.  
  82.   else
  83.     with Canvas do
  84.     if FState in [bsDown, bsExclusive] then begin
  85.       Pen.Color := clWhite;
  86.       MoveTo(Width-1, 0);
  87.       LineTo(Width-1, Height-1);
  88.       LineTo(-1, Height-1);
  89.     end
  90.     else begin
  91.       Pen.Color := clWhite;
  92.       MoveTo(0, Height-1);
  93.       LineTo(0, 0);
  94.       LineTo(Width-1, 0);
  95.  
  96.       Pen.Color := clBtnFace;
  97.       MoveTo(1, Height-2);
  98.       LineTo(1, 1);
  99.       LineTo(Width-2, 1);
  100.  
  101.       Pixels[0, Height-1] := clBlack;
  102.       Pixels[1, Height-2] := clBtnShadow;
  103.     end;
  104. end;
  105.  
  106.  
  107. procedure Register;
  108. begin
  109.   RegisterComponents('Samples', [TStyleSpeed]);
  110. end;
  111.  
  112.  
  113. end.
  114.