Marco Cantù 1998, Mastering Delphi 4

Project: AFLOCAL.DPR


Project Structure


AFLOCAL.DPR

library AfLocal;

uses
  ComServ,
  AfLocal_TLB in 'AfLocal_TLB.pas',
  Local in 'Local.pas' {ActiveLocalData: TActiveForm} {ActiveLocalData: CoClass};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

{$E ocx}

begin
end.

AFLOCAL_TLB.PAS

unit AfLocal_TLB;

{ This file contains pascal declarations imported from a type library.
  This file will be written during each import or refresh of the type
  library editor.  Changes to this file will be discarded during the
  refresh process. }

{ AfLocal Library }
{ Version 1.0 }

{ Conversion log:
  Hint: Class is not registered.  Ambient properties cannot be determined.
 }

interface

uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

const
  LIBID_AfLocal: TGUID = '{CE612B45-243B-11D1-98D0-444553540000}';

const

{ TxActiveFormBorderStyle }

  afbNone = 0;
  afbSingle = 1;
  afbSunken = 2;
  afbRaised = 3;

{ TxPrintScale }

  poNone = 0;
  poProportional = 1;
  poPrintToFit = 2;

{ TxMouseButton }

  mbLeft = 0;
  mbRight = 1;
  mbMiddle = 2;

{ TxWindowState }

  wsNormal = 0;
  wsMinimized = 1;
  wsMaximized = 2;

const

{ Component class GUIDs }
  Class_ActiveLocalData: TGUID = '{CE612B48-243B-11D1-98D0-444553540000}';

type

{ Forward declarations: Interfaces }
  IActiveLocalData = interface;
  IActiveLocalDataDisp = dispinterface;
  IActiveLocalDataEvents = dispinterface;

{ Forward declarations: CoClasses }
  ActiveLocalData = IActiveLocalData;

{ Forward declarations: Enums }
  TxActiveFormBorderStyle = TOleEnum;
  TxPrintScale = TOleEnum;
  TxMouseButton = TOleEnum;
  TxWindowState = TOleEnum;

{ Dispatch interface for ActiveLocalData Control }

  IActiveLocalData = interface(IDispatch)
    ['{CE612B46-243B-11D1-98D0-444553540000}']
    function Get_AutoScroll: WordBool; safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    function Get_Caption: WideString; safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    function Get_Color: TColor; safecall;
    procedure Set_Color(Value: TColor); safecall;
    function Get_Font: Font; safecall;
    procedure Set_Font(const Value: Font); safecall;
    function Get_KeyPreview: WordBool; safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    function Get_PixelsPerInch: Integer; safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    function Get_Scaled: WordBool; safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    function Get_Active: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    function Get_HelpFile: WideString; safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    function Get_WindowState: TxWindowState; safecall;
    procedure Set_WindowState(Value: TxWindowState); safecall;
    function Get_Visible: WordBool; safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    function Get_Enabled: WordBool; safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    function Get_Cursor: Smallint; safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    property AutoScroll: WordBool read Get_AutoScroll write Set_AutoScroll;
    property AxBorderStyle: TxActiveFormBorderStyle read Get_AxBorderStyle write Set_AxBorderStyle;
    property Caption: WideString read Get_Caption write Set_Caption;
    property Color: TColor read Get_Color write Set_Color;
    property Font: Font read Get_Font write Set_Font;
    property KeyPreview: WordBool read Get_KeyPreview write Set_KeyPreview;
    property PixelsPerInch: Integer read Get_PixelsPerInch write Set_PixelsPerInch;
    property PrintScale: TxPrintScale read Get_PrintScale write Set_PrintScale;
    property Scaled: WordBool read Get_Scaled write Set_Scaled;
    property Active: WordBool read Get_Active;
    property DropTarget: WordBool read Get_DropTarget write Set_DropTarget;
    property HelpFile: WideString read Get_HelpFile write Set_HelpFile;
    property WindowState: TxWindowState read Get_WindowState write Set_WindowState;
    property Visible: WordBool read Get_Visible write Set_Visible;
    property Enabled: WordBool read Get_Enabled write Set_Enabled;
    property Cursor: Smallint read Get_Cursor write Set_Cursor;
  end;

