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

Вниз

Проблема С PaintBox (Соие программы типа Paint) на чистом kolздан   Найти похожие ветки 

← →
Valera   (2008-05-09 19:11) [0]

Подскажите пожалуйста что я делаю не так.

Мне надо нарисовать линию которую было бы видно в момент
рисования(MouseMove) но она рисуеться с тормозом как его убрать.

Вот Исходник

program paintMy;

uses
 Windows,
 messages,
 KOL;

var
 form,PaintBox:PControl;
 PaintBmp,MainTemp:Pbitmap;
 xD,yD:integer;
 mousedown:boolean;

procedure MouseDown_(Dummy : Pointer;Sender: PControl; var Mouse: TMouseEventData );
begin
MainTemp.Assign(PaintBmp);
xD:=Mouse.x;
yd:=Mouse.y;
PaintBox.Invalidate;
mousedown:=True;
end;

procedure MouseMove_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
IF mousedown then begin
PaintBmp.Assign(MainTemp);
PaintBmp.Canvas.MoveTo(xd,yd);
PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
end;

PaintBox.Invalidate;
end;

procedure MouseUp_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
IF mousedown then begin
PaintBmp.Assign(MainTemp);
PaintBmp.Canvas.MoveTo(xd,yd);
PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
end;
PaintBox.Invalidate;
mousedown:=False;
end;

procedure Paint( Dummy : Pointer; Sender: PControl; DC: HDC );
begin
PaintBmp.Draw(DC,0,0);
end;

begin
form:=NewForm(nil,"Paint");
with form^ do begin
 Left := 430;
 Top := 494;
 ClientHeight := 500;
 ClientWidth := 600;
 Font.Color := clWindowText;
end;

PaintBox:=NewPaintBox(Form);
PaintBox.Align:=caClient;
Paintbox.Transparent:=true;
PaintBox.OnMouseDown:= TOnMouse( MakeMethod( nil, @MouseDown_ ) );
PaintBox.OnMouseMove:= TOnMouse( MakeMethod( nil, @MouseMove_ ) );
PaintBox.OnMouseUp:= TOnMouse( MakeMethod( nil, @MouseUp_ ) );
PaintBox.OnPaint:= TOnPaint( MakeMethod( nil, @Paint ) );
///**************************************************************

 MainTemp:=newBitmap(1,1);

 PaintBmp:=newBitmap(PaintBox.Width,PaintBox.Height);
 PaintBmp.Invert;

Run(form);  ////// запуск формы

end.


---

← →
Compiler ©   (2008-05-09 22:29) [1]

Меняем
PaintBmp.Assign(MainTemp); в процедуре procedure MouseMove_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData ); на

StretchBlt( PaintBmp.canvas.Handle, PaintBmp.BoundsRect.Left, PaintBmp.BoundsRect.Top,
            PaintBmp.BoundsRect.Right - PaintBmp.BoundsRect.Left,
            PaintBmp.BoundsRect.Bottom - PaintBmp.BoundsRect.Top,
            MainTemp.canvas.Handle, MainTemp.BoundsRect.Left, MainTemp.BoundsRect.Top,
            MainTemp.BoundsRect.Right - MainTemp.BoundsRect.Left,
            MainTemp.BoundsRect.Bottom - MainTemp.BoundsRect.Top,
            SRCCOPY );


---

← →
Дмитрий К ©   (2008-05-09 22:36) [2]

program paintMy;

uses
Windows,
messages,
KOL;

var
form,PaintBox:PControl;
PaintBmp,MainTemp:Pbitmap;
xD,yD:integer;
mousedown:boolean;

procedure MouseDown_(Dummy : Pointer;Sender: PControl; var Mouse: TMouseEventData );
begin
 MainTemp.CopyRect(MainTemp.BoundsRect, PaintBmp,PaintBmp.BoundsRect);
 xD:=Mouse.x;
 yd:=Mouse.y;
 PaintBox.Invalidate;
 mousedown:=True;
end;

procedure MouseMove_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
 IF mousedown then begin
   PaintBmp.CopyRect(PaintBmp.BoundsRect, MainTemp, MainTemp.BoundsRect);
   PaintBmp.Canvas.MoveTo(xd,yd);
   PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
 end;
 PaintBox.Invalidate;
end;

procedure MouseUp_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
 if mousedown then begin
   PaintBmp.CopyRect(PaintBmp.BoundsRect, MainTemp, MainTemp.BoundsRect);
   PaintBmp.Canvas.MoveTo(xd,yd);
   PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
 end;
 PaintBox.Invalidate;
 mousedown:=False;
end;

