jvrichedit.pas

East make Tray Icon in delphi

  CFU_UNDERLINELONGDASH = 13; // (*) display as dash
  CFU_UNDERLINEHEAVYWAVE = 12; // (*) display as wave
  CFU_UNDERLINEDOUBLEWAVE = 11; // (*) display as wave
  CFU_UNDERLINEHAIRLINE = 10; // (*) display as single
  CFU_UNDERLINETHICK = 9;
  CFU_UNDERLINEWAVE = 8;
  CFU_UNDERLINEDASHDOTDOT = 7;
  CFU_UNDERLINEDASHDOT = 6;
  CFU_UNDERLINEDASH = 5;
  CFU_UNDERLINEDOTTED = 4;
  CFU_UNDERLINEDOUBLE = 3; // (*) display as single
  CFU_UNDERLINEWORD = 2; // (*) display as single
  CFU_UNDERLINE = 1;
  CFU_UNDERLINENONE = 0;

  AttrFlags: array[TJvAttributeType] of Word =
  (0, SCF_SELECTION, SCF_WORD or SCF_SELECTION);

  CF_EMBEDDEDOBJECT = 'Embedded Object';
  CF_LINKSOURCE = 'Link Source';

  EM_GETZOOM = (WM_USER + 224);
  EM_SETZOOM = (WM_USER + 225);

  // Some masks for tab alignment and leader handling
  // Note: not the official names which I don't know

  TA_ALIGNMENT = $0F000000; // Bits 24-27
  TA_LEADER = $F0000000; // Bits 28-31
  //TA_ALL       = $FF000000; // Bits 24-31
  TA_TAB = $00FFFFFF; // Tab: bits 0-23
  TA_TAB_LEADER = (TA_TAB or TA_LEADER);
  TA_TAB_ALIGNMENT = (TA_TAB or TA_ALIGNMENT);

  { Flags to specify which interfaces should be returned in the structure above }

  REO_GETOBJ_NO_INTERFACES = $00000000;
  REO_GETOBJ_POLEOBJ = $00000001;
  REO_GETOBJ_PSTG = $00000002;
  REO_GETOBJ_POLESITE = $00000004;
  REO_GETOBJ_ALL_INTERFACES = $00000007;

  { Place object at selection }

  REO_CP_SELECTION = ULONG(-1);

  { Use character position to specify object instead of index }

  REO_IOB_SELECTION = ULONG(-1);
  REO_IOB_USE_CP = ULONG(-2);

  { Object flags }

  REO_NULL = $00000000; { No flags                         }
  REO_READWRITEMASK = $0000003F; { Mask out RO bits                 }
  REO_DONTNEEDPALETTE = $00000020; { Object doesn't need palette      }
  REO_BLANK = $00000010; { Object is blank                  }
  REO_DYNAMICSIZE = $00000008; { Object defines size always       }
  REO_INVERTEDSELECT = $00000004; { Object drawn all inverted if sel }
  REO_BELOWBASELINE = $00000002; { Object sits below the baseline   }
  REO_RESIZABLE = $00000001; { Object may be resized            }
  REO_LINK = $80000000; { Object is a link (RO)            }
  REO_STATIC = $40000000; { Object is static (RO)            }
  REO_SELECTED = $08000000; { Object selected (RO)             }
  REO_OPEN = $04000000; { Object open in its server (RO)   }
  REO_INPLACEACTIVE = $02000000; { Object in place active (RO)      }
  REO_HILITED = $01000000; { Object is to be hilited (RO)     }
  REO_LINKAVAILABLE = $00800000; { Link believed available (RO)     }
  REO_GETMETAFILE = $00400000; { Object requires metafile (RO)    }

  { Flags for IRichEditOle.GetClipboardData,   }
  { IRichEditOleCallback.GetClipboardData and  }
  { IRichEditOleCallback.QueryAcceptData       }

  RECO_PASTE = $00000000; { paste from clipboard  }
  RECO_DROP = $00000001; { drop                  }
  RECO_COPY = $00000002; { copy to the clipboard }
  RECO_CUT = $00000003; { cut to the clipboard  }
  RECO_DRAG = $00000004; { drag                  }

  ReadError = $0001;
  WriteError = $0002;
  NoError = $0000;

  RichLangOptions: array[TRichLangOption] of DWORD = (IMF_AUTOKEYBOARD,
    IMF_AUTOFONT, IMF_IMECANCELCOMPLETE, IMF_IMEALWAYSSENDNOTIFY);

  CHex: array[0..$F] of Char =
  ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
    'A', 'B', 'C', 'D', 'E', 'F');

  { Converter API names }

  ForeignToRtf32Name = 'ForeignToRtf32';
  InitConverter32Name = 'InitConverter32';
  IsFormatCorrect32Name = 'IsFormatCorrect32';
  RtfToForeign32Name = 'RtfToForeign32';
  UninitConverterName = 'UninitConverter';
  CchFetchLpszErrorName = 'CchFetchLpszError';

  CConvertBufferSize = $1004;

var
  { Clipboard formats }
  CFEmbeddedObject: Integer;
  CFLinkSource: Integer;
  CFRtf: Integer;
  CFRtfNoObjs: Integer;

  { Global converter vars }
  GlobalConversionFormatList: TConversionFormatList = nil;
  GCurrentConverter: TJvMSTextConversion = nil;
  GMSTextConvertersRegistered: Boolean;

  Painting: Boolean = False;

//=== Local procedures =======================================================

function GConversionFormatList: TConversionFormatList;
begin
  if not Assigned(GlobalConversionFormatList) then
    GlobalConversionFormatList := TConversionFormatList.Create;
  Result := GlobalConversionFormatList;
end;

function GetParentWindow(Control: TControl): THandle;
begin
  if Control <> nil then
    Control := GetParentForm(Control);

  if Control is TWinControl then
    Result := TWinControl(Control).Handle
  else
    Result := Application.Handle;
end;

{ OLE utility routines }

function WStrLen(Str: PWideChar): Integer;
begin
  Result := 0;
  while Str[Result] <> #0 do
    Inc(Result);
end;

procedure ReleaseObject(var Obj);
begin
  if IUnknown(Obj) <> nil then
  begin
    IUnknown(Obj) := nil;
  end;
end;

procedure CreateStorage(var Storage: IStorage);
var
  LockBytes: ILockBytes;
begin
  OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
  try
    OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
      STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage));
  finally
    ReleaseObject(LockBytes);
  end;
end;

procedure DestroyMetaPict(MetaPict: HGLOBAL);
begin
  if MetaPict <> 0 then
  begin
    DeleteMetaFile(PMetafilePict(GlobalLock(MetaPict))^.hMF);
    GlobalUnlock(MetaPict);
    GlobalFree(MetaPict);
  end;
end;

function OleSetDrawAspect(OleObject: IOleObject; Iconic: Boolean;
  IconMetaPict: HGLOBAL; var DrawAspect: Longint): HRESULT;
var
  OleCache: IOleCache;
  EnumStatData: IEnumStatData;
  OldAspect, AdviseFlags, Connection: Longint;
  TempMetaPict: HGLOBAL;
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  ClassID: TCLSID;
  StatData: TStatData;
begin
  Result := S_OK;
  OldAspect := DrawAspect;
  if Iconic then
  begin
    DrawAspect := DVASPECT_ICON;
    AdviseFlags := ADVF_NODATA;
  end
  else
  begin
    DrawAspect := DVASPECT_CONTENT;
    AdviseFlags := ADVF_PRIMEFIRST;
  end;
  if (DrawAspect <> OldAspect) or (DrawAspect = DVASPECT_ICON) then
  begin
    Result := OleObject.QueryInterface(IOleCache, OleCache);
    if Succeeded(Result) then
    try
      if DrawAspect <> OldAspect then
      begin
        { Setup new cache with the new aspect }
        FillChar(FormatEtc, SizeOf(FormatEtc), 0);
        FormatEtc.dwAspect := DrawAspect;
        FormatEtc.lindex := -1;
        Result := OleCache.Cache(FormatEtc, AdviseFlags, Connection);
      end;
      if Succeeded(Result) and (DrawAspect = DVASPECT_ICON) then
      begin
        TempMetaPict := 0;
        if IconMetaPict = 0 then
        begin
          if Succeeded(OleObject.GetUserClassID(ClassID)) then
          begin
            TempMetaPict := OleGetIconOfClass(ClassID, nil, True);
            IconMetaPict := TempMetaPict;
          end;
        end;
        try
          FormatEtc.cfFormat := CF_METAFILEPICT;
          FormatEtc.ptd := nil;
          FormatEtc.dwAspect := DVASPECT_ICON;
          FormatEtc.lindex := -1;
          FormatEtc.tymed := TYMED_MFPICT;
          Medium.tymed := TYMED_MFPICT;
          Medium.hMetaFilePict := IconMetaPict;
          Medium.unkForRelease := nil;
          Result := OleCache.SetData(FormatEtc, Medium, False);
        finally
          DestroyMetaPict(TempMetaPict);
        end;
      end;
      if Succeeded(Result) and (DrawAspect <> OldAspect) then
      begin
        { remove any existing caches that are set up for the old display aspect }
        OleCache.EnumCache(EnumStatData);
        if EnumStatData <> nil then
        try
          while EnumStatData.Next(1, StatData, nil) = 0 do
            if StatData.FormatEtc.dwAspect = OldAspect then
              OleCache.Uncache(StatData.dwConnection);
        finally
          ReleaseObject(EnumStatData);
        end;
      end;
    finally
      ReleaseObject(OleCache);
    end;
    if Succeeded(Result) and (DrawAspect <> DVASPECT_ICON) then
      OleObject.Update;
  end;
end;

function GetIconMetaPict(OleObject: IOleObject; DrawAspect: Longint): HGLOBAL;
var
  DataObject: IDataObject;
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  ClassID: TCLSID;
begin
  Result := 0;
  if DrawAspect = DVASPECT_ICON then
  begin
    OleObject.QueryInterface(IDataObject, DataObject);
    if DataObject <> nil then
    begin
      FormatEtc.cfFormat := CF_METAFILEPICT;
      FormatEtc.ptd := nil;
      FormatEtc.dwAspect := DVASPECT_ICON;
      FormatEtc.lindex := -1;
      FormatEtc.tymed := TYMED_MFPICT;
      if Succeeded(DataObject.GetData(FormatEtc, Medium)) then
        Result := Medium.hMetaFilePict;
      ReleaseObject(DataObject);
    end;
  end;
  if Result = 0 then
  begin
    OleCheck(OleObject.GetUserClassID(ClassID));
    Result := OleGetIconOfClass(ClassID, nil, True);
  end;
end;

{ Return the first piece of a moniker }

function OleStdGetFirstMoniker(Moniker: IMoniker): IMoniker;
var
  Mksys: Longint;
  EnumMoniker: IEnumMoniker;
begin
  Result := nil;
  if Moniker <> nil then
  begin
    if (Moniker.IsSystemMoniker(Mksys) = 0) and
      (Mksys = MKSYS_GENERICCOMPOSITE) then
    begin
      if Moniker.Enum(True, EnumMoniker) <> 0 then
        Exit;
      EnumMoniker.Next(1, Result, nil);
      ReleaseObject(EnumMoniker);
    end
    else
    begin