{ DispInterface declaration for Dual Interface IActiveLocalData }

  IActiveLocalDataDisp = dispinterface
    ['{CE612B46-243B-11D1-98D0-444553540000}']
    property AutoScroll: WordBool dispid 1;
    property AxBorderStyle: TxActiveFormBorderStyle dispid 2;
    property Caption: WideString dispid 3;
    property Color: TColor dispid 4;
    property Font: Font dispid 5;
    property KeyPreview: WordBool dispid 6;
    property PixelsPerInch: Integer dispid 7;
    property PrintScale: TxPrintScale dispid 8;
    property Scaled: WordBool dispid 9;
    property Active: WordBool readonly dispid 10;
    property DropTarget: WordBool dispid 11;
    property HelpFile: WideString dispid 12;
    property WindowState: TxWindowState dispid 13;
    property Visible: WordBool dispid 14;
    property Enabled: WordBool dispid 15;
    property Cursor: Smallint dispid 16;
  end;

{ Events interface for ActiveLocalData Control }

  IActiveLocalDataEvents = dispinterface
    ['{CE612B47-243B-11D1-98D0-444553540000}']
    procedure OnActivate; dispid 1;
    procedure OnClick; dispid 2;
    procedure OnCreate; dispid 3;
    procedure OnDblClick; dispid 4;
    procedure OnDestroy; dispid 5;
    procedure OnDeactivate; dispid 6;
    procedure OnKeyPress(var Key: Smallint); dispid 7;
    procedure OnPaint; dispid 8;
  end;

{ ActiveLocalDataControl }

  TActiveLocalDataOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;

  TActiveLocalData = class(TOleControl)
  private
    FOnActivate: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnCreate: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnKeyPress: TActiveLocalDataOnKeyPress;
    FOnPaint: TNotifyEvent;
    FIntf: IActiveLocalData;
  protected
    procedure InitControlData; override;
    procedure InitControlInterface(const Obj: IUnknown); override;
  public
    property ControlInterface: IActiveLocalData read FIntf;
    property Active: WordBool index 10 read GetWordBoolProp;
  published
    property AutoScroll: WordBool index 1 read GetWordBoolProp write SetWordBoolProp stored False;
    property AxBorderStyle: TxActiveFormBorderStyle index 2 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Caption: WideString index 3 read GetWideStringProp write SetWideStringProp stored False;
    property Color: TColor index 4 read GetTColorProp write SetTColorProp stored False;
    property Font: TFont index 5 read GetTFontProp write SetTFontProp stored False;
    property KeyPreview: WordBool index 6 read GetWordBoolProp write SetWordBoolProp stored False;
    property PixelsPerInch: Integer index 7 read GetIntegerProp write SetIntegerProp stored False;
    property PrintScale: TxPrintScale index 8 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Scaled: WordBool index 9 read GetWordBoolProp write SetWordBoolProp stored False;
    property DropTarget: WordBool index 11 read GetWordBoolProp write SetWordBoolProp stored False;
    property HelpFile: WideString index 12 read GetWideStringProp write SetWideStringProp stored False;
    property WindowState: TxWindowState index 13 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Visible: WordBool index 14 read GetWordBoolProp write SetWordBoolProp stored False;
    property Enabled: WordBool index 15 read GetWordBoolProp write SetWordBoolProp stored False;
    property Cursor: Smallint index 16 read GetSmallintProp write SetSmallintProp stored False;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnKeyPress: TActiveLocalDataOnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  end;

procedure Register;

implementation

uses ComObj;

procedure TActiveLocalData.InitControlData;
const
  CEventDispIDs: array[0..7] of Integer = (
    $00000001, $00000002, $00000003, $00000004, $00000005, $00000006,
    $00000007, $00000008);
  CTFontIDs: array [0..0] of Integer = (
    $00000005);
  CControlData: TControlData = (
    ClassID: '{CE612B48-243B-11D1-98D0-444553540000}';
    EventIID: '{CE612B47-243B-11D1-98D0-444553540000}';
    EventCount: 8;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil;
    Flags: $00000000;
    Version: 300;
    FontCount: 1;
    FontIDs: @CTFontIDs);
