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
|
Home:
Code Repository:
Mastering Delphi 5