home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / ole2.pak / OLE2WIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  8.0 KB  |  308 lines
  1. unit Ole2win;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
  6.   ToCtrl, BoleDefs, Buttons, Menus, ExtCtrls, Dialogs;
  7.  
  8. type
  9.   TOLEWin = class(TForm)
  10.     MainMenu1: TMainMenu;
  11.     Edit1: TMenuItem;
  12.     Cut1: TMenuItem;
  13.     Copy1: TMenuItem;
  14.     Paste1: TMenuItem;
  15.     InsertObject1: TMenuItem;
  16.     PasteSpecial1: TMenuItem;
  17.     N2: TMenuItem;
  18.     N3: TMenuItem;
  19.     Object1: TMenuItem;
  20.     Object2: TMenuItem;
  21.     ResetObject1: TMenuItem;
  22.     PasteInObject1: TMenuItem;
  23.     Links1: TMenuItem;
  24.     File1: TMenuItem;
  25.     New1: TMenuItem;
  26.     Open1: TMenuItem;
  27.     Save1: TMenuItem;
  28.     N1: TMenuItem;
  29.     Exit1: TMenuItem;
  30.     Help1: TMenuItem;
  31.     ScrollBox1: TScrollBox;
  32.     OleContainer1: TOleContainer;
  33.     SpdBar: TPanel;
  34.     MsgBar: TPanel;
  35.     OpenDialog1: TOpenDialog;
  36.     SaveDialog1: TSaveDialog;
  37.     procedure ResetObjectClick(Sender: TObject);
  38.     procedure CloseBtnClick(Sender: TObject);
  39.     procedure Copy1Click(Sender: TObject);
  40.     procedure InsertObject1Click(Sender: TObject);
  41.     procedure PasteSpecial1Click(Sender: TObject);
  42.     procedure Links1Click(Sender: TObject);
  43.     procedure Edit1Click(Sender: TObject);
  44.     procedure Object1Click(Sender: TObject);
  45.     procedure Cut1Click(Sender: TObject);
  46.     procedure StatusLineEvent(Sender: TObject; Msg: String);
  47.     procedure PasteInObject1Click(Sender: TObject);
  48.     procedure NewOleWin1Click(Sender: TObject);
  49.     procedure Exit1Click(Sender: TObject);
  50.     procedure Open1Click(Sender: TObject);
  51.     procedure Save1Click(Sender: TObject);
  52.     procedure DoDrop(DragTgt, DragSource: TObject; X, Y: Integer);
  53.   private
  54.     { Private declarations }
  55.     FLinkClipFmt  : Word;
  56.     FEmbedClipFmt : Word;
  57.     procedure CreateOleObject (PInfo : Pointer);
  58.   public
  59.     { Public declarations }
  60.     constructor Create(AOwner: TComponent); override;
  61.   end;
  62.  
  63. var
  64.   OLEWin: TOLEWin;
  65.  
  66. implementation
  67.  
  68. uses SysUtils;
  69.  
  70. {$R *.DFM}
  71.  
  72. constructor TOLEWin.Create(AOwner: TComponent);
  73. begin
  74.   inherited Create (AOwner);
  75.   FEmbedClipFmt := RegisterClipboardFormat ('Embedded Object');
  76.   FLinkClipFmt  := RegisterClipboardFormat ('Link Source');
  77.   RegisterFormAsOleDropTarget (Self,
  78.     [OleFormat (FEmbedClipFmt, '%s', '%s', FALSE),
  79.      OleFormat (FLinkClipFmt,  '%s', '%s', TRUE)]);
  80.   OnDragDrop := DoDrop;
  81. end;
  82.  
  83. procedure TOLEWin.ResetObjectClick(Sender: TObject);
  84. var
  85.   InitInfo : Pointer;
  86. begin
  87.   if ActiveControl.InheritsFrom (TOleContainer) then
  88.   begin
  89.     if InsertOleObjectDlg (Self, 0, InitInfo) = True then
  90.     begin
  91.       TOleContainer(ActiveControl).PInitInfo := InitInfo;
  92.       ReleaseOleInitInfo (InitInfo);
  93.     end;
  94.   end;
  95. end;
  96.  
  97. procedure TOLEWin.PasteInObject1Click(Sender: TObject);
  98. var
  99.   InitInfo : Pointer;
  100. begin
  101.   if ActiveControl.InheritsFrom (TOleContainer) then
  102.   begin
  103.     if PasteSpecialOleDlg (Self, 0, InitInfo) = True then
  104.     begin
  105.       TOleContainer(ActiveControl).PInitInfo := InitInfo;
  106.       ReleaseOleInitInfo (InitInfo);
  107.     end;
  108.   end;
  109. end;
  110.  
  111. procedure TOLEWin.CloseBtnClick(Sender: TObject);
  112. begin
  113.   Close;
  114. end;
  115.  
  116. procedure TOLEWin.Copy1Click(Sender: TObject);
  117. begin
  118.   if ActiveControl.InheritsFrom (TOleContainer) then
  119.   begin
  120.     TOleContainer (ActiveControl).CopyToClipboard (True);
  121.     MessageDlg ('Copied to clipboard!', mtInformation, [mbOK], 0);
  122.   end;
  123. end;
  124.  
  125. procedure TOLEWin.InsertObject1Click(Sender: TObject);
  126. var
  127.    PInfo: Pointer;
  128. begin
  129.   if InsertOleObjectDlg (Self, 0, PInfo) then
  130.     CreateOleObject (PInfo);
  131.   ReleaseOleInitInfo (PInfo);
  132. end;
  133.  
  134. procedure TOLEWin.CreateOleObject (PInfo : Pointer);
  135. var
  136.   Ctrl : TOleContainer;
  137.   X,Y  : Integer;
  138. begin
  139.   Ctrl := TOleContainer.Create (Self);
  140.   X := 10;
  141.   Y := 10;
  142.   if ScrollBox1.ControlCount > 0 then
  143.   begin
  144.     X := ScrollBox1.Controls [ScrollBox1.ControlCount - 1].Left;
  145.     Y := ScrollBox1.Controls [ScrollBox1.ControlCount - 1].Top +
  146.          ScrollBox1.Controls [ScrollBox1.ControlCount - 1].Height + 20;
  147.   end;
  148.   Ctrl.SetBounds (X, Y, 230, 150);
  149.   Ctrl.visible := True;
  150.   Ctrl.enabled := True;
  151.   Ctrl.AutoSize := True;
  152.   Ctrl.OnStatusLineEvent := StatusLineEvent;
  153.   Ctrl.PInitInfo := PInfo;
  154.   Ctrl.Parent := ScrollBox1;
  155.   ActiveControl := Ctrl;
  156. end;
  157.  
  158. procedure TOLEWin.PasteSpecial1Click(Sender: TObject);
  159. var
  160.   Ptr  : PChar;
  161.   Str  : String;
  162.   Fmt  : Word;
  163.   Hdl  : THandle;
  164.   PInfo : Pointer;
  165. begin
  166.   if PasteSpecialDlg (Self,
  167.     [OleFormat (FEmbedClipFmt, '%s', '%s', FALSE),
  168.      OleFormat (FLinkClipFmt,  '%s', '%s', TRUE)],
  169.     0, Fmt, Hdl, PInfo) then
  170.   begin
  171.     if (Fmt = CF_TEXT) then
  172.     begin
  173.       Ptr := GlobalLock (Hdl);
  174.       Str := StrPas (Ptr);
  175.       GlobalUnlock (Hdl);
  176.       Str := Format('Text on the clipboard = %s', [Str]);
  177.       MessageDlg (Str, mtInformation, [mbOK], 0);
  178.       GlobalFree (Hdl);
  179.     end
  180.     else if (Fmt = CF_METAFILEPICT) then
  181.     begin
  182.       MessageDlg ('MetaFile on the clipboard.', mtInformation, [mbOK], 0);
  183.       GlobalFree (Hdl);
  184.     end
  185.     else
  186.       CreateOleObject (PInfo);
  187.     ReleaseOleInitInfo (PInfo);
  188.   end;
  189. end;
  190.  
  191. procedure TOLEWin.Links1Click(Sender: TObject);
  192. begin
  193.   LinksDlg (Self, 0);
  194. end;
  195.  
  196. procedure TOLEWin.Edit1Click(Sender: TObject);
  197. begin
  198.   Cut1.Enabled := ActiveControl.InheritsFrom (TOleContainer);
  199.   Copy1.Enabled := ActiveControl.InheritsFrom (TOleContainer);
  200.   InsertObject1.Enabled := True;
  201.   PasteSpecial1.Enabled := PasteSpecialEnabled (Self,
  202.       [OleFormat (FEmbedClipFmt, '%s', '%s', FALSE),
  203.       OleFormat (FLinkClipFmt,  '%s', '%s', TRUE)]);
  204.   Links1.Enabled := LinksDlgEnabled (Self);
  205. end;
  206.  
  207. procedure TOLEWin.Object1Click(Sender: TObject);
  208. begin
  209.   ResetObject1.Enabled := ActiveControl.InheritsFrom (TOleContainer);
  210.   PasteInObject1.Enabled := ActiveControl.InheritsFrom (TOleContainer) and
  211.     PasteSpecialEnabled (Self,
  212.       [OleFormat (FEmbedClipFmt, '%s', '%s', FALSE),
  213.        OleFormat (FLinkClipFmt,  '%s', '%s', TRUE)]);
  214. end;
  215.  
  216. procedure TOLEWin.Cut1Click(Sender: TObject);
  217. begin
  218.   if ActiveControl.InheritsFrom (TOleContainer) then
  219.   begin
  220.     TOleContainer (ActiveControl).CopyToClipboard (True);
  221.     ActiveControl.Free;
  222.     MessageDlg ('Cut to clipboard!', mtInformation, [mbOK], 0);
  223.   end;
  224. end;
  225.  
  226. procedure TOLEWin.StatusLineEvent(Sender: TObject;
  227.   Msg: String);
  228. begin
  229.   MsgBar.Caption := Msg;
  230. end;
  231.  
  232. procedure TOLEWin.DoDrop(DragTgt, DragSource: TObject; X, Y: Integer);
  233. var
  234.   Ctrl: TOleContainer;
  235.   Ptr: PChar;
  236.   Str: String;
  237.   Point: TPoint;
  238. begin
  239.   if DragSource.InheritsFrom (TOleDropNotify) then
  240.   begin
  241.     if TOleDropNotify(DragSource).PInitInfo <> Nil then
  242.     begin
  243.       Point.X := X;
  244.       Point.Y := Y;
  245.       Point := ClientToScreen(Point);
  246.       Point := ScrollBox1.ScreenToClient(Point);
  247.       Ctrl := TOleContainer.Create (TForm(DragTgt));
  248.       Ctrl.SetBounds (Point.X, Point.Y, 100, 100);
  249.       Ctrl.visible := True;
  250.       Ctrl.enabled := True;
  251.       Ctrl.AutoSize := True;
  252.       Ctrl.Parent := ScrollBox1;
  253.       Ctrl.PInitInfo := TOleDropNotify(DragSource).PInitInfo;
  254.     end;
  255.   end;
  256. end;
  257.  
  258. procedure TOLEWin.NewOleWin1Click(Sender: TObject);
  259. var
  260.   Child : TOLEWin;
  261. begin
  262.   Child := TOLEWin.Create(Self);
  263.   Child.Visible := True;
  264. end;
  265.  
  266. procedure TOLEWin.Exit1Click(Sender: TObject);
  267. begin
  268.   Close;
  269. end;
  270.  
  271. procedure TOLEWin.Open1Click(Sender: TObject);
  272. var
  273.   Frm : TOLEWin;
  274.   Stream: TStream;
  275. begin
  276.   if OpenDialog1.Execute then
  277.   begin
  278.     Frm := TOLEWin.Create(Application);
  279.     Stream := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
  280.     try
  281.       Frm.OleContainer1.LoadFromStream(Stream);
  282.     finally
  283.       Stream.Free;
  284.     end;
  285.     Frm.Caption := ExtractFileName(OpenDialog1.FileName);
  286.     Frm.OleContainer1.Modified := False;
  287.     Frm.Visible := True;
  288.   end;
  289. end;
  290.  
  291. procedure TOLEWin.Save1Click(Sender: TObject);
  292. var
  293.   Stream: TStream;
  294. begin
  295.   if SaveDialog1.Execute then
  296.   begin
  297.     Stream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
  298.     try
  299.       OleContainer1.SaveToStream(Stream);
  300.     finally
  301.       Stream.Free;
  302.     end;
  303.   end;
  304. end;
  305.  
  306. end.
  307.  
  308.