Zdravím všechny,
pracuji na jednoduchém grafickém editoru, ale zasekla jsem se na jedné věci. Potřebuji, aby mi po zaškrtnutí příslušního RadioButtonu (RadioButton2) šlo "kreslit myší" na plochu Image1, přičemž by tloušťka kreslené stopy byla ovládána SpinEditem2. Udělala jsem si přiřazení hodnoty ze SpinEditu2 do proměnné tloustkacary, kterou jsem přiřadila Image1.Canvas.Pen.Width:=tloustkacary (asi by to šlo i rovnou, ale pro mě je to přehlednější :o)), nevím si ale rady s tím, jak přimět pero kreslit od chvíle, kdy kliknu stisknu příslušný RadioButton2 a kliknu na plochu Image1, a přestat když myš pustím. Napadlo mě to řešit přes něco podobného MouseDown a MouseUp, ale nedaří se mi.. neporadíte?
Fórum › Delphi
Kreslení myší na Image1, jak použít MouseDown?
Když máš povolené kreslení (RadioButtonem), tak při OnMouseDown si nahoď nějaký flag (stavovou proměnnou).
V OnMouseMove prováděj kreslení myší, když je nahozený tento flag.
V OnMouseUp flag nuluj.
Asi ještě budeš potřebovat SetCapture (ReleaseCapture), aby si mohla zachytávat zprávy i když budeš kurzorem mimo okno nebo ClipCursor na omezení pohybu kurzoru jen na velikost okna (při kreslení).
Zkus to takhle:
var
Form1: TForm1;
kreslim: Boolean;
implementation
{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.Pen.Width := SpinEdit2.Value;
if RadioButton2.Checked then
kreslim := True;
if kreslim then
with Image1.Canvas do
MoveTo(X, Y);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if kreslim then
with Image1.Canvas do
LineTo(X, Y);
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
kreslim := False;
end;
Zkusila jsem, ale asi mám zádrhel ještě někde jinde, někde mám chybu a nemohu to najít. Vkládám celý svůj kód, kdyby vás pánové někoho napadlo co s tím je.. všimla jsem si také, že mi nevím proč nepracuje procedura FormCreate. Kružnice a čtverec se mi vykresluje bez problémů, ale to kreslení myší, kdy bych měla být schopna začít kreslit po zatržení RadioButton3 (pardon, předtím jsem psala 2 - v kódu to mám poopraveno) a klepnutí na plochu Image1 mi pořád nejde. :smile19:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
SpinEdit3: TSpinEdit;
SpinEdit4: TSpinEdit;
Label5: TLabel;
Button3: TButton;
RadioGroup1: TRadioGroup;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
ColorDialog1: TColorDialog;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpinEdit3Change(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure SpinEdit4Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
//DEFINICE PROCEDURY OD HONZC
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
//DEFINICE PROCEDURY OD HONZC
private
barva: TColor;
tloustka: integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
x, y: integer;
d: integer;
kreslim: boolean; //K PROCEDURE OD HONZC
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject); //při vytvoření formuláře by měla nastavit Brush, ale nenastavuje
begin
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style:= bsSolid;
Image1.Canvas.Pen.Color:=clBlack;
Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);
end;
//PROCEDURA OD HONZC
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.Pen.Width:= SpinEdit3.Value;
if RadioButton3.Checked then
kreslim:= True;
if kreslim = True then
with Image1.Canvas do
MoveTo(X, Y);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if kreslim = True then
with Image1.Canvas do
LineTo(X, Y);
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
kreslim := False;
end;
//KONEC PROCEDURY OD HONZC
procedure TForm1.Button3Click(Sender: TObject); //vymazání obsahu plátna
begin
Image1.Picture:=nil;
end;
procedure TForm1.Button2Click(Sender: TObject); //tlačítko, po jehož stisknutí se vykreslí kruh nebo čtverec
begin
Image1.Canvas.MoveTo(x,y);
Image1.Canvas.Pen.Color:=barva;
Image1.Canvas.Pen.Width:=tloustka;
if (RadioButton2.Checked = True) then
Image1.Canvas.Ellipse(x,y,SpinEdit4.Value,SpinEdit4.Value);
if (RadioButton1.Checked = True) then
Image1.Canvas.Rectangle(x,y,SpinEdit4.Value,SpinEdit4.Value);
end;
procedure TForm1.SpinEdit3Change(Sender: TObject); //hodnota tloušťky čáry
begin
tloustka:=SpinEdit3.Value;
end;
procedure TForm1.SpinEdit1Change(Sender: TObject); //x-ová souřadnice
begin
x:=SpinEdit1.Value;
end;
procedure TForm1.SpinEdit2Change(Sender: TObject); //y-ová souřadnice
begin
y:=SpinEdit2.Value;
end;
procedure TForm1.SpinEdit4Change(Sender: TObject); //poloměr pro kružnici a čtverec
begin
d:=SpinEdit4.Value;
end;
procedure TForm1.Button1Click(Sender: TObject); //změna barvy čáry
begin
if ColorDialog1.Execute then barva := ColorDialog1.Color;
end;
end.
To Aqua
Ponechám stranou, že tvoje kreslení je docela nešikovné (vykreslování tvarů tak, že souřadnice a velikost tvaru zadáváš nastavováním nějakých SpinEditů), tak k tomu FormCreate.
Zkus vyměnit řádek Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);
za Image1.Canvas.FillRect(Rect(0,0,Image1.Width, Image1.Height));
To, že ti nefunguje ten můj kód je asi způsobeno tím, že nemáš procedury, které jsem ti napsal přiřazeny v ObjectInspectoru těm Eventsům.
Náprava: V Object TreeView klikni na Image1
V Object Inspector zapni záložku Events
Postupně dvojklikem myší klikni do políček vedle OnMouseDown, OnMouseMove a OnMouseUp
Aha, máte pravdu pánové, neměla jsem proklikané Events, ten amatér se ve mě nezapře. :smile1:
liborb: Děkuju za radu. :smile1:
Honzc: Já vím, že ty SpinSdity nejsou nejlepší, ale mám to tak přímo zadáno, že tam mají takto být. Procedury s Mouse už jedou, moc děkuji, zachránil jsi mě. :smile6: Jen mám stále ještě problém s tím, že po vytvoření "okna", to jest když má zapracovat FormCreate, nevybarví se mi ten Brush na bílo. Zkusím ještě nějak upravit obsah FormCreatu, ale nehlásí mi to chybu v kódu, tak nevím. Ještě musím domyslet trik, který by umožnil měnit barvu pera pomocí ColorDialog1.Coloru.
Tak může být problém jenom v tom, že se okno nepřekreslí. To zjistíš například tak, že ho překryješ jiným oknem a pak ho zase daš do popředí. Pokud je to tím, tak na konec FormCreate bude potřeba přidat Invalidate (Repaint).
liborb napsal:
Tak může být problém jenom v tom, že se okno nepřekreslí. To zjistíš například tak, že ho překryješ jiným oknem a pak ho zase daš do popředí. Pokud je to tím, tak na konec FormCreate bude potřeba přidat Invalidate (Repaint).
Zkoušela jsem obojí. ale stále to nefunguje.. netuším v čem to může být. :smile19:
Už mi to funguje, děkuji všem za rady. Zádrhel byl v tom, že jsem FormCreate nenastavila přes Project Managera.
Přidej příspěvek
Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku
×Vložení zdrojáku
×Vložení obrázku
×Vložení videa
Uživatelé prohlížející si toto vlákno
Podobná vlákna
Mousedown - použití při kreslení — založil romadur
Jak použít disabled — založil farth
Jak pouzit .htaccess a mod_rewrite — založil David
Jak použít příkaz return?? — založil Jirda
Jak načítat polohu z myši přes RS232 — založil azza