Работа с TFont

Вертикальный текст

2017-10-22T04:27:39+07:00

Code:

var

Hfont: Thandle;

logfont: TLogFont;

font: Thandle;

count: integer;

begin

LogFont.lfheight := 30;

logfont.lfwidth := 10;

logfont.lfweight := 900;

LogFont.lfEscapement := -200;

logfont.lfcharset := 1;

logfont.lfoutprecision := out_tt_precis;

logfont.lfquality := draft_quality;

logfont.lfpitchandfamily := FF_Modern;

font := createfontindirect(logfont);

Selectobject(Form1.canvas.handle, font);

SetTextColor(Form1.canvas.handle, rgb(0, 0, 200));

SetBKmode(Form1.canvas.handle, transparent);

{textout(form1.canvas.handle,10,10,'Повернутый',7);}

for count := 1 to 100 do

begin

canvas.textout(Random(form1.width), Random(form1.height), 'Повернутый');

SetTextColor(form1.canvas.handle, rgb(Random(255), Random(255),

Random(255)));

end;

deleteobject(font);

end;

Вывести полупрозрачный текст

2017-10-22T04:27:00+07:00

Code:

procedure TForm1.FormPaint(Sender: TObject);

var

x, y: integer;

bm: TBitMap;

begin

Form1.ClientWidth := 200;

Form1.ClientHeight := 100;

randomize;

for x := 0 to 199 do

for y := 0 to 99 do

if random(3) = 1 then

Form1.Canvas.Pixels[x,y] := clGreen

else

Form1.Canvas.Pixels[x,y] := clLime;

bm := TBitMap.Create;

bm.Width := 200;

bm.Height := 100;

with bm.Canvas do

begin

Brush.Color := clGreen;

FillRect(ClipRect);

Font.name := 'Arial';

Font.Size := 50;

Font.Color := clGray;

Font.Style := [fsBold];

TextOut((bm.Width - TextWidth('Text')) div 2,

(bm.Height - TextHeight('Text')) div 2, 'Text');

end;

Form1.Canvas.CopyMode := cmSrcPaint;

Form1.Canvas.CopyRect(bm.Canvas.ClipRect, bm.Canvas,

bm.Canvas.ClipRect);

bm.Destroy;

end;

Изменение регистра букв

2017-10-22T04:21:50+07:00

В Delphi есть три функции для изменения регистра: upcase, lowercase, uppercase. Но они работают только для латинского алфавита. Чтобы сделать аналогичные функции для русского алфавита я использовал то, что в кодировке Windows-1251 буквы расставлены по алфавиту, как большие, так и маленькие. То есть номер большой буквы связан с номером маленькой константой. И в русском, и в английском алфавитах маленькие буквы находятся за большими с разностью в 32 символа. Здесь реализованы четыре функции: upcase и locase для изменения регистра одного символа, и uppercase и lowercase для изменения регистра строки

Подробнее...

Как вывести текст с красивым обрезанием если не помещается?

2017-10-22T04:28:29+07:00

Используй вызов DrawTextEx, установив в параметре dwDTFormat значение DT_PATH_ELLIPSIS.

Подробнее...

Как выдать текст под наклоном?

2017-10-22T04:26:13+07:00

Чтобы вывести под любым углом текст необходимо использовать TrueType Fonts (например "Arial"). Например:

Подробнее...

Как изменить фоновый цвет текста?

2017-10-22T04:29:48+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

OldTextColor: TColorRef;

OldBkColor: TColorRef;

OldBkMode: Integer;

begin

OldTextColor := SetTextColor(Form1.Canvas.Handle, clYellow);

OldBkColor := SetBkColor(Form1.Canvas.Handle, clGreen);

OldBkMode := SetBkMode(Form1.Canvas.Handle, OPAQUE);

TextOut(Form1.Canvas.Handle, 20, 20, 'Delphi World - лучше всех! ;-)', 27);

SetBkMode(Form1.Canvas.Handle, OldBkMode);

SetBkColor(Form1.Canvas.Handle, OldBkColor);

SetTextColor(Form1.Canvas.Handle, OldTextColor);

end;

Автор: Олег Кулабухов

Как сделать фон у текста прозрачным?

2017-10-22T04:38:09+07:00

Для этого можно воспользоваться API функцией SetBkMode().

Подробнее...

Каким обpазом выбиpать pазмеp шpифта?

