Falta alguma coisa nesse componente...
Pessoal, meu nome é Edilio. Obrigado pela força. Segue o código do componente. É uma simples linha, que em tempo de execução deve possibilitar ser movida, e redimensionada, sendo que ela vai ser ou horizontal ou vertical. Até agora consegui apenas que ela seja criada, redimensionada através da propriedade tamanho, e orientada horizontal e verticalmente. Falta a possibilidade de redimensionar em tempo de projeto também:
unit Linha;
interface
uses
Classes, Controls, Graphics, WinTypes, WinProcs;
type
TOrientacao = (dHorizontal, dVertical);
TLinha = class(TGraphicControl)
private
FOrientacao : TOrientacao;
FColor : TColor;
FTamanho : Integer;
procedure SetOrientacao(valor : TOrientacao);
procedure SetColor(valor : TColor);
procedure SetTamanho(valor : Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner : TComponent); override;
published
property Tamanho : Integer read FTamanho write SetTamanho default 100;
property Orientacao : TOrientacao read FOrientacao write SetOrientacao default dHorizontal;
property Color : TColor read FColor write SetColor default clBlack;
property Align;
end;
procedure Register;
implementation
constructor TLinha.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FOrientacao:=dHorizontal;
FTamanho := 100;
FColor:=clBlack;
Width:=FTamanho;
Height:=1;
end;
procedure TLinha.SetTamanho(valor : Integer);
begin
if FTamanho <> valor then
begin
FTamanho := valor;
Repaint;
end;
end;
procedure TLinha.SetOrientacao(Valor : TOrientacao);
begin
if FOrientacao <> valor then
begin
FOrientacao := Valor;
Repaint;
end;
end;
procedure TLinha.SetColor(Valor : TColor);
begin
if FColor <> Valor then
begin
FColor := Valor;
Repaint;
end;
end;
procedure TLinha.Paint;
begin
canvas.Pen.Color := FColor;
canvas.Pen.Mode := pmCopy;
if FOrientacao = dVertical then
begin
Height := FTamanho;
Width := 1;
Canvas.MoveTo(0,0);
Canvas.LineTo(0,Height);
end
else
begin
Width := FTamanho;
Height := 1;
Canvas.MoveTo(0,0);
Canvas.LineTo(Width,0);
end;
end;
procedure Register;
begin
RegisterComponents(´Desenho´, [TLinha]);
end;
end.
unit Linha;
interface
uses
Classes, Controls, Graphics, WinTypes, WinProcs;
type
TOrientacao = (dHorizontal, dVertical);
TLinha = class(TGraphicControl)
private
FOrientacao : TOrientacao;
FColor : TColor;
FTamanho : Integer;
procedure SetOrientacao(valor : TOrientacao);
procedure SetColor(valor : TColor);
procedure SetTamanho(valor : Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner : TComponent); override;
published
property Tamanho : Integer read FTamanho write SetTamanho default 100;
property Orientacao : TOrientacao read FOrientacao write SetOrientacao default dHorizontal;
property Color : TColor read FColor write SetColor default clBlack;
property Align;
end;
procedure Register;
implementation
constructor TLinha.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FOrientacao:=dHorizontal;
FTamanho := 100;
FColor:=clBlack;
Width:=FTamanho;
Height:=1;
end;
procedure TLinha.SetTamanho(valor : Integer);
begin
if FTamanho <> valor then
begin
FTamanho := valor;
Repaint;
end;
end;
procedure TLinha.SetOrientacao(Valor : TOrientacao);
begin
if FOrientacao <> valor then
begin
FOrientacao := Valor;
Repaint;
end;
end;
procedure TLinha.SetColor(Valor : TColor);
begin
if FColor <> Valor then
begin
FColor := Valor;
Repaint;
end;
end;
procedure TLinha.Paint;
begin
canvas.Pen.Color := FColor;
canvas.Pen.Mode := pmCopy;
if FOrientacao = dVertical then
begin
Height := FTamanho;
Width := 1;
Canvas.MoveTo(0,0);
Canvas.LineTo(0,Height);
end
else
begin
Width := FTamanho;
Height := 1;
Canvas.MoveTo(0,0);
Canvas.LineTo(Width,0);
end;
end;
procedure Register;
begin
RegisterComponents(´Desenho´, [TLinha]);
end;
end.
Earmarques
Curtidas 0