Marco Cantù 1998, Mastering Delphi 4
Project: TLIBDEMO.DPR
Project Structure
TLIBDEMO.DPR
program TLibDemo;
uses
Forms,
MainForm in 'MainForm.pas' {ServerForm},
DemoObj in 'DemoObj.pas' {FirstServer: CoClass};
{$R *.RES}
{$R *.TLB}
begin
Application.Initialize;
Application.CreateForm(TServerForm, ServerForm);
Application.Run;
end.
PROJECT1LIB_TLB.PAS
unit Project1Lib_TLB;
// ************************************************************************ //
// WARNING //
// ------- //
// The types declared in this file were generated from data read from a //
// Type Library. If this type library is explicitly or indirectly (via //
// another type library referring to this type library) re-imported, or the //
// 'Refresh' command of the Type Library Editor activated while editing the //
// Type Library, the contents of this file will be regenerated and all //
// manual modifications will be lost. //
// ************************************************************************ //
// *********************************************************************//
// HelpString: Project1Lib Library
// Version: 1.0
// *********************************************************************//
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used: //
// Type Libraries : LIBID_xxxx //
// CoClasses : CLSID_xxxx //
// DISPInterfaces : DIID_xxxx //
// Non-DISP interfaces: IID_xxxx //
// *********************************************************************//
const
LIBID_Project1Lib: TGUID = '{89855B41-8EFE-11D0-98D0-444553540000}';
IID_IFirstServer: TGUID = '{89855B42-8EFE-11D0-98D0-444553540000}';
CLASS_FirstServer: TGUID = '{89855B43-8EFE-11D0-98D0-444553540000}';
// *********************************************************************//
// Forward declaration of interfaces defined in Type Library //
// *********************************************************************//
type
IFirstServer = interface;
IFirstServerDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library //
// (NOTE: Here we map each CoClass to it's Default Interface //
// *********************************************************************//
FirstServer = IFirstServer;
IFirstServer = interface(IDispatch)
['{89855B42-8EFE-11D0-98D0-444553540000}']
procedure ChangeColor; safecall;
function Get_Value: Integer; safecall;
procedure Set_Value(Value: Integer); safecall;
property Value: Integer read Get_Value write Set_Value;
end;
// Dispinterface declaration for dual interface IFirstServer
IFirstServerDisp = dispinterface
['{89855B42-8EFE-11D0-98D0-444553540000}']
procedure ChangeColor; dispid 1;
property Value: Integer dispid 2;
end;
CoFirstServer = class
class function Create: IFirstServer;
class function CreateRemote(const MachineName: string): IFirstServer;
end;
implementation
uses ComObj;
class function CoFirstServer.Create: IFirstServer;
begin
Result := CreateComObject(CLASS_FirstServer) as IFirstServer;
end;
class function CoFirstServer.CreateRemote(const MachineName: string): IFirstServer;
begin
Result := CreateRemoteComObject(MachineName, CLASS_FirstServer) as IFirstServer;
end;
end.
MAINFORM.PAS
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls;
type
TServerForm = class(TForm)
Label1: TLabel;
Edit1: TEdit;
UpDown1: TUpDown;
BtnColor: TButton;
BtnShow: TButton;
procedure Edit1Change(Sender: TObject);
procedure BtnColorClick(Sender: TObject);
procedure BtnShowClick(Sender: TObject);
private
CurrentValue: Integer;
protected
procedure SetValue (NewValue: Integer);
public
property Value: Integer
read CurrentValue write SetValue;
procedure ChangeColor;
end;
var
ServerForm: TServerForm;
implementation
{$R *.DFM}
procedure TServerForm.Edit1Change(Sender: TObject);
begin
CurrentValue := UpDown1.Position;
end;
procedure TServerForm.SetValue (NewValue: Integer);
begin
if NewValue <> CurrentValue then
begin
CurrentValue := Value;
UpDown1.Position := CurrentValue;
end;
end;
procedure TServerForm.ChangeColor;
begin
Color := RGB (
Random (255), Random (255), Random (255));
end;
procedure TServerForm.BtnColorClick(Sender: TObject);
begin
ChangeColor;
end;
procedure TServerForm.BtnShowClick(Sender: TObject);
begin
ShowMessage (IntToStr (CurrentValue));
end;
end.
DEMOOBJ.PAS
unit DemoObj;
interface
uses
ComObj, Project1Lib;
type
TFirstServer = class(TAutoObject, IFirstServer)
protected
function Get_Value: Integer; safecall;
procedure ChangeColor; safecall;
procedure Set_Value(Value: Integer); safecall;
end;
implementation
uses ComServ, MainForm;
function TFirstServer.Get_Value: Integer;
begin
Result := ServerForm.Value;
end;
procedure TFirstServer.ChangeColor;
begin
ServerForm.ChangeColor;
end;
procedure TFirstServer.Set_Value(Value: Integer);
begin
ServerForm.Value := Value;
end;
initialization
TAutoObjectFactory.Create(ComServer, TFirstServer, Class_FirstServer, ciMultiInstance);
end.
MAINFORM.DFM
object ServerForm: TServerForm
Left = 191
Top = 108
Width = 243
Height = 224
Caption = 'Type Library Demo Server'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 51
Width = 30
Height = 13
Caption = '&Value:'
end
object Edit1: TEdit
Left = 64
Top = 48
Width = 81
Height = 21
TabOrder = 0
Text = '5'
OnChange = Edit1Change
end
object UpDown1: TUpDown
Left = 145
Top = 48
Width = 15
Height = 21
Associate = Edit1
Min = 0
Position = 5
TabOrder = 1
Wrap = False
end
object BtnColor: TButton
Left = 64
Top = 128
Width = 97
Height = 25
Caption = '&Change Color'
TabOrder = 2
OnClick = BtnColorClick
end
object BtnShow: TButton
Left = 64
Top = 88
Width = 97
Height = 25
Caption = '&Show Value...'
TabOrder = 3
OnClick = BtnShowClick
end
end
Copyright Marco Cantù 1998