home *** CD-ROM | disk | FTP | other *** search
- unit UExcelEdit;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ComCtrls, ExtCtrls, DB, ImgList, Menus, OleCtnrs, StdCtrls,
- UFlxMessages, TypInfo, UOleDrag, Activex, ToolWin, ActnList, OleCtrls, SHDocVw,
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
- UAddRange, UXlsDB;
-
- type
- TExcelEdit = class(TForm)
- PanelFields: TPanel;
- edFields: TTreeView;
- TreeImageList: TImageList;
- Paneldoc: TPanel;
- MainMenu1: TMainMenu;
- PanelCommand: TPanel;
- ImageList1: TImageList;
- ImageList2: TImageList;
- ImageList3: TImageList;
- ToolBar1: TToolBar;
- btnOk: TToolButton;
- btnCancel: TToolButton;
- File1: TMenuItem;
- Save1: TMenuItem;
- Exit1: TMenuItem;
- ActionList1: TActionList;
- ActionSave: TAction;
- ActionClose: TAction;
- SaveDialog: TSaveDialog;
- ActionSaveAs: TAction;
- ToolButton1: TToolButton;
- Save2: TMenuItem;
- N1: TMenuItem;
- Document: TWebBrowser;
- ActionToogleToolbar: TAction;
- ToolButton2: TToolButton;
- ToolButton3: TToolButton;
- ToolButton4: TToolButton;
- Splitter2: TSplitter;
- Panel1: TPanel;
- Panel2: TPanel;
- ListRanges: TListView;
- Splitter1: TSplitter;
- ToolBar2: TToolBar;
- ToolButton5: TToolButton;
- ToolButton6: TToolButton;
- ActionRefresh: TAction;
- ActionNew: TAction;
- ToolButton7: TToolButton;
- ActionDelete: TAction;
- ToolButton8: TToolButton;
- PopupMenu1: TPopupMenu;
- New1: TMenuItem;
- Delete1: TMenuItem;
- Refresh1: TMenuItem;
- procedure edFieldsMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure ActionCloseExecute(Sender: TObject);
- procedure ActionSaveExecute(Sender: TObject);
- procedure ActionSaveAsExecute(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure DocumentDownloadComplete(Sender: TObject);
- procedure DocumentDownloadBegin(Sender: TObject);
- procedure ActionToogleToolbarExecute(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure DocumentDocumentComplete(Sender: TObject;
- const pDisp: IDispatch; var URL: OleVariant);
- procedure ActionRefreshExecute(Sender: TObject);
- procedure ActionNewExecute(Sender: TObject);
- procedure ActionDeleteExecute(Sender: TObject);
- procedure ActionDeleteUpdate(Sender: TObject);
- procedure ListRangesSelectItem(Sender: TObject; Item: TListItem;
- Selected: Boolean);
- private
- FileName: TFileName;
- firstTime: boolean;
- FDataModule: TComponent;
- AddRange: TAddRange;
- function Save: boolean;
- function SaveAs: boolean;
- procedure RecurseMenuTree(const ParentMenu: TMenuItem; const v: variant);
- procedure GenericMenuAction(Sender: TObject);
- { Private declarations }
- public
- procedure LoadData(const aDataModule: TComponent; const aFileName: TFileName);
- { Public declarations }
- end;
-
- procedure InvokeExcelEditor(const aDataModule: TComponent; const aFileName: TFileName; const ProjName: string='');
- implementation
-
- {$R *.DFM}
-
- procedure InvokeExcelEditor(const aDataModule: TComponent; const aFileName: TFileName; const ProjName: string='');
- var
- ExcelEdit: TExcelEdit;
- Fname: TFileName;
- OldCursor: TCursor;
- begin
- OldCursor:=Screen.Cursor;
- Screen.Cursor:=crHourGlass;
- try
- if aFileName='' then FName:='' else
- begin
- try
- FName:=SearchPathStr(aFileName);
- except
- on e:Exception do
- begin
- ShowMessage(format(ErrNoTemplate, [e.Message, ProjName]));
- exit;
- end;
- end; //except
- end;
-
- ExcelEdit:= TExcelEdit.Create(nil);
- try
- ExcelEdit.LoadData(aDataModule, FName);
- ExcelEdit.ShowModal;
- finally
- FreeAndNil(ExcelEdit);
- end;
- finally
- Screen.Cursor:=OldCursor;
- end; //finally
- end;
-
- { TExcelEdit }
-
- procedure TExcelEdit.LoadData(const aDataModule: TComponent; const aFileName: TFileName);
- var
- i, k: integer;
- CurrItem, Child, Root: TTreeNode;
- Ds: TDataSet;
- IDs: IXlsDataSet;
-
- count: integer;
- data: PTypeData;
- info: PTypeInfo;
- propList: PPropList;
-
- begin
- FDatamodule:=aDataModule;
- PanelCommand.Caption:=format(TxtEditTemplate,[aFileName]);
- edFields.Items.Clear;
- Root:=edFields.Items.Add(Nil, TxtDatasets);
- Root.ImageIndex:=2;
- Root.SelectedIndex:=2;
- Root.Data:=nil;
-
- for i:=0 to aDataModule.ComponentCount-1 do
- begin
- if (aDataModule.Components[i]is TDataSet) then
- begin
- Ds:=aDataModule.Components[i] as TDataSet;
- CurrItem:=edFields.Items.AddChild(Root, Ds.Name);
- CurrItem.ImageIndex:=0;
- CurrItem.SelectedIndex:=0;
- CurrItem.Data:=nil;
-
- Child:= edFields.Items.AddChild(CurrItem, FullDataSetStr);
- Child.ImageIndex:=1;
- Child.SelectedIndex:=1;
- Child.Data:=nil;
- for k:=0 to Ds.FieldCount-1 do
- begin
- Child:= edFields.Items.AddChild(CurrItem, Ds.Fields[k].FieldName);
- Child.ImageIndex:=1;
- Child.SelectedIndex:=1;
- Child.Data:=Ds.Fields[k];
- end;
- end else
- if Supports(aDataModule.Components[i], IXlsDataSet, IDs) then
- begin
- CurrItem:=edFields.Items.AddChild(Root, IDs.DsName);
- CurrItem.ImageIndex:=8;
- CurrItem.SelectedIndex:=8;
- CurrItem.Data:=nil;
-
- Child:= edFields.Items.AddChild(CurrItem, FullDataSetStr);
- Child.ImageIndex:=7;
- Child.SelectedIndex:=7;
- Child.Data:=nil;
- for k:=0 to IDs.FieldCount-1 do
- begin
- Child:= edFields.Items.AddChild(CurrItem, IDs.Fields[k].DisplayName);
- Child.ImageIndex:=7;
- Child.SelectedIndex:=7;
- Child.Data:=nil;
- end;
- end;
- end;
-
- //Properties
- Root:=edFields.Items.Add(Nil, TxtProperties);
- Root.ImageIndex:=3;
- Root.SelectedIndex:=3;
-
-
- info := aDataModule.ClassInfo;
- data := GetTypeData(info);
- GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
- try
- count := GetPropList(info, [tkVariant], propList);
- for i := 0 to count - 1 do
- begin
- Child:= edFields.Items.AddChild(Root, propList^[i]^.Name);
- Child.ImageIndex:=4;
- Child.SelectedIndex:=4;
- end;
- finally
- FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
- end; //finally
-
- //Extras
- Root:=edFields.Items.Add(Nil, TxtExtras);
- Root.ImageIndex:=5;
- Root.SelectedIndex:=5;
- Child:= edFields.Items.AddChild(Root, MarkedRowStr);
- Child.ImageIndex:=6;
- Child.SelectedIndex:=6;
- Child:= edFields.Items.AddChild(Root, HPageBreakStr);
- Child.ImageIndex:=6;
- Child.SelectedIndex:=6;
-
-
- edFields.AlphaSort;
-
- FileName:=aFileName;
- if FileName<>'' then Document.Navigate(filename);
- end;
-
- procedure TExcelEdit.edFieldsMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- dwEffect: integer;
- DataObject: IDataObject;
- DropSource: IDropSource;
- DragText: string;
- begin
- if (Button=mbLeft) and (edFields.Selected<>nil) then
- begin
- Dragtext:='';
- if ((edFields.Selected.ImageIndex=1) or (edFields.Selected.ImageIndex=7))
- and (edFields.Selected.Parent<>nil) then //Field or IXlsField
- begin
- DragText:=FieldStr+edFields.Selected.Parent.Text+FieldStr+edFields.Selected.Text;
- if (ssAlt in Shift) then
- if (edFields.Selected.Data<>nil) then //Field
- DragText:=TField(edFields.Selected.Data).DisplayName+#13+#10+DragText
- else //IXlsField
- DragText:=edFields.Selected.Text+#13+#10+DragText
- end;
-
- if (edFields.Selected.ImageIndex=4)and (edFields.Selected.Parent<>nil) then //Property
- DragText:=VarStr+edFields.Selected.Text+VarStr;
-
- if (edFields.Selected.ImageIndex=6)and (edFields.Selected.Parent<>nil) then //Extra
- DragText:=edFields.Selected.Text;
-
- if DragText<>'' then
- begin
- DataObject:= TFlxDataObject.Create(DragText);
- DropSource:= TFlxDropsource.Create;
- ActiveX.DoDragDrop(DataObject, DropSource, DROPEFFECT_COPY or DROPEFFECT_MOVE, dweffect);
- end;
- end;
- end;
-
- procedure TExcelEdit.ActionCloseExecute(Sender: TObject);
- begin
- Close;
- end;
-
- function TExcelEdit.Save: boolean;
- begin
- if FileName='' then
- begin
- Result:=SaveAs;
- exit;
- end;
- Document.ExecWB( OLECMDID_SAVE, 0);
- Result:=true;
- end;
-
- function TExcelEdit.SaveAs: boolean;
- begin
- Result:=true;
- try
- Document.ExecWB( OLECMDID_SAVECOPYAS, 0);
- except
- Result:=false;
- ShowMessage(ErrDocumentNotSaved);
- end; //except
- end;
-
- procedure TExcelEdit.ActionSaveExecute(Sender: TObject);
- begin
- Save;
- end;
-
- procedure TExcelEdit.ActionSaveAsExecute(Sender: TObject);
- begin
- SaveAs;
- end;
-
- procedure TExcelEdit.FormCloseQuery(Sender: TObject;
- var CanClose: Boolean);
- var
- r: integer;
- v: variant;
- begin
- CanClose:=False;
- try
- v:=Document.OleObject.Document;
- //dont use v:=Document.Document; This keeps the app in memory, no app.quit or workbook.close will release it
- if VarIsEmpty(v) then
- begin
- CanClose:=true;
- exit;
- end;
- if not v.Application.ActiveWorkbook.Saved then
- begin
- r:=MessageBox(Handle, PCHAR(format(TxtFileModified,[Filename])),PCHAR(TxtFileModifiedCaption),MB_YESNOCANCEL+MB_ICONWARNING);
- if r=IDCANCEL then exit;
- if r=IDYES then CanClose:=Save
- else
- CanClose:=true;
- end
- else CanClose:=true;
- except
- on e:Exception do
- begin
- Application.ShowException(e);
- CanClose:=true;
- end;
- end; //except
-
- canclose:=true;
- end;
-
- procedure TExcelEdit.DocumentDownloadComplete(Sender: TObject);
- begin
- Document.Enabled:=true;
- end;
-
- procedure TExcelEdit.DocumentDownloadBegin(Sender: TObject);
- begin
- document.Enabled:=false;
- end;
-
- procedure TExcelEdit.ActionToogleToolbarExecute(Sender: TObject);
- begin
- Document.ExecWB( OLECMDID_HIDETOOLBARS, OLECMDEXECOPT_DONTPROMPTUSER);
- end;
-
- procedure TExcelEdit.FormCreate(Sender: TObject);
- begin
- FirstTime:=true;
- // IDocHostUIHandler
- //IDocHostShowUI
- end;
-
- procedure TExcelEdit.DocumentDocumentComplete(Sender: TObject;
- const pDisp: IDispatch; var URL: OleVariant);
- {var
- v: variant;
- i: integer;
- }
- begin
- try
- if FirstTime then
- begin
- ActionToogleToolbar.Execute;
-
- { Not Yet...
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- v:=v.Application.CommandBars['Worksheet Menu Bar'].Controls;
- for i:=2 to v.Count do RecurseMenuTree(MainMenu1.Items, v.Item[i]); //Skip file menu
- }
- FirstTime:=false;
- ActionRefresh.Execute;
- end;
- except
- //nothing
- end;
- end;
-
- procedure TExcelEdit.ActionRefreshExecute(Sender: TObject);
- var
- v: variant;
- i: integer;
- Li: TListItem;
- begin
- ListRanges.Items.BeginUpdate;
- try
- ListRanges.Items.Clear;
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- for i:=1 to v.Application.ActiveWorkbook.Names.Count do
- begin
- Li:=ListRanges.Items.Add;
- Li.Caption:=v.Application.ActiveWorkbook.Names.Item(i).Name;
- Li.SubItems.Add(v.Application.ActiveWorkbook.Names.Item(i));
- end;
-
- finally
- ListRanges.Items.EndUpdate;
- end;
-
- end;
-
- procedure TExcelEdit.ActionNewExecute(Sender: TObject);
- var
- v: variant;
- s:string;
- begin
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- try
- s:=format(TxtNamedRangeFormula,[v.Application.ActiveSheet.Name, v.Application.Selection.Address]);
- except
- s:='';
- end;
-
- if AddRange=nil then AddRange:=TAddRange.Create(Self);
- AddRange.InitData(s, FDataModule);
- if (AddRange.ShowModal=mrOK) and (AddRange.cbName.Text<>'') then
- begin
- v.Application.ActiveWorkbook.Names.Add(AddRange.cbName.Text, addrange.edRange.Text);
- ActionRefresh.Execute;
- end;
- end;
-
- procedure TExcelEdit.ActionDeleteExecute(Sender: TObject);
- var
- v: variant;
- r: integer;
- begin
- if ListRanges.Selected=nil then exit;
- r:=MessageBox(Handle, PCHAR(format(TxtDeleteRange,[ListRanges.Selected.Caption])),PCHAR(TxtDeleteRangeCaption),MB_YESNO+MB_ICONWARNING);
- if r<>IDYES then exit;
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- v.Application.ActiveWorkbook.Names.Item(ListRanges.Selected.Caption).Delete;
- ActionRefresh.Execute;
- end;
-
- procedure TExcelEdit.ActionDeleteUpdate(Sender: TObject);
- begin
- ActionDelete.Enabled:= ListRanges.SelCount=1;
- end;
-
- procedure TExcelEdit.ListRangesSelectItem(Sender: TObject; Item: TListItem;
- Selected: Boolean);
- var
- v, Rg: variant;
- i: integer;
- begin
- if not Selected then exit;
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- if ListRanges.Selected=nil then exit;
-
- //Search for the range. we cant use just v.Application.ActiveWorkbook.Names.Item(ListRanges.Selected.Caption).RefersToRange
- //because it finds ranges in current sheet before globals
- Rg:=Unassigned;
- for i:=1 to v.Application.ActiveWorkbook.Names.Count do
- begin
- if v.Application.ActiveWorkbook.Names.Item(i).Name=ListRanges.Selected.Caption then
- begin
- Rg:=v.Application.ActiveWorkbook.Names.Item(i).RefersToRange;
- break;
- end;
-
- end;
- if VarIsEmpty(Rg) then exit;
- v.Application.ActiveWorkbook.Sheets[Rg.Worksheet.Name].Activate;
- Rg.Select;
- end;
-
- procedure TExcelEdit.RecurseMenuTree(const ParentMenu: TMenuItem; const v: variant);
- var
- Mi: TMenuItem;
- i: integer;
- begin
- Mi:= TMenuItem.Create(ParentMenu);
- Mi.Caption:=v.Caption;
- if v.Type<>10 then Mi.Tag:=v.ID else Mi.Tag:=-1;
- Mi.OnClick:= GenericMenuAction;
- ParentMenu.Add(Mi);
- if v.Type=10 then //has submenus
- for i:=1 to v.Controls.Count do RecurseMenuTree(Mi, v.Controls.Item[i]);
- end;
-
- procedure TExcelEdit.GenericMenuAction(Sender: TObject);
- var
- v: variant;
- begin
- if (Sender is TMenuItem) and ((Sender as TMenuItem).Tag>0) then
- begin
- v:=Document.OleObject.Document;
- if VarIsEmpty(v) then exit;
- v:=v.Application.CommandBars['Worksheet Menu Bar'].FindControl(1, (Sender as TMenuItem).Tag, EmptyParam, False, True);
- if not VarIsEmpty(v) and not VarIsNull(v) and v.Enabled then v.Execute;
- end;
-
- end;
-
- end.
-