Jump to content


Photo

Auto-Adjust ?


  • Please log in to reply
58 replies to this topic

#41 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 19 March 2008 - 02:18 PM

Here is the line of text asked.

Attached Files



#42 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 19 March 2008 - 08:12 PM

Hello Dersen,

Maybe you should try to download latest release. I remember that I have work on this issue and this sample text work correctly in my (latest) release.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#43 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 20 March 2008 - 05:26 PM

I just install it and test it, but it makes me go back to the problem with the wordwrap that is not well managed by the component TNxHtmlColumn..

#44 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 20 March 2008 - 08:25 PM

Hello Dersen,

You may apply again your code that you have used before.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#45 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 22 March 2008 - 04:27 PM

Unfortunately not, I have the problem of wordwrap, or my display problem in italic characters, and this with my code as I expect, therefore, that your constituents properly manage the wordwrap which resolved all my current problems with the TNxHtmlColumn component.

If I do not continue a disturbing you with this.

#46 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 24 March 2008 - 10:57 PM

Hello Dersen,

I am not sure that I understand correctly your post. Automatic Word-wrap support in Html Column require a lot of time to be implemented. Existing code must be re-written which require more time.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#47 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 25 March 2008 - 11:20 PM

Yes This is essentially I need: Automatic Word-wrap support in Html Column and auto height to!

#48 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 25 March 2008 - 11:24 PM

Hello Dersen,

But as I have say I will need time to implement it.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#49 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 22 April 2008 - 01:37 PM

What new for this ?

#50 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 22 April 2008 - 03:26 PM

Hello Dergen,

Nothing yet. I will notify you when it is done, please make sure that this is a hard feature to implement.
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#51 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 05 May 2008 - 01:37 PM

I know well, but my client is not patient!

What should I tell him to do it wait?

#52 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 05 May 2008 - 03:24 PM

Hello Dergen,

I really wouldn't go with new code too soon because I will brake current code completelly. I hope that your client may understand.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#53 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 09 June 2008 - 05:19 PM

The version out Jun 10 2008, fixed this bug?

#54 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 09 June 2008 - 05:23 PM

Hello,

No, it is not fixed/added yet. I will notify you when it is added. I really don't want to rush with this feature.

It is not hard to wrap in middle of word, but to wrap complete word it will require a lot of rewriting.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#55 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 09 June 2008 - 06:54 PM

Hello,

I have do some test again and this feature will really need a lot of time to be added, and html draw procedure need to be rewriten. I suggest leaving this feature until its done.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#56 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 04 October 2008 - 05:43 PM

QUOTE (Boki (Berg) @ Jun 9 2008, 07:54 PM) <{POST_SNAPBACK}>
Hello,

I have do some test again and this feature will really need a lot of time to be added, and html draw procedure need to be rewriten. I suggest leaving this feature until its done.

Best regards


Look me solution:

CODE
procedure TMainDemo.DBAdvGrid1CustomDrawCell(Sender: TObject;
  ACol, ARow: Integer; CellRect: TRect; CellState: TCellState);
Var
  H: Integer;
begin
  if DBAdvGrid1.Columns[ACol].Field <> nil then
  begin
    DBAdvGrid1.Canvas.Font := DBAdvGrid1.Columns[ACol].Font;
    H := TextHTMLOut(DBAdvGrid1.Canvas, CellRect.Left + 3, CellRect.Top + 3, DBAdvGrid1.Columns[ACol].Width - 6, DBAdvGrid1.Columns[ACol].Field.AsString);
  end;
end;



