开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
IntfScrollF.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

IntfScrollF.pas：源码内容
  1. unit IntfScrollF;
  3. interface
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
  8.   IntfColSel;
  10. type
  11.   TFormScroll = class(TForm, IColorSelect)
  12.     ScrollBarRed: TScrollBar;
  13.     ScrollBarGreen: TScrollBar;
  14.     ScrollBarBlue: TScrollBar;
  15.     LabelRed: TLabel;
  16.     LabelGreen: TLabel;
  17.     LabelBlue: TLabel;
  18.     Shape1: TShape;
  19.     Shape2: TShape;
  20.     Shape3: TShape;
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     LabelScroll: TLabel;
  24.     TrackBar1: TTrackBar;
  25.     Panel1: TPanel;
  26.     sbRed: TSpeedButton;
  27.     sbBlue: TSpeedButton;
  28.     sbGreen: TSpeedButton;
  29.     BitBtn1: TBitBtn;
  30.     BitBtn2: TBitBtn;
  31.     procedure ScrollBarsScroll(Sender: TObject; ScrollCode: TScrollCode;
  32.       var ScrollPos: Integer);
  33.     procedure TrackBar1Change(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  35.     procedure sbRedClick(Sender: TObject);
  36.     procedure sbBlueClick(Sender: TObject);
  37.     procedure sbGreenClick(Sender: TObject);
  38.   private
  39.     procedure SetSelColor (Col: TColor);
  40.     function GetSelColor: TColor;
  41.   public
  42.     procedure ApplyClick (Sender: TObject);
  43.     function Display (Modal: Boolean = True): Boolean;
  44.   published
  45.     property SelectedColor: TColor
  46.       read GetSelColor write SetSelColor;
  47.   end;
  49. implementation
  51. {$R *.DFM}
  53. procedure TFormScroll.ScrollBarsScroll(Sender: TObject;
  54.   ScrollCode: TScrollCode; var ScrollPos: Integer);
  55. begin
  56.   (Sender as TScrollBar).Hint := IntToStr(ScrollPos);
  58.   Shape1.Brush.Color := RGB (ScrollBarRed.Position,
  59.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  60.   Shape2.Pen.Color := RGB (ScrollBarRed.Position,
  61.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  62. end;
  64. procedure TFormScroll.TrackBar1Change(Sender: TObject);
  65. begin
  66.   LabelScroll.Caption := 'Scroll by ' + IntToStr(TrackBar1.Position);
  67.   ScrollBarGreen.LargeChange := TrackBar1.Position;
  68.   ScrollBarRed.LargeChange := TrackBar1.Position;
  69.   ScrollBarBlue.LargeChange := TrackBar1.Position;
  70. end;
  72. procedure TFormScroll.FormClose(Sender: TObject; var Action: TCloseAction);
  73. begin
  74.   // used by the modeless form
  75.   Action := caFree;
  76. end;
  78. procedure TFormScroll.ApplyClick(Sender: TObject);
  79. begin
  80.   // set the color of the main form
  81.   Application.MainForm.Color := SelectedColor;
  82. end;
  84. procedure TFormScroll.sbRedClick(Sender: TObject);
  85. begin
  86.   SelectedColor := clRed;
  87. end;
  89. // set and get properties
  91. function TFormScroll.GetSelColor: TColor;
  92. begin
  93.   Result := RGB (ScrollBarRed.Position,
  94.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  95. end;
  97. procedure TFormScroll.SetSelColor (Col: TColor);
  98. var
  99.   RGBCol: Integer;
  100. begin
  101.   RGBCol := ColorToRGB (Col);
  102.   ScrollBarRed.Position := GetRValue (RGBCol);
  103.   ScrollBarGreen.Position := GetGValue (RGBCol);
  104.   ScrollBarBlue.Position := GetBValue (RGBCol);
  105.   Shape1.Brush.Color := Col;
  106.   Shape2.Pen.Color := Col;
  107. end;
  109. procedure TFormScroll.sbBlueClick(Sender: TObject);
  110. begin
  111.   SelectedColor := clBlue;
  112. end;
  114. procedure TFormScroll.sbGreenClick(Sender: TObject);
  115. begin
  116.   SelectedColor := clGreen;
  117. end;
  119. function TFormScroll.Display(Modal: Boolean): Boolean;
  120. begin
  121.   Result := True; // default
  122.   if Modal then
  123.     Result := (ShowModal = mrOK)
  124.   else
  125.   begin
  126.     BitBtn1.Caption := 'Apply';
  127.     BitBtn1.OnClick := ApplyClick;
  128.     BitBtn2.Kind := bkClose;
  129.     Show;
  130.   end;
  131. end;
  133. initialization
  134.   RegisterColorSelect (TFormScroll);
  136. end.