-
Valera (09.05.08 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. -
Меняем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 ); -
Дмитрий К © (09.05.08 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 (10.05.08 01:50) [3]Большое спасибо.. Это именно то что надо.
-
Valera (10.05.08 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 (10.05.08 02:42) [5]Ура я понял в чем дело.
Paintbox.Transparent:=true;
Вот этот код тормозит. И еще раз всем спасибо кто отвечал на данный вопрос. -
Valera (10.05.08 04:06) [6]Кстати в MouseDown процедуре лучше использоватьMainTemp.Assign(PaintBmp);
т.к. если туда поместить картинку высокого качествва (например фотографию) то приMainTemp.CopyRect(MainTemp.BoundsRect, PaintBmp,PaintBmp.BoundsRect);
она смажеться.
| ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net |
| Конференция "KOL" » Проблема С PaintBox (Соие программы типа Paint) на чистом kolздан [Delphi, Windows] | |
| ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net |
Есть новые 
Нет новых [134431 +14][b:0][p:0.004]