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