pluto hat geschrieben:das habe ich jetzt auch geschaft nur habe ich noch probleme mit der geschwindigkeit(*schnif*) komme da einfach nicht weiter !
Code: Alles auswählen
procedure TPaintControl.Paint;
var
dx,dy:Integer;
begin
inherited Paint;
dx:=0; dy:=0;
if ismouseup = true then begin
ismouseup:=false;
buffer.canvas.copyrect(rect(mx,my,sx+1,sy+1),buffer2.canvas,rect(mx,my,sx+1,sy+1));
end;
// if t = true then begin
if oldrect.Right-sx > 0 then
dx:=oldrect.Right-sx
else
dx:=sx-oldrect.Right;
if oldrect.Bottom-sy > 0 then
dy:=oldrect.Bottom-sy
else
dy:=sy-oldrect.Bottom;
oldrect.Right:=dx+oldrect.Right+1;
oldrect.Bottom:=dy+oldrect.Bottom+1;
buffer3.canvas.copyrect(oldrect,buffer.canvas,oldrect);
t:=False;
// end;
t:=True;
// buffer3.Canvas.Draw(0,0,Buffer);
with Buffer2.Canvas do begin
buffer2.Canvas.Brush.Style:=bsSolid;
buffer2.Canvas.Brush.Color:=clWhite;
Rectangle(0,0,buffer2.Width,buffer2.Height);
// buffer2.canvas.copyrect(rect(mx,my,sx+1,sy+1),buffer.canvas,rect(mx,my,sx+1,sy+1));
Brush.style:=bsClear;
Pen.Style:=psDash;
Pen.color:=clRed;
Rectangle(mx,my,sx,sy);
buffer3.canvas.copyrect(rect(mx,my,sx+1,sy+1),buffer2.canvas,rect(mx,my,sx+1,sy+1));
// canvas.copyrect(rect(mx,my,sx+1,sy+1),buffer3.canvas,rect(mx,my,sx+1,sy+1));
Canvas.Draw(0,0,Buffer3);
end;
Code: Alles auswählen
procedure TForm1.FormResize(Sender: TObject);
var
ox,oy:Integer;
begin
if Assigned(Buffer) then
begin
ox:=buffer.Width; oy:=buffer.Height;
Buffer.Width:=Width;
Buffer.Height:=Height;
Buffer2.Width:=Width;
Buffer2.Height:=Height;
Buffer3.Width:=Width;
Buffer3.Height:=Height;
buffer.canvas.FillRect(ox,oy,Width,Height);
buffer3.canvas.FillRect(0,0,Width,Height);
buffer2.canvas.FillRect(0,0,Width,Height);
canvas.FillRect(0,0,Width,Height);
end;
end;
Code: Alles auswählen
unit aaaUnit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls;
type
{ TPaintControl }
TPaintControl=class (TCustomControl)
public
ismouseup:Boolean;
procedure MouseDown(Button:TMouseButton;Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure Paint; override;
end;
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ private declarations }
PainterControl: TPaintControl;
public
{ public declarations }
end;
var
Form1: TForm1;
mx, my,sx,sy:integer;
Buffer,buffer2,buffer3:TBitmap;
implementation { TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
PainterControl := TPaintControl.Create(Self);
PainterControl.Align := alClient;
PainterControl.Parent := Self;
PainterControl.DoubleBuffered := True;
PainterControl.ismouseup:=False;
Buffer:=TBitmap.create; Buffer2:=TBitmap.create; Buffer3:=TBitmap.create;
mx:=200;my:=200; sx:=0; sy:=0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PainterControl.Free;
Buffer.free;
buffer2.free;
buffer3.free;
end;
procedure TForm1.FormResize(Sender: TObject);
var
ox,oy:Integer;
begin
t:=true;
if Assigned(Buffer) then
begin
ox:=buffer.Width; oy:=buffer.Height;
Buffer.Width:=Width;
Buffer.Height:=Height;
Buffer2.Width:=Width;
Buffer2.Height:=Height;
Buffer3.Width:=Width;
Buffer3.Height:=Height;
buffer.canvas.FillRect(0,0,Width,Height);
buffer3.canvas.FillRect(0,0,Width,Height);
buffer2.canvas.FillRect(0,0,Width,Height);
canvas.FillRect(0,0,Width,Height);
mx:=0; my:=0; sx:=0; sy:=0;
end;
end;
{ TPaintControl }
procedure TPaintControl.MouseDown(Button:TMouseButton;Shift: TShiftState; X,Y: Integer);
begin
t:=true;
if ssLeft in Shift then begin
inherited MouseDown(Button,Shift,X,Y);
mx:=x; my:=y;
end;
end;
procedure TPaintControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then begin
sx:=x; sy:=y;
inherited MouseMove(Shift, X, Y);
Invalidate;
end;
end;
procedure TPaintControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
inherited MouseUp(button,Shift, X, Y);
ismouseup:=True;
Invalidate
end;
procedure TPaintControl.Paint;
var
r1:TRect;
begin
inherited Paint;
// sobalt die maustaste gedruckt wird bzw. wurde
// wird der inhalt von buffer2 nach buffer kopiert(um ihn zu fixieren)
if (ismouseup = true) then begin
ismouseup:=false;
r1.left:=mx; r1.top:=my;
// damit ich auch den rechten unt unteren rand
// vom viereck erhalte muss ich hier die
// alte position +1 nehmen(jeweils)
r1.Right:=sx+1; r1.Bottom:=sy+1;
// damit das viereck dauerhaft wird
// wird es auf buffer kopiert !
buffer.canvas.copyrect(r1,buffer2.canvas,r1);
end;
// damit ich was zu sehen bekomme wird das komplete
// buffer nach buffer3 kopiert(weil ich kann ja buffer nicht immer andern)
r1.left:=0; r1.top:=0; r1.Right:=Width; r1.Bottom:=Height;
buffer3.canvas.copyrect(r1,buffer.canvas,r1);
with Buffer2.Canvas do begin
// um die alten recht ecke zu vermeiden
// wird hier ein groeses viereck gezogen
Brush.Style:=bsSolid;
Brush.Color:=clWhite;
Rectangle(0,0,Width,Height);
Brush.color:=clRed;
Brush.style:=bsSolid;
Pen.Style:=psSolid;
Pen.color:=clYellow;
// das eigentliche viereck wird gezeichnet
Rectangle(mx,my,sx,sy);
// buffer2 wird anschliend nach buffer3 kopiert aber nur den teil
// der sich geandert hat
buffer3.canvas.copyrect(rect(mx,my,sx+1,sy+1),buffer2.canvas,rect(mx,my,sx+1,sy+1));
// um es zu sehen wird der buffer komplet nach canvas(von form1 kopiert)
Canvas.Draw(0,0,Buffer3);
end;
end;
initialization
{$I aaaUnit1.lrs}
end.
Code: Alles auswählen
// diese procedure soll denn komplenten buffer
// in buffer4 kopieren damit ich buffer cleraren kann
// und anschliessend sichere ich es zurueck !
// die beschrieben fehler treten nur auf wenn ich in buffer4 schreiben moechte
procedure TForm1.FormResize(Sender: TObject);
var
arect:Trect;
begin
if Assigned(Buffer) then begin
t:=true;
Buffer4.Width:=buffer.Width; Buffer4.Height:=buffer.Height;
arect.left:=0; aRect.top:=0; arect.Right:=buffer4.Width; arect.Bottom:=buffer4.Height;
// buffer4.canvas.FillRect(aRect);
// wenn ich dieses copyrect nehme geht das maximieren langsamm
// aber der fehler mit dem schwartzen rand ab einer bestimmten groese(wenn ich
// das form verkleinere)
buffer4.canvas.CopyRect(aRect,buffer.canvas,aRect);
Buffer.Width:=Width;Buffer.Height:=Height; Buffer2.Width:=Width;Buffer2.Height:=Height;
Buffer3.Width:=Width;Buffer3.Height:=Height;
// setzte ich das copyrect hier in dann geht das maxiermieren
// aber sobalt ich jetzt das form verkleinere bekomme ich einen schwartzen
// rand
arect.left:=0; aRect.top:=0; arect.Bottom:=Height; arect.Right:=Width;
buffer.canvas.FillRect(arect); buffer3.canvas.FillRect(arect); buffer2.canvas.FillRect(arect);
Screen.Forms[0].Caption:=IntTostr(aRect.left) + '\' + IntTostr(aRect.Top) + '\' + IntTostr(aRect.Right) + '\' + IntTostr(aRect.Bottom);
// buffer.canvas.draw(0,0,buffer4);
arect.left:=0; aRect.top:=0; arect.Right:=buffer4.Width; arect.Bottom:=buffer4.Height;
buffer.canvas.CopyRect(aRect,buffer4.canvas,aRect);
mx:=0; my:=0; sx:=0; sy:=0;
t:=false;
end;
end;
Code: Alles auswählen
// diese procedure soll denn komplenten buffer
// in buffer4 kopieren damit ich buffer cleraren kann
// und anschliessend sichere ich es zurueck !
// die beschrieben fehler treten nur auf wenn ich in buffer4 schreiben moechte
procedure TForm1.FormResize(Sender: TObject);
var
arect:Trect;
begin
if Assigned(Buffer) then begin
t:=true;
Buffer4.Width:=panel1.Width; Buffer4.Height:=panel1.Height;
buffer4.Canvas.FillRect(0,0,buffer4.Width,buffer4.Height);
arect.left:=0; aRect.top:=0; arect.Right:=buffer4.Width; arect.Bottom:=buffer4.Height;
buffer4.canvas.CopyRect(aRect,buffer.canvas,aRect);
Buffer.Width:=panel1.Width;Buffer.Height:=panel1.Height; Buffer2.Width:=panel1.Width;Buffer2.Height:=panel1.Height;
Buffer3.Width:=panel1.Width;Buffer3.Height:=panel1.Height;
arect.left:=0; aRect.top:=0; arect.Bottom:=panel1.Height; arect.Right:=panel1.Width;
buffer.canvas.FillRect(arect); buffer3.canvas.FillRect(arect); buffer2.canvas.FillRect(arect);
Screen.Forms[0].Caption:=IntTostr(aRect.left) + '\' + IntTostr(aRect.Top) + '\' + IntTostr(aRect.Right) + '\' + IntTostr(aRect.Bottom);
// buffer.canvas.draw(0,0,buffer4);
arect.left:=0; aRect.top:=0; arect.Right:=buffer4.Width; arect.Bottom:=buffer4.Height;
buffer.canvas.CopyRect(aRect,buffer4.canvas,aRect);
mx:=0; my:=0; sx:=0; sy:=0;
t:=false;
end;
end;
aaaprojekt.zip paintprojekttest.zippluto hat geschrieben: beim vergrößern daurt das jetzt d.h. wenn ich die zeichenfläche vergrößere dauert es bzw. stock es !
pluto hat geschrieben:ich dachte bis jetzt eine paintbox ist zum zeichnen da aber da liege ich wohl falsch und alle andren auch *G*
Code: Alles auswählen
P.S: Du müsstest natürlich zu diesem Zweck deine Objekte mit mehr Information versehen (Rahmefarbe, Füllfarbe, Form (Kreis, Ellipse, Rechteck), z-Index etc).
Verein
Links Suche