2017-10-22T04:30:47+07:00

Автор: Nomadic

Каким обpазом выбиpать pазмеp шpифта, т.к. все мои стpадания по выбоpyпаpаметpов шpифта в CreateFont() никак не отpажались на его pазмеpе. Все что я пpидyмал, это юзать glScale(), но в этом слyчае полyчаем плохое качество (по сpавнению с той-же Воpдой) пpи малом pазмеpе символов

Вот часть работающего примера на Си (переведенного мною на Паскаль (АА)).

Подробнее...

Свойства шрифта Style и Color в виде строки

2017-10-22T04:36:20+07:00

Как мне получить значение Font.Style и Font.Color в виде строки, я хотел бы присвоить его заголовку компонента Label, но style и color не являются строковыми величинами.

Есть масса способов это сделать, но я использую следующий способ:

Подробнее...

Сохранение свойств шрифтов

2017-10-22T04:33:00+07:00

Code:

//Saving and restoring font properties in the registry

Uses typInfo, Registry;

Function GetFontProp( anObj: TObject) : TFont;

Var

PInfo: PPropInfo;

Begin

{ try to get a pointer to the property information for a property with the

name 'Font'. TObject.ClassInfo returns a pointer to the RTTI table,

which

we need to pass to GetPropInfo }

PInfo := GetPropInfo( anObj.ClassInfo, 'font' );

Result := Nil;

If PInfo <> Nil Then

{ found a property with this name, check if it has the correct type }

If (PInfo^.Proptype^.Kind = tkClass) and

GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont)

Then

Result := TFont(GetOrdProp( anObj, PInfo ));

End; { GetfontProp }

Function StyleToString( styles: TFontStyles ): String;

var

style: TFontStyle;

Begin

Result := '[';

For style := Low(style) To High(style) Do Begin

If style IN styles Then Begin

If Length(result) > 1 Then

result := result + ',';

result := result + GetEnumname( typeInfo(TFontStyle), Ord(style));

End; { If }

End; { For }

Result := Result + ']';

End; { StyleToString }

Function StringToStyle( S: String ): TFontStyles;

Var

sl : TStringlist;

style: TfontStyle;

i : Integer;

Begin

Result := [];

If Length(S) < 2 Then Exit;

If S[1] = '[' Then

Delete(S, 1, 1);

If S[Length(S)] = ']' Then

Delete(S, Length(S), 1);

If Length(S) = 0 Then Exit;

sl:= TStringlist.Create;

try

sl.commatext := S;

For i := 0 To sl.Count-1 Do Begin

try

style := TFontStyle( GetEnumValue( Typeinfo(TFontStyle), sl[i] ));

Include( Result, style );

except

end;

End; { For }

finally

sl.free

end;

End; { StringToStyle }

Procedure SaveFontProperties( forControl: TControl;

toIni: TRegInifile;

const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

toIni.WriteInteger( Section, basename+'Charset', font.charset );

toIni.WriteString ( Section, basename+'Name', font.Name );

toIni.WriteInteger( Section, basename+'Size', font.size );

toIni.WriteString ( Section, basename+'Color',

'$'+IntToHex(font.color,8));

toIni.WriteString ( Section, basename+'Style',

StyleToString( font.Style ));

End; { SaveFontProperties }

Procedure RestoreFontProperties( forControl: TControl;

toIni: TRegInifile;

const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

font.Charset :=

toIni.ReadInteger( Section, basename+'Charset', font.charset );

font.Name :=

toIni.ReadString ( Section, basename+'Name', font.Name );

font.Size :=

toIni.ReadInteger( Section, basename+'Size', font.size );

font.Color := TColor( StrToInt(

toIni.ReadString ( Section, basename+'Color',

'$'+IntToHex(font.color,8))

));

font.Style := StringToStyle(

toIni.ReadString ( Section, basename+'Style',

StyleToString( font.Style ))

);

End; { RestoreFontProperties }

Подробнее...

Управление настройками шрифта

2017-10-22T04:23:12+07:00

Данный код изменяет стиль шрифта поля редактирования, если оно выбрано. Может быть адаприрован для управления шрифтами в других объектах.

Подробнее...

Хранение стилей шрифта

2017-10-22T04:37:28+07:00

Как мне сохранить свойство шрифта Style, ведь он же набор?

Вы можете получать и устанавливать FontStyle через его преобразование к типу byte.

Для примера:

Подробнее...