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 ListCli

Project Structure

ListCli.dpr
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.
LCliForm.pas
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.
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: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.
LCliForm.dfm
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