Форум: "Основная";
Текущий архив: 2002.03.07;
Скачать: [xml.tar.bz2];

Вниз

Ищу компонент.   Найти похожие ветки 

← →
MBo   (2002-02-21 15:22) [1]

недописанное упражнение, но работает

type
TCLabel=class(TGraphicControl)
private
FCaption:string;
FColor:TColor;
FFont,FSmallFont,TempFont:TFont;
VShift:integer;
FTransparent:Boolean;
public
constructor create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Paint;override;
published
property Caption:String read FCaption write FCaption;
property Color:Tcolor read FColor write FColor;
property Font:TFont read FFont write FFont;
property SmallFont:TFont read FSmallFont write FSmallFont;
property Transparent:Boolean read FTransparent write FTransparent;
end;

constructor TCLabel.create(AOwner: TComponent);
begin
inherited;
FColor:=clBtnFace;
FFont:=TFont.create;
FSmallFont:=TFont.create;
TempFont:=TFont.create;
setbounds(10,10,150,30);
end;

destructor TCLabel.Destroy;
begin
FFont.Free;
FSmallFont.Free;
TempFont.Free;
inherited;
end;

procedure TCLabel.Paint;
var
xpos,ypos,curypos:integer;
tagend:integer;
tags,temps:string;

procedure setfnt;
var c,c2:char;
l:integer;
begin
l:=length(tags);
if l>0 then begin
c:=tags[1];
case c of
"/":begin
if l>1 then begin
c2:=tags[2];
case c2 of
"b":TempFont.Style:=TempFont.Style - [fsBold];
"g":TempFont.name:=FFont.name;
"i":TempFont.Style:=TempFont.Style - [fsItalic];
"s":TempFont.size:=FFont.size;
"v":begin TempFont.assign(FFont); VShift:=0; end;
"n":begin TempFont.assign(FFont); VShift:=0; end;
end;
end;
end;
"b":TempFont.Style:=TempFont.Style + [fsBold];
"g":TempFont.name:="Symbol";
"v":begin TempFont.assign(FSmallFont); VShift:=-5; end;
"n":begin TempFont.assign(FSmallFont); VShift:=5; end;
"i":TempFont.Style:=TempFont.Style + [fsItalic];
"s": if l>1 then TempFont.Size:=StrToIntDef(Copy(tags,2,l-1),FFont.Size);
end;
end;
end;

function findtag:integer;
var i,j:integer;
begin
result:=0;
i:=pos("<",temps);
j:=pos(">",temps);
if (i>0) and (j>i) then begin
result:=i;tagend:=j;tags:=copy(temps,i+1,j-i-1);
end;
end;

begin
inherited;
if not FTransparent then begin
canvas.Brush.Color := FColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(ClientRect);
end;
Canvas.Brush.Style:=bsClear;
tempfont.assign(ffont);
temps:=fcaption;
xpos:=0;ypos:=height div 2;
while length(temps)>0 do begin
if findtag<>1 then begin
Canvas.Font.assign(TempFont);
curypos:=ypos-TempFont.size*3 div 4+Vshift;
canvas.TextOut(xpos,curypos,temps[1]);
xpos:=xpos+canvas.TextWidth(temps[1]);
delete(temps,1,1);
end else begin
setfnt;
delete(temps,1,tagend);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
cl:=tclabel.create(self);
cl.Parent:=self;
cl.Transparent:=True;
cl.caption:=
"<g> <s18>S</g></s><v> i</v><n>j</n>H<n>2</n>SO<n>4";
cl.Font.name:="Arial";
cl.Font.size:=12;
cl.SmallFont.name:="Arial";
cl.SmallFont.size:=8;
cl.SmallFont.Color:=clGreen;
end;


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.03.07;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.005 c