Project Structure

• ListCli.dpr
• LCliForm.pas
• ListServ_TLB.pas
• LCliForm.dfm

program ListCli;

uses
  Forms,
  LCliForm in 'LCliForm.pas' {ListCliForm},
  ListServ_TLB in 'ListServ_TLB.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TListCliForm, ListCliForm);
  Application.Run;
end.

unit LCliForm;

interface

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

type
  TListCliForm = class(TForm)
    btnFont: TButton;
    FontDialog1: TFontDialog;
    btnMemList: TButton;
    EditItem: TEdit;
    btnMemoTo: TButton;
    Memo1: TMemo;
    btnAdd: TButton;
    btnServer: TButton;
    procedure btnFontClick(Sender: TObject);
    procedure btnMemListClick(Sender: TObject);
    procedure btnMemoToClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnServerClick(Sender: TObject);
  private
    fInternalListServ: IListServer;
    function GetListSrv: IListServer;
  public
    property ListSrv: IListServer
      read GetListSrv;
  end;

var
  ListCliForm: TListCliForm;

implementation

{$R *.DFM}

uses
  ActiveX, AxCtrls, StdVCL;

procedure TListCliForm.btnFontClick(Sender: TObject);
var
  NewFont: IFontDisp;
begin
  // select a font and apply it
  if FontDialog1.Execute then
  begin
    GetOleFont (FontDialog1.Font, NewFont);
    ListSrv.Font := NewFont;
  end;
end;

procedure TListCliForm.btnMemListClick(Sender: TObject);
var
  TempIStrs: IStrings;
  List: TStrings;
  I: Integer;
begin
  // set a list of strings...
  List := TStringList.Create;
  try
    for I := 1 to 10 do
      List.Add ('Item ' + IntToStr (I));
    GetOleStrings (List, TempIStrs);
    ListSrv.Items := TempIStrs;
  finally
    List.Free;
  end;
end;

procedure TListCliForm.btnMemoToClick(Sender: TObject);
var
  TempIStrs: IStrings;
begin
  GetOleStrings (Memo1.Lines, TempIStrs);
  ListSrv.Items := TempIStrs;
end;

procedure TListCliForm.btnAddClick(Sender: TObject);
var
  TempIStrs: IStrings;
  List: TStrings;
begin
  // create a temporary list of strings
  List := TStringList.Create;
  try
    // get items from server
    TempIStrs := ListSrv.Items;
    // add new item
    TempIStrs.Add (EditItem.Text);
    // make local copy
    SetOleStrings (List, TempIStrs);
    // copy back to interface
    GetOleStrings (List, TempIStrs);
    // send to server
    ListSrv.Items := TempIStrs;
  finally
    List.Free;
  end;
end;

procedure TListCliForm.btnServerClick(Sender: TObject);
var
  TempIStrs: IStrings;
begin
  // get the interface and move strings to memo
  TempIStrs := ListSrv.Items;
  SetOleStrings (Memo1.Lines, TempIStrs);
end;

function TListCliForm.GetListSrv: IListServer;
begin
  // eventually create the server
  if not Assigned (fInternalListServ) then
    fInternalListServ := CoCoListServ.Create;
  Result := fInternalListServ;
end;

end.

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:42:50 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)
// ************************************************************************ //
// *************************************************************************//
// NOTE:                                                                      
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties  
// which return objects that may need to be explicitly created via a function 
// call prior to any access via the property. These items have been disabled  
// in order to prevent accidental use from within the object inspector. You   
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively   
// removing them from the $IFDEF blocks. However, such items must still be    
// programmatically created via a method of the appropriate CoClass before    
// they can be used.                                                          
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}

interface

uses ActiveX, Classes, Graphics, OleServer, 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.

object ListCliForm: TListCliForm
  Left = 198
  Top = 105
  Width = 385
  Height = 248
  Caption = 'List Client'
  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 btnFont: TButton
    Left = 192
    Top = 144
    Width = 121
    Height = 25
    Caption = 'Change Font'
    TabOrder = 0
    OnClick = btnFontClick
  end
  object btnMemList: TButton
    Left = 192
    Top = 48
    Width = 121
    Height = 25
    Caption = 'Memory -> Server'
    TabOrder = 1
    OnClick = btnMemListClick
  end
  object EditItem: TEdit
    Left = 208
    Top = 112
    Width = 145
    Height = 21
    TabOrder = 2
    Text = 'New item'
  end
  object btnMemoTo: TButton
    Left = 192
    Top = 16
    Width = 121
    Height = 25
    Caption = 'Memo -> Server'
    TabOrder = 3
    OnClick = btnMemoToClick
  end
  object Memo1: TMemo
    Left = 16
    Top = 16
    Width = 161
    Height = 185
    Lines.Strings = (
      'aaaaaaaa'
      'bbbbbbbb'
      'cccccccc'
      'dddddddd'
      'eeeeeeee')
    TabOrder = 4
  end
  object btnAdd: TButton
    Left = 192
    Top = 80
    Width = 121
    Height = 25
    Caption = 'Add to Server'
    TabOrder = 5
    OnClick = btnAddClick
  end
  object btnServer: TButton
    Left = 192
    Top = 176
    Width = 121
    Height = 25
    Caption = 'Memo <- Server'
    TabOrder = 6
    OnClick = btnServerClick
  end
  object FontDialog1: TFontDialog
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    MinFontSize = 0
    MaxFontSize = 0
    Left = 64
    Top = 80
  end
end