oledlgs.pas

是一个delphi的流程制作软件

  Io.cchFile := OLEUI_CCHPATHMAX;
  ZeroMemory (@Name, sizeof (Name));
  Io.lpszFile := @Name;
// Set Ole params - any missing will generate an error
  Io.oleRender := integer (FRender);
  Io.lpIOleClientSite := FClientSite;
  Io.lpIStorage := FStorage;
  Io.ppvObj := FRetObject;
// if a IID is given then use it, else use the IID ofIOleObject
  if FIID <> '' then
    Io.iid := OleStdStringToCLSID(FIID)
  else
    Io.iid := IOleObject;
// if Format is non-zero then use it, else leave the pointer at nil
  if FFormatEtc.Format <> 0 then
  begin
    with FFormatEtc do
      FormatEtc := SetFormatEtc (Format, XlatMediums (Medium), nil, XlatAspect (Aspect));
    Io.lpFormatEtc := @FormatEtc
  end;

  try
// Run the dialog
    FReturned := OLEUIInsertObject (Io);
    Result := OleUICheck (Returned, otInsertObject, Io.sc) = OLEUI_OK;

// if Ok the obtain out data
    if Result then
    begin
// recover the out flags
      FCheckLink := Io.dwFlags and IOF_CHECKLINK <> 0;
      FCheckDisplayAsIcon := Io.dwFlags and IOF_CHECKDISPLAYASICON <> 0;
      FSelectCreateNew := Io.dwFlags and IOF_SELECTCREATENEW <> 0;
      FSelectCreateFromFile := Io.dwFlags and IOF_SELECTCREATEFROMFILE <> 0;
// recover the clsid, filename, error code and metafilepict
      FCLSID := Io.CLSID;
      FFilename := Io.lpszFile;
      FSCode := Io.sc;
      FMetafile.MetaPict := Io.hMetapict
    end
  finally
    FreeMetafilePict (Io.hMetapict);
    if Assigned (Pca) then
      FreeMem (Pca, PcaSize)
  end
end;

// --- OleObjectPropsDialog ----------------------------------------------------

constructor TOleViewProps.Create;
begin
  inherited Create;
  FScaleMax := 100
end;

procedure TOleViewProps.SetFlags (Value : integer);
begin
  FSelectRelative :=  Value and VPF_SELECTRELATIVE <> 0;
  FDisableRelative :=  Value and VPF_DISABLERELATIVE <> 0;
  FDisableScale :=  Value and VPF_DISABLESCALE <> 0
end;

function TOleViewProps.GetFlags : integer;
begin
  Result := 0;
  if FSelectRelative then
    Result := Result or VPF_SELECTRELATIVE;
  if FDisableRelative then
    Result := Result or VPF_DISABLERELATIVE;
  if FDisableScale then
    Result := Result or VPF_DISABLESCALE
end;

function TOleLinkProps.GetFlags : integer;
begin
  Result := 0;
  if FShowHelp then
    Result := Result or ELF_SHOWHELP;
  if FDisableChangeSource then
    Result := Result or ELF_DISABLECHANGESOURCE;
  if FDisableOpenSource then
    Result := Result or ELF_DISABLEOPENSOURCE;
  if FDisableUpdateNow then
    Result := Result or ELF_DISABLEUPDATENOW;
  if FDisableBreakLink then
    Result := Result or ELF_DISABLECANCELLINK
end;

constructor TOleObjectPropsDialog.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
  FViewProps := TOleViewProps.Create;
  FLinkProps := TOleLinkProps.Create
end;

destructor TOleObjectPropsDialog.Destroy;
begin
  FViewProps.Free;
  FLinkProps.Free;
  inherited Destroy
end;

function TOleObjectPropsDialog.Execute : boolean;
var
  Op : TOleUIObjectProps;
  Gp : TOleUIGnrlProps;
  Vp : TOleUIViewProps;
  Lp : TOleUILinkProps;
  Ps : TPropSheetHeader;