procedure Paint( Dummy : Pointer; Sender: PControl; DC: HDC );
begin
 PaintBmp.Draw(DC,0,0);
end;

begin
 form:=NewForm(nil,"Paint");
 with form^ do begin
   Left := 430;
   Top := 494;
   ClientHeight := 500;
   ClientWidth := 600;
   Font.Color := clWindowText;
 end;
 PaintBox:=NewPaintBox(Form);
 PaintBox.Align:=caClient;
 Paintbox.Transparent:=true;
 PaintBox.OnMouseDown:= TOnMouse( MakeMethod( nil, @MouseDown_ ) );
 PaintBox.OnMouseMove:= TOnMouse( MakeMethod( nil, @MouseMove_ ) );
 PaintBox.OnMouseUp:= TOnMouse( MakeMethod( nil, @MouseUp_ ) );
 PaintBox.OnPaint:= TOnPaint( MakeMethod( nil, @Paint ) );
 ///**************************************************************
 MainTemp:=newBitmap(PaintBox.Width,PaintBox.Height);
 MainTemp.Invert;
 PaintBmp:=newBitmap(PaintBox.Width,PaintBox.Height);
 PaintBmp.Invert;
 Run(form);  ////// запуск формы
end.

---

← →
Valera   (2008-05-10 01:50) [3]

Большое спасибо.. Это именно то что надо.

---

← →
Valera   (2008-05-10 02:30) [4]

Помогло но не совсем если сделать форму большой то тормоз виден очевидно.


program paintMy;

uses
Windows,
messages,
KOL;

var
form,PaintBox:PControl;
PaintBmp,MainTemp:Pbitmap;
xD,yD:integer;
mousedown:boolean;

procedure MouseDown_(Dummy : Pointer;Sender: PControl; var Mouse: TMouseEventData );
begin
MainTemp.CopyRect(MainTemp.BoundsRect, PaintBmp,PaintBmp.BoundsRect);
xD:=Mouse.x;
yd:=Mouse.y;
PaintBox.Invalidate;
mousedown:=True;
end;

procedure MouseMove_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
IF mousedown then begin
  PaintBmp.CopyRect(PaintBmp.BoundsRect, MainTemp, MainTemp.BoundsRect);
  PaintBmp.Canvas.MoveTo(xd,yd);
  PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
end;
PaintBox.Invalidate;
end;

procedure MouseUp_(Dummy : Pointer; Sender: PControl; var Mouse: TMouseEventData );
begin
if mousedown then begin
  PaintBmp.CopyRect(PaintBmp.BoundsRect, MainTemp, MainTemp.BoundsRect);
  PaintBmp.Canvas.MoveTo(xd,yd);
  PaintBmp.Canvas.LineTo(Mouse.x,Mouse.y);
end;
PaintBox.Invalidate;
mousedown:=False;
end;

procedure Paint( Dummy : Pointer; Sender: PControl; DC: HDC );
begin
PaintBmp.Draw(DC,0,0);
end;

begin
form:=NewForm(nil,"Paint").SetSize(800,800);

PaintBox:=NewPaintBox(Form);
PaintBox.Align:=caClient;
Paintbox.Transparent:=true;
PaintBox.OnMouseDown:= TOnMouse( MakeMethod( nil, @MouseDown_ ) );
PaintBox.OnMouseMove:= TOnMouse( MakeMethod( nil, @MouseMove_ ) );
PaintBox.OnMouseUp:= TOnMouse( MakeMethod( nil, @MouseUp_ ) );
PaintBox.OnPaint:= TOnPaint( MakeMethod( nil, @Paint ) );
///**************************************************************
MainTemp:=newBitmap(PaintBox.Width,PaintBox.Height);
MainTemp.Invert;
PaintBmp:=newBitmap(PaintBox.Width,PaintBox.Height);
PaintBmp.Invert;

Run(form);  ////// запуск формы

end.



CopyRect помогает только на маленьких изображениях.

Помогите плиз сделать так это делает обычный Paint (microsoft).

Может надо как то совсем по другому.

---

← →
Valera   (2008-05-10 02:42) [5]

Ура я понял в чем дело.

Paintbox.Transparent:=true;

Вот этот код тормозит. И еще раз всем спасибо кто отвечал на данный вопрос.

---

← →
Valera   (2008-05-10 04:06) [6]

Кстати в MouseDown процедуре лучше использоватьMainTemp.Assign(PaintBmp); т.к. если туда поместить картинку высокого качествва (например фотографию) то при
MainTemp.CopyRect(MainTemp.BoundsRect, PaintBmp,PaintBmp.BoundsRect); она смажеться.

---

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

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

Наверх

Память: 0.47 MB
Время: 0.005 c