Marco Cantù 1998, Mastering Delphi 4
Project: LISTSERV.DPR
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. //
// ************************************************************************ //
// *********************************************************************//
// HelpString: Project1 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_ListServ: TGUID = '{323C4A83-E400-11D1-B9F1-004845400FAA}';
IID_IListServer: TGUID = '{323C4A84-E400-11D1-B9F1-004845400FAA}';
CLASS_ListServer: TGUID = '{323C4A86-E400-11D1-B9F1-004845400FAA}';
// *********************************************************************//
// Forward declaration of interfaces defined in Type Library //
// *********************************************************************//
type
IListServer = interface;
IListServerDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library //
// (NOTE: Here we map each CoClass to it's Default Interface //
// *********************************************************************//
ListServer = IListServer;
IListServer = interface(IDispatch)
['{323C4A84-E400-11D1-B9F1-004845400FAA}']
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;
// Dispinterface declaration for dual interface IListServer
IListServerDisp = dispinterface
['{323C4A84-E400-11D1-B9F1-004845400FAA}']
property Items: IStrings dispid 1;
property Font: IFontDisp dispid 2;
end;
CoListServer = class
class function Create: IListServer;
class function CreateRemote(const MachineName: string): IListServer;
end;
implementation
uses ComObj;
class function CoListServer.Create: IListServer;
begin
Result := CreateComObject(CLASS_ListServer) as IListServer;
end;
class function CoListServer.CreateRemote(const MachineName: string): IListServer;
begin
Result := CreateRemoteComObject(MachineName, CLASS_ListServer) 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
fItems.Assign (ListServForm.Listbox1.Items);
// convert and return the strings
GetOleStrings (fItems, Result);
end;
procedure TListServer.Set_Items(const Value: IStrings);
begin
// convert the strings passed as parameter
SetOleStrings (fItems, Value);
// copy to the listbox items
ListServForm.Listbox1.Items.Assign (fItems);
end;
initialization
TAutoObjectFactory.Create(ComServer, TListServer,
Class_ListServer, 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
Copyright Marco Cantù 1998