Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

графика [kol_mck, Windows]


гоша   (27.01.14 01:20

объясните пожалуйста, что не так:

procedure TForm1.FormClick(Sender: TObject);
var x, y: integer;

begin
   for x:=0 to Form.Width-1 do
     for y:=0 to Form.Height-1 do

 NewBitmap(200,200).canvas.pixels[ X, Y ]:=clRed;
 end;


thaddy ©   (27.01.14 17:25[1]

NewBitmap should be OUTSIDE of the loop.....


гоша   (27.01.14 18:25[2]

thanks but not working,
how?
please help !


famrus   (28.01.14 10:10[3]

program Project1;

uses
 windows,messages,
 kol;

{$R *.res}
var
form,button:PControl;
BM:pbitmap;

//область для процедур
procedure clickbutton1(dummy:pointer;Sender:PControl; var mouse:TMouseEventData);
var x, y: integer;

begin
if BM = nil then Bm:=NewBitmap(200,200);

with bm.canvas^ do
  for x:=0 to Form.Width-1 do
    for y:=0 to Form.Height-1 do
    pixels[ X, Y ]:=clRed;

Bm.Draw(form.Canvas.Handle,0,0);
end;

Begin
form:=NewForm(Applet,'шаблон').SetSize(300,240).setposition(330,300);
Button:=NewButton(form,'Выполнить').SetSize(90,30).SetPosition(25,75);
//.centeronparent.Tabulate;
//область для работы

Button.OnClick:=TonEvent(MakeMethod(nil,@clickbutton1));
Run(form);
end.


гоша   (29.01.14 19:38[4]

большое спасибо)

буду разбираться


гоша   (29.01.14 20:45[5]

снова созрел вопрос - а как задать формат, к примеру:pf1bit


RusSun ©   (30.01.14 16:50[6]

Bmp.PixelFormat := pf1bit;


RusSun ©   (30.01.14 16:59[7]

http://kolmck.net/docs/KOLbook_RU.htm читать


гоша   (31.01.14 02:38[8]

Спасибки огромное


митя   (26.08.14 18:57[9]

procedure TForm1.btnButton1Click(Sender: PObj);

var
x,y: Integer;
begin
Bm:=NewBitmap(Form.Width,Form.Height);

NewBrush;

Bm.Draw(form.Canvas.Handle,0,0);

end;


как выставить цвет бруша? - подскажите пожалуйста


RusSun ©   (27.08.14 08:55[10]

http://www.delphimaster.net/view/11-1193514327


Thaddy ©   (27.08.14 09:55[11]

var bmp:PBitmap;  //should be in form object or something; you should also free it somewhere.

procedure TForm1.FormClick(Sender: TObject);
var x, y: integer;
begin
 if nor assigned(bmp) then  Bmp:=NewBitmap(200,200);
  for x:=0 to Form.Width-1 do
    for y:=0 to Form.Height-1 do
      bmp.canvas.pixels[ X, Y ]:=clRed;
end;


митя   (28.08.14 22:48[12]

var
 Bm:pbitmap;
x,y: Integer;
begin
Bm:=NewBitmap(form.Width-1,form.Height-1);

   with bm.canvas^ do
Ellipse(10, 10, 100, 100);

//SetBkColor(form.canvas.Handle,$ffffff);
Bm.Draw(form.Canvas.Handle,20,-1);
   bm.free;
end;
пока что получилось только это - не могу понять как избавиться от чёрного фона


RusSun ©   (29.08.14 19:12[13]

BM.Canvas.Brush.BrushStyle:=bsSolid;
BM.Canvas.Brush.Color:=clBtnFace;
BM.Canvas.FloodFill(0,0,clBtnFace,fsBorder);


RusSun ©   (29.08.14 19:16[14]

program Project1;

uses
 windows,
 kol;

{$R *.res}
var
form:PControl;
fRgn:HRGN;
fon:pBitmap;
fon_:HBrush;
//область для процедур
procedure formPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
fon:=  NewBitmap( 0, 0 );
try
fon.LoadFromFile('Голубые кружева 16.bmp');
fon_:=createPatternBrush(fon.Handle);
FrameRgn (form.Canvas.Handle, fRgn,fon_,71,71);   // 2,2
finally
fon.Free;
DeleteObject (fRgn);
end;
end;
Begin
form:=NewForm(Applet,'Brush paint').SetSize(250,250).setposition(330,300);
fRgn := CreateEllipticRgn (0, 0, 200, 200);
//.centeronparent.Tabulate;
//область для работы

form.OnPaint:=tonpaint(MakeMethod(nil,@formpaint));
Run(form);

end.


митя   (29.08.14 23:22[15]

Спасибо Огромное Человеку под ником RusSun © , который всегда даёт внятные и чёткие ответы - побольше бы таких людей


митя   (28.02.15 19:25[16]

Ещё один вопрос: как сделать чтобы нарисованное изображение не затиралось?


митя   (13.06.15 00:06[17]


type co_ordinate = record
 x,y : integer;
end;
type scanline    = array[0..319] of byte;
var
 pForm      : TForm1;
 Threshold  : integer;
 blobs      : array[0..5] of co_ordinate;
 Frame      : Cardinal;
 drawing    : boolean;
implementation

{$IF Defined(KOL_MCK)}{$ELSE}{$R *.DFM}{$IFEND}

{$IFDEF KOL_MCK}
{$I Unit1_1.inc}
{$ENDIF}
var bmp  : PBitmap;

procedure TForm1.KOLFormFormCreate(Sender: PObj);
var Temp : integer;
  pal  : PLogPalette;
  hpal : HPALETTE;
  x,y:Integer;
begin
frame     := 0;
 bmp := NewBitmap(form.Width,form.Height);
  bmp.PixelFormat:=pf8bit;

 bmp.width  := form.Width;
bmp.height := form.Height;

 timer1.Enabled := true;

end;

procedure TForm1.Timer1Timer(Sender: PObj);
var X_Loop, Y_Loop, I : integer;
   Value, t          : integer;
   Scan              : ^scanline;
begin
Frame := frame +1;
if drawing = false then
begin
 blobs[0].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
 blobs[0].y := 100 + round(90 * SIN((4 * frame) * 0.01745329252222));
 blobs[1].x := 160 + round(150 * SIN((6 * frame) * 0.01745329252222));
 blobs[1].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));
 blobs[2].x := 160 + round(150 * SIN((7 * frame) * 0.01745329252222));
 blobs[2].y := 100 + round(90 * SIN((5 * frame) * 0.01745329252222));
 blobs[3].x := 160 + round(150 * SIN((3 * frame) * 0.01745329252222));
 blobs[3].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
 blobs[4].x := 160 + round(150 * SIN((4 * frame) * 0.01745329252222));
 blobs[4].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
 blobs[5].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
 blobs[5].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));

 drawing := true;
 For Y_Loop := 0 to 239 do
 begin
   scan := Bmp.ScanLine[y_loop];
   for X_Loop := 0 to 319 do
   begin
     t := 0;
     For I := 0 to 5 do
     begin
       value := (Blobs[i].X-X_loop)*(Blobs[i].X-X_Loop);
       value := value + (Blobs[i].Y-Y_loop)*(Blobs[i].Y-Y_Loop);
       if value < 1 then value := 1;
       t := t+ (100000 div value);
     end;
     t := 255-t;
     if t < 0 then t := 0;
     Scan[x_loop] := t;
{      if t >= 200 then scan[x_loop] := 0 else scan[x_loop] := 10;}
     // Bmp.Draw(form.Canvas.Handle,0,0);
   end;
 
 end;

 drawing := false;
 Bmp.Draw(form.Canvas.Handle,0,0);
end;
end;
end.


подскажите знающие люди: должен быть синий фон и красные блобы - цвет почемуто искажён, что не так?


Дмитрий К ©   (13.06.15 18:44[18]

Палитра не заполнена.
   for i := 0 to Bmp.DIBPalEntryCount - 1 do
     Bmp.DIBPalEntries[i] := RGB2BGR(RGB(255 - i, 0, 128 - i));


митя   (15.06.15 14:09[19]

Спасибо тебе и ркепкого здоровья добрый человек - заработало )


митя   (19.01.16 01:12[20]

Подскажите пожалуйста - а как менять палитру формата pf4bpp битмапа?


Лори   (22.01.16 20:42[21]

Зачем вообще использовать палитровые битмапы? Мы ж не в каменном веке. Цель?


митя   (23.01.16 00:58[22]

Спасибо за помощь - уже разобрался


митя   (23.03.16 16:14[23]

как задать прозрачность лейбам или панелькам?


RusSun ©   (23.03.16 19:08[24]

Transparent:=true;


RusSun ©   (23.03.16 19:19[25]

http://delphimaster.net/view/11-1211396216
для формы
_______________________________________________
Дмитрий К ©   (2008-05-22 00:08) [1]

Как вариант:
program testMouseWheel;

uses
Windows, KOL;

var Form, PB: PControl;

procedure FormMouseWheel(Dummy, Sender: PControl; var Mouse: TMouseEventData);
var zDelta: SmallInt; r:TRect; p: TPoint;
begin
GetWindowRect(PB.Handle, r);
GetCursorPos(p);
if PointInRect(p, r) then
begin
  zDelta := HiWord(Mouse.Shift);
  if zDelta < 0 then
  begin
    PB.Width := PB.Width - 10;
    PB.Height := PB.Height - 10;
  end
  else begin
    PB.Width := PB.Width + 10;
    PB.Height := PB.Height + 10;
  end;
end;
end;

procedure PBPaint(Dummy, Sender: PControl; DC: HDC);
begin
Sender.Canvas.FillRect(Sender.ClientRect);
end;

var wp: TWindowPlacement; FullScreened: Boolean; (***)

procedure FullScreen(Undo: Boolean); (***)
begin
if Undo then
begin
  Form.Style := Form.Style or (WS_CAPTION or WS_THICKFRAME);
  SetWindowPlacement(Form.Handle, @wp);
  FullScreened := False;
end
else begin
  wp.length := SizeOf(wp);
  GetWindowPlacement(Form.Handle, @wp);
  Form.Style := Form.Style and not (WS_CAPTION or WS_THICKFRAME);
  Form.BoundsRect := MakeRect(0, 0, ScreenWidth, ScreenHeight);
  FullScreened := True;
end;
end;

procedure FormKeyUp(Dummy, Sender: PControl; var Key: Longint; Shift: DWORD); (***)
begin
if (Key = VK_F11) and (Shift and (MK_ALT or MK_CONTROL or MK_SHIFT) = 0) then
begin
  FullScreen(FullScreened);
end;
end;

begin
Form := NewForm(nil, "test");
PB := NewPaintBox(Form);
PB.Style := PB.Style or WS_BORDER;
PB.Canvas.Brush.Color := clRed;
PB.OnPaint := TOnPaint(MakeMethod(nil, @PBPaint));
Form.OnMouseWheel := TOnMouse(MakeMethod(nil, @FormMouseWheel));
Form.ExStyle := Form.ExStyle or WS_EX_LAYERED;
Form.OnKeyUp := TOnKey(MakeMethod(nil, @FormKeyUp)); (***)
SetLayeredWindowAttributes(Form.GetWindowHandle, clRed, 200, LWA_COLORKEY or LWA_ALPHA);

Run(Form);
end.


митя   (23.03.16 22:05[26]

спасибо большое за ответ - я имею ввиду прозрачность на фоне динамической картинки, к проимеру на форме идёт анимация а лежащая на ней лайба отображает только шрифт без фона


митя   (04.04.16 19:20[27]

Созрел ещё вопрос - как сделать так чтобы при рисовании процессор не нагружался(как в mspaint)


имя   (21.04.16 13:39[28]

Удалено модератором


имя   (21.04.16 14:09[29]

Удалено модератором


имя   (21.04.16 14:36[30]

Удалено модератором


митя   (16.10.16 21:25[31]

Как извлечь палитру из PNG?


Dimaxx ©   (17.10.16 22:14[32]

Грузануть в коловский PNGImage, в нем есть PBitmap, а в нем - палитра (если изображение 8-битное).


митя   (21.12.16 15:38[33]

Как создать StayOnTop-Вторичную Форму только для главной формы, т.е. чтобы вызванная форма перекрывалась формами других приложений а своей главной формой не перекрывалось?


митя   (21.12.16 15:40[34]

Да, и при этом главная форма должна быть полностью доступной как и второстепенная


митя   (29.01.17 16:05[35]

"избил"(что называется) весь интернет - так и не нашёл решения дорисовки пиксела функции LineTo - люди добрые помогите, подскажите верный ответ


DKOL   (30.01.17 12:11[36]

Что значит "дорисовки пиксела функции LineTo"?


митя   (02.02.17 12:36[37]

DKOL, если вы не в курсе то не засоряйте тему, а ежели знаете толк то будте добры помогите


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо