Форум: "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.048 c