home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / VCL / STYLSPED.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  2.8 KB  |  115 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 2.1                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1998         }
  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.     property OnDragDrop;
  39.     property OnDragOver;
  40.     property OnEndDrag;
  41.   end;
  42.  
  43. procedure Register;
  44.  
  45. implementation
  46.  
  47. procedure TStyleSpeed.SetStyle(Value : TSpeedStyle);
  48. begin
  49.   if Value <> FStyle then begin
  50.     FStyle := Value;
  51.     Invalidate;
  52.   end;
  53. end;
  54.  
  55.  
  56. procedure TStyleSpeed.Paint;
  57. begin
  58.   inherited Paint;
  59.  
  60.   if Style = sbBitBtn then
  61.     with Canvas do begin
  62.       Pen.Color := clBtnShadow;
  63.       MoveTo(0, Height-2);
  64.       LineTo(0, 0);
  65.       LineTo(Width-2, 0);
  66.  
  67.       if FState in [bsDown, bsExclusive] then begin
  68.         LineTo(Width-2, Height-2);
  69.         LineTo(0, Height-2);
  70.  
  71.         Pen.Color := clBlack;
  72.         MoveTo(1, Height-2);
  73.         LineTo(1, 1);
  74.         LineTo(Width-2, 1);
  75.  
  76.         Pen.Color := clWhite;
  77.         MoveTo(Width-1, 0);
  78.         LineTo(Width-1, Height-1);
  79.         LineTo(-1, Height-1);
  80.       end
  81.     end
  82.  
  83.   else if Style = sbWin95 then
  84.     with Canvas do
  85.     if FState in [bsDown, bsExclusive] then begin
  86.       Pen.Color := clWhite;
  87.       MoveTo(Width-1, 0);
  88.       LineTo(Width-1, Height-1);
  89.       LineTo(-1, Height-1);
  90.     end
  91.     else begin
  92.       Pen.Color := clWhite;
  93.       MoveTo(0, Height-1);
  94.       LineTo(0, 0);
  95.       LineTo(Width-1, 0);
  96.  
  97.       Pen.Color := clBtnFace;
  98.       MoveTo(1, Height-2);
  99.       LineTo(1, 1);
  100.       LineTo(Width-2, 1);
  101.  
  102.       Pixels[0, Height-1] := clBlack;
  103.       Pixels[1, Height-2] := clBtnShadow;
  104.     end;
  105. end;
  106.  
  107.  
  108. procedure Register;
  109. begin
  110.   RegisterComponents('Samples', [TStyleSpeed]);
  111. end;
  112.  
  113.  
  114. end.
  115.