| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Изменить цвет пикселя на контроле [D5, XP]

SetPixel_on_Control ©   (2014-10-06 16:19:00) 

Есть желание изменить цвет одного - двух пикселей, например, на TPanel или TMemo (не целиком TPanel.Color или TMemo.Color, а именно несколько пикселей на них). Насколько это реально и достаточно не сложно?
Спасибо.

---

Alarm   (2014-10-10 14:37:00) [1]

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

---

ВладОшин   (2014-10-09 21:42:00) [2]

Глупый вопрос - зачем?
Хочешь юзера с ума свести?  Вдруг подумает, что пиксель на мониторе выбит :)

---

Andy BitOff   (2014-10-07 00:36:00) [3]

Не все так просто с ВинКонтролами. Я бы даже сказал, что очень не просто.

На разбирайся, если есть особой желание. Это не решение твоей задачи, это помощь для возможного ее решения.

uses ...
 GDIPAPI,
 GDIPOBJ,
 GDIPUTIL;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Panel1: TPanel;
   RadioButton1: TRadioButton;
   Edit1: TEdit;
   ListBox1: TListBox;
   StaticText1: TStaticText;
   Memo1: TMemo;
...

procedure TForm1.ControlPaint(Sender: TWinControl);
var
 a, r, g, b: byte;
 x, y, width, height, sizePixel, widthInBytes: Integer;
 DC: HDC;
 InnerImage: TGPBitmap;
 GPGraph: TGPGraphics;
 ImageBA: pByteArray;
 BitmapData: TBitmapData;
//  ImageFormatPNG: TGUID;
begin

 InnerImage := TGPBitmap.Create(Sender.ClientWidth, Sender.ClientHeight);
 GPGraph := TGPGraphics.Create(InnerImage);

 try
   DC := GPGraph.GetHDC();      // отрисовываем сам контрол
   try
     Sender.PaintTo(DC, 0, 0);
   finally
     GPGraph.ReleaseHDC(DC);
     GPGraph.Free;
   end;

   width := Floor(InnerImage.getWidth);      // работаем с данными изображения
   height := Floor(InnerImage.GetHeight);
   sizePixel := 4;
   widthInBytes := width * sizePixel;
   InnerImage.LockBits(MakeRect(0, 0, width, height), ImageLockModeRead or ImageLockModeWrite, PixelFormat32bppARGB, BitmapData);
   try
     for y := 0 to height - 1 do begin
       ImageBA := Pointer(Integer(BitmapData.Scan0) + widthInBytes * y);
       x := 0;
       while x < widthInBytes do begin
         a := ImageBA[x + 3];
         r := ImageBA[x + 2];
         g := ImageBA[x + 1];
         b := ImageBA[x];

         if y mod 2 = 0 then begin  // через строчку
           r := 255;                // Красненький :)
           g := 0;
           b := 0;
         end;

         ImageBA[x + 3] := a;
         ImageBA[x + 2] := r;
         ImageBA[x + 1] := g;
         ImageBA[x] := b;

         Inc(x, sizePixel);
       end;
     end;
   finally
     InnerImage.UnlockBits(BitmapData);
   end;

//    GetEncoderClsid('image/png', ImageFormatPNG);  // Save в файл для теста
//    InnerImage.Save('image.png', ImageFormatPNG);

   DC := GetDc(Sender.Handle);       // выводим
   try
     GPGraph := TGPGraphics.Create(DC);
     GPGraph.DrawImage(InnerImage, 0, 0, Sender.ClientWidth, Sender.ClientHeight);
   finally
     ReleaseDC(0, DC);
   end;
 finally
   GPGraph.Free;
   InnerImage.Free;
 end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 ControlPaint(Button1);
 ControlPaint(Panel1);
 ControlPaint(RadioButton1);
 ControlPaint(Edit1);
 ControlPaint(ListBox1);
 ControlPaint(StaticText1);
 ControlPaint(Memo1);
end;


---

DQ   (2014-10-06 22:31:00) [4]

Перекрыть ON_PAINT этих контролов. Судя по вопросу - будет сложно. =)

---

junglecat   (2014-10-06 19:00:00) [5]

SetPixel будет виден до первой перерисовки контролом себя

---

SetPixel_on_Control   (2014-10-06 18:08:00) [6]

Как мне показалось, здесь нужно SetPixel. Не знаю, что назначить HDC?

---

SetPixel_on_Control   (2014-10-06 18:06:00) [7]

> junglecat ©   (06.10.14 16:48) [3]

Да и на "голой" форме, не говоря о контролах, пока не получилось

---

junglecat   (2014-10-06 16:48:00) [8]

в мемо так просто не получится

---

megavoid   (2014-10-06 16:37:00) [9]

Form1.Canvas.Pixels[10, 10] := clRed;

---

SetPixel_on_Control   (2014-10-06 16:29:00) [10]

PS
Располагая только их координатами на форме ...

---

Наверх