Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 20 - Project ListServ

Project Structure

ListServ.dpr
program ListServ;

uses
  Forms,
  ListForm in 'ListForm.pas' {ListServForm},
  ListServ_TLB in 'ListServ_TLB.pas',
  ListObj in 'ListObj.pas' {ListServer: CoClass};

{$R *.TLB}

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TListServForm, ListServForm);
  Application.Run;
end.
ListForm.pas
unit ListForm;

interface

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

type
  TListServForm = class(TForm)
    ListBox1: TListBox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ListServForm: TListServForm;

implementation

{$R *.DFM}

end.
ListServ_TLB.pas
unit ListServ_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.                                         
// ************************************************************************ //

// PASTLWTR : $Revision:   1.118  $
// File generated on 4/29/2001 4:40:18 PM from Type Library described below.

// ************************************************************************  //
// Type Lib: C:\md6code\20\ListServ\ListServ.tlb (1)
// LIBID: {3BDFE8EA-CA1A-4918-8643-8F8D5EE2371E}
// LCID: 0
// Helpfile: 
// DepndLst: 
//   (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
//   (2) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}

interface

uses ActiveX, Classes, Graphics, StdVcl, Variants, Windows;


  // *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx
//   DISPInterfaces     : DIID_xxxx
//   Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  ListServMajorVersion = 1;
  ListServMinorVersion = 0;

  LIBID_ListServ: TGUID = '{3BDFE8EA-CA1A-4918-8643-8F8D5EE2371E}';

  IID_IListServer: TGUID = '{DD9E3D16-E878-4ECC-9F1D-CDEE4B2C3B02}';
  CLASS_CoListServ: TGUID = '{4D54A7F2-9D93-469A-BEB9-F8C8F25F3408}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
  IListServer = interface;
  IListServerDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  CoListServ = IListServer;


// *********************************************************************//
// Interface: IListServer
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {DD9E3D16-E878-4ECC-9F1D-CDEE4B2C3B02}
// *********************************************************************//
  IListServer = interface(IDispatch)
    ['{DD9E3D16-E878-4ECC-9F1D-CDEE4B2C3B02}']
    function  Get_Items: IStrings; safecall;
    procedure Set_Items(const Value: IStrings); safecall;
    function  Get_Font: IFontDisp; safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    property Items: IStrings read Get_Items write Set_Items;
    property Font: IFontDisp read Get_Font write Set_Font;
  end;

// *********************************************************************//
// DispIntf:  IListServerDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {DD9E3D16-E878-4ECC-9F1D-CDEE4B2C3B02}
// *********************************************************************//
  IListServerDisp = dispinterface
    ['{DD9E3D16-E878-4ECC-9F1D-CDEE4B2C3B02}']
    property Items: IStrings dispid 1;
    property Font: IFontDisp dispid 2;
  end;

// *********************************************************************//
// The Class CoCoListServ provides a Create and CreateRemote method to          
// create instances of the default interface IListServer exposed by              
// the CoClass CoListServ. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoCoListServ = class
    class function Create: IListServer;
    class function CreateRemote(const MachineName: string): IListServer;
  end;

implementation

uses ComObj;

class function CoCoListServ.Create: IListServer;
begin
  Result := CreateComObject(CLASS_CoListServ) as IListServer;
end;

class function CoCoListServ.CreateRemote(const MachineName: string): IListServer;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CoListServ) as IListServer;
end;

end.
ListObj.pas
unit ListObj;

interface

uses
  ComObj, ActiveX, StdVCL, Classes, Graphics, ListServ_TLB;

type
  TListServer = class(TAutoObject, IListServer)
  private
    fItems: TStrings;
    fFont: TFont;
  protected
    function Get_Font: IFontDisp; safecall;
    function Get_Items: IStrings; safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_Items(const Value: IStrings); safecall;
  public
    destructor Destroy; override;
    procedure Initialize; override;
  end;

implementation

uses
  ComServ, ListForm, AxCtrls;

procedure TListServer.Initialize;
begin
  inherited Initialize;
  fItems := TStringList.Create;
  fFont := TFont.Create;
end;

destructor TListServer.Destroy;
begin
  fItems.Free;
  fFont.Free;
  inherited Destroy;
end;

function TListServer.Get_Font: IFontDisp;
begin
  // get the form of the form
  fFont.Assign (ListServForm.Font);
  // convert it
  GetOleFont (fFont, Result);
end;

procedure TListServer.Set_Font(const Value: IFontDisp);
begin
  // convert the font passed as parameter
  SetOleFont (fFont, Value);
  // apply it to the form
  ListServForm.Font.Assign (fFont);
  // force a refresh of the list box
  ListServForm.Listbox1.Invalidate;
end;

function TListServer.Get_Items: IStrings;
begin
  // get the listbox items, converting them
  GetOleStrings (ListServForm.Listbox1.Items, Result);
end;

procedure TListServer.Set_Items(const Value: IStrings);
begin
  // convert the strings received as parameter
  SetOleStrings (ListServForm.Listbox1.Items, Value);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TListServer,
    CLASS_CoListServ, ciMultiInstance, tmSingle);
end.
ListForm.dfm
object ListServForm: TListServForm
  Left = 192
  Top = 107
  Width = 379
  Height = 282
  Caption = 'List Server'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 32
    Top = 16
    Width = 305
    Height = 217
    ItemHeight = 13
    TabOrder = 0
  end
end