Project Structure

• Formdll.dpr
• ScrollF.pas
• ScrollF.dfm

library FormDLL;

uses
  ScrollF in 'ScrollF.pas' {FormScroll};

exports
  GetColor, ShowColor, SyncApp;

end.

unit ScrollF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons;

type
  TFormScroll = class(TForm)
    ScrollBarRed: TScrollBar;
    ScrollBarGreen: TScrollBar;
    ScrollBarBlue: TScrollBar;
    LabelRed: TLabel;
    LabelGreen: TLabel;
    LabelBlue: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Label1: TLabel;
    Label2: TLabel;
    LabelScroll: TLabel;
    TrackBar1: TTrackBar;
    Panel1: TPanel;
    sbRed: TSpeedButton;
    sbBlue: TSpeedButton;
    sbGreen: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    spApplication: TSpeedButton;
    procedure ScrollBarsScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure sbRedClick(Sender: TObject);
    procedure sbBlueClick(Sender: TObject);
    procedure sbGreenClick(Sender: TObject);
    procedure spApplicationClick(Sender: TObject);
  private
    FormHandle: THandle;
    MsgBack: Integer;
    procedure SetSelColor (Col: TColor);
    function GetSelColor: TColor;
  public
    procedure ApplyClick (Sender: TObject);
    property SelectedColor: TColor
      read GetSelColor write SetSelColor;
  end;

// extern DLL functions declarations
function GetColor (Col: LongInt): LongInt; stdcall;
procedure ShowColor (Col: LongInt;
  FormHandle: THandle; MsgBack: Integer); stdcall;
procedure SyncApp (AppHandle: THandle); stdcall;

implementation

{$R *.DFM}

procedure TFormScroll.ScrollBarsScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  (Sender as TScrollBar).Hint := IntToStr(ScrollPos);

  Shape1.Brush.Color := RGB (ScrollBarRed.Position,
    ScrollBarGreen.Position, ScrollBarBlue.Position);
  Shape2.Pen.Color := RGB (ScrollBarRed.Position,
    ScrollBarGreen.Position, ScrollBarBlue.Position);
end;

procedure TFormScroll.TrackBar1Change(Sender: TObject);
begin
  LabelScroll.Caption := 'Scroll by ' + IntToStr(TrackBar1.Position);
  ScrollBarGreen.LargeChange := TrackBar1.Position;
  ScrollBarRed.LargeChange := TrackBar1.Position;
  ScrollBarBlue.LargeChange := TrackBar1.Position;
end;

procedure TFormScroll.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // used by the modeless form
  Action := caFree;
end;

procedure TFormScroll.FormActivate(Sender: TObject);
begin
  // change buttons for modeless form
  if FormHandle <> 0 then
  begin
    BitBtn1.Caption := 'Apply';
    BitBtn1.OnClick := ApplyClick;
    BitBtn2.Kind := bkClose;
  end;
end;

procedure TFormScroll.ApplyClick(Sender: TObject);
begin
  // notify to the main form
  SendMessage (FormHandle, MsgBack, SelectedColor, 0);
end;

procedure TFormScroll.sbRedClick(Sender: TObject);
begin
  SelectedColor := clRed;
end;

// set and get properties

function TFormScroll.GetSelColor: TColor;
begin
  Result := RGB (ScrollBarRed.Position,
    ScrollBarGreen.Position, ScrollBarBlue.Position);
end;

procedure TFormScroll.SetSelColor (Col: TColor);
var
  RGBCol: Integer;
begin
  RGBCol := ColorToRGB (Col);
  ScrollBarRed.Position := GetRValue (RGBCol);
  ScrollBarGreen.Position := GetGValue (RGBCol);
  ScrollBarBlue.Position := GetBValue (RGBCol);
  Shape1.Brush.Color := Col;
  Shape2.Pen.Color := Col;
end;

procedure TFormScroll.sbBlueClick(Sender: TObject);
begin
  SelectedColor := clBlue;
end;

procedure TFormScroll.sbGreenClick(Sender: TObject);
begin
  SelectedColor := clGreen;
end;

procedure TFormScroll.spApplicationClick(Sender: TObject);
begin
  ShowMessage ('Application Handle: ' +
    IntToStr (Application.Handle));
end;

// extern DLL functions

function GetColor (Col: LongInt): LongInt; stdcall;
var
  FormScroll: TFormScroll;
begin
  // default value
  Result := Col;
  try
    FormScroll := TFormScroll.Create (Application);
    try
      // initialize the data
      FormScroll.SelectedColor := Col;
      // show the form
      if FormScroll.ShowModal = mrOK then
        Result := FormScroll.SelectedColor;
    finally
      FormScroll.Free;
    end;
  except
    on E: Exception do
      MessageDlg ('Error in FormDLL: ' +
        E.Message, mtError, [mbOK], 0);
  end;
end;

