Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project LISTCLI
Project StructureLISTCLI.DPRprogram 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.PASunit 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.PASunit 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.DFMobject 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
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |