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

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

Delphi控件源码

开发平台：

Delphi

ScrollF.pas：源码内容
  1. unit ScrollF;
  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.     spApplication: TSpeedButton;
  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.     procedure spApplicationClick(Sender: TObject);
  39.   private
  40.     procedure SetSelColor (Col: TColor);
  41.     function GetSelColor: TColor;
  42.   public
  43.     procedure ApplyClick (Sender: TObject);
  44.     property SelectedColor: TColor
  45.       read GetSelColor write SetSelColor;
  46.   end;
  48. // extern DLL functions declarations
  49. function GetColor (Col: LongInt): LongInt; stdcall;
  50. procedure ShowColor (Col: LongInt); stdcall;
  52. implementation
  54. {$R *.DFM}
  56. procedure TFormScroll.ScrollBarsScroll(Sender: TObject;
  57.   ScrollCode: TScrollCode; var ScrollPos: Integer);
  58. begin
  59.   (Sender as TScrollBar).Hint := IntToStr(ScrollPos);
  61.   Shape1.Brush.Color := RGB (ScrollBarRed.Position,
  62.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  63.   Shape2.Pen.Color := RGB (ScrollBarRed.Position,
  64.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  65. end;
  67. procedure TFormScroll.TrackBar1Change(Sender: TObject);
  68. begin
  69.   LabelScroll.Caption := 'Scroll by ' + IntToStr(TrackBar1.Position);
  70.   ScrollBarGreen.LargeChange := TrackBar1.Position;
  71.   ScrollBarRed.LargeChange := TrackBar1.Position;
  72.   ScrollBarBlue.LargeChange := TrackBar1.Position;
  73. end;
  75. procedure TFormScroll.FormClose(Sender: TObject; var Action: TCloseAction);
  76. begin
  77.   // used by the modeless form
  78.   Action := caFree;
  79. end;
  81. procedure TFormScroll.ApplyClick(Sender: TObject);
  82. begin
  83.   // access to the main form directly
  84.   Application.MainForm.Color := SelectedColor;
  85. end;
  87. procedure TFormScroll.sbRedClick(Sender: TObject);
  88. begin
  89.   SelectedColor := clRed;
  90. end;
  92. // set and get properties
  94. function TFormScroll.GetSelColor: TColor;
  95. begin
  96.   Result := RGB (ScrollBarRed.Position,
  97.     ScrollBarGreen.Position, ScrollBarBlue.Position);
  98. end;
  100. procedure TFormScroll.SetSelColor (Col: TColor);
  101. var
  102.   RGBCol: Integer;
  103. begin
  104.   RGBCol := ColorToRGB (Col);
  105.   ScrollBarRed.Position := GetRValue (RGBCol);
  106.   ScrollBarGreen.Position := GetGValue (RGBCol);
  107.   ScrollBarBlue.Position := GetBValue (RGBCol);
  108.   Shape1.Brush.Color := Col;
  109.   Shape2.Pen.Color := Col;
  110. end;
  112. procedure TFormScroll.sbBlueClick(Sender: TObject);
  113. begin
  114.   SelectedColor := clBlue;
  115. end;
  117. procedure TFormScroll.sbGreenClick(Sender: TObject);
  118. begin
  119.   SelectedColor := clGreen;
  120. end;
  122. procedure TFormScroll.spApplicationClick(Sender: TObject);
  123. begin
  124.   ShowMessage ('Application Handle: ' +
  125.     IntToStr (Application.Handle));
  126. end;
  128. // extern DLL functions
  130. function GetColor (Col: LongInt): LongInt; stdcall;
  131. var
  132.   FormScroll: TFormScroll;
  133. begin
  134.   // default value
  135.   Result := Col;
  136.   try
  137.     FormScroll := TFormScroll.Create (Application);
  138.     try
  139.       // initialize the data
  140.       FormScroll.SelectedColor := Col;
  141.       // show the form
  142.       if FormScroll.ShowModal = mrOK then
  143.         Result := FormScroll.SelectedColor;
  144.     finally
  145.       FormScroll.Free;
  146.     end;
  147.   except
  148.     on E: Exception do
  149.       MessageDlg ('Error in FormDLL: ' +
  150.         E.Message, mtError, [mbOK], 0);
  151.   end;
  152. end;
  154. procedure ShowColor (Col: LongInt); stdcall;
  155. var
  156.   FormScroll: TFormScroll;
  157. begin
  158.   FormScroll := TFormScroll.Create (Application);
  159.   try
  160.     // initialize the data
  161.     FormScroll.SelectedColor := Col;
  162.     // initialzie the buttons
  163.     FormScroll.BitBtn1.Caption := 'Apply';
  164.     FormScroll.BitBtn1.OnClick := FormScroll.ApplyClick;
  165.     FormScroll.BitBtn2.Kind := bkClose;
  166.     // show the form
  167.     FormScroll.Show;
  168.   except
  169.     on E: Exception do
  170.     begin
  171.       MessageDlg ('Error in FormDLL: ' +
  172.         E.Message, mtError, [mbOK], 0);
  173.       FormScroll.Free;
  174.     end;
  175.   end;
  176. end;
  178. initialization
  179.   Application.CreateHandle;
  180. end.