home *** CD-ROM | disk | FTP | other *** search
- unit OutlImpl;
-
- interface
-
- uses
- Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
- ComServ, StdVCL, AXCtrls, DelC_TLB, Grids, Outline;
-
- type
- TOutlineX = class(TActiveXControl, IOutlineX)
- private
- { Private declarations }
- FDelphiControl: TOutline;
- FEvents: IOutlineXEvents;
- procedure ClickEvent(Sender: TObject);
- procedure CollapseEvent(Sender: TObject; Index: Integer);
- procedure DblClickEvent(Sender: TObject);
- procedure ExpandEvent(Sender: TObject; Index: Integer);
- procedure KeyPressEvent(Sender: TObject; var Key: Char);
- protected
- { Protected declarations }
- procedure InitializeControl; override;
- procedure EventSinkChanged(const EventSink: IUnknown); override;
- procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
- function Add(Index: Integer; const Text: WideString): Integer; safecall;
- function AddChild(Index: Integer; const Text: WideString): Integer;
- safecall;
- function Get_BorderStyle: TxBorderStyle; safecall;
- function Get_Color: TColor; safecall;
- function Get_Ctl3D: WordBool; safecall;
- function Get_Cursor: Smallint; safecall;
- function Get_DragCursor: Smallint; safecall;
- function Get_DragMode: TxDragMode; safecall;
- function Get_Enabled: WordBool; safecall;
- function Get_Font: Font; safecall;
- function Get_ItemCount: Integer; safecall;
- function Get_ItemHeight: Integer; safecall;
- function Get_ItemSeparator: WideString; safecall;
- function Get_Lines: IStrings; safecall;
- function Get_OutlineStyle: TxOutlineStyle; safecall;
- function Get_ParentColor: WordBool; safecall;
- function Get_ParentCtl3D: WordBool; safecall;
- function Get_Row: Integer; safecall;
- function Get_ScrollBars: TxScrollStyle; safecall;
- function Get_SelectedItem: Integer; safecall;
- function Get_Style: TxOutlineType; safecall;
- function Get_Visible: WordBool; safecall;
- function GetItem(X, Y: Integer): Integer; safecall;
- function GetTextItem(const Value: WideString): Integer; safecall;
- function Insert(Index: Integer; const Text: WideString): Integer; safecall;
- procedure AboutBox; safecall;
- procedure BeginUpdate; safecall;
- procedure Clear; safecall;
- procedure Delete(Index: Integer); safecall;
- procedure EndUpdate; safecall;
- procedure FullCollapse; safecall;
- procedure FullExpand; safecall;
- procedure LoadFromFile(const FileName: WideString); safecall;
- procedure SaveToFile(const FileName: WideString); safecall;
- procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
- procedure Set_Color(Value: TColor); safecall;
- procedure Set_Ctl3D(Value: WordBool); safecall;
- procedure Set_Cursor(Value: Smallint); safecall;
- procedure Set_DragCursor(Value: Smallint); safecall;
- procedure Set_DragMode(Value: TxDragMode); safecall;
- procedure Set_Enabled(Value: WordBool); safecall;
- procedure Set_Font(const Value: Font); safecall;
- procedure Set_ItemHeight(Value: Integer); safecall;
- procedure Set_ItemSeparator(const Value: WideString); safecall;
- procedure Set_Lines(const Value: IStrings); safecall;
- procedure Set_OutlineStyle(Value: TxOutlineStyle); safecall;
- procedure Set_ParentColor(Value: WordBool); safecall;
- procedure Set_ParentCtl3D(Value: WordBool); safecall;
- procedure Set_Row(Value: Integer); safecall;
- procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
- procedure Set_SelectedItem(Value: Integer); safecall;
- procedure Set_Style(Value: TxOutlineType); safecall;
- procedure Set_Visible(Value: WordBool); safecall;
- procedure SetUpdateState(Value: WordBool); safecall;
- end;
-
- implementation
-
- uses About18;
-
- { TOutlineX }
-
- procedure TOutlineX.InitializeControl;
- begin
- FDelphiControl := Control as TOutline;
- FDelphiControl.OnClick := ClickEvent;
- FDelphiControl.OnCollapse := CollapseEvent;
- FDelphiControl.OnDblClick := DblClickEvent;
- FDelphiControl.OnExpand := ExpandEvent;
- FDelphiControl.OnKeyPress := KeyPressEvent;
- end;
-
- procedure TOutlineX.EventSinkChanged(const EventSink: IUnknown);
- begin
- FEvents := EventSink as IOutlineXEvents;
- end;
-
- procedure TOutlineX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
- begin
- { Define property pages here. Property pages are defined by calling
- DefinePropertyPage with the class id of the page. For example,
- DefinePropertyPage(Class_OutlineXPage); }
- end;
-
- function TOutlineX.Add(Index: Integer; const Text: WideString): Integer;
- begin
-
- end;
-
- function TOutlineX.AddChild(Index: Integer;
- const Text: WideString): Integer;
- begin
-
- end;
-
- function TOutlineX.Get_BorderStyle: TxBorderStyle;
- begin
- Result := Ord(FDelphiControl.BorderStyle);
- end;
-
- function TOutlineX.Get_Color: TColor;
- begin
- Result := FDelphiControl.Color;
- end;
-
- function TOutlineX.Get_Ctl3D: WordBool;
- begin
- Result := FDelphiControl.Ctl3D;
- end;
-
- function TOutlineX.Get_Cursor: Smallint;
- begin
- Result := Smallint(FDelphiControl.Cursor);
- end;
-
- function TOutlineX.Get_DragCursor: Smallint;
- begin
- Result := Smallint(FDelphiControl.DragCursor);
- end;
-
- function TOutlineX.Get_DragMode: TxDragMode;
- begin
- Result := Ord(FDelphiControl.DragMode);
- end;
-
- function TOutlineX.Get_Enabled: WordBool;
- begin
- Result := FDelphiControl.Enabled;
- end;
-
- function TOutlineX.Get_Font: Font;
- begin
- GetOleFont(FDelphiControl.Font, Result);
- end;
-
- function TOutlineX.Get_ItemCount: Integer;
- begin
- Result := FDelphiControl.ItemCount;
- end;
-
- function TOutlineX.Get_ItemHeight: Integer;
- begin
- Result := FDelphiControl.ItemHeight;
- end;
-
- function TOutlineX.Get_ItemSeparator: WideString;
- begin
- Result := WideString(FDelphiControl.ItemSeparator);
- end;
-
- function TOutlineX.Get_Lines: IStrings;
- begin
- GetOleStrings(FDelphiControl.Lines, Result);
- end;
-
- function TOutlineX.Get_OutlineStyle: TxOutlineStyle;
- begin
- Result := Ord(FDelphiControl.OutlineStyle);
- end;
-
- function TOutlineX.Get_ParentColor: WordBool;
- begin
- Result := FDelphiControl.ParentColor;
- end;
-
- function TOutlineX.Get_ParentCtl3D: WordBool;
- begin
- Result := FDelphiControl.ParentCtl3D;
- end;
-
- function TOutlineX.Get_Row: Integer;
- begin
- Result := FDelphiControl.Row;
- end;
-
- function TOutlineX.Get_ScrollBars: TxScrollStyle;
- begin
- Result := Ord(FDelphiControl.ScrollBars);
- end;
-
- function TOutlineX.Get_SelectedItem: Integer;
- begin
- Result := FDelphiControl.SelectedItem;
- end;
-
- function TOutlineX.Get_Style: TxOutlineType;
- begin
- Result := Ord(FDelphiControl.Style);
- end;
-
- function TOutlineX.Get_Visible: WordBool;
- begin
- Result := FDelphiControl.Visible;
- end;
-
- function TOutlineX.GetItem(X, Y: Integer): Integer;
- begin
-
- end;
-
- function TOutlineX.GetTextItem(const Value: WideString): Integer;
- begin
-
- end;
-
- function TOutlineX.Insert(Index: Integer; const Text: WideString): Integer;
- begin
-
- end;
-
- procedure TOutlineX.AboutBox;
- begin
- ShowOutlineXAbout;
- end;
-
- procedure TOutlineX.BeginUpdate;
- begin
-
- end;
-
- procedure TOutlineX.Clear;
- begin
-
- end;
-
- procedure TOutlineX.Delete(Index: Integer);
- begin
-
- end;
-
- procedure TOutlineX.EndUpdate;
- begin
-
- end;
-
- procedure TOutlineX.FullCollapse;
- begin
-
- end;
-
- procedure TOutlineX.FullExpand;
- begin
-
- end;
-
- procedure TOutlineX.LoadFromFile(const FileName: WideString);
- begin
-
- end;
-
- procedure TOutlineX.SaveToFile(const FileName: WideString);
- begin
-
- end;
-
- procedure TOutlineX.Set_BorderStyle(Value: TxBorderStyle);
- begin
- FDelphiControl.BorderStyle := TBorderStyle(Value);
- end;
-
- procedure TOutlineX.Set_Color(Value: TColor);
- begin
- FDelphiControl.Color := Value;
- end;
-
- procedure TOutlineX.Set_Ctl3D(Value: WordBool);
- begin
- FDelphiControl.Ctl3D := Value;
- end;
-
- procedure TOutlineX.Set_Cursor(Value: Smallint);
- begin
- FDelphiControl.Cursor := TCursor(Value);
- end;
-
- procedure TOutlineX.Set_DragCursor(Value: Smallint);
- begin
- FDelphiControl.DragCursor := TCursor(Value);
- end;
-
- procedure TOutlineX.Set_DragMode(Value: TxDragMode);
- begin
- FDelphiControl.DragMode := TDragMode(Value);
- end;
-
- procedure TOutlineX.Set_Enabled(Value: WordBool);
- begin
- FDelphiControl.Enabled := Value;
- end;
-
- procedure TOutlineX.Set_Font(const Value: Font);
- begin
- SetOleFont(FDelphiControl.Font, Value);
- end;
-
- procedure TOutlineX.Set_ItemHeight(Value: Integer);
- begin
- FDelphiControl.ItemHeight := Value;
- end;
-
- procedure TOutlineX.Set_ItemSeparator(const Value: WideString);
- begin
- FDelphiControl.ItemSeparator := String(Value);
- end;
-
- procedure TOutlineX.Set_Lines(const Value: IStrings);
- begin
- SetOleStrings(FDelphiControl.Lines, Value);
- end;
-
- procedure TOutlineX.Set_OutlineStyle(Value: TxOutlineStyle);
- begin
- FDelphiControl.OutlineStyle := TOutlineStyle(Value);
- end;
-
- procedure TOutlineX.Set_ParentColor(Value: WordBool);
- begin
- FDelphiControl.ParentColor := Value;
- end;
-
- procedure TOutlineX.Set_ParentCtl3D(Value: WordBool);
- begin
- FDelphiControl.ParentCtl3D := Value;
- end;
-
- procedure TOutlineX.Set_Row(Value: Integer);
- begin
- FDelphiControl.Row := Value;
- end;
-
- procedure TOutlineX.Set_ScrollBars(Value: TxScrollStyle);
- begin
- FDelphiControl.ScrollBars := TScrollStyle(Value);
- end;
-
- procedure TOutlineX.Set_SelectedItem(Value: Integer);
- begin
- FDelphiControl.SelectedItem := Value;
- end;
-
- procedure TOutlineX.Set_Style(Value: TxOutlineType);
- begin
- FDelphiControl.Style := TOutlineType(Value);
- end;
-
- procedure TOutlineX.Set_Visible(Value: WordBool);
- begin
- FDelphiControl.Visible := Value;
- end;
-
- procedure TOutlineX.SetUpdateState(Value: WordBool);
- begin
-
- end;
-
- procedure TOutlineX.ClickEvent(Sender: TObject);
- begin
- if FEvents <> nil then FEvents.OnClick;
- end;
-
- procedure TOutlineX.CollapseEvent(Sender: TObject; Index: Integer);
- begin
- if FEvents <> nil then FEvents.OnCollapse(Index);
- end;
-
- procedure TOutlineX.DblClickEvent(Sender: TObject);
- begin
- if FEvents <> nil then FEvents.OnDblClick;
- end;
-
- procedure TOutlineX.ExpandEvent(Sender: TObject; Index: Integer);
- begin
- if FEvents <> nil then FEvents.OnExpand(Index);
- end;
-
- procedure TOutlineX.KeyPressEvent(Sender: TObject; var Key: Char);
- var
- TempKey: Smallint;
- begin
- TempKey := Smallint(Key);
- if FEvents <> nil then FEvents.OnKeyPress(TempKey);
- Key := Char(TempKey);
- end;
-
- initialization
- TActiveXControlFactory.Create(
- ComServer,
- TOutlineX,
- TOutline,
- Class_OutlineX,
- 18,
- '{FA7B847C-9ED7-11D0-AA40-444553540000}',
- 0);
- end.
-