Function TextHTMLOut(CanvasCible: TCanvas; X, Y, Largeur: Integer; Chaine: String; AvecMarques: Boolean = False): Integer;
Var
  Car, Car2 : String[1];
  W, xx, Xc, i, iPrec, II, iii, J, HMax, HMin, HH, DX : Integer;
  Balise, SB : ShortString;
  FS : TFontStyles;
  ExCL : TColor;
  DW : DWord;
  Count : Byte;
  TelQuel : String;
  SS : ShortString;
  Alignement : Char;
  Rect, Rect2 : Trect;
  BitMap : TBitMap;
  Image : TJpegImage;
  Mots : Array of ShortString;
  XEspace : Integer;
  CursorPos, MotLength, Ajouter : Integer;
  ExName  : ShortString;
  ExStyle : TFontStyles;
  ExColor : Tcolor;
  ExSize  : Integer;
  Dernxx : Integer;
  OriFont: TFont;
Begin
  OriFont := CanvasCible.Font;
  DernXX := 0;
  SetLength(TableauDesLiens,0);
  SetLength(TableauDesCursorPos,0);
  SetLength(Fontes,0);
  Xc := X;
  Largeur := xc +Largeur;
  I := 1;
  Alignement := 'L';
  HMin := CanvasCible.TextHeight('W');
  CanvasCible.Brush.Style := bsClear;
  TelQuel := '';
  While I<=Length(Chaine) do
  Begin
    Car := Copy(Chaine,I,1);
    If Car = '<' then
    Begin
      If Telquel<>'' then
      Begin
        CursorPos := I-Length(TelQuel);
        SetLength(Mots,0);
        While Pos(' ',TelQuel)>0 do
        Begin
          SetLength(Mots,Length(Mots)+1);
          Mots[Length(Mots)-1] := Copy(TelQuel,1,Pos(' ',TelQuel));
          Delete(TelQuel,1,Pos(' ',TelQuel));
        End;
        If Telquel<>'' then
        Begin
          SetLength(Mots,Length(Mots)+1);
          Mots[Length(Mots)-1] := Telquel;
          TelQuel := '';
        End;
        For Ii := 1 to Length(Mots) do
        Begin
          MotLength := Length(Mots[ii-1]);
          Ajouter := HTMLVersTxt(Mots[ii-1]);
          If (X+CanvasCible.TextWidth(Mots[ii-1])>Largeur) and
             (X<>XC) then
          Begin
            If XEspace>XC then
            Begin
              Rect.Left := XEspace;
              Rect.Right := X;
              Rect.Top := Y;
              Rect.Bottom := Y + Hmax;
              Rect2.Left := XC;
              Rect2.Right := X + Xc - Xespace;
              Rect2.Top := Rect.Bottom;
              Rect2.Bottom := Rect2.Top+ Hmax ;
              CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
              CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
              CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
              CanvasCible.Brush.style := bsSolid;
              CanvasCible.Rectangle(Rect);
              CanvasCible.Brush.style := bsClear;
            End;
            Rect.Left := Xc;
            Rect.Right := X;
            If XEspace>XC then
            Begin
              X := Rect2.Right;
              XEspace := Rect2.Right;
            End Else
            Begin
              X := Xc;
              XEspace := XC;
            End;
            Rect.Top := Y;
            If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
            Hmax := 0;
            Rect.Bottom := Y;
            DX := 0;
            If Alignement='R' then DX := Largeur - Rect.Right;
            If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
            Rect2 := Rect;
            Rect2.Left := Rect2.Left + DX;
            Rect2.Right := Rect2.Right + DX;
            If Alignement<>'L' then
            Begin
              CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
              CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
              CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
              CanvasCible.Brush.style := bsSolid;
              Rect.Right := Rect.Left + DX;
              CanvasCible.Rectangle(Rect);
              CanvasCible.Brush.style := bsClear;
              For iii := 1 to Length(TableauDesCursorPos) do
              Begin
                If TableauDesCursorPos[iii-1].Yd=Rect.Top then
                Begin
                  TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
                  TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
                End;
              End;
            End;
          End;
          SetLength(TableauDesCursorPos,Length(TableauDesCursorPos)+1);
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].Name := CanvasCible.Font.Name;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].Size := CanvasCible.Font.Size;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].Color := CanvasCible.Font.Color;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].Style := CanvasCible.Font.Style;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].xd := x;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].yd := y;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].CursorPos := CursorPos;
          CursorPos := CursorPos + MotLength;
          iPrec := i;
          CanvasCible.TextOut(X,Y,Mots[ii-1]);
          X := X  +  CanvasCible.TextWidth(Mots[ii-1]);
          If Pos(' ',Mots[ii-1])>0 then XEspace := X-1;
          If HMax < CanvasCible.TextHeight(Mots[ii-1])
                                       then HMax := CanvasCible.TextHeight(Mots[ii-1]);
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].xf := x;
          TableauDesCursorPos[Length(TableauDesCursorPos)-1].yf := Y + HMax;
        End;
      End;
      If AvecMarques  and (DernXX<>x)then
      Begin
        Balise := Copy(Chaine,i+1,6);
        Car2 := Copy(Chaine,I+1,1);
        CanvasCible.Brush.Color := clYellow;
        If car2='/' then
        Begin
          xx := x-1;
          Car2 := Copy(Chaine,I+2,1);
          Balise := Copy(Chaine,i+2,6);
        End else
        Begin
          xx := x;
          Balise := Majuscule(Balise);
          If (Pos('HEAD',Balise)<>1) and
             (Pos('HTML',Balise)<>1) and
             (Pos('HR',Balise)<>1) then
          Begin
            // Trait
            DernXX := X;
            ExColor := CanvasCible.Pen.Color;
            CanvasCible.Pen.Color := clGray;
            CanvasCible.MoveTo(xx,Y);
            CanvasCible.Lineto(xx,Y+HMax);
            CanvasCible.Pen.Color := ExColor;
            // Balise
            if xx <> x then
              xx := xx - 5
            else
              xx := x +1;

            ExName  := CanvasCible.Font.Name ;
            ExStyle := CanvasCible.Font.Style;
            ExColor := CanvasCible.Font.Color;
            ExSize  := CanvasCible.Font.Size ;
            CanvasCible.Font.Name  := OriFont.Name;
            CanvasCible.Font.Style := OriFont.Style;
            CanvasCible.Font.Color := OriFont.Color;
            CanvasCible.Font.Size  := OriFont.Size;
            Case Car2[1] of
              'B' : If Pos('B>',Balise)=1 then CanvasCible.Font.Style := [fsBold] else CanvasCible.Font.Color := clPurple;
              'U' : CanvasCible.Font.Style := [fsUnderline];
              'I' : if Pos('IMG',Balise)=1 then CanvasCible.Font.Color := clGreen else CanvasCible.Font.Style := [fsItalic];
              'F' : CanvasCible.Font.Color := clBlue;
              'P' : CanvasCible.Font.Color := clPurple;
              'A' : CanvasCible.Font.Color := clRed;
            end;
            CanvasCible.TextOut(xx,y,Car2);
            CanvasCible.Font.Name  := ExName ;
            CanvasCible.Font.Style := ExStyle;
            CanvasCible.Font.Color := ExColor;
            CanvasCible.Font.Size  := ExSize ;
            CanvasCible.Brush.Style := bsClear;
          End;
        End;
      End;
      Balise := Car;
      While Car<>'>' do
      Begin
        Inc(I);
        Car := Copy(Chaine,I,1);
        Balise := Balise + Car;
      End;
      Inc(i);
      While Pos('< ',Balise)>0 do RemplaceA('< ','<',Balise);
      While Pos(' >',Balise)>0 do RemplaceA(' >','>',Balise);
      If (Pos('<FONT',Majuscule(Balise)) = 1) then
      Begin
        SetLength(Fontes,Length(Fontes)+1);
        Fontes[Length(Fontes)-1].Name := CanvasCible.Font.Name;
        Fontes[Length(Fontes)-1].Style := CanvasCible.Font.Style;
        Fontes[Length(Fontes)-1].Color := CanvasCible.Font.Color;
        Fontes[Length(Fontes)-1].Size := CanvasCible.Font.Size;
        Delete(Balise,1,5);
        RemplaceA('>',' ',Balise);
        While Pos(' =',Balise)>0 do RemplaceA(' =','=',Balise);
        While Pos('= ',Balise)>0 do RemplaceA('= ','=',Balise);
        ElagueLesEspaces(Balise);
        While Balise<>'' do
        Begin
          If Pos('COLOR=',Majuscule(Balise))=1 then
          Begin
            Delete(Balise,1,6);
            If Pos(' ',Balise)>0 then
            Begin
              SB := Copy(Balise,1,Pos(' ',Balise)-1);
              Delete(Balise,1,Pos(' ',Balise));
            End
            Else
            Begin
              SB := Balise;
              Balise := '';
            End;
            If Pos('#',SB)=1 then
            Begin
              SB[1] := '$';
              DW := StrToInt(SB);
              DW := (DW and $FF) shl 16
                  + (DW and $FF00)
                  + (DW and $FF0000) shr 16;
              CanvasCible.Font.Color := TColor(DW);
            End
            Else
            Begin
              CanvasCible.Font.Color := TranslateColorName(LowerCase(SB));
            End;
          End
          else
          If (Pos('FACE=',Majuscule(Balise))=1) or (Pos('NAME=',Majuscule(Balise)) = 1) then
          Begin
            Delete(Balise,1,5);
            Count := 0;
            SB := '';
            While Count<2 do
            Begin
              Car := Copy(Balise,1,1);
              Delete(Balise,1,1);
              If Car='"' then Inc(Count);
              SB := SB + Car;
              If Balise='' then Count := 2;
            End;
            Delete(SB,1,1) ;
            Dec(SB[0]);
            CanvasCible.Font.Name := SB;
          End
          else
          If (Pos('SIZE=',Majuscule(Balise)) = 1)  then
          Begin
            Delete(Balise,1,5);
            Count := 0;
            SB := '';
            If Balise[1]<>'"' then
            Begin
              Insert('"',Balise,1);
              If Pos(' ',Balise)>1 then
                Insert('"',Balise,Pos(' ',Balise)) else Balise := Balise + '"';
            End;
            While Count<2 do
            Begin
              Car := Copy(Balise,1,1);
              Delete(Balise,1,1);
              If Car='"' then Inc(Count);
              SB := SB + Car;
              If Balise='' then Count := 2;
            End;
            Delete(SB,1,1) ;
            Dec(SB[0]);
            If StrToInt(SB)<8 then
              CanvasCible.Font.Size := StrToInt(SB) * 4 else CanvasCible.Font.Size := StrToInt(SB);
          End
          else
          While Balise[1]<>' ' do
          Begin
            Balise[1] := ' ';
            Delete(Balise,1,1);
          End;
          ElagueLesEspaces(Balise);
        End;
      End
      Else
      If (Pos('</FONT',Majuscule(Balise)) = 1) then
      Begin
        If Length(Fontes) > 0 then
        Begin
          CanvasCible.Font.Name  := Fontes[Length(Fontes)-1].Name;
          CanvasCible.Font.Style := Fontes[Length(Fontes)-1].Style;
          CanvasCible.Font.Color := Fontes[Length(Fontes)-1].Color;
          CanvasCible.Font.Size  := Fontes[Length(Fontes)-1].Size;
          SetLength(Fontes,Length(Fontes)-1);
        End;
      End
      else
      If (Pos('<A',Majuscule(Balise)) = 1) then
      Begin
        SetLength(Fontes,Length(Fontes)+1);
        Fontes[Length(Fontes)-1].Name := CanvasCible.Font.Name;
        Fontes[Length(Fontes)-1].Style := CanvasCible.Font.Style;
        Fontes[Length(Fontes)-1].Color := CanvasCible.Font.Color;
        Fontes[Length(Fontes)-1].Size := CanvasCible.Font.Size;
        Delete(Balise,1,2);
        RemplaceA('>',' ',Balise);
        While Pos(' =',Balise)>0 do RemplaceA(' =','=',Balise);
        While Pos('= ',Balise)>0 do RemplaceA('= ','=',Balise);
        ElagueLesEspaces(Balise);
        While Balise <> '' do
        Begin
          If Pos('HREF=',Majuscule(Balise))=1 then
          Begin
            Delete(Balise,1,5);
            Count := 0;
            SB := '';
            While Count<2 do
            Begin
              Car := Copy(Balise,1,1);
              Delete(Balise,1,1);
              If Car='"' then Inc(Count);
              SB := SB + Car;
              If Balise='' then Count := 2;
            End;
            Delete(SB,1,1) ;
            Dec(SB[0]);
            SetLength(TableauDesLiens,Length(TableauDesLiens)+1);
            With TableauDesLiens[Length(TableauDesLiens)-1] do
            Begin
              X1 := X;
              Y1 := Y;
              Lien := SB;
            End;
            CanvasCible.Font.Color := clBlue;
            FS := CanvasCible.Font.Style;
            Include(FS,fsUnderline);
            CanvasCible.Font.Style := fs;
          End
          else
          While Balise[1]<>' ' do
          Begin
            Balise[1] := ' ';
            Delete(Balise,1,1);
          End;
          ElagueLesEspaces(Balise);
        End;
      End
      Else
      If (Pos('</A',Majuscule(Balise)) = 1) then
      Begin
        With TableauDesLiens[Length(TableauDesLiens)-1] do
        Begin
          X2 := X;
          Y2 := Y + HMax;
          Lien := SB;
        End;
        If Length(Fontes)>0 then
        Begin
          CanvasCible.Font.Name  := Fontes[Length(Fontes)-1].Name;
          CanvasCible.Font.Style := Fontes[Length(Fontes)-1].Style;
          CanvasCible.Font.Color := Fontes[Length(Fontes)-1].Color;
          CanvasCible.Font.Size  := Fontes[Length(Fontes)-1].Size;
          SetLength(Fontes,Length(Fontes)-1);
        End;
      End else
      If (Pos('<HR',Majuscule(Balise)) = 1) then
      Begin
        X := Xc; XEspace := XC;
        If HMax=0 then  Y := Y + HMin else Y := Y + HMax;
        CanvasCible.Pen.Color := clBlack;
        CanvasCible.MoveTo(X,Y);
        CanvasCible.LineTo(Largeur,Y);
        X := Xc; XEspace := XC;
        If HMax=0 then  Y := Y + HMin else Y := Y + HMax;
        HMax := 0;
      End else
      If (Pos('<H',Majuscule(Balise))=1) then
      Begin
        If (Pos('<HTML',Majuscule(Balise))<>1) and
           (Pos('<HEAD',Majuscule(Balise))<>1)then
        Begin
          SetLength(Fontes,Length(Fontes)+1);
          Fontes[Length(Fontes)-1].Name := CanvasCible.Font.Name;
          Fontes[Length(Fontes)-1].Style := CanvasCible.Font.Style;
          Fontes[Length(Fontes)-1].Color := CanvasCible.Font.Color;
          Fontes[Length(Fontes)-1].Size := CanvasCible.Font.Size;
          Delete(Balise,1,2);
          CanvasCible.Font.Size := (5-StrToInt(Balise[1]))*4;
          CanvasCible.Font.Style := [fsBold];
        End;
      End
      Else
      If (Pos('</H',Majuscule(Balise))=1) then
      Begin
        If (Pos('</HTML',Majuscule(Balise))<>1) and
           (Pos('</HEAD',Majuscule(Balise))<>1)then
        If Length(Fontes)>0 then
        Begin
          CanvasCible.Font.Name  := Fontes[Length(Fontes)-1].Name;
          CanvasCible.Font.Style := Fontes[Length(Fontes)-1].Style;
          CanvasCible.Font.Color := Fontes[Length(Fontes)-1].Color;
          CanvasCible.Font.Size  := Fontes[Length(Fontes)-1].Size;
          SetLength(Fontes,Length(Fontes)-1);
        End;
      End
      else
      If (Pos('<BLOCKQUOTE',Majuscule(Balise))=1) or (Pos('<DIR',Majuscule(Balise))=1) then
      Begin
        If Xc<>X then
        Begin
          Rect.Left := Xc;
          Rect.Right := X;
          X := Xc; XEspace := XC;
          Rect.Top := Y;
          If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
          Hmax := 0;
          Rect.Bottom := Y;
          DX := 0;
          If Alignement='R' then DX := Largeur - Rect.Right;
          If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
          Rect2 := Rect;
          Rect2.Left := Rect2.Left + DX;
          Rect2.Right := Rect2.Right + DX;
          If Alignement<>'L' then
          Begin
            CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
            CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.style := bsSolid;
            Rect.Right := Rect.Left + DX;
            CanvasCible.Rectangle(Rect);
            CanvasCible.Brush.style := bsClear;
            For iii := 1 to Length(TableauDesCursorPos) do
            Begin
              If TableauDesCursorPos[iii-1].Yd=Rect.Top then
              Begin
                TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
                TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
              End;
            End;
          End;
        End;
        Xc := Xc + 30;
        X := Xc; XEspace := XC;
      End
      else
      If (Pos('</BLOCKQUOTE',Majuscule(Balise))=1) or (Pos('</DIR',Majuscule(Balise))=1) then
      Begin
        If Xc<>X then
        Begin
          Rect.Left := Xc;
          Rect.Right := X;
          X := Xc; XEspace := XC;
          Rect.Top := Y;
          If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
          Hmax := 0;
          Rect.Bottom := Y;
          If Alignement='R' then DX := Largeur - Rect.Right;
          If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
          Rect2 := Rect;
          Rect2.Left := Rect2.Left + DX;
          Rect2.Right := Rect2.Right + DX;
          If Alignement<>'L' then
          Begin
            CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
            CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.style := bsSolid;
            Rect.Right := Rect.Left + DX;
            CanvasCible.Rectangle(Rect);
            CanvasCible.Brush.style := bsClear;
            For iii := 1 to Length(TableauDesCursorPos) do
            Begin
              If TableauDesCursorPos[iii-1].Yd=Rect.Top then
              Begin
                TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
                TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
              End;
            End;
          End;
        End;
        Xc := Xc - 30;
        X := Xc; XEspace := XC;
      End
      else
      If (Pos('<P',Majuscule(Balise))=1) or (Pos('<BR',Majuscule(Balise))=1) then
      Begin
        Rect.Left := Xc;
        Rect.Right := X;
        X := Xc; XEspace := XC;
        Rect.Top := Y;
        If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
        Hmax := 0;
        Rect.Bottom := Y;
        If Alignement='R' then DX := Largeur - Rect.Right;
        If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
        Rect2 := Rect;
        Rect2.Left := Rect2.Left + DX;
        Rect2.Right := Rect2.Right + DX;
        If Alignement<>'L' then
        Begin
          CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
          CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
          CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
          CanvasCible.Brush.style := bsSolid;
          Rect.Right := Rect.Left + DX;
          CanvasCible.Rectangle(Rect);
          CanvasCible.Brush.style := bsClear;
          For iii := 1 to Length(TableauDesCursorPos) do
          Begin
            If TableauDesCursorPos[iii-1].Yd=Rect.Top then
            Begin
              TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
              TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
            End;
          End;
        End;
        If Pos('CENTER',Majuscule(Balise))>0 then Alignement := 'C';
        If Pos('LEFT',Majuscule(Balise))>0 then Alignement := 'L';
        If Pos('RIGHT',Majuscule(Balise))>0 then Alignement := 'R';
      End else
      If (Balise='<B>') or (Balise='<b>') then
      Begin
        If Not(fsBold in CanvasCible.Font.Style) then
        Begin
          HH := CanvasCible.TextHeight('W');
          FS := CanvasCible.Font.Style;
          Include(FS,fsBold);
          CanvasCible.Font.Style := FS;
          If HH > CanvasCible.TextHeight('W') then CanvasCible.Font.Size := CanvasCible.Font.Size + 1;
        End;
      End
      else
      If (Balise='</B>') or (Balise='</b>') then
      Begin
        If fsBold in CanvasCible.Font.Style then
        Begin
          HH := CanvasCible.TextHeight('W');
          FS := CanvasCible.Font.Style;
          Exclude(FS,fsBold);
          CanvasCible.Font.Style := FS;
          If HH < CanvasCible.TextHeight('W') then CanvasCible.Font.Size := CanvasCible.Font.Size - 1;
        End;
      End
      else
      If (Balise='<I>') or (Balise='<i>') then
      Begin
        If Not(fsItalic in CanvasCible.Font.Style) then
        Begin
          FS := CanvasCible.Font.Style;
          Include(FS,fsItalic);
          CanvasCible.Font.Style := FS;
          Dec(X);
        End;
      End
      else
      If (Balise='</I>') or (Balise='</i>') then
      Begin
        If fsItalic in CanvasCible.Font.Style then
        Begin
          FS := CanvasCible.Font.Style;
          Exclude(FS,fsItalic);
          CanvasCible.Font.Style := FS;
          Inc(X);
        end;
      End
      Else
      If (Balise='<U>') or (Balise='<u>') then
      Begin
        FS := CanvasCible.Font.Style;
        Include(FS,fsUnderline);
        CanvasCible.Font.Style := FS;
      End
      else
      If (Balise='</U>') or (Balise='</u>') then
      Begin
        FS := CanvasCible.Font.Style;
        Exclude(FS,fsUnderline);
        CanvasCible.Font.Style := FS;
      End
      else
      Begin
        Excl := CanvasCible.Font.Color;
        FS := CanvasCible.Font.Style;
        CanvasCible.Font.Style := [];
        CanvasCible.Font.Color := clBlack;
        For J := 1 to Length(Balise) do
        Begin
          Car := Copy(Balise,J,1);
          If J = Length(Balise) then CanvasCible.Font.Style := [];
          If CanvasCible.TextWidth(Car)+X>Largeur then
          Begin
          Rect.Left := Xc;
          Rect.Right := X;
          X := Xc; XEspace := XC;
          Rect.Top := Y;
          If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
          Hmax := 0;
          Rect.Bottom := Y;
          If Alignement='R' then DX := Largeur - Rect.Right;
          If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
          Rect2 := Rect;
          Rect2.Left := Rect2.Left + DX;
          Rect2.Right := Rect2.Right + DX;
          If Alignement<>'L' then
          Begin
            CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
            CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
            CanvasCible.Brush.style := bsSolid;
            Rect.Right := Rect.Left + DX;
            CanvasCible.Rectangle(Rect);
            CanvasCible.Brush.style := bsClear;
            For iii := 1 to Length(TableauDesCursorPos) do
            Begin
              If TableauDesCursorPos[iii-1].Yd=Rect.Top then
              Begin
                TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
                TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
              End;
            End;
          End;
          End;
          CanvasCible.TextOut(X,Y,Car);
          Inc(X,CanvasCible.TextWidth(Car));
          if J=1 then CanvasCible.Font.Style := [fsBold,FsItalic];
        End;
        CanvasCible.Font.Color := ExCl;
        CanvasCible.Font.Style := FS;
      End;
    End
    Else
    Begin
      Telquel := Telquel + Car;
      Inc(I);
    End;
  End;
  While Telquel<>'' do
  Begin
    SS := Telquel;
    While (SS[0]>#0) and (X+CanvasCible.TextWidth(SS)>Largeur) do Dec(SS[0]);
    If SS<>Telquel then
    If Pos(' ',SS)>0 then
    While SS[Ord(SS[0])]<>' ' do Dec(SS[0]);
    Delete(Telquel,1,Ord(SS[0]));
    CanvasCible.TextOut(X,Y,SS);
    X := X  +  CanvasCible.TextWidth(SS);
    If HMax < CanvasCible.TextHeight(SS) then HMax := CanvasCible.TextHeight(SS);
    ElagueLesEspacesS(TelQuel);
    If Telquel<>'' then
    Begin
      Rect.Left := Xc;
      Rect.Right := X;
      X := Xc; XEspace := XC;
      Rect.Top := Y;
      If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
      Hmax := 0;
      Rect.Bottom := Y;
      If Alignement='R' then DX := Largeur - Rect.Right;
      If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
      Rect2 := Rect;
      Rect2.Left := Rect2.Left + DX;
      Rect2.Right := Rect2.Right + DX;
      If Alignement<>'L' then
      Begin
        CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
        CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
        CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
        CanvasCible.Brush.style := bsSolid;
        Rect.Right := Rect.Left + DX;
        CanvasCible.Rectangle(Rect);
        CanvasCible.Brush.style := bsClear;
        For iii := 1 to Length(TableauDesCursorPos) do
        Begin
          If TableauDesCursorPos[iii-1].Yd=Rect.Top then
          Begin
            TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
            TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
          End;
        End;
      End;
    End;
  End;
  Rect.Left := Xc;
  Rect.Right := X;
  X := Xc; XEspace := XC;
  Rect.Top := Y;
  If HMax=0 then Y := Y + Hmin else Y := Y + Hmax;
  Hmax := 0;
  Rect.Bottom := Y;
  DX := 0;
  If Alignement='R' then DX := Largeur - Rect.Right;
  If Alignement='C' then DX := (Largeur - Rect.Right) div 2;
  Rect2 := Rect;
  Rect2.Left := Rect2.Left + DX;
  Rect2.Right := Rect2.Right + DX;
  If Alignement<>'L' then
  Begin
    CanvasCible.CopyRect(Rect2,CanvasCible,Rect);
    CanvasCible.Pen.color := CanvasCible.Pixels[x,y];
    CanvasCible.Brush.color := CanvasCible.Pixels[x,y];
    CanvasCible.Brush.style := bsSolid;
    Rect.Right := Rect.Left + DX;
    CanvasCible.Rectangle(Rect);
    CanvasCible.Brush.style := bsClear;
    For iii := 1 to Length(TableauDesCursorPos) do
    Begin
      If TableauDesCursorPos[iii-1].Yd=Rect.Top then
      Begin
        TableauDesCursorPos[iii-1].Xd := TableauDesCursorPos[iii-1].Xd + DX;
        TableauDesCursorPos[iii-1].Xf := TableauDesCursorPos[iii-1].Xf + DX;
      End;
    End;
  End;
  Result := Y;
End;


#57 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 04 October 2008 - 05:45 PM

This is a routine that I found on the web and I adapted to your grid!

#58 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 8,191 posts
  • Gender:Male

Posted 07 October 2008 - 06:04 PM

Hello Dergen,

I hope that you can fit this procedure into your app. Using OnCustomDrawCell should help.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Users Section: users.bergsoft.net
Articles and Tutorials: help.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#59 Der§en

Der§en
  • Members
  • 167 posts
  • Gender:Male
  • Location:Paris

Posted 09 October 2008 - 07:44 PM

QUOTE (Boki (Berg) @ Oct 7 2008, 07:04 PM) <{POST_SNAPBACK}>
Hello Dergen,

I hope that you can fit this procedure into your app. Using OnCustomDrawCell should help.

Best regards


Yes, this procedure works correctly for my programs!




1 user(s) are reading this topic

0 members, 1 guests, 0 anonymous users