procedure ShowColor (Col: LongInt;
  FormHandle: THandle; MsgBack: Integer); stdcall;
var
  FormScroll: TFormScroll;
begin
  FormScroll := TFormScroll.Create (Application);
  try
    // initialize the data
    FormScroll.FormHandle := FormHandle;
    FormScroll.MsgBack := MsgBack;
    FormScroll.SelectedColor := Col;
    // show the form
    FormScroll.Show;
  except
    on E: Exception do
    begin
      MessageDlg ('Error in FormDLL: ' +
        E.Message, mtError, [mbOK], 0);
      FormScroll.Free;
    end;
  end;
end;

procedure SyncApp (AppHandle: THandle); stdcall;
begin
  Application.Handle := AppHandle;
end;

end.

object FormScroll: TFormScroll
  Left = 215
  Top = 130
  ActiveControl = ScrollBarRed
  BorderStyle = bsDialog
  Caption = 'Scroll Colors'
  ClientHeight = 316
  ClientWidth = 431
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  ShowHint = True
  OnActivate = FormActivate
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object Shape3: TShape
    Left = 176
    Top = 176
    Width = 145
    Height = 65
  end
  object Shape2: TShape
    Left = 177
    Top = 177
    Width = 143
    Height = 63
    Pen.Color = clBtnFace
    Pen.Width = 40
  end
  object LabelRed: TLabel
    Left = 16
    Top = 56
    Width = 23
    Height = 13
    Caption = 'Red:'
  end
  object LabelGreen: TLabel
    Left = 16
    Top = 88
    Width = 32
    Height = 13
    Caption = 'Green:'
  end
  object LabelBlue: TLabel
    Left = 16
    Top = 120
    Width = 24
    Height = 13
    Caption = 'Blue:'
  end
  object Shape1: TShape
    Left = 16
    Top = 176
    Width = 145
    Height = 65
    Brush.Color = clBtnFace
  end
  object Label1: TLabel
    Left = 176
    Top = 152
    Width = 52
    Height = 13
    Caption = 'Solid color:'
  end
  object Label2: TLabel
    Left = 16
    Top = 152
    Width = 69
    Height = 13
    Caption = 'Dithered color:'
  end
  object LabelScroll: TLabel
    Left = 16
    Top = 269
    Width = 55
    Height = 13
    Caption = 'Scroll by 25'
  end
  object ScrollBarRed: TScrollBar
    Left = 104
    Top = 56
    Width = 305
    Height = 17
    Hint = 'Red'
    LargeChange = 25
    Max = 255
    PageSize = 0
    Position = 192
    TabOrder = 0
    OnScroll = ScrollBarsScroll
  end
  object ScrollBarGreen: TScrollBar
    Left = 104
    Top = 88
    Width = 305
    Height = 17
    Hint = 'Green'
    LargeChange = 25
    Max = 255
    PageSize = 0
    Position = 192
    TabOrder = 1
    OnScroll = ScrollBarsScroll
  end
  object ScrollBarBlue: TScrollBar
    Left = 104
    Top = 120
    Width = 305
    Height = 17
    Hint = 'Blue'
    LargeChange = 25
    Max = 255
    PageSize = 0
    Position = 192
    TabOrder = 2
    OnScroll = ScrollBarsScroll
  end
  object TrackBar1: TTrackBar
    Left = 96
    Top = 264
    Width = 321
    Height = 33
    Ctl3D = True
    Max = 30
    Min = 1
    Orientation = trHorizontal
    ParentCtl3D = False
    Frequency = 1
    Position = 25
    SelEnd = 0
    SelStart = 0
    TabOrder = 3
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 431
    Height = 41
    Align = alTop
    TabOrder = 4
    object sbRed: TSpeedButton
      Left = 8
      Top = 8
      Width = 80
      Height = 25
      Hint = 'Set the color'
      Caption = 'Red'
      Flat = True
      OnClick = sbRedClick
    end
    object sbBlue: TSpeedButton
      Left = 96
      Top = 8
      Width = 80
      Height = 25
      Hint = 'Set the color'
      Caption = 'Blue'
      Flat = True
      OnClick = sbBlueClick
    end
    object sbGreen: TSpeedButton
      Left = 184
      Top = 8
      Width = 80
      Height = 25
      Hint = 'Set the color'
      Caption = 'Green'
      Flat = True
      OnClick = sbGreenClick
    end
    object spApplication: TSpeedButton
      Left = 272
      Top = 8
      Width = 80
      Height = 25
      Hint = 'Get the handle'
      Caption = 'Application?'
      Flat = True
      OnClick = spApplicationClick
    end
  end
  object BitBtn1: TBitBtn
    Left = 336
    Top = 176
    Width = 75
    Height = 25
    TabOrder = 5
    Kind = bkOK
  end
  object BitBtn2: TBitBtn
    Left = 336
    Top = 216
    Width = 75
    Height = 25
    TabOrder = 6
    Kind = bkCancel
  end
end