Czy da się ustawić TImage tak by był w kształcie koła?
- Rejestracja:prawie 12 lat
- Ostatnio:prawie 12 lat
0
Właśnie to wypróbowałam, ale jest pewien problem.
Chcę ustawić na TShape bitmapę i przesuwać ten obiekt po formie:
Shape1.Brush.Bitmap := Bitmap;
Shape1.SetBounds(Shape1.Left+10, Shape1.Top - 10, Shape1.Width, Shape1.Height
Tylko wtedy ten obiekt przesuwa mi się po tej bitmapie i zmienia się obrazek w kole.
Jak to naprawić?
edytowany 2x, ostatnio: flowCRANE

flowCRANE
Pokaż więcej kodu;
- Rejestracja:około 17 lat
- Ostatnio:około 11 lat
0
Brush.bitmap ustawia pattern i właśnie tak to działa.
Dużo prościej będzie, jeżeli narysujesz sobie to koło w pliku bmp. Obszar poza okręgiem wypełniasz kolorem różowym: clFuchsia. Ładujesz obraz do TImage, w którym ustawiasz Transparent := true; I wszystko co różowe będzie przezroczyste.
- Rejestracja:prawie 15 lat
- Ostatnio:prawie 11 lat
- Postów:184
0
Nie mam czasu się rozpisywać, więc tylko kod (pisany na szybko, ale działa - można przesuwać okrągły obrazek po formularzu). W razie wątpliwości pytaj.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;
type
TCircleImage = class(TCustomControl)
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
end;
type
TForm1 = class(TForm)
Image1: TImage;
procedure CircleImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
CircleImage: TCircleImage;
implementation
{$R *.DFM}
constructor TCircleImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width:= 100;
Height:= 100;
end;
procedure TCircleImage.Paint;
var aRect: TRect;
begin
aRect:= Rect(0, 0, 100, 100);
Canvas.CopyRect(aRect, Form1.Image1.Canvas, aRect);
end;
procedure TForm1.CircleImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var aHandle: THandle;
begin
aHandle:= (Sender as TCircleImage).Handle;
BringWindowToTop(aHandle);
ReleaseCapture;
SendMessage(aHandle, WM_NCLBUTTONDOWN, 2, 0); // 2 = HTCAPTION
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CircleImage:= TCircleImage.Create(Self);
CircleImage.Parent:= Self;
SetWindowRgn(CircleImage.Handle, CreateEllipticRgn(0, 0, 100, 100), true);
CircleImage.OnMouseDown:= CircleImageMouseDown;
CircleImage.Left:= 10;
CircleImage.Top:= 10;
end;
end.