Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 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;

скрин:
Это сообщение посчитали полезным следующие участники:

Отправлено: 17:25, 26-05-2013 | #538