Marco Cantù 1998, Mastering Delphi 4

Project: TLIBCLI.DPR


Project Structure


TLIBCLI.DPR

program TLibCli;

uses
  Forms,
  TLibCliF in 'TLibCliF.pas' {ClientForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TClientForm, ClientForm);
  Application.Run;
end.

TLIBCLIF.PAS

unit TLibCliF;

interface

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

type
  TClientForm = class(TForm)
    BtnColor1: TButton;
    BtnColor2: TButton;
    BtnIntf: TButton;
    BtnVariant: TButton;
    BtnDispIntf: TButton;
    Bevel1: TBevel;
    ListResult: TListBox;
    BtnColorBis: TButton;
    procedure FormCreate(Sender: TObject);
    procedure BtnColor1Click(Sender: TObject);
    procedure BtnColor2Click(Sender: TObject);
    procedure BtnIntfClick(Sender: TObject);
    procedure BtnVariantClick(Sender: TObject);
    procedure BtnDispIntfClick(Sender: TObject);
    procedure BtnColorBisClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MyServer, MyServerBis: Variant;
    IMyServer, IMyServerBis: IFirstServer;
    DMyServer: DFirstServer;
  end;

var
  ClientForm: TClientForm;

implementation

{$R *.DFM}

procedure TClientForm.FormCreate(Sender: TObject);
begin
  // creates server objects
  IMyServer := CoFirstServer.Create;
  DMyServer := CoFirstServer.Create as DFirstServer;
  MyServer := CoFirstServer.Create;
end;

procedure TClientForm.BtnColor1Click(Sender: TObject);
begin
  IMyServer.ChangeColor;
end;

procedure TClientForm.BtnColor2Click(Sender: TObject);
begin
  MyServer.ChangeColor;
end;

procedure TClientForm.BtnIntfClick(Sender: TObject);
var
  I, K: Integer;
  Ticks: Integer;
begin
  Screen.Cursor := crHourglass;
  try
    Ticks := GetTickCount;
    K := 0;
    for I := 1 to 100 do
      K := K + IMyServer.Value;
    Ticks := GetTickCount - Ticks;
    ListResult.items.Add (Format (
      'Interface: %d - Seconds %.3f', [K, Ticks / 1000]));
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TClientForm.BtnVariantClick(Sender: TObject);
var
  I, K: Integer;
  Ticks: Integer;
begin
  Screen.Cursor := crHourglass;
  try
    Ticks := GetTickCount;
    K := 0;
    for I := 1 to 100 do
      K := K + MyServer.Value;
    Ticks := GetTickCount - Ticks;
    ListResult.items.Add (Format (
      'Variant: %d - Seconds %.3f', [K, Ticks / 1000]));
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TClientForm.BtnDispIntfClick(Sender: TObject);
var
  I, K: Integer;
  Ticks: Integer;
begin
  Screen.Cursor := crHourglass;
  try
    Ticks := GetTickCount;
    K := 0;
    for I := 1 to 100 do
      K := K + DMyServer.Value;
    Ticks := GetTickCount - Ticks;
    ListResult.items.Add (Format (
      'DispIntf %d - Seconds %.3f', [K, Ticks / 1000]));
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TClientForm.BtnColorBisClick(Sender: TObject);
begin
  if varType (MyServerBis) = varEmpty then
    MyServerBis := CoFirstServer.Create;
  MyServerBis.ChangeColor;

  if not Assigned (IMyServerBis) then
    IMyServerBis := CoFirstServer.Create;
  IMyServerBis.ChangeColor;
end;

end.

TLIBCLIF.DFM

object ClientForm: TClientForm
  Left = 204
  Top = 115
  Width = 464
  Height = 295
  Caption = 'Type Library Client'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 16
    Top = 64
    Width = 417
    Height = 193
  end
  object BtnColor1: TButton
    Left = 32
    Top = 16
    Width = 113
    Height = 25
    Caption = 'Change Color 1'
    TabOrder = 0
    OnClick = BtnColor1Click
  end
  object BtnColor2: TButton
    Left = 168
    Top = 16
    Width = 113
    Height = 25
    Caption = 'Change Color 2'
    TabOrder = 1
    OnClick = BtnColor2Click
  end
  object BtnIntf: TButton
    Left = 32
    Top = 96
    Width = 113
    Height = 25
    Caption = 'Compute (Interface)'
    TabOrder = 2
    OnClick = BtnIntfClick
  end
  object BtnVariant: TButton
    Left = 32
    Top = 144
    Width = 113
    Height = 25
    Caption = 'Compute (Variant)'
    TabOrder = 3
    OnClick = BtnVariantClick
  end
  object BtnDispIntf: TButton
    Left = 32
    Top = 192
    Width = 113
    Height = 25
    Caption = 'Compute (DispIntf)'
    TabOrder = 4
    OnClick = BtnDispIntfClick
  end
  object ListResult: TListBox
    Left = 160
    Top = 80
    Width = 257
    Height = 161
    ItemHeight = 13
    TabOrder = 5
  end
  object BtnColorBis: TButton
    Left = 304
    Top = 16
    Width = 113
    Height = 25
    Caption = 'Change Color Bis'
    TabOrder = 6
    OnClick = BtnColorBisClick
  end
end


Copyright Marco Cantù 1998