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

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

Delphi控件源码

开发平台：

Delphi

PackScrollF.pas：源码内容
  1. unit PackScrollF;
  3. interface
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons;
  9. type
  10.   TFormScroll = class(TForm)
  11.     ScrollBarRed: TScrollBar;
  12.     ScrollBarGreen: TScrollBar;
  13.     ScrollBarBlue: TScrollBar;
  14.     LabelRed: TLabel;
  15.     LabelGreen: TLabel;
  16.     LabelBlue: TLabel;
  17.     Shape1: TShape;
  18.     Shape2: TShape;
  19.     Shape3: TShape;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     LabelScroll: TLabel;
  23.     TrackBar1: TTrackBar;
  24.     Panel1: TPanel;
  25.     sbRed: TSpeedButton;
  26.     sbBlue: TSpeedButton;
  27.     sbGreen: TSpeedButton;
  28.     BitBtn1: TBitBtn;
  29.     BitBtn2: TBitBtn;
  30.     procedure ScrollBarsScroll(Sender: TObject; ScrollCode: TScrollCode;
  31.       var ScrollPos: Integer);
  32.     procedure TrackBar1Change(Sender: TObject);
  33.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  34.     procedure sbRedClick(Sender: TObject);
  35.     procedure sbBlueClick(Sender: TObject);
  36.     procedure sbGreenClick(Sender: TObject);
  37.   private
  38.     procedure SetSelColor (Col: TColor);
  39.     function GetSelColor: TColor;
  40.   public
  41.     procedure ApplyClick (Sender: TObject);
  42.   published  
  43.     property SelectedColor: TColor
  44.       read GetSelColor write SetSelColor;
  45.   end;
  47. implementation
  49. {$R *.DFM}
  51. procedure TFormScroll.ScrollBarsScroll(Sender: TObject;
  52.   ScrollCode: TScrollCode; var ScrollPos: Integer);
  53. begin
  54.   (Sender as TScrollBar).Hint := IntToStr(ScrollPos);
  56.   Shape1.Brush.Color := RGB (ScrollBarRed.Position,
  57.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  58.   Shape2.Pen.Color := RGB (ScrollBarRed.Position,
  59.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  60. end;
  62. procedure TFormScroll.TrackBar1Change(Sender: TObject);
  63. begin
  64.   LabelScroll.Caption := 'Scroll by ' + IntToStr(TrackBar1.Position);
  65.   ScrollBarGreen.LargeChange := TrackBar1.Position;
  66.   ScrollBarRed.LargeChange := TrackBar1.Position;
  67.   ScrollBarBlue.LargeChange := TrackBar1.Position;
  68. end;
  70. procedure TFormScroll.FormClose(Sender: TObject; var Action: TCloseAction);
  71. begin
  72.   // used by the modeless form
  73.   Action := caFree;
  74. end;
  76. procedure TFormScroll.ApplyClick(Sender: TObject);
  77. begin
  78.   // set the color of the main form
  79.   Application.MainForm.Color := SelectedColor;
  80. end;
  82. procedure TFormScroll.sbRedClick(Sender: TObject);
  83. begin
  84.   SelectedColor := clRed;
  85. end;
  87. // set and get properties
  89. function TFormScroll.GetSelColor: TColor;
  90. begin
  91.   Result := RGB (ScrollBarRed.Position,
  92.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  93. end;
  95. procedure TFormScroll.SetSelColor (Col: TColor);
  96. var
  97.   RGBCol: Integer;
  98. begin
  99.   RGBCol := ColorToRGB (Col);
  100.   ScrollBarRed.Position := GetRValue (RGBCol);
  101.   ScrollBarGreen.Position := GetGValue (RGBCol);
  102.   ScrollBarBlue.Position := GetBValue (RGBCol);
  103.   Shape1.Brush.Color := Col;
  104.   Shape2.Pen.Color := Col;
  105. end;
  107. procedure TFormScroll.sbBlueClick(Sender: TObject);
  108. begin
  109.   SelectedColor := clBlue;
  110. end;
  112. procedure TFormScroll.sbGreenClick(Sender: TObject);
  113. begin
  114.   SelectedColor := clGreen;
  115. end;
  117. initialization
  118.   RegisterClass (TFormScroll);
  120. end.