begin
  ControlData := @CControlData;
end;

procedure TActiveLocalData.InitControlInterface(const Obj: IUnknown);
begin
  FIntf := Obj as IActiveLocalData;
end;


procedure Register;
begin
  RegisterComponents('ActiveX', [TActiveLocalData]);
end;

end.

LOCAL.PAS

unit Local;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, AfLocal_TLB, Grids, DBGrids, Db, DBTables, ExtCtrls;

type
  TActiveLocalData = class(TActiveForm, IActiveLocalData)
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
  private
    { Private declarations }
    FEvents: IActiveLocalDataEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    procedure Initialize; override;
    function Get_Active: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: TColor; safecall;
    function Get_Cursor: Smallint; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: Font; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_WindowState: TxWindowState; safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: TColor); safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: Font); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    procedure Set_WindowState(Value: TxWindowState); safecall;
  public
    { Public declarations }
  end;

implementation

uses ComServ;

{$R *.DFM}

{ TActiveLocalData }

procedure TActiveLocalData.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IActiveLocalDataEvents;
end;

procedure TActiveLocalData.Initialize;
begin
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TActiveLocalData.Get_Active: WordBool;
begin
  Result := Active;
end;

function TActiveLocalData.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TActiveLocalData.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TActiveLocalData.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TActiveLocalData.Get_Color: TColor;
begin
  Result := Color;
end;

function TActiveLocalData.Get_Cursor: Smallint;
begin
  Result := Smallint(Cursor);
end;

function TActiveLocalData.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TActiveLocalData.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TActiveLocalData.Get_Font: Font;
begin
  GetOleFont(Font, Result);
end;

function TActiveLocalData.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TActiveLocalData.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TActiveLocalData.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TActiveLocalData.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TActiveLocalData.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TActiveLocalData.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TActiveLocalData.Get_WindowState: TxWindowState;
begin
  Result := Ord(WindowState);
end;

procedure TActiveLocalData.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TActiveLocalData.Set_AxBorderStyle(
  Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TActiveLocalData.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TActiveLocalData.Set_Color(Value: TColor);
begin
  Color := Value;
end;

procedure TActiveLocalData.Set_Cursor(Value: Smallint);
begin
  Cursor := TCursor(Value);
end;

procedure TActiveLocalData.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TActiveLocalData.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TActiveLocalData.Set_Font(const Value: Font);
begin
  SetOleFont(Font, Value);
end;

procedure TActiveLocalData.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure TActiveLocalData.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure TActiveLocalData.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure TActiveLocalData.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure TActiveLocalData.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure TActiveLocalData.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;

procedure TActiveLocalData.Set_WindowState(Value: TxWindowState);
begin
  WindowState := TWindowState(Value);
end;

procedure TActiveLocalData.ActivateEvent(Sender: TObject);
var
  ModuleName: string;
begin
  if FEvents <> nil then
    FEvents.OnActivate;
  // specific code
  SetLength (ModuleName, 1000);
  GetModuleFileName (HInstance, pChar (ModuleName), 1000);
  Table1.DatabaseName := ExtractFilePath (PChar (ModuleName));
  Panel1.Caption := Table1.DatabaseName +
    '/' + Table1.TableName;
  Table1.Open;
end;

procedure TActiveLocalData.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TActiveLocalData.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TActiveLocalData.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TActiveLocalData.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TActiveLocalData.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TActiveLocalData.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TActiveLocalData.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TActiveLocalData,
    Class_ActiveLocalData,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL);
end.

LOCAL.DFM

object ActiveLocalData: TActiveLocalData
  Left = 219
  Top = 159
  Width = 391
  Height = 249
  Caption = 'ActiveLocalData'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 41
    Width = 383
    Height = 181
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 383
    Height = 41
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 1
  end
  object Table1: TTable
    ReadOnly = True
    TableName = 'COUNTRY.DB'
    Left = 24
    Top = 16
  end
  object DataSource1: TDataSource
    AutoEdit = False
    DataSet = Table1
    Left = 64
    Top = 16
  end
end


Copyright Marco Cantù 1998