VPF::градиентная заливка memo - Форум программистов

AlexeyShestchenko

Дата 11.2.2008, 13:16 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

у меня мемо.readonly;
хочу чтобы он был внутри градиентным.
вот градиент:

Код


procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
   Horicontal: Boolean; Colors: array of TColor;s:string);
 type
   RGBArray = array[0..2] of Byte;
 var
   x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
   Faktor: double;
   A: RGBArray;
   B: array of RGBArray;
   merkw: integer;
   merks: TPenStyle;
   merkp: TColor;
 begin
   mx := High(Colors);
   if mx > 0 then
   begin
     if Horicontal then
       mass := Rect.Right - Rect.Left
     else
       mass := Rect.Bottom - Rect.Top;
     SetLength(b, mx + 1);
     for x := 0 to mx do
     begin
       Colors[x] := ColorToRGB(Colors[x]);
       b[x][0] := GetRValue(Colors[x]);
       b[x][1] := GetGValue(Colors[x]);
       b[x][2] := GetBValue(Colors[x]);
     end;
     merkw := ACanvas.Pen.Width;
     merks := ACanvas.Pen.Style;
     merkp := ACanvas.Pen.Color;
     ACanvas.Pen.Width := 1;
     ACanvas.Pen.Style := psSolid;
     faColorsh := Round(mass / mx);
     for y := 0 to mx - 1 do
     begin
       if y = mx - 1 then
         bis := mass - y * faColorsh - 1
       else
         bis := faColorsh;
       for x := 0 to bis do
       begin
         Stelle := x + y * faColorsh;
         faktor := x / bis;
         for z := 0 to 3 do
           a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
         ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
         if Horicontal then
         begin
           ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
           ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
         end
         else
         begin
           ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
           ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
         end;
       end;
     end;
     b := nil;
     ACanvas.Pen.Width := merkw;
     ACanvas.Pen.Style := merks;
     ACanvas.Pen.Color := merkp;
     ACanvas.TextOut(0,0,s);
   end
   else
     // Please specify at least two colors
    raise EMathError.Create('Es mussen mindestens zwei Farben angegeben werden.');
 end;



в onpoint формы
var
  c: TCanvas;
  n, en: integer;
  x, y: integer;
  s: string;
begin
  n := 1; //Первый символ для покраски
  en := 10; //Последний символ
  try
    c := TCanvas.Create;
    c.Handle := GetDC(Memo1.Handle); //Создали канвас для мемо ;-)
    s := copy(Memo1.Text, n, en);
 //   c.FillRect(GetClientRect); //Тут в место нулей надо определять положение, но это ты и сам сделаешь
DrawGradient(c, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite],s);
  finally
    c.Free; //Убили канвас
  end;

но чет работает неверно,почему? косяк сам в рисовании текста на канве :(
textout съедает градиент...

volvo877

Дата 11.2.2008, 13:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 1
Всего: 116

Код


     ACanvas.Brush.Style := bsClear; // <--- Не забыл случайно? 
     ACanvas.TextOut(0, 0, s);

AlexeyShestchenko

Дата 11.2.2008, 14:07 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

спасибо, только textout Рисует весь текст в одну строчку...как с этим быть?

думаю не стоит в Onpoint делать цикл и построчно зарисовыввать, и скорее они буду т друг друга затирать даже есть создать еще переменную по Y

VICTAR

Дата 11.2.2008, 15:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 2
Всего: 80

DrawText + DT_WORDBREAK позволяет вывести многострочный текст.
Для Delphi 2006 и выше есть перегруженный TextRect, позволяющий сделать тоже самое средствами Canvas.

AlexeyShestchenko

Дата 11.2.2008, 16:33 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

Цитата

DrawText(h,pchar(memo.text),Length(memo.Text),Rect,DT_WORDBREAK);

не помогает :(
ваще ниче не рисует

VICTAR

Дата 11.2.2008, 16:47 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 2
Всего: 80

h - это что?
Rect -?

AlexeyShestchenko

Дата 11.2.2008, 16:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

вроде прокатило, по-крайней мере для readonly

Код


procedure TForm1.FormPaint(Sender: TObject);
var
  c: TCanvas;
  rect:trect;
begin

rect.Top := 10;
rect.Left := 10;

  try
    memo1.Repaint;
    c := TCanvas.Create;
    c.Handle := GetDC(Memo1.Handle);
  DrawGradient(memo1.Handle,c, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite],memo1);
  DrawText(c.Handle,pchar(Memo2.Text),Length(Memo2.Text),Rect,DT_WORDBREAK);
  finally
    c.Free;
  end;
end;

не пойму один и тот же текст у меня в onpoint и в onbutton, на кнопку текст рисуется, а сам по оепоинт нет почему????

Это сообщение отредактировал(а) Alexeis - 12.2.2008, 22:51

VICTAR

Дата 11.2.2008, 17:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 2
Всего: 80

Цитата(AlexeyShestchenko @ 11.2.2008, 16:59

)

не пойму один и тот же текст у меня в onpoint и в onbutton, на кнопку текст рисуется, а сам по оепоинт нет почему????

Можно перевести на общедоступный?

Добавлено через 1 минуту и 17 секунд
ИМХО не лучший вариант отрисовать Memo в OnPaint формы

AlexeyShestchenko

Дата 11.2.2008, 17:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

ок =)
в buttonOnclick и formonpaint

один и тот же код отрисовки memo1:

Код


var
  c: TCanvas;
  rect:trect;
begin
rect.Top := 5;
rect.Left := 5;
  try
  c := TCanvas.Create;
  c.Handle := GetDC(Memo1.Handle);
  DrawGradient(memo1.Handle,c, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite]);
  c.Brush.Style := bsClear;
  DrawText(c.Handle,pchar(Memo2.Text),Length(Memo2.Text),Rect,DT_WORDBREAK);
  finally
    c.Free;
  end;
end;

По нажатию на кнопку, в мемо1 рисуется текст из мемо2, а если подвигать форму то текст пропадает,хотя градиент остается...

VICTAR

Дата 11.2.2008, 17:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 2
Всего: 80

Цитата(AlexeyShestchenko @ 11.2.2008, 17:06

)

Цитата(VICTAR @ 11.2.2008, 17:03

)

ИМХО не лучший вариант отрисовать Memo в OnPaint формы

AlexeyShestchenko

Дата 11.2.2008, 17:23 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

WMPaint вылечил от проблемы, теперь новый лаг, если выделить текст в мемо,то он выделяет синим как обычно и стирает градиент smile

))

построчно =)

AlexeyShestchenko

Дата 12.2.2008, 19:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 59
Регистрация: 7.2.2008

Репутация: нет
Всего: нет

сначала рисую на битмапе потом его в мемо.
работает,но при изменении текста и т.д. в мемо картинка наслаиваиться?
как мне вызывать обновление в wmcopy,change,cut...

Код


Procedure TmyMemo.DefaultHandler (Var Message); 
   Begin 
     Inherited DefaultHandler(Message); 
     With TMessage(Message) Do 
     Begin 
       Case Msg Of
         cn_CTLCOLORMSGBOX..cn_CTLCOLORSTATIC:
           begin 
             SetBkMode(WParam, Transparent); 
           end; 
       End; 
     End; 
   End;
   Procedure TmyMemo.WM_EraseBkGnd(Var Msg : TWMEraseBkGnd);

   Var 
     Canvas : TCanvas; 

   Begin 
     Inherited; 
     Canvas := TCanvas.Create; 
     Canvas.Handle := msg.DC; 
     Canvas.Draw(0,0,fBitmap); 
     Canvas.Free; 
   End;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »