home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / Design / UExcelEdit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-11  |  14.2 KB  |  515 lines
  1. unit UExcelEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, ExtCtrls, DB, ImgList, Menus, OleCtnrs, StdCtrls,
  8.   UFlxMessages, TypInfo, UOleDrag, Activex, ToolWin, ActnList, OleCtrls, SHDocVw,
  9.   {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  10.   UAddRange, UXlsDB;
  11.  
  12. type
  13.   TExcelEdit = class(TForm)
  14.     PanelFields: TPanel;
  15.     edFields: TTreeView;
  16.     TreeImageList: TImageList;
  17.     Paneldoc: TPanel;
  18.     MainMenu1: TMainMenu;
  19.     PanelCommand: TPanel;
  20.     ImageList1: TImageList;
  21.     ImageList2: TImageList;
  22.     ImageList3: TImageList;
  23.     ToolBar1: TToolBar;
  24.     btnOk: TToolButton;
  25.     btnCancel: TToolButton;
  26.     File1: TMenuItem;
  27.     Save1: TMenuItem;
  28.     Exit1: TMenuItem;
  29.     ActionList1: TActionList;
  30.     ActionSave: TAction;
  31.     ActionClose: TAction;
  32.     SaveDialog: TSaveDialog;
  33.     ActionSaveAs: TAction;
  34.     ToolButton1: TToolButton;
  35.     Save2: TMenuItem;
  36.     N1: TMenuItem;
  37.     Document: TWebBrowser;
  38.     ActionToogleToolbar: TAction;
  39.     ToolButton2: TToolButton;
  40.     ToolButton3: TToolButton;
  41.     ToolButton4: TToolButton;
  42.     Splitter2: TSplitter;
  43.     Panel1: TPanel;
  44.     Panel2: TPanel;
  45.     ListRanges: TListView;
  46.     Splitter1: TSplitter;
  47.     ToolBar2: TToolBar;
  48.     ToolButton5: TToolButton;
  49.     ToolButton6: TToolButton;
  50.     ActionRefresh: TAction;
  51.     ActionNew: TAction;
  52.     ToolButton7: TToolButton;
  53.     ActionDelete: TAction;
  54.     ToolButton8: TToolButton;
  55.     PopupMenu1: TPopupMenu;
  56.     New1: TMenuItem;
  57.     Delete1: TMenuItem;
  58.     Refresh1: TMenuItem;
  59.     procedure edFieldsMouseDown(Sender: TObject; Button: TMouseButton;
  60.       Shift: TShiftState; X, Y: Integer);
  61.     procedure ActionCloseExecute(Sender: TObject);
  62.     procedure ActionSaveExecute(Sender: TObject);
  63.     procedure ActionSaveAsExecute(Sender: TObject);
  64.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  65.     procedure DocumentDownloadComplete(Sender: TObject);
  66.     procedure DocumentDownloadBegin(Sender: TObject);
  67.     procedure ActionToogleToolbarExecute(Sender: TObject);
  68.     procedure FormCreate(Sender: TObject);
  69.     procedure DocumentDocumentComplete(Sender: TObject;
  70.       const pDisp: IDispatch; var URL: OleVariant);
  71.     procedure ActionRefreshExecute(Sender: TObject);
  72.     procedure ActionNewExecute(Sender: TObject);
  73.     procedure ActionDeleteExecute(Sender: TObject);
  74.     procedure ActionDeleteUpdate(Sender: TObject);
  75.     procedure ListRangesSelectItem(Sender: TObject; Item: TListItem;
  76.       Selected: Boolean);
  77.   private
  78.     FileName: TFileName;
  79.     firstTime: boolean;
  80.     FDataModule: TComponent;
  81.     AddRange: TAddRange;
  82.     function Save: boolean;
  83.     function SaveAs: boolean;
  84.     procedure RecurseMenuTree(const ParentMenu: TMenuItem; const v: variant);
  85.     procedure GenericMenuAction(Sender: TObject);
  86.     { Private declarations }
  87.   public
  88.     procedure LoadData(const aDataModule: TComponent; const aFileName: TFileName);
  89.     { Public declarations }
  90.   end;
  91.  
  92.   procedure InvokeExcelEditor(const aDataModule: TComponent; const aFileName: TFileName; const ProjName: string='');
  93. implementation
  94.  
  95. {$R *.DFM}
  96.  
  97. procedure InvokeExcelEditor(const aDataModule: TComponent; const aFileName: TFileName; const ProjName: string='');
  98. var
  99.   ExcelEdit: TExcelEdit;
  100.   Fname: TFileName;
  101.   OldCursor: TCursor;
  102. begin
  103.   OldCursor:=Screen.Cursor;
  104.   Screen.Cursor:=crHourGlass;
  105.   try
  106.     if aFileName='' then FName:='' else
  107.     begin
  108.       try
  109.         FName:=SearchPathStr(aFileName);
  110.       except
  111.         on e:Exception do
  112.         begin
  113.           ShowMessage(format(ErrNoTemplate, [e.Message, ProjName]));
  114.           exit;
  115.         end;
  116.       end; //except
  117.     end;
  118.  
  119.     ExcelEdit:= TExcelEdit.Create(nil);
  120.     try
  121.       ExcelEdit.LoadData(aDataModule, FName);
  122.       ExcelEdit.ShowModal;
  123.     finally
  124.       FreeAndNil(ExcelEdit);
  125.     end;
  126.   finally
  127.     Screen.Cursor:=OldCursor;
  128.   end; //finally
  129. end;
  130.  
  131. { TExcelEdit }
  132.  
  133. procedure TExcelEdit.LoadData(const aDataModule: TComponent; const aFileName: TFileName);
  134. var
  135.   i, k: integer;
  136.   CurrItem, Child, Root: TTreeNode;
  137.   Ds: TDataSet;
  138.   IDs: IXlsDataSet;
  139.  
  140.   count:    integer;
  141.   data:     PTypeData;
  142.   info:     PTypeInfo;
  143.   propList: PPropList;
  144.  
  145. begin
  146.   FDatamodule:=aDataModule;
  147.   PanelCommand.Caption:=format(TxtEditTemplate,[aFileName]);
  148.   edFields.Items.Clear;
  149.   Root:=edFields.Items.Add(Nil, TxtDatasets);
  150.   Root.ImageIndex:=2;
  151.   Root.SelectedIndex:=2;
  152.   Root.Data:=nil;
  153.  
  154.   for i:=0 to aDataModule.ComponentCount-1 do
  155.   begin
  156.     if (aDataModule.Components[i]is TDataSet) then
  157.     begin
  158.       Ds:=aDataModule.Components[i] as TDataSet;
  159.       CurrItem:=edFields.Items.AddChild(Root, Ds.Name);
  160.       CurrItem.ImageIndex:=0;
  161.       CurrItem.SelectedIndex:=0;
  162.       CurrItem.Data:=nil;
  163.  
  164.       Child:= edFields.Items.AddChild(CurrItem, FullDataSetStr);
  165.       Child.ImageIndex:=1;
  166.       Child.SelectedIndex:=1;
  167.       Child.Data:=nil;
  168.       for k:=0 to Ds.FieldCount-1 do
  169.       begin
  170.         Child:= edFields.Items.AddChild(CurrItem, Ds.Fields[k].FieldName);
  171.         Child.ImageIndex:=1;
  172.         Child.SelectedIndex:=1;
  173.         Child.Data:=Ds.Fields[k];
  174.       end;
  175.     end else
  176.     if Supports(aDataModule.Components[i], IXlsDataSet, IDs) then
  177.     begin
  178.       CurrItem:=edFields.Items.AddChild(Root, IDs.DsName);
  179.       CurrItem.ImageIndex:=8;
  180.       CurrItem.SelectedIndex:=8;
  181.       CurrItem.Data:=nil;
  182.  
  183.       Child:= edFields.Items.AddChild(CurrItem, FullDataSetStr);
  184.       Child.ImageIndex:=7;
  185.       Child.SelectedIndex:=7;
  186.       Child.Data:=nil;
  187.       for k:=0 to IDs.FieldCount-1 do
  188.       begin
  189.         Child:= edFields.Items.AddChild(CurrItem, IDs.Fields[k].DisplayName);
  190.         Child.ImageIndex:=7;
  191.         Child.SelectedIndex:=7;
  192.         Child.Data:=nil;
  193.       end;
  194.     end;
  195.   end;
  196.  
  197.   //Properties
  198.   Root:=edFields.Items.Add(Nil, TxtProperties);
  199.   Root.ImageIndex:=3;
  200.   Root.SelectedIndex:=3;
  201.  
  202.  
  203.   info := aDataModule.ClassInfo;
  204.   data := GetTypeData(info);
  205.   GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
  206.   try
  207.     count := GetPropList(info, [tkVariant],  propList);
  208.     for i := 0 to count - 1 do
  209.     begin
  210.       Child:= edFields.Items.AddChild(Root, propList^[i]^.Name);
  211.       Child.ImageIndex:=4;
  212.       Child.SelectedIndex:=4;
  213.     end;
  214.   finally
  215.     FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
  216.   end; //finally
  217.  
  218.   //Extras
  219.   Root:=edFields.Items.Add(Nil, TxtExtras);
  220.   Root.ImageIndex:=5;
  221.   Root.SelectedIndex:=5;
  222.   Child:= edFields.Items.AddChild(Root, MarkedRowStr);
  223.   Child.ImageIndex:=6;
  224.   Child.SelectedIndex:=6;
  225.   Child:= edFields.Items.AddChild(Root, HPageBreakStr);
  226.   Child.ImageIndex:=6;
  227.   Child.SelectedIndex:=6;
  228.  
  229.  
  230.   edFields.AlphaSort;
  231.  
  232.   FileName:=aFileName;
  233.   if FileName<>'' then Document.Navigate(filename);
  234. end;
  235.  
  236. procedure TExcelEdit.edFieldsMouseDown(Sender: TObject;
  237.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  238. var
  239.   dwEffect: integer;
  240.   DataObject: IDataObject;
  241.   DropSource: IDropSource;
  242.   DragText: string;
  243. begin
  244.   if (Button=mbLeft) and (edFields.Selected<>nil) then
  245.   begin
  246.     Dragtext:='';
  247.     if ((edFields.Selected.ImageIndex=1) or (edFields.Selected.ImageIndex=7))
  248.     and (edFields.Selected.Parent<>nil) then //Field or IXlsField
  249.     begin
  250.       DragText:=FieldStr+edFields.Selected.Parent.Text+FieldStr+edFields.Selected.Text;
  251.       if (ssAlt in Shift) then
  252.         if (edFields.Selected.Data<>nil)  then //Field
  253.           DragText:=TField(edFields.Selected.Data).DisplayName+#13+#10+DragText
  254.         else //IXlsField
  255.           DragText:=edFields.Selected.Text+#13+#10+DragText
  256.     end;
  257.  
  258.     if (edFields.Selected.ImageIndex=4)and (edFields.Selected.Parent<>nil) then //Property
  259.       DragText:=VarStr+edFields.Selected.Text+VarStr;
  260.  
  261.     if (edFields.Selected.ImageIndex=6)and (edFields.Selected.Parent<>nil) then //Extra
  262.       DragText:=edFields.Selected.Text;
  263.  
  264.     if DragText<>'' then
  265.     begin
  266.       DataObject:= TFlxDataObject.Create(DragText);
  267.       DropSource:= TFlxDropsource.Create;
  268.       ActiveX.DoDragDrop(DataObject, DropSource, DROPEFFECT_COPY or DROPEFFECT_MOVE, dweffect);
  269.     end;
  270.   end;
  271. end;
  272.  
  273. procedure TExcelEdit.ActionCloseExecute(Sender: TObject);
  274. begin
  275.   Close;
  276. end;
  277.  
  278. function TExcelEdit.Save: boolean;
  279. begin
  280.   if FileName='' then
  281.   begin
  282.     Result:=SaveAs;
  283.     exit;
  284.   end;
  285.   Document.ExecWB( OLECMDID_SAVE, 0);
  286.   Result:=true;
  287. end;
  288.  
  289. function TExcelEdit.SaveAs: boolean;
  290. begin
  291.   Result:=true;
  292.   try
  293.     Document.ExecWB( OLECMDID_SAVECOPYAS, 0);
  294.   except
  295.     Result:=false;
  296.     ShowMessage(ErrDocumentNotSaved);
  297.   end; //except
  298. end;
  299.  
  300. procedure TExcelEdit.ActionSaveExecute(Sender: TObject);
  301. begin
  302.   Save;
  303. end;
  304.  
  305. procedure TExcelEdit.ActionSaveAsExecute(Sender: TObject);
  306. begin
  307.   SaveAs;
  308. end;
  309.  
  310. procedure TExcelEdit.FormCloseQuery(Sender: TObject;
  311.   var CanClose: Boolean);
  312. var
  313.   r: integer;
  314.   v: variant;
  315. begin
  316.   CanClose:=False;
  317.   try
  318.   v:=Document.OleObject.Document;
  319.   //dont use v:=Document.Document; This keeps the app in memory, no app.quit or workbook.close will release it
  320.     if VarIsEmpty(v) then
  321.     begin
  322.       CanClose:=true;
  323.       exit;
  324.     end;
  325.     if not v.Application.ActiveWorkbook.Saved then
  326.    begin
  327.       r:=MessageBox(Handle, PCHAR(format(TxtFileModified,[Filename])),PCHAR(TxtFileModifiedCaption),MB_YESNOCANCEL+MB_ICONWARNING);
  328.       if r=IDCANCEL then exit;
  329.       if r=IDYES then CanClose:=Save
  330.       else
  331.         CanClose:=true;
  332.     end
  333.     else CanClose:=true;
  334.   except
  335.     on e:Exception do
  336.     begin
  337.       Application.ShowException(e);
  338.       CanClose:=true;
  339.     end;
  340.   end; //except
  341.  
  342. canclose:=true;
  343. end;
  344.  
  345. procedure TExcelEdit.DocumentDownloadComplete(Sender: TObject);
  346. begin
  347.   Document.Enabled:=true;
  348. end;
  349.  
  350. procedure TExcelEdit.DocumentDownloadBegin(Sender: TObject);
  351. begin
  352.   document.Enabled:=false;
  353. end;
  354.  
  355. procedure TExcelEdit.ActionToogleToolbarExecute(Sender: TObject);
  356. begin
  357.   Document.ExecWB( OLECMDID_HIDETOOLBARS, OLECMDEXECOPT_DONTPROMPTUSER);
  358. end;
  359.  
  360. procedure TExcelEdit.FormCreate(Sender: TObject);
  361. begin
  362.   FirstTime:=true;
  363.   // IDocHostUIHandler
  364.   //IDocHostShowUI
  365. end;
  366.  
  367. procedure TExcelEdit.DocumentDocumentComplete(Sender: TObject;
  368.   const pDisp: IDispatch; var URL: OleVariant);
  369. {var
  370.   v: variant;
  371.   i: integer;
  372. }
  373. begin
  374.   try
  375.     if FirstTime then
  376.     begin
  377.       ActionToogleToolbar.Execute;
  378.  
  379. {     Not Yet...
  380.       v:=Document.OleObject.Document;
  381.       if VarIsEmpty(v) then exit;
  382.       v:=v.Application.CommandBars['Worksheet Menu Bar'].Controls;
  383.       for i:=2 to v.Count do RecurseMenuTree(MainMenu1.Items, v.Item[i]);  //Skip file menu
  384. }
  385.       FirstTime:=false;
  386.       ActionRefresh.Execute;
  387.     end;
  388.   except
  389.     //nothing
  390.   end;
  391. end;
  392.  
  393. procedure TExcelEdit.ActionRefreshExecute(Sender: TObject);
  394. var
  395.   v: variant;
  396.   i: integer;
  397.   Li: TListItem;
  398. begin
  399.   ListRanges.Items.BeginUpdate;
  400.   try
  401.    ListRanges.Items.Clear;
  402.    v:=Document.OleObject.Document;
  403.    if VarIsEmpty(v) then exit;
  404.    for i:=1 to v.Application.ActiveWorkbook.Names.Count do
  405.    begin
  406.      Li:=ListRanges.Items.Add;
  407.      Li.Caption:=v.Application.ActiveWorkbook.Names.Item(i).Name;
  408.      Li.SubItems.Add(v.Application.ActiveWorkbook.Names.Item(i));
  409.    end;
  410.  
  411.   finally
  412.     ListRanges.Items.EndUpdate;
  413.   end;
  414.  
  415. end;
  416.  
  417. procedure TExcelEdit.ActionNewExecute(Sender: TObject);
  418. var
  419.   v: variant;
  420.   s:string;
  421. begin
  422.   v:=Document.OleObject.Document;
  423.   if VarIsEmpty(v) then exit;
  424.   try
  425.     s:=format(TxtNamedRangeFormula,[v.Application.ActiveSheet.Name, v.Application.Selection.Address]);
  426.   except
  427.     s:='';
  428.   end;
  429.  
  430.   if AddRange=nil then AddRange:=TAddRange.Create(Self);
  431.   AddRange.InitData(s, FDataModule);
  432.   if (AddRange.ShowModal=mrOK) and (AddRange.cbName.Text<>'') then
  433.   begin
  434.     v.Application.ActiveWorkbook.Names.Add(AddRange.cbName.Text, addrange.edRange.Text);
  435.     ActionRefresh.Execute;
  436.   end;
  437. end;
  438.  
  439. procedure TExcelEdit.ActionDeleteExecute(Sender: TObject);
  440. var
  441.   v: variant;
  442.   r: integer;
  443. begin
  444.   if ListRanges.Selected=nil then exit;
  445.   r:=MessageBox(Handle, PCHAR(format(TxtDeleteRange,[ListRanges.Selected.Caption])),PCHAR(TxtDeleteRangeCaption),MB_YESNO+MB_ICONWARNING);
  446.   if r<>IDYES then exit;
  447.   v:=Document.OleObject.Document;
  448.   if VarIsEmpty(v) then exit;
  449.   v.Application.ActiveWorkbook.Names.Item(ListRanges.Selected.Caption).Delete;
  450.   ActionRefresh.Execute;
  451. end;
  452.  
  453. procedure TExcelEdit.ActionDeleteUpdate(Sender: TObject);
  454. begin
  455.   ActionDelete.Enabled:= ListRanges.SelCount=1;
  456. end;
  457.  
  458. procedure TExcelEdit.ListRangesSelectItem(Sender: TObject; Item: TListItem;
  459.   Selected: Boolean);
  460. var
  461.   v, Rg: variant;
  462.   i: integer;
  463. begin
  464.   if not Selected then exit;
  465.   v:=Document.OleObject.Document;
  466.   if VarIsEmpty(v) then exit;
  467.   if ListRanges.Selected=nil then exit;
  468.  
  469.   //Search for the range. we cant use just v.Application.ActiveWorkbook.Names.Item(ListRanges.Selected.Caption).RefersToRange
  470.   //because it finds ranges in current sheet before globals
  471.   Rg:=Unassigned;
  472.   for i:=1 to v.Application.ActiveWorkbook.Names.Count do
  473.   begin
  474.     if v.Application.ActiveWorkbook.Names.Item(i).Name=ListRanges.Selected.Caption then
  475.     begin
  476.       Rg:=v.Application.ActiveWorkbook.Names.Item(i).RefersToRange;
  477.       break;
  478.     end;
  479.  
  480.   end;
  481.   if VarIsEmpty(Rg) then exit;
  482.   v.Application.ActiveWorkbook.Sheets[Rg.Worksheet.Name].Activate;
  483.   Rg.Select;
  484. end;
  485.  
  486. procedure TExcelEdit.RecurseMenuTree(const ParentMenu: TMenuItem; const v: variant);
  487. var
  488.   Mi: TMenuItem;
  489.   i: integer;
  490. begin
  491.   Mi:= TMenuItem.Create(ParentMenu);
  492.   Mi.Caption:=v.Caption;
  493.   if v.Type<>10 then Mi.Tag:=v.ID else Mi.Tag:=-1;
  494.   Mi.OnClick:= GenericMenuAction;
  495.   ParentMenu.Add(Mi);
  496.   if v.Type=10 then //has submenus
  497.     for i:=1 to v.Controls.Count do RecurseMenuTree(Mi, v.Controls.Item[i]);
  498. end;
  499.  
  500. procedure TExcelEdit.GenericMenuAction(Sender: TObject);
  501. var
  502.   v: variant;
  503. begin
  504.   if (Sender is TMenuItem) and ((Sender as TMenuItem).Tag>0) then
  505.   begin
  506.     v:=Document.OleObject.Document;
  507.     if VarIsEmpty(v) then exit;
  508.     v:=v.Application.CommandBars['Worksheet Menu Bar'].FindControl(1, (Sender as TMenuItem).Tag, EmptyParam, False, True);
  509.     if not VarIsEmpty(v) and not VarIsNull(v) and v.Enabled then v.Execute;
  510.   end;
  511.  
  512. end;
  513.  
  514. end.
  515.