Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
neorom,
Цитата neorom:
А как на счота обводки букв(текста) ? »
|
Протировал с некоторыми изменениями и улучшениями отсюда http://www.cyberforum.ru/delphi-begi...ead553467.html
теперь создание надписей через процедуры CreateTextWithBorder(...), CreateTextWithShadow(...), что намного практичнее и проще
что отправлять им в качестве аргументов понятно по названиям ссылок в заголовках и переменных в структуре _LITTLE_FONT_INFO
процедура CreateSquare(...) - бонус - создаёт прямоугольник. Кстати то что не умеет инно можно дополнить WinApi функциями из gdi32.dll. Пример такого подхода в шапке, в "создании кастомного чекбокса"
читать дальше »
Код: 
const
TRANSPARENT = 1;
STEAM_GREEN = $506a5a;
type
HDC = LongWord;
_LITTLE_FONT_INFO = record
Style: TFontStyles;
Size: Integer;
Name: String;
end;
function SetBkMode(DC: HDC; BkMode: Integer): Integer; external 'SetBkMode@gdi32.dll stdcall';
procedure CreateTextWithShadow(Canvas: TCanvas; const Text: String; const FontInfo: _LITTLE_FONT_INFO; const TextLeft, TextTop, TextColor, ShadowColor, ShadowLeft, ShadowTop: Integer);
begin
with Canvas do
begin
Font.Color := ShadowColor;
Font.Size := FontInfo.Size;
Font.Name := FontInfo.Name;
Font.Style := FontInfo.Style;
TextOut(TextLeft + ShadowLeft, TextTop + ShadowTop, Text);
Font.Color := TextColor;
TextOut(TextLeft, TextTop, Text);
end;
end;
procedure CreateTextWithBorder(Canvas: TCanvas; const Text: String; const FontInfo: _LITTLE_FONT_INFO; const TextLeft, TextTop, TextColor, ShadowColor, BorderWidth: Integer);
begin
with Canvas do
begin
Font.Color := ShadowColor;
Font.Size := FontInfo.Size;
Font.Name := FontInfo.Name;
Font.Style := FontInfo.Style;
TextOut(TextLeft + BorderWidth, TextTop + BorderWidth, Text);
TextOut(TextLeft - BorderWidth, TextTop - BorderWidth, Text);
TextOut(TextLeft + BorderWidth, TextTop - BorderWidth, Text);
TextOut(TextLeft - BorderWidth, TextTop + BorderWidth, Text);
Canvas.Font.Color := TextColor;
TextOut(TextLeft, TextTop, Text);
end;
end;
procedure CreateSquare(Canvas: TCanvas; const Left, Top, Width, Height, BorderWidth, BorderColor: Integer);
begin
with Canvas do
begin
Pen.Color := BorderColor;
Pen.Width := BorderWidth;
MoveTo(Left, Top);
LineTo(Left, Top + Height);
LineTo(Left + Width, Top + Height);
LineTo(Left + Width, Top);
LineTo(Top, Left);
end;
end;
procedure WizardFormOnPaint(Sender: TObject);
var
lfi: _LITTLE_FONT_INFO;
begin
SetBKMode(TWizardForm(Sender).Canvas.Handle, TRANSPARENT);
lfi.Style := [fsBold];
lfi.Size := 54;
lfi.Name := 'Tahoma';
CreateTextWithBorder(TWizardForm(Sender).Canvas, 'VALVE', lfi, ScaleX(16), ScaleY(16), clBlack, clWhite, 1);
lfi.Style := [];
lfi.Size := 24;
lfi.Name := 'Arial';
CreateTextWithShadow(TWizardForm(Sender).Canvas, 'VALVE', lfi, ScaleX(127), ScaleY(77), clWhite, clBlack, 4, 3);
CreateSquare(TWizardForm(Sender).Canvas, ScaleX(5), ScaleY(5), ScaleX(300), ScaleY(120), 1, clWhite);
end;
procedure InitializeWizard();
begin
WizardForm.Color := STEAM_GREEN;
WizardForm.OuterNotebook.Hide;
WizardForm.OnPaint := @WizardFormOnPaint;
end;
скрин:
|