OLE клиент-сервер 2
Автор: Xavier Pacheco
unit Ctrl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ColorGrd, ExtCtrls, Srv_TLB, Buttons;
type
TControlForm = class(TForm)
CallViaRG: TRadioGroup;
ShapeTypeRG: TRadioGroup;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Edit: TEdit;
GroupBox3: TGroupBox;
ConBtn: TButton;
DisBtn: TButton;
InfoBtn: TButton;
ColorBtn: TButton;
ColorDialog: TColorDialog;
ColorShape: TShape;
ExitBtn: TButton;
TextBtn: TButton;
procedure ConBtnClick(Sender: TObject);
procedure DisBtnClick(Sender: TObject);
procedure ColorBtnClick(Sender: TObject);
procedure ExitBtnClick(Sender: TObject);
procedure TextBtnClick(Sender: TObject);
procedure InfoBtnClick(Sender: TObject);
procedure ShapeTypeRGClick(Sender: TObject);
private
{ Private declarations }
FIntf: IAutoTest;
FDispintf: IAutoTestDisp;
FVar: OleVariant;
procedure SetControls;
procedure EnableControls(DoEnable: Boolean);
public
{ Public declarations }
end;
var
ControlForm: TControlForm;
implementation
{$R *.DFM}
uses ComObj;
procedure TControlForm.SetControls;
// Initializes the controls to the current server values
begin
case CallViaRG.ItemIndex of
0:
begin
ColorShape.Brush.Color := FIntf.ShapeColor;
ShapeTypeRG.ItemIndex := FIntf.ShapeType;
Edit.Text := FIntf.EditText;
end;
1:
begin
ColorShape.Brush.Color := FDispintf.ShapeColor;
ShapeTypeRG.ItemIndex := FDispintf.ShapeType;
Edit.Text := FDispintf.EditText;
end;
2:
begin
ColorShape.Brush.Color := FVar.ShapeColor;
ShapeTypeRG.ItemIndex := FVar.ShapeType;
Edit.Text := FVar.EditText;
end;
end;
end;
procedure TControlForm.EnableControls(DoEnable: Boolean);
begin
DisBtn.Enabled := DoEnable;
InfoBtn.Enabled := DoEnable;
ColorBtn.Enabled := DoEnable;
ShapeTypeRG.Enabled := DoEnable;
Edit.Enabled := DoEnable;
TextBtn.Enabled := DoEnable;
end;
procedure TControlForm.ConBtnClick(Sender: TObject);
begin
FIntf := CoAutoTest.Create;
FDispintf := CreateComObject(Class_AutoTest) as IAutoTestDisp;
FVar := CreateOleObject('Srv.AutoTest');
EnableControls(True);
SetControls;
end;
procedure TControlForm.DisBtnClick(Sender: TObject);
begin
FIntf := nil;
FDispintf := nil;
FVar := Unassigned;
EnableControls(False);
end;
procedure TControlForm.ColorBtnClick(Sender: TObject);
var
NewColor: TColor;
begin
if ColorDialog.Execute then
begin
NewColor := ColorDialog.Color;
case CallViaRG.ItemIndex of
0: FIntf.ShapeColor := NewColor;
1: FDispintf.ShapeColor := NewColor;
2: FVar.ShapeColor := NewColor;
end;
ColorShape.Brush.Color := NewColor;
end;
end;
procedure TControlForm.ExitBtnClick(Sender: TObject);
begin
Close;
end;
procedure TControlForm.TextBtnClick(Sender: TObject);
begin
case CallViaRG.ItemIndex of
0: FIntf.EditText := Edit.Text;
1: FDispintf.EditText := Edit.Text;
2: FVar.EditText := Edit.Text;
end;
end;
procedure TControlForm.InfoBtnClick(Sender: TObject);
begin
case CallViaRG.ItemIndex of
0: FIntf.ShowInfo;
1: FDispintf.ShowInfo;
2: FVar.ShowInfo;
end;
end;
procedure TControlForm.ShapeTypeRGClick(Sender: TObject);
begin
case CallViaRG.ItemIndex of
0: FIntf.ShapeType := ShapeTypeRG.ItemIndex;
1: FDispintf.ShapeType := ShapeTypeRG.ItemIndex;
2: FVar.ShapeType := ShapeTypeRG.ItemIndex;
end;
end;
end.
Скачать весь проект
|