Jednoduché tvary v Delphi – Delphi – Fórum – Programujte.com

Dobrý den, nevím si rady s krekslením obdélníka, elipsy atd...samozřejmě znám komponentu TShape, ale ta je mi k ničemu. Potřeboval bych, aby když v ComboBoxu vyberu např. možnost "elipsa", aby se mi tažením myši kreslila libovolně velká elipsa, dokud myš nepustím, snad víte co myslím. Předem díky za odpověď

Tady to kreslí obdélníky nebo elipsy:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ComCtrls;

type
TForm1 = class(TForm)
SpinEdit1: TSpinEdit; //tloušťka čáry (1 až 5 pixelů)
Label1: TLabel; //Nadpis 'Tloušťka čáry'
ComboBox1: TComboBox; //barva čáry (položky(Items) černá,červená,modrá,zelená,
//žlutá,fialová,světle modrá)
//ItemIndex dát 0
Label2: TLabel; //Nadpis 'Barva čáry'
StatusBar1: TStatusBar;
Label3: TLabel; //Nadpis 'Objekt'
ComboBox2: TComboBox; //objekt (položky(Items) obdélník, elipsa)
//ItemIndex dát 0
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
PocX,PocY,KonX,KonY: Integer;
Hranice: Boolean;
Barva: TColor;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
PocX := X;
KonX := X;
PocY := Y;
KonY := Y;
Hranice := True;
case ComboBox1.ItemIndex of
0: Barva := clBlack;
1: Barva := clRed;
2: Barva := clBlue;
3: Barva := clLime;
4: Barva := clYellow;
5: Barva := clFuchsia;
6: Barva := clAqua;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Hranice then
begin
Canvas.Pen.Mode := pmNot;
Canvas.Pen.Width := SpinEdit1.Value;
Canvas.Pen.Style := psDash;
Canvas.Brush.Style := bsClear;
case ComboBox2.ItemIndex of
0: Canvas.Rectangle(PocX, PocY, KonX, KonY);
1: Canvas.Ellipse(PocX, PocY, KonX, KonY);
end;
KonX := X;
KonY := Y;
case ComboBox2.ItemIndex of
0: Canvas.Rectangle(PocX, PocY, KonX, KonY);
1: Canvas.Ellipse(PocX, PocY, KonX, KonY);
end;
StatusBar1.Panels[0].Text := ' délka = '+IntToStr(abs(X-PocX));
StatusBar1.Panels[1].Text := ' výška = '+IntToStr(abs(Y-PocY));
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Hranice then
begin
Hranice := False;
Canvas.Pen.Color := Barva;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmCopy;
Canvas.Brush.Style := bsClear;
case ComboBox2.ItemIndex of
0: Canvas.Rectangle(PocX, PocY, KonX, KonY);
1: Canvas.Ellipse(PocX, PocY, KonX, KonY);
end;
end;
end;

end.

Díky moc, funguje to, objekt to nakreslí, ale v okamžiku kliknutí na formulář to hodí error: List index out of bounds (0), a dál se nedostanu. Kde dělám chybu?Díky

To maniak123
A máš v Object Inspectoru u komponenty SpinEdit1 nastaveno:
MaxValue na 5
MinValue na 1
Value na 1

a v těch ComboBoxech to co je vždy uvedeno za //....?

mám, všechno jsem nastavoval:-(

nikdo nic?:-(

Tak sem dej svůj kód a uvidíme.

je to ten kód výše...

Nemáš ve StatusBaru 2 sloupečky (ale pouze 1)
Tedy přidej - viz. níže

procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.Panels.Add;
StatusBar1.Panels[0].Width := 100;
end;

No vidíš, to mě nenapadlo, ale hází to pořád to samé, ale změnilo se číslo v závorce z 0 na 1, tzn. na "List index out of bounds (1)"

EDIT: Problém vyřešen, panel jsem přidal ručně (pravým tl. na statusbaru na formuláři), nicméně odhalil jsi chybu a za to děkuju moc:-)

Stejně tak díky autorovi kódu, je to moje dlouhodobá maturitní práce, díky vám oběma, pomohli jste mi

EDIT2: P.S.: Kdyby jste se chtěli mrknout na můj druhý problém, tak se to vlákno jmenuje Barevné složky, díky:-)