begin
  ZeroMemory (@Op, sizeof (TOleUIObjectProps));
  Op.cbStruct := sizeof (TOleUIObjectProps);
  Op.dwFlags := 0;
  if FObjectIsLink then
  begin
    Op.dwFlags := Op.dwFlags or OPF_OBJECTISLINK;
    Op.lpLinkInfo := FLinkInfo;
    Op.dwLink := FLinkId
  end;
  if FNoFillDefault then
    Op.dwFlags := Op.dwFlags or OPF_NOFILLDEFAULT;
  if FShowHelp then
    Op.dwFlags := Op.dwFlags or OPF_SHOWHELP;
  if FDisableConvert then
    Op.dwFlags := Op.dwFlags or OPF_DISABLECONVERT;
  Op.dwObject := FObjectId;
  Op.lpObjInfo := FObjectInfo;

// Other sheets
  Op.lpGP := @Gp;
  Op.lpVP := @Vp;
  Op.lpLP := @Lp;
  Op.lpPS := @Ps;

// General Props sheet
  ZeroMemory (@Gp, sizeof (TOleUIGnrlProps));
  Gp.cbStruct := sizeof (TOleUIGnrlProps);
  Gp.lpfnHook := FHook;
  Gp.lCustData := FData;

// View Props sheet
  ZeroMemory (@Vp, sizeof (TOleUIViewProps));
  Vp.cbStruct := sizeof (TOleUIViewProps);
  Vp.dwFlags := FViewProps.Flags;
  Vp.nScaleMin := FViewProps.FScaleMin;
  Vp.nScaleMax := FViewProps.FScaleMax;
  if FObjectIsLink then
    Vp.dwFlags := Vp.dwFlags or VPF_DISABLESCALE;  // linked objects cannot scale

//  Link Props sheet
  ZeroMemory (@Lp, sizeof (TOleUILinkProps));
  Lp.cbStruct := sizeof (TOleUILinkProps);
  Lp.dwFlags := FLinkProps.Flags;

// Propsheet
  ZeroMemory (@Ps, sizeof (TPropSheetHeader));
  Ps.dwSize := sizeof (TPropSheetHeader);
  Ps.hWndParent := Application.Handle;
  Ps.hInstance := MainInstance;
  if FCaption <> '' then
    Ps.pszCaption := PChar (FCaption);

  FReturned := OleUIObjectProperties(Op);
  Result := OleUICheck (FReturned, otObjectProps) = OLEUI_OK
end;

//------------------------------------------------------------------------------

function TOleEditLinksDialog.Execute : boolean;
var
  El : TOleUIEditLinks;
begin
  InitExecute (El, sizeof (TOleUIEditLinks));
// set up flags
  if FDisableUpdateNow then
    El.dwFlags := El.dwFlags or ELF_DISABLEUPDATENOW;
  if FDisableOpenSource then
    El.dwFlags := El.dwFlags or ELF_DISABLEOPENSOURCE;
  if FDisableChangeSource then
    El.dwFlags := El.dwFlags or ELF_DISABLECHANGESOURCE;
  if FDisableBreakLink then
    El.dwFlags := El.dwFlags or ELF_DISABLECANCELLINK;
  if FShowHelp then
    El.dwFlags := El.dwFlags or ELF_SHOWHELP;
// put in call back interface
  El.OleUILinkContainer := FEditLink;

// execute dialog
  FReturned := OleUIEditLinks (El);
  Result := OleUICheck (FReturned, otEditLinks) = OLEUI_OK
end;

//--- OleUIConvert -------------------------------------------------------------

//--- Format

// Only Content and Icon aspects are valid so screen out the rest
procedure TConvertFormat.SetAspect (const Value : TClipAspect);
begin
  if Value in [caContent, caIcon] then
    inherited SetAspect (Value)
end;

//--- DefaultCLSID

function TDefaultCLSID.GetCLSID : TCLSID;
begin
  if FCLSID <> '' then
    Result := OleStdStringToCLSID (FCLSID)
  else
    Result := CLSID_NULL
end;

procedure TDefaultCLSID.SetCLSID (Value : TCLSID);
begin
  FCLSID := OleStdCLSIDToString (Value)
end;

//--- Dialog

constructor TOleConvertDialog.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
  FMetafile := TUIMetafile.Create;
  FActivateDefault := TDefaultCLSID.Create;
  FConvertDefault := TDefaultCLSID.Create;
  FFormat := TConvertFormat.Create;
  FFormat.FName := 'Bitmap';
  FFormat.FFormat := cfBitmap;
  FFormat.FAspect := caContent;
  FExclude := TStringList.Create
