Project FORMDLL
Project Structure
FORMDLL.DPR
library FormDLL;
uses
ScrollF in 'SCROLLF.PAS' {FormScroll};
exports
GetColor, ShowColor, SyncApp;
end.
SCROLLF.PAS
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.
SCROLLF.DFM
object FormScroll: TFormScroll
Left = 215
Top = 130
ActiveControl = ScrollBarRed
BorderStyle = bsDialog
Caption = 'Scroll Colors'
ClientHeight = 316
ClientWidth = 431
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
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
ThumbLength = 20
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
|
Home:
Code Repository:
Mastering Delphi 5