Fórum Falta alguma coisa nesse componente... #167345

02/07/2003

0

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.


Earmarques

Earmarques

Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar