[solved]: LazActiveX/TEvsWebBrowser/WYSIWYG Editor Problem with MSHMTL
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
musicones · 2013-01-11 15:20

Hi,

I'm working on an little WYSIWYG HTML Editor by using ActiveX and
TEvsWebBrowser in Lazarus 1.1/FPC 2.6.1.
The easy formating things work nice, like align (left, center, right),
bold, italic.

Now I wanted to implement FormatBlocks  to format an block, lets say
with HEADER 1.
To do that I would like to read out the possible format styles. It's
possible, but a lot of people stucked translating mshtml to pascal,
the most talks in web are about delphi style.

So I tried one, maybe possible solution, to fit into freepascal, but I
get an error message I don't know how to handle.
Maybe someone of you is a bit more in and knows a solution, or can say
if it is an bug, or an not completed feature of freepascal, so lets
see.

Here is an procedure i execute on a button click for testing purposes.
Aim is to read out the styles I need to use as params for
blockformating.

Complete procedure:
Code: [Select]procedure THTMLEditorView.FillStylesCombo;
const
  IDM_GETBLOCKFMTS = 2233;
  GUID_TriEditCommandGroup: TGUID =
'{2582F1C0-084E-11d1-9A0E-006097C9B344}';
  CMDSETID_Forms3: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';
var
  CommandTarget: IOleCommandTarget;
  MyHResult: HRESULT;
  MyVariant, varRange, oNULL: OleVariant;
  Ps: PSafeArray;
  Warr: array of WideString;
  sCommands: string;
  StrCount, I: integer;
  Pw: PWideChar;
begin
  ONull := Null;

  // making the variant a VariantArray
  TVariantArg(MyVariant).vt := VT_ARRAY;

  //if that doesn't works try @CMDSETID_Forms3 in stead of
@GUID_TriEditCommandGroup.
  {
  TVariantArg(vo).vt := vt_bstr;
  TVariantArg(vo).bStrVal := nil;
  Hr := CommandTarget.Exec(@CMDSETID_Forms3, IDM_BLOCKFMT,
  OLECMDEXECOPT_DONTPROMPTUSER, NullVariant, Va);
  }

  MyHResult := CommandTarget.Exec(
    CMDSETID_Forms3,
    IDM_GETBLOCKFMTS,
    OLECMDEXECOPT_DONTPROMPTUSER,
    ONull,
    MyVariant);


(*
  if (MyHResult = S_OK) then
  begin
    //get a pointer to the SafeArray
    Ps := TVariantArg(VarRange).pArray;

    //Get number of strings in the SafeArray

    StrCount := TSAFEARRAYBOUND(Ps^.rgsabound).cElements;

    //make room fore all the strings in our WideString array
    SetLength(Warr, StrCount);
    try
      //lock the SafeArray = no risk of memory reallocation during
      Inc(Ps^.cLocks);
      //copy the SafeArray-Strings to the WideString array
      //Ps.pvData points to start of the SafeArrays Data-segment
      //Ps.cbElements = size of each record = a PWideChar
      CopyMemory(@Warr[0], Ps^.pvData, I * 4 {Ps.cbElements});
    finally
      Dec(Ps^.cLocks); //unlock the SafeArray
    end;

    sCommands := '';

    //get each string from the WideString array
    for I := 0 to StrCount do sCommands := sCommands + Warr[I] +
#13#10;
  end
  else
    sCommands := 'GetBlockFmts error';

  showInfo(sCommands);
*)

(*
  //then the API-call way
  if (MyHResult = S_OK) then
  begin
    //get a pointer to the SafeArray
    Ps := TVariantArg(VarRange).pArray;

    sCommands := '';

    for I := VarArrayLowBound(VarRange, 1) to
VarArrayHighBound(VarRange, 1) do
    begin
      //get each string from the SafeArray
      SafeArrayGetElement(Ps, PLongInt(I), Pw);
      sCommands := sCommands + Pw + #13#10;
    end;
  end
  else
    sCommands := 'GetBlockFmts error';

  showInfo(sCommands);

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


*)

end;      

problematic code:
Code: [Select]  MyHResult := CommandTarget.Exec(
    CMDSETID_Forms3,
    IDM_GETBLOCKFMTS,
    OLECMDEXECOPT_DONTPROMPTUSER,
    ONull,
    MyVariant);

It results into an "Access violation".

I can not say more, because it is not possible to debug the code.
That is because the application doesn't work starting it in lazarus.
It seems to be a problem with activeX container or the TEvsWebBrowser.
When i start the application in the ide i get an error in the moment i
click on into the editor. So i can start the application only without
ide (click on exe).

First Problem solved: CommandTarget was not initialized here is the
initialization code:

Code: [Select]CommandTarget := (Document as IOleCommandTarget);....

Now the next Problem:
Code: [Select]  if (MyHResult = S_OK) then
  begin
    TVariantArg(ValOUT).VT := VT_BYREF or VT_SAFEARRAY;

//    Val := PSafeArray(TVariantArg(ValOUT).ppArray);
    Val := PSafeArray(TVariantArg(ValOUT).pArray);

    S := '';

    // count of the array elements
   ActiveX.SafeArrayGetLBound(Val, 1, iMin);
   ActiveX.SafeArrayGetUBound(Val, 1, iMax);

    for I := iMin to iMax - 1 do
    begin
      //get each string from the SafeArray
      MyHResult := SafeArrayGetElement(Val, PLongInt(I), sBuffer);

      case MyHResult of
        S_OK: S := S + sBuffer + #13#10;
        DISP_E_BADINDEX: S := S + 'The specified index is invalid: ' +
IntToStr(I) + #10#13;
        E_INVALIDARG: S := S + 'One of the arguments is invalid: ' +
IntToStr(I) + #10#13;
        E_OUTOFMEMORY: S := S + 'Memory could not be allocated for the
element: ' + IntToStr(I) + #10#13;
        else S := S + 'other error: ' + IntToStr(I) + #10#13;
      end;
    end;
  end
  else
    S := 'GetBlockFmts error';

  showInfo(S);    

It runs into E_INVALIDARG and I can't figure out why...

thank you

regards
Antonio

----------------------------------------------------------------------
musicones · 2013-01-16 10:00

Code: [Select]procedure THTMLEditorView.FillStylesCombo2;
type
  TWideStringArray = Array of WideString;

  function SafeArrayAsStringArray(ar: PSafeArray): TWideStringArray;
  var
    lb, ub, i: Integer;
    ind: array [0..0] of Integer;
  begin
    SafeArrayGetLBound(ar, 1, lb);
    SafeArrayGetUBound(ar, 1, ub);
    SetLength(result, ub-lb+1);

    for i := lb to ub do
    begin
      ind[0] := i;
      SafeArrayGetElement(ar, @ind, result[i-lb]);
    end;
  end;

const
  IDM_GETBLOCKFMTS = 2233;
  CMDSETID_Forms3: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';
var
  CommandTarget: IOleCommandTarget;
  ListOfFormats: OleVariant;
  SafeListOfFormats: PSafeArray;
  StringListOfFormats: TWideStringArray;
  MyHResult: HResult;
  S: string;
  i: Integer;
begin
  { Initialize variable }
  S := EmptyStr;

  { cast document as IOleCommandTarget }
  CommandTarget := (Document as IOleCommandTarget);

  { prepare OleVariant ListOfFormats }
  TVariantArg(ListOfFormats).VT := VT_BYREF or VT_SAFEARRAY;
  TVariantArg(ListOfFormats).ppArray := nil;

  { Read the list of formats into ListOfFormats }
  MyHResult := CommandTarget.Exec(
    CMDSETID_Forms3,
    IDM_GETBLOCKFMTS,
    OLECMDEXECOPT_DONTPROMPTUSER,
    EmptyParam,
    ListOfFormats
  );

  { if CommandTarget.Exec was successfull, get the listitems }
  if (MyHResult = S_OK) then
  begin
    // set varType again
    TVariantArg(ListOfFormats).VT := VT_BYREF or VT_SAFEARRAY;

    { OleVariant as SafeArray }
    SafeListOfFormats :=
PSafeArray(TVariantArg(ListOfFormats).ppArray);

    { Copy elements of safearray into stringarray }
    StringListOfFormats := SafeArrayAsStringArray(SafeListOfFormats);

    { go through stringarray and read elements into an string for
testing purposes }
    for i := Low(StringListOfFormats) to High(StringListOfFormats) do
    begin
       S := S + StringListOfFormats[i] + LineEnding;
    end;

    showMessage(S);
  end;
end;    

One little problem reamins, umlauts are not displayed correctly.
For example "Überschrift 1" is displayed as "?berschrift1"