Ветеран
Сообщения: 863
Благодарности: 262
|
Профиль
|
Отправить PM
| Цитировать
Цитата MogilShik2007:
|
Вот модуль работы с текстом, цвета, правка и т.д. »
|
судя из примера должно работать, но увы...нет, для компонентов не подходит:
Скрытый текст
Код:  #include "ReDrawText v.1.5e4.iss"
[Setup]
AppName=MyProgram
AppVerName=1.0
DefaultDirName={pf}\MyProgram
OutputDir=.
[Components]
Name: one; Description: "Компонент 1"; Types: full custom;
Name: one\two; Description: "Компонент 2"; Types: full custom;
[Code]
var
Label1: TLabel;
Label1Rdw: TRedrawedLabel;
procedure RedesignWizardForm;
begin
Label1 := TLabel.Create(WizardForm);
with Label1 do
begin
Hint:=IntToStr($00FF00);
AutoSize:=False;
Parent := WizardForm.WelcomePage;
Alignment:=taCenter;
Left := ScaleX(216);
Top := ScaleY(256);
Width := ScaleX(40);
Height := ScaleY(14);
//звездочки удалите
Caption := '[*name=Verdana][*size=8][*i][*color=$FF0000]Крутая Игра[/color][/i][/size][/name]';
end;
Label1Rdw:= ReDrawText(Label1);
end;
procedure InitializeWizard();
begin
RedesignWizardForm;
WizardForm.ComponentsList.ItemCaption[0] := Label1.Caption;
end;
Модуль ReDrawText v.1.5e4.iss
Код: [code]
type
TSize = record
cx: Longint;
cy: Longint;
end;
ABC = record
abcA: Integer;
abcB: UINT;
abcC: Integer;
end;
HDC = Longword;
HGDIOBJ = Longword;
TRedrawedLabel = record Base: TLabel; Parts, Shadow: array of Tlabel; end;
#ifdef UNICODE
#define A "W"
PChar = PAnsiChar;
#else
#define A "A"
#endif
const
FS_SOLID = $8;
FS_MINIMIZE = $10;
function GetTextExtentPoint32(DC: HDC; S: String; Len: Integer; var Size: TSize): Boolean; external 'GetTextExtentPoint32{#A}@gdi32.dll stdcall';
function GetTextExtentExPoint(DC: HDC; lpszStr: PChar; cchString, nMaxExtent: Integer; var lpnFit: Integer; alpDx: Integer; var lpSize: TSize): Boolean; external 'GetTextExtentExPoint{#A}@gdi32.dll stdcall';
function GetClientDC(hWnd: HWND): HDC; external 'GetDC@user32.dll stdcall';
function ReleaseClientDC(hWnd: HWND; hDC: HDC): Integer; external 'ReleaseDC@user32.dll stdcall';
function SelectObject(DC: HDC; p2: HGDIOBJ): HGDIOBJ; external 'SelectObject@gdi32.dll stdcall';
function SetRect(var lpRect: TRect; xLeft,yTop,xRight,yBottom: Integer): Boolean; external 'SetRect@user32.dll stdcall';
function InvalidateRect(hWnd: HWND; lpRect: TRect; bErase: BOOL): BOOL; external 'InvalidateRect@user32.dll stdcall';
function GetCharABCWidths(DC: HDC; uFirstChar, uLastChar: UINT; var lpAbc: ABC): Boolean; external 'GetCharABCWidths{#A}@gdi32.dll stdcall';
function FindSpace(s: string; Min, Max: Integer): Integer;
var n: integer;
begin
Result:= -1;
if (Max=0)or(s='') then Exit;
if Max>Length(S) then Max:=Length(S);
if Min<=0 then Min:=1;
if s[Max]=' ' then begin
Result:= Max;
Exit;
end;
for n:=Max downto min do begin
if s[n]=' ' then begin
Result:= n;
Break;
end;
end;
end;
function GetTextWidth(aFont: TFont; Text: String): Integer;
var DC: HDC; aSize: TSize; OldObj: Longword; abc1, abc2: ABC;
begin
DC:= GetClientDC(0);
try
if Text='' then Exit;
OldObj:= SelectObject(DC, aFont.Handle);
GetTextExtentPoint32(DC, PChar(Text), Length(Text), aSize);
GetCharABCWidths(DC, Ord(Text[1]), Ord(Text[1]), abc1);
GetCharABCWidths(DC, Ord(Text[Length(text)]), Ord(Text[Length(text)]), abc2);
Result:= aSize.cx;
if (Length(Text)<>1)and(aFont.Style + [fsItalic]=aFont.Style) then begin
if abc1.abcA<0 then Result:= Result-abc1.abcA;
if abc2.abcC<0 then Result:= Result-abc2.abcC
end;
finally
SelectObject(DC, OldObj);
ReleaseClientDC(0, DC);
end;
end;
function GetTextHeight(aFont: TFont; Text: String): Integer;
var DC: HDC; aSize: TSize; OldObj: Longword;
begin
DC:= GetClientDC(0);
try
OldObj:= SelectObject(DC, aFont.Handle);
GetTextExtentPoint32(DC, PChar(Text), Length(Text), aSize);
Result:= aSize.cy;
finally
SelectObject(DC, OldObj);
ReleaseClientDC(0, DC);
end;
end;
function GetTextLen(aFont: TFont; Text: String; MaxWidth: Integer): Integer;
var DC: HDC; aSize: TSize; OutLen: Integer; OldObj: Longword;
begin
DC:= GetClientDC(0);
try
OldObj:= SelectObject(DC, aFont.Handle);
GetTextExtentExPoint(DC, PChar(Text), Length(Text), MaxWidth, OutLen, 0, aSize);
Result:= OutLen;
finally
SelectObject(DC, OldObj);
ReleaseClientDC(0, DC);
end;
end;
function TrimEx(S: String): String;
begin
if S <> '' then begin
while (Length(S)>0)and(S[1]=' ') do Delete(S, 1, 1);
while (Length(S)>0)and(S[length(S)]= ' ') do Delete(S, Length(S), 1);
end;
Result:= S;
end;
procedure DestroyRWlabel(var Lbl: TRedrawedlabel);
var n: Integer; r: TRect;
begin
for n:=0 to GetArrayLength(Lbl.Shadow)-1 do Lbl.Shadow[n].Free;
for n:=0 to GetArrayLength(Lbl.Parts)-1 do Lbl.Parts[n].Free;
SetArrayLength(lbl.Shadow, 0);
SetArrayLength(lbl.Parts, 0);
if Lbl.Base <> nil then begin
SetRect(r, Lbl.Base.Left, Lbl.base.Top, Lbl.base.left+Lbl.Base.Width, Lbl.Base.Top+Lbl.Base.Height);
InvalidateRect(Lbl.Base.Parent.Handle, r, true);
end;
Lbl.Base:= nil;
end;
procedure ShowRWLabel(var Lbl: TRedrawedlabel);
var n: Integer;
begin
if Lbl.Base.Enabled then for n:=0 to getArraylength(Lbl.Shadow)-1 do Lbl.Shadow[n].Show;
for n:=0 to getArraylength(Lbl.Parts)-1 do Lbl.Parts[n].Show;
end;
procedure HideRWLabel(var Lbl: TRedrawedlabel);
var n: Integer;
begin
if Lbl.Base.Enabled then for n:=0 to getArraylength(Lbl.Shadow)-1 do Lbl.Shadow[n].Hide;
for n:=0 to getArraylength(Lbl.Parts)-1 do Lbl.Parts[n].Hide;
end;
procedure CopyFont(InFnt: TFont; var OutFont: TFont);
begin
OutFont.Height:= InFnt.Height;
OutFont.Name:= InFnt.Name;
OutFont.Pitch:= InFnt.Pitch;
OutFont.Size:= InFnt.Size;
OutFont.Style:= InFnt.Style;
OutFont.PixelsPerInch:= InFnt.PixelsPerInch;
OutFont.Color:= InFnt.Color;
end;
function ReDrawText(var Lbl: Tlabel): TRedrawedLabel;
var s, b: string; i, k, l, newline, aLeft, aTop, aWidth, aHeight, Space, TW,x: Integer;
Flags: Dword; tp1, tp2, tp3, tp4, minlen, lens: Integer; tags, et, ev: string; aFont: TFont;
begin
DestroyRWlabel(Result);
Result.Base:= lbl; aFont:= TFont.Create;
ALeft:=Lbl.Left; ATop:= LBL.Top; AWidth:=0; s:= Lbl.Caption; Space:= GetTextWidth(Lbl.Font, ' ');
repeat
s:=TrimEx(s); k:=Pos('[', s); Flags:=0; tags:=''; lens:= Length(S);
CopyFont(lbl.Font, aFont);
if k=1 then try
repeat
if (s='')or(s[1]<>'[')or((s[1]='[')and(s[2]='/')) then break;
tp1:=2; while (tp1<lenS)and(s[tp1]<>']') do tp1:=tp1+1;
tp2:=2; while (tp2<tp1)and(s[tp2]<>'=') do tp2:=tp2+1;
et:= copy(s, 2, tp2-2);
ev:= copy(s, tp2+1, tp1-tp2-1);
case lowercase(et) of
'b' : aFont.Style:= aFont.Style + [fsBold];
'i' : aFont.Style:= aFont.Style + [fsItalic];
'u' : aFont.Style:= aFont.Style + [fsUnderline];
's' : aFont.Style:= aFont.Style + [fsStrikeOut];
'color': aFont.Color:= StrToInt(ev);
'min' : begin
if StrToInt(ev) >= Lbl.Width then minlen:= Lbl.Width else minlen:= StrToInt(ev);
Flags:= Flags or FS_MINIMIZE or FS_SOLID;
end;
'name' : aFont.Name:= ev;
'size' : aFont.Size:= StrToInt(ev);
'solid': Flags:= Flags or FS_SOLID;
end;
tags:= tags+copy(s, 1, tp1);
delete(s, 1, tp1);
until k=0;
finally
k:=Pos('[', s);
end;
aHeight:=GetTextHeight(aFont, s)+2;
aWidth:=(Lbl.Left+Lbl.Width)-ALeft;
newline:= Pos(#13#10, S);
i:= Pos('%n', S);
if (i<>0)and((i<newline)or(newline=0)) then newline:= i;
if newline=1 then begin
aLeft:= Lbl.Left;
aTop:= ATop+AHeight;
Delete(S, 1, 2);
s:=tags+s;
Continue;
end;
l:= GetTextLen(aFont, s, aWidth);
while Pos(' ',Copy(s,1,l)) = 0 do begin
l:=l+1;
if l>=Length(s) then break;
end;
if (k<>0)and(l>k) then l:=k-1;
if k=0 then if lenS<=l then l:= lenS;
if (l>0)and(l<>(k-1))and(lenS>l)and(s[l]<>' ') then l:= FindSpace(s, 1, l);
if (l<k-1)and(Flags and FS_SOLID <> 0) then l:= k-1;
if ((newline-1)<l)and(newline<>0) then l:= newline-1;
b:= copy(s, 1, l);
Delete(s, 1, l);
try
repeat
if (s='')or(s[1]<>'[')or((s[1]='[')and(s[2]<>'/')) then Break;
tp2:=2; while s[tp2]<>']' do tp2:=tp2+1;
tp3:= pos('['+copy(s, 3, tp2-3), tags);
tp4:= tp3; while tags[tp4]<>']' do tp4:=tp4+1;
delete(tags, tp3, tp4-tp3+1);
delete(s, 1, tp2);
until k=0;
finally
if tags<>'' then s:=tags+s;
end;
if b<>'' then begin
b:= TrimEx(b); if Flags and FS_MINIMIZE <> 0 then b:= MinimizePathName(b, aFont, MinLen);
i:= GetArrayLength(Result.Parts); SetArrayLength(Result.Parts, i+1); SetArrayLength(Result.Shadow, i+1);
aWidth:= GetTextWidth(aFont, b);
if ((aLeft+aWidth)-(Lbl.Left+Lbl.Width)>=0) then begin
if Length(Lbl.Caption) <> Length(s+b+' ') then aTop:= aTop+aHeight;
aLeft:= Lbl.Left;
end;
if aHeight+aTop > Lbl.Top+Lbl.Height then aHeight:=aHeight-((aHeight+aTop)-(Lbl.Top+Lbl.Height));
Result.Parts[i]:= TLabel.Create(Lbl.Parent);
with Result.Parts[i] do begin
Autosize:= False; Font:= aFont;
SetBounds(aLeft,aTop,aWidth,aHeight);
Transparent:= True;
Parent:= Lbl.Parent;
Caption:= b;
Alignment:=Lbl.Alignment;
end;
if Lbl.Enabled then begin
Result.Shadow[i]:= TLabel.Create(Lbl.Parent);
with Result.Shadow[i] do begin
Autosize:= False; Font:= aFont;
SetBounds(aLeft,aTop+1,aWidth,aHeight);
Transparent:= True;
Parent:= Lbl.Parent;
Caption:= b;
Font.Color:=StrToIntDef(Lbl.Hint,$000000);
SendToBack;
Alignment:=Lbl.Alignment;
end;
end;
case Lbl.Alignment of
taLeftJustify:
begin
if Result.Parts[i].Width > Lbl.Width then begin
Result.Parts[i].Width:=Lbl.Width;
if Lbl.Enabled then Result.Shadow[i].Width:=Result.Parts[i].Width;
end;
ALeft:= ALeft+AWidth+Space;
end;
taCenter:
begin
TW:=TW+aWidth+Space;
if Result.Parts[i].Width > Lbl.Width then begin
Result.Parts[i].Width:=Lbl.Width;
if Lbl.Enabled then Result.Shadow[i].Width:=Result.Parts[i].Width;
Result.Parts[i].Left:=Lbl.Left;
if Lbl.Enabled then Result.Shadow[i].Left:=Result.Parts[i].Left+1;
TW:=TW-aWidth;
aWidth:=Lbl.Width;
TW:=TW+aWidth;
end;
if aLeft = Lbl.Left then begin
TW:=TW-aWidth-Space;
while x > 0 do begin
Result.Parts[i-x].Left:=(Result.Parts[i-x].Left+(Lbl.Width/2))-(TW/2);
if Lbl.Enabled then Result.Shadow[i-x].Left:=Result.Parts[i-x].Left+1;
x:=x-1;
end;
TW:=aWidth+Space;
x:=1;
end else x:=x+1;
if Length(s)=0 then begin
x:=x-1;
while x >= 0 do begin
Result.Parts[i-x].Left:=(Result.Parts[i-x].Left+(Lbl.Width/2))-(TW/2);
if Lbl.Enabled then Result.Shadow[i-x].Left:=Result.Parts[i-x].Left+1;
x:=x-1;
end;
end;
ALeft:= ALeft+AWidth+Space;
end;
taRightJustify:
begin
TW:=TW+aWidth+Space;
if Result.Parts[i].Width > Lbl.Width then begin
Result.Parts[i].Width:=Lbl.Width;
if Lbl.Enabled then Result.Shadow[i].Width:=Result.Parts[i].Width;
Result.Parts[i].Left:=Lbl.Left;
if Lbl.Enabled then Result.Shadow[i].Left:=Result.Parts[i].Left+1;
TW:=TW-aWidth;
aWidth:=Lbl.Width;
TW:=TW+aWidth;
end;
if aLeft = Lbl.Left then begin
TW:=TW-aWidth-Space;
while x > 0 do begin
Result.Parts[i-x].Left:=(Lbl.Left+Lbl.Width)-TW;
if Lbl.Enabled then Result.Shadow[i-x].Left:=Result.Parts[i-x].Left+1;
TW:=TW-Result.Parts[i-x].Width-Space;
x:=x-1;
end;
TW:=aWidth+Space;
x:=1;
end else x:=x+1;
if Length(s)=0 then begin
x:=x-1;
while x >= 0 do begin
Result.Parts[i-x].Left:=(Lbl.Left+Lbl.Width)-TW;
if Lbl.Enabled then Result.Shadow[i-x].Left:=Result.Parts[i-x].Left+1;
TW:=TW-Result.Parts[i-x].Width-Space;
x:=x-1;
end;
end;
ALeft:= ALeft+AWidth+Space;
end;
end;
end;
if aHeight < 0 then begin
Lbl.Hide;
exit;
end;
until (Length(s)=0);
Lbl.Hide; aFont.Free;
end;
|
