Auto-Adjust ?
#41
Posted 19 March 2008 - 02:18 PM
#42
Posted 19 March 2008 - 08:12 PM
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
--
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
Posted 20 March 2008 - 05:26 PM
#44
Posted 20 March 2008 - 08:25 PM
You may apply again your code that you have used before.
Best regards
--
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
Posted 22 March 2008 - 04:27 PM
If I do not continue a disturbing you with this.
#46
Posted 24 March 2008 - 10:57 PM
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
--
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
Posted 25 March 2008 - 11:20 PM
#48
Posted 25 March 2008 - 11:24 PM
But as I have say I will need time to implement it.
Best regards
--
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
Posted 22 April 2008 - 01:37 PM
#50
Posted 22 April 2008 - 03:26 PM
Nothing yet. I will notify you when it is done, please make sure that this is a hard feature to implement.
--
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
Posted 05 May 2008 - 01:37 PM
What should I tell him to do it wait?
#52
Posted 05 May 2008 - 03:24 PM
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
--
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
Posted 09 June 2008 - 05:19 PM
#54
Posted 09 June 2008 - 05:23 PM
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
--
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
Posted 09 June 2008 - 06:54 PM
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
--
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
Posted 04 October 2008 - 05:43 PM
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:
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
Posted 04 October 2008 - 05:45 PM
#58
Posted 07 October 2008 - 06:04 PM
I hope that you can fit this procedure into your app. Using OnCustomDrawCell should help.
Best regards
--
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
Posted 09 October 2008 - 07:44 PM
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!
0 user(s) are reading this topic
0 members, 0 guests, 0 anonymous users