Конференция "KOL" » графика [kol_mck, Windows]
 
  • гоша (27.01.14 01:20) [0]
    объясните пожалуйста, что не так:

    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]
  • гоша (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]
  • 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, если вы не в курсе то не засоряйте тему, а ежели знаете толк то будте добры помогите
  • митя (24.04.18 00:42) [38]
    Существует ли готовое решение BmpSave2png ?
    Заранее спасибо!
  • Netspirit (24.04.18 13:04) [39]
  • митя (25.04.18 13:06) [40]
    tinyLoadJPGGIFBMPFile(Image.jpg);
    bmp.SaveToStream(ImageStream);
    png.LoadFromStream(ImageStream);
    png.SaveToFile(Image.png);

    Подскажите пожалуйста как правильно
  • Netspirit (26.04.18 13:44) [41]
    procedure TestBmpToPng;
    var
     bmp: PBitmap;
     png: PPngObject;
    begin
     bmp := NewBitmap(0,0);
     png := NewPngObject;
     
     bmp.LoadFromFile('Test.bmp');
     png.AssignHandle(bmp.Handle, False{Transparent}, 0{Transp. color});
     png.SaveToFile('Test.png');
     
     bmp.Free;
     png.Free;
    end;

  • митя (27.04.18 15:24) [42]
    Netspirit -спасибо!
 
Конференция "KOL" » графика [kol_mck, Windows]
Есть новые Нет новых   [134427   +26][b:0][p:0.005]