TImage w kształcie koła

0

Czy da się ustawić TImage tak by był w kształcie koła?

0

Nie, ale zapewne można coś samemu zaimplementować.

0

W takim razie czy jest jakiś komponent w standardowej bibliotece, który można przedstawić w kształcie koła, ma opcje OnClik oraz nie jest oznaczany przez przerywane kreski podczas kliknięcia(jak np. TButton lub TBitBtn)?

0

Może TShape z palety Additional, tylko zamiast OnClick oprogramuj OnMouseDown.

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ć?

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.

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.

1 użytkowników online, w tym zalogowanych: 0, gości: 1