////////////////////////////////////////////////////////////////////////////////
// TMyImage v1.0
//
// Beispielkomponente um zu zeigen wie in einer grafischen Komponente
// (TGraphicControl) auf den Bildschirm gezeichnet werden kann.
//
// Die Komponente zeigt das Bild das TPicture zugewiesen wird an.
// Um dieses Bild wird ein Rahmen gezeichnet. Das Aussehen des Rahmens kann
// mit den Eigenschaften Border* bestimmt werden.
// Es wurden nur die Basis Funktionalitäten von TImage nachgebaut.
// Das ist ein Programmierbeispiel, keine erinsatzfähige Komponente.
//
// Das Beispiel entstand im Rahmen folgenden Beitrags aus [url]www.delphipraxis.net:[/url]
// [url]http://www.delphipraxis.net/topic95229_komponentenentwicklung+fuer+fortgeschrittene.html[/url]
//
////////////////////////////////////////////////////////////////////////////////
// Die Komponente ist Freeware und darf beliebig benutzt und erweitert werden.
// Es wäre nett, wenn dann auch der geänderte Quelltext in obiges URL-Adresse
// gesendet wird. Dann haben alle was davon.
// Es wäre auch nett wenn mein (unser) Name in den Dateien enthalten bleibt.
// Die Komponente wird von Ihnen auf eigenes Risiko eingesetzt. Ich übernehme
// keine Haftung für Schäden die durch die Komponente oder die Benutzung der
// Komponente entstanden sind bzw. entstehen.
////////////////////////////////////////////////////////////////////////////////
// (C) 2006, MaBuSE, member of DelphiPraxis.net
////////////////////////////////////////////////////////////////////////////////
// ReleaseNotes:
// v1.0 - 26.10.2006 - MaBuSE: Erste Version war in 15 min programmiert
////////////////////////////////////////////////////////////////////////////////
unit MyImage;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Types;
type
TMyImage =
class(TGraphicControl)
private
{ Private-Deklarationen }
FBorderColor: TColor;
FBorderStyle: TPenStyle;
FBorderVisible: Boolean;
FBorderWidth: Integer;
FPicture: TPicture;
FStretch: Boolean;
function DestRect: TRect;
procedure PictureChanged(Sender: TObject);
procedure SetBorderColor(
const Value: TColor);
procedure SetBorderStyle(
const Value: TPenStyle);
procedure SetBorderVisible(
const Value: Boolean);
procedure SetBorderWidth(
const Value: Integer);
procedure SetPicture(
const Value: TPicture);
procedure SetStretch(
const Value: Boolean);
protected
{ Protected-Deklarationen }
procedure Paint;
override;
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published-Deklarationen }
property BorderColor: TColor
read FBorderColor
write SetBorderColor;
property BorderStyle: TPenStyle
read FBorderStyle
write SetBorderStyle;
property BorderVisible: Boolean
read FBorderVisible
write SetBorderVisible;
property BorderWith: Integer
read FBorderWidth
write SetBorderWidth;
property Picture: TPicture
read FPicture
write SetPicture;
property Stretch: Boolean
read FStretch
write SetStretch;
property OnClick;
property OnDblClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Beispiele', [TMyImage]);
end;
{ TMyImage }
// Der Konstruktor erzeugt ein TPicture, dass das Bild beinhalten wird.
// TPicture hat ein OnChange Ereignis, dass uns benachichtigt, wenn sich das
// Bild geändert hat. Es wird dann PictureChanges aufgerufen.
constructor TMyImage.Create(AOwner: TComponent);
begin
inherited;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
Height := 105;
Width := 105;
FBorderColor := clRed;
FBorderStyle := psSolid;
FBorderVisible := True;
FBorderWidth := 1;
FStretch := False;
end;
// Hier wird das Rechteck festgelegt, in das das Bild geszeichnet wird.
// Es ist ein "einfaches" Stretch programmiert
// Stretch := True -> Das Rechteck hat die Maße der Komponente
// Stretch := False -> Das Rechteck hat die Maße der Grafik
// Natürlich könnte man da noch Propertional und Center berücksichtigen ;-)
function TMyImage.DestRect: TRect;
begin
with Result
do
begin
Left := 0;
Top := 0;
if FStretch
then
begin
Right := ClientWidth;
Bottom := ClientHeight;
end
else
begin
Right := Picture.Width;
Bottom := Picture.Height;
end;
end;
end;
destructor TMyImage.Destroy;
begin
FPicture.Free;
inherited;
end;
// Diese Methode zeichnet die Komponente
// zuerst wird das Bild gezeichnet, danach der Rahmen
procedure TMyImage.Paint;
begin
try
with Canvas
do
begin
StretchDraw(DestRect, Picture.Graphic);
end;
except
end;
if FBorderVisible
then
with Canvas
do
begin
Pen.Color := FBorderColor;
Pen.Style := FBorderStyle;
Pen.Width := FBorderWidth;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
end;
// Diese Methode sorgt dafür, dass die Komponente neu gezeichnet wird.
// Hier können später noch Anweisungen rein, die bei jeder Bildänderung
// durchgeführt werden sollen.
procedure TMyImage.PictureChanged(Sender: TObject);
begin
Invalidate;
end;
// Alle Eigenschaften haben eine Methode zum Setzen des Wertes
// Diese Methode wird nur benötigt, da PictureChaged aufgerufen werden soll,
// damit die Komponente sich neuzeichnet.
procedure TMyImage.SetBorderColor(
const Value: TColor);
begin
FBorderColor := Value;
PictureChanged(self);
end;
procedure TMyImage.SetBorderStyle(
const Value: TPenStyle);
begin
FBorderStyle := Value;
PictureChanged(self);
end;
procedure TMyImage.SetBorderVisible(
const Value: Boolean);
begin
FBorderVisible := Value;
PictureChanged(self);
end;
procedure TMyImage.SetBorderWidth(
const Value: Integer);
begin
FBorderWidth := Value;
PictureChanged(self);
end;
procedure TMyImage.SetPicture(
const Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TMyImage.SetStretch(
const Value: Boolean);
begin
FStretch := Value;
PictureChanged(self);
end;
end.