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 5

Project LISTCLI

Project Structure


LISTCLI.DPR

program ListCli;

uses
  Forms,
  LCliForm in 'LCliForm.pas' {ListCliForm},
  ImportTlb in 'ImportTlb.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, ImportTlb, StdCtrls;

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 := CoListServer.Create;
  Result := fInternalListServ;
end;

end.

IMPORTTLB.PAS

unit ImportTlb;

// ************************************************************************ //
// 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.

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