home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / DTOOLS30.ZIP / DEMOBACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-06  |  1.9 KB  |  82 lines
  1. unit Demoback;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Toggler, StdCtrls, Dtmisc, Custbtn;
  8.  
  9. type
  10.   TBackgroundControls = class(TForm)
  11.     ShadowButton1: TShadowButton;
  12.     TiledBitmap1: TTiledBitmap;
  13.     FountainFill1: TFountainFill;
  14.     GroupBox1: TGroupBox;
  15.     cycFrom: TODCycler;
  16.     cycTo: TODCycler;
  17.     procedure cycPaint(Sender: TObject);
  18.     procedure cycClick(Sender: TObject);
  19.   private
  20.     { Private declarations }
  21.     function GetCycleColor(val: Integer): TColor;
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   BackgroundControls: TBackgroundControls;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. function TBackgroundControls.GetCycleColor(val: Integer): TColor;
  34. begin
  35.   case val of
  36.     0:  Result := clRed;
  37.     1:  Result := clBlue;
  38.     2:  Result := clWhite;
  39.     3:  Result := clYellow;
  40.     4:  Result := clAqua;
  41.     5:  Result := clFuchsia;
  42.     6:  Result := clBlack;
  43.     7:  Result := clNavy;
  44.   end;
  45. end;
  46.  
  47. procedure TBackgroundControls.cycPaint(Sender: TObject);
  48. var
  49.   cyc: TODCycler;
  50.   r: TRect;
  51.   CCaption: array[0..255] of Char;
  52. begin
  53.   cyc := TODCycler(Sender);
  54.   cyc.Canvas.Brush.Color := GetCycleColor(cyc.Value);
  55.   cyc.Canvas.FillRect(cyc.ClientRect);
  56.   cyc.Canvas.Font.Color := (cyc.Canvas.Brush.Color xor $00FFFFFF) and $00FFFFFF;
  57.   r := cyc.ClientRect;
  58.   Inc(r.left, 4);
  59.   DrawText(cyc.Canvas.Handle, StrPCopy(CCaption, cyc.Caption), -1, r,
  60.     DT_SINGLELINE or DT_VCENTER);
  61.   if cyc.Focused then begin
  62.     r := cyc.ClientRect;
  63.     InflateRect(r, -2, -2);
  64.     cyc.Canvas.DrawFocusRect(r);
  65.   end;
  66. end;
  67.  
  68. procedure TBackgroundControls.cycClick(Sender: TObject);
  69. var
  70.   cyc: TODCycler;
  71.   col: TColor;
  72. begin
  73.   cyc := TODCycler(Sender);
  74.   col := GetCycleColor(cyc.Value);
  75.   if cyc.Value > 3 then
  76.     FountainFill1.ToColor := col
  77.   else
  78.     FountainFill1.FromColor := col;
  79. end;
  80.  
  81. end.
  82.