Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 09.11.2007, 22:47   #1
Shady
 
Регистрация: 09.11.2007
Сообщений: 9
По умолчанию Помогите решить задачу.

Создать приложение, выводящие компонент TLabel под заданным углом на форме.

Помогите пжлалуста. Нужно завтра) Так что чем оперативнее тем лучше. Респектов выпишу много)
Shady вне форума
Старый 09.11.2007, 23:34   #2
Alex21
With best regards
Участник клуба
 
Регистрация: 20.04.2007
Сообщений: 1,448
По умолчанию

TLabel под углом не выводится.
Под углом выводят на канве - canvas.
Alex21 вне форума
Старый 09.11.2007, 23:36   #3
Shady
 
Регистрация: 09.11.2007
Сообщений: 9
По умолчанию

Препод сказал, что нужно что-то с канвасом поделать, но то что имеено TLabel под углом, это точно(
Shady вне форума
Старый 09.11.2007, 23:46   #4
Alex21
With best regards
Участник клуба
 
Регистрация: 20.04.2007
Сообщений: 1,448
По умолчанию Вариант -=1=-

Код:
procedure TForm1.FormPaint(Sender: TObject);
var
  lf: TLogFont;
begin
  FillChar(lf, SizeOf(lf), 0); 
  with lf do begin 
    // Высота буквы
    lfHeight := 15;
    // Ширина буквы
    lfWidth := 20;
    // Угол наклона в десятых градуса
    lfEscapement := 100;
     // Жирность 0..1000, 0 - по умолчанию
    lfWeight := 1000;
    // Курсив
    lfItalic := 0;
    // Подчеркнут
    lfUnderline := 1;
    // Зачеркнут
    lfStrikeOut := 1;
    // CharSet
    lfCharSet := RUSSIAN_CharSet;
    // Название шрифта
    StrCopy(lfFaceName, 'Arial');
  end;
  with Form1.Canvas do begin
    FillRect(ClipRect);
    Font.Handle := CreateFontIndirect(lf);
    TextOut(0, 100, 'It is a text string');
  end;

end;

{ Эта процедура устанавливает угол вывода текста для указанного Canvas, угол в градусах }
{ Шрифт должен быть TrueType ! }
procedure CanvasSetTextAngle(c: TCanvas; d: single);
var   LogRec: TLOGFONT;     { Информация о шрифте }
begin 
 {Читаем текущюю инф. о шрифте }
 GetObject(c.Font.Handle,SizeOf(LogRec) ,Addr(LogRec) );
 { Изменяем угол } 
 LogRec.lfEscapement := round(d*10);
 { Устанавливаем новые параметры }
 c.Font.Handle := CreateFontIndirect(LogRec);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CanvasSetTextAngle(canvas,21);
end;
Alex21 вне форума
Старый 09.11.2007, 23:47   #5
Alex21
With best regards
Участник клуба
 
Регистрация: 20.04.2007
Сообщений: 1,448
По умолчанию Вариант -=2=-

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  logfont: TLogFont;
  font: Thandle;
  count: integer;
begin
  LogFont.lfheight := 20;
  logfont.lfwidth := 20;
  logfont.lfweight := 750;
  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);
  for count := 1 to 100 do
  begin 
    canvas.textout(Random(form1.width), Random(form1.height), 'Hello'); 
    SetTextColor(form1.canvas.handle, rgb(Random(255), Random(255), Random
      (255))); 
  end; 
  Deleteobject(font);
end;
Alex21 вне форума
Старый 10.11.2007, 01:54   #6
Shady
 
Регистрация: 09.11.2007
Сообщений: 9
По умолчанию

Спасибо и респект огромной. Но что-то первый варинат никак не хочет работать. Не могли бы вы прислать мну архив рабочей программы? artyomka777@mail.ru
Shady вне форума
Старый 10.11.2007, 23:01   #7
bill
Форумчанин
 
Аватар для bill
 
Регистрация: 26.04.2007
Сообщений: 440
По умолчанию

Я так понимаю надо поворачивать надпись, которая есть в label-е. Есть lmd компоненты. Там это можно задать автоматически. Во всяком случае на кнопках-LMDTextSpeedButton это реализовывалось.
bill вне форума
Старый 10.11.2007, 23:09   #8
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,758
По умолчанию

закрыл тему, название не соответствует правилам форума.
Alar вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите решить задачу... studentIC Помощь студентам 3 12.03.2008 08:29
Помогите решить задачу. Кронос Помощь студентам 3 28.10.2007 14:11
Помогите решить задачу cL1zMa Паскаль, Turbo Pascal, PascalABC.NET 5 15.12.2006 11:04