end;

destructor TOleConvertDialog.Destroy;
begin
  FExclude.Free;
  FConvertDefault.Free;
  FActivateDefault.Free;
  FMetafile.Free;
  FFormat.Free;
  inherited Destroy
end;

function TOleConvertDialog.Execute : boolean;
var
  Cv : TOleUIConvert;
  Pca : PCLSIDArray;
  PcaSize : integer;
begin
  InitExecute (Cv, sizeof (TOleUIConvert));
// Flags
  Cv.dwFlags := 0;
  if FShowHelp then
    Cv.dwFlags := Cv.dwFlags or CF_SHOWHELPBUTTON;
  if FActivateDefault.Active then
    Cv.dwFlags := Cv.dwFlags or CF_SETACTIVATEDEFAULT;
  if FConvertDefault.Active then
    Cv.dwFlags := Cv.dwFlags or CF_SETCONVERTDEFAULT;
  if FSelect = csConvertTo then
    Cv.dwFlags := Cv.dwFlags or CF_SELECTCONVERTTO
  else
    Cv.dwFlags := Cv.dwFlags or CF_SELECTACTIVATEAS;
  if FDisableDisplayAsIcon then
    Cv.dwFlags := Cv.dwFlags or CF_DISABLEDISPLAYASICON;
  if FDisableActivateAs then
    Cv.dwFlags := Cv.dwFlags or CF_DISABLEACTIVATEAS;
  if FHideChangeIcon then
    Cv.dwFlags := Cv.dwFlags or CF_HIDECHANGEICON;
  if FConvertOnly then
    Cv.dwFlags := Cv.dwFlags or CF_CONVERTONLY;
// various clsids (clisdii?)
  Cv.CLSID := AsCLSID;
  Cv.clsidConvertDefault := FConvertDefault.AsCLSID;
  Cv.clsidActivateDefault := FActivateDefault.AsCLSID;
// Format & Aspect
  Cv.wFormat := FFormat.FFormat;
  Cv.dvAspect := XlatAspect (FFormat.FAspect);
// Linked object?
  Cv.fIsLinkedObject := FIsLinked;
// icon aspect
  if not FMetafile.Empty then
    Cv.hMetaPict := FMetafile.MetaPict;
// Fill CLSID exclusions
  Pca := MakeCLSIDArray (FExclude, PcaSize);
  Cv.lpClsidExclude := pointer (Pca);
  Cv.cClsidExclude := FExclude.Count;
// User type name of object to convert
  if FUserType <> '' then
    Cv.lpszUserType := PChar (FUserType);
// Default icon label
  if FIconLabel <> '' then
    Cv.lpszDefLabel := PChar (FIconLabel);

  try
// Run the dialog
    FReturned := OLEUIConvert (Cv);
    Result := OleUICheck (FReturned, otConvert) = OLEUI_OK;

// if Ok the obtain out data
    if Result then
    begin
      if Cv.dwFlags and CF_SELECTCONVERTTO <> 0 then
        FSelect := csConvertTo
      else
        FSelect := csActivateAs;
      FNewCLSID := Cv.clsidNew;
      FFormat.FAspect := XlatAspect (Cv.dvAspect);
      FUserType := Cv.lpszUserType;
      FIconLabel := Cv.lpszDefLabel;
      FMetafile.MetaPict := Cv.hMetaPict;
      FIconChanged := Cv.fObjectsIconChanged
    end
  finally
    FreeMetafilePict (Cv.hMetaPict);
    if Assigned (Pca) then
      FreeMem (Pca, PcaSize)
  end
end;

procedure TOleConvertDialog.SetMetafile (Value : TUIMetafile);
begin
  FMetafile.Assign (Value)
end;

function TOleConvertDialog.StoreMetafile : boolean;
begin
  Result := FMetafile.Handle <> 0
end;

function TOleConvertDialog.GetAsCLSID : TCLSID;
begin
  if FCLSID <> '' then
    Result := OleStdStringToCLSID (FCLSID)
  else
    Result := CLSID_NULL
end;

procedure TOleConvertDialog.SetAsCLSID (Value : TCLSID);
begin
  FCLSID := OleStdCLSIDToString (Value)
end;

procedure TOleConvertDialog.SetExclude (Value : TStrings);
begin
  FExclude.Assign (Value)
end;

//--- Ole UI Change Source -----------------------------------------------------

constructor TOleChangeSourceDialog.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
  FExplorerDlg := true;
  FExplorer := true
end;

function TOleChangeSourceDialog.Execute : boolean;
var
  Cs : TOleUIChangeSource;
begin
  InitExecute (Cs, sizeof (TOleUIChangeSource));
  if FShowHelp then
    Cs.dwFlags := Cs.dwFlags or CSF_SHOWHELP;
  if FOnlyGetSource then
    Cs.dwFlags := Cs.dwFlags or CSF_ONLYGETSOURCE;
  if FExplorer then
    Cs.dwFlags := Cs.dwFlags or CSF_EXPLORER;

  Cs.lpOleUILinkContainer := FLinkContainer;
  Cs.dwLink := FLink;
  Cs.lpszDisplayName := PChar (FDisplayName);
  Cs.nFileLength := FFileLength;

  FReturned := OLEUIChangeSource (Cs);
  Result := OleUICheck (FReturned, otChangeSource) = OLEUI_OK;

// if Ok the obtain out data
  if Result then
  begin
    FValidSource := Cs.dwFlags and CSF_VALIDSOURCE <> 0;
    FDisplayName := Cs.lpszDisplayName;
    FFileLength := Cs.nFileLength;
    FFromName := Cs.lpszFrom;
    FToName := Cs.lpszTo
  end
end;

//--- OleUIPromptUserDialog ---------------------------------------------------

function OleStdPromptUser (Style : TOlePromptUserStyle; Caption : string;
  Param : string = '') : TOleUserReturn;
const
  XlatStyle : array [TOlePromptUserStyle] of integer =
    (IDD_LINKSOURCEUNAVAILABLE, IDD_CANNOTUPDATELINK, IDD_SERVERNOTREG,
     IDD_SERVERNOTFOUND, IDD_OUTOFMEMORY, IDD_LINKTYPECHANGED);
var
  Ret : integer;
var
  Buffer : array [0..255] of WideChar; //@@  convert to..
begin
  if Param = '' then
    Param := '<Unknown Object>';
  Ret := OleUIPromptUser (XlatStyle[Style], Application.Handle, PChar (Caption),
    StringToWideChar (Param, Buffer, SizeOf(Buffer) div 2));
  case Ret of
    OLEUI_FALSE     : Result := urFalse;
    OLEUI_OK        : Result := urOk;      // ok button pressed
    OLEUI_CANCEL    : Result := urCancel;  // dialog closed
    IDC_OLEUIHELP   : Result := urHelp;    // Help button pressed
    IDC_PU_LINKS    : Result := urLinks;   // Links... button pressed
    IDC_PU_CONVERT  : Result := urConvert  // Convert... button pressed
  else
    Result:= urFalse;   // error occured
    OleUICheck (Ret, otPromptUser)
  end
end;

function TOlePromptUserDialog.Execute : TOleUserReturn;
begin
  Result := OleStdPromptUser (FStyle, FCaption, FParam)
end;

//--- Ole UI Update Links Dialog -----------------------------------------------

function TOleUpdateLinksDialog.Execute : boolean;
begin
  if (FCount > 0) and Assigned (FLinks) then
    if FCaption = '' then
      Result := OleUIUpdateLinks (FLinks, Application.Handle, nil, FCount)
    else
      Result := OleUIUpdateLinks (FLinks, Application.Handle, PChar (FCaption), FCount)
  else
    Result := false
end;

//--- API calls not in OleDlg --------------------------------------------------

const
  OleDlgDLL = 'oledlg.dll';

function OleUIPromptUser;   external OleDlgDLL name 'OleUIPromptUserA';
function OleUIUpdateLinks;  external OleDlgDLL name 'OleUIUpdateLinksA';
function OleUIChangeSource; external OleDlgDLL name 'OleUIChangeSourceA';

end.