Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.03.09;
Скачать: [xml.tar.bz2];

Вниз

градиентная заливка memo   Найти похожие ветки 

 
AlexeyShestchenko   (2008-02-11 14:53) [0]

у меня мемо.readonly;
хочу чтобы он был внутри градиентным.
вот градиент
1.как правильно рисовать в данном случае на мемо, у меня textout рисует все в одну строчку.?
2.как избавится от глюка когда выделяешь текст в мемо то градиент в выделенной строчке изчезает?
: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.brush.style := bsclear;
    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 := memo1.lines.text;
DrawGradient(c, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite],s);
 finally
   c.Free; /
 end;


 
clickmaker ©   (2008-02-11 14:56) [1]


> в onpoint формы

угадал все буквы, но не смог прочесть слово?
низачот, садись, два


 
AlexeyShestchenko   (2008-02-11 15:33) [2]

Может есть у кого какие-нибудь идеи по моей теме?


 
Ins ©   (2008-02-11 15:41) [3]


> 1.как правильно рисовать в данном случае на мемо

Обрабатывать WM_PAINT/WM_ERAESBKGND


> 2.как избавится от глюка когда выделяешь текст в мемо то
> градиент в выделенной строчке изчезает?

Обрабатывать WM_CTLCOLOREDIT.

Гляньте здесь:
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=38999


 
clickmaker ©   (2008-02-11 15:51) [4]


> Обрабатывать WM_CTLCOLOREDIT.

тоже низачот.
read-only memo шлет WM_CTLCOLORSTATIC


 
Ins ©   (2008-02-11 15:53) [5]


> clickmaker ©   (11.02.08 15:51) [4]


Принято :)


 
AlexeyShestchenko   (2008-02-11 17:03) [6]

procedure TForm1.WM_CTLCOLORSTATIC(var mes: TMessage);
var
 dc:HDC;
begin
 if mes.LParam=Memo1.Handle then
   begin
     dc:=HDC(mes.WParam);
     SetBkMode(dc,TRANSPARENT);
     mes.Result:=0;
   end;
end;

в onbutonclick и onpaint одинаковый код:
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;

если давить на кнопку то текст рисуется, подвигать форму и текст исчезает хотя в онпоинт прописан почему??!!


 
AlexeyShestchenko   (2008-02-11 17:22) [7]

WMPaint вылечил :) буду дальше мучать...


 
AlexeyShestchenko   (2008-02-11 17:29) [8]

что обрабатывать тепрь, выделяю текст в memo,и построчно за выделением исчезает градиент.
WM_CTLCOLOREDIT.
WM_CTLCOLORSTATIC
уже обработал


 
AlexeyShestchenko   (2008-02-11 18:13) [9]

мастера, ну так что еще обработать, чтобы тексто можно было нормально выделять?


 
AlexeyShestchenko   (2008-02-12 15:36) [10]

тогда может компоненты хоть с подобными функциями?


 
AlexeyShestchenko   (2008-02-12 19:14) [11]

сначала рисую на битмапе потом его в мемо.
работает,но при изменении текста и т.д. в мемо картинка наслаиваиться?
как мне вызывать обновление в 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;


 
ketmar ©   (2008-02-12 19:21) [12]

тебе ещё не надоело? это страх и ужос всё равно будет. для нормальной работы надо весь memo самому малевать. вопрос: нафига такие танцы?

---
Understanding is not required. Only obedience.


 
AlexeyShestchenko   (2008-02-12 19:34) [13]

нужен многострочный текст поверх гридиента с возможностью редактиров.(хотя бы рид онли)


 
clickmaker ©   (2008-02-12 19:39) [14]


> как мне вызывать обновление в wmcopy,change,cut...

RedrawWindow(memo1.Handle, 0, nil, RDW_ERASE or RDW_INVALIDATE)?
правда, мерцать будет, наверно


 
AlexeyShestchenko   (2008-02-12 21:30) [15]

спасибо за ответ, но моргает :(
неужели нельзя сделать чтоб все норм было? скажите в какую сторону дуть,хочется сделать по-человечески,чтоб как надо работало!


 
Leonid Troyanovsky ©   (2008-02-12 21:52) [16]


> AlexeyShestchenko   (12.02.08 21:30) [15]

> неужели нельзя сделать чтоб все норм было?

Дык, сделай - TWnControl тебе в руки.
Для редактирования пользуй, например, EDIT.

Особо ленивые могут плясать хоть от TDrawGrid.

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2008-02-12 21:57) [17]


> Leonid Troyanovsky ©   (12.02.08 21:52) [16]

> Дык, сделай - TWnControl

TWinControl, sorry.

--
Regards, LVT.


 
AlexeyShestchenko   (2008-02-12 22:22) [18]

ладно,еще помучаюсь...а потом тогда примусь за twincontrol


 
ketmar ©   (2008-02-13 17:11) [19]

>[15] AlexeyShestchenko (2008-02-12 21:30:00)
>моргает

и будет. потому что memo. пиши редактор сам, с нуля.

---
Understanding is not required. Only obedience.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.03.09;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.041 c
11-1184499935
Lex1
2007-07-15 15:45
2008.03.09
KOL поддерживает регулярные выражения?


15-1202116512
Dmitry S
2008-02-04 12:15
2008.03.09
Самый "дешевый" способ загрузить картинку PNG?


15-1201944617
Андрей
2008-02-02 12:30
2008.03.09
Браузер файлов на диске


15-1201942448
kiber-pilot
2008-02-02 11:54
2008.03.09
Генерация словоформ


2-1202755883
1иван
2008-02-11 21:51
2008.03.09
TMemoryStream + dll





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский