Fórum Label SetFocus #266784

Use um edit sem bordas.

Vou precisar da propriedade Transparent = True;

Para o que você precisa de um componente assim?

Será usado para fazer o menu do sistema,

Tentei fazer o componente,

mas...

Olha as derivações (de maneira resumida)...

Tedit -> TCustomEdit -> TWinControl(que da as propriedades que preciso como setfocus, coloca o objeto na tablist e outros) -> TControl

TLabel -> TCustomLabel -> TGraphicsControl -> TControl

O Tlabel não herda nada de TWincontrol.

Então tentei fazer um componente a partir da classe TWincontrol,

fui acrescentando a Classe GraphicsControls e CustomLabel e por fim TLAbel.

A propriedade Transparent não funcionou, e a operação de desenhar o texto é chamada toda hora, até que aconteça um overflow.

Percibi que o problema está na classe Graphics.

unit WCDonatoLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

TDonatoWinControlGraphic = class(TWinControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure paint; Virtual;
property Canvas: TCanvas read FCanvas;
public
// adaptado
CaptureControl: TControl;
//TGraphics faria Override para TCntrol mas aqui faz para WinCntrol
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//fim de override
end;


TDonatoCustomLabel = class(TDonatoWinControlGraphic)
private
FFocusControl: TWinControl;
FAlignment: TAlignment;
FAutoSize: Boolean;
FLayout: TTextLayout;
FWordWrap: Boolean;
FShowAccelChar: Boolean;
function GetTransparent: Boolean;
function pegarClientRect: TRect;
procedure SetAlignment(Value: TAlignment);
procedure SetFocusControl(Value: TWinControl);
procedure SetShowAccelChar(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure SetLayout(Value: TTextLayout);
procedure SetWordWrap(Value: Boolean);
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure AdjustBounds; dynamic;
procedure DoDrawText(var Rect: TRect; Flags: Longint); dynamic;
function GetLabelText: string; virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
// procedure Paint; Override;
procedure SetAutoSize(Value: Boolean); virtual;
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
property FocusControl: TWinControl read FFocusControl write SetFocusControl;
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
property Transparent: Boolean read GetTransparent write SetTransparent default False;
property Layout: TTextLayout read FLayout write SetLayout default tlTop;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
public
constructor Create(AOwner: TComponent); override;
procedure Paint; Override;
property Canvas;
end;


TDonatoLabel = class(TDonatoCustomLabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(´Donato´, [TDonatoLabel, TDonatoCustomLabel, TDonatoWinControlGraphic]);
end;

{ TDonatoWinControlGraphic }

constructor TDonatoWinControlGraphic.Create(AOwner: TComponent);
begin
//ha códigos de TControl que não foram importador
// pq a graphifcsControl faz override para Tcontrol
// graphics
inherited ;
//Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;

end;

destructor TDonatoWinControlGraphic.Destroy;
begin
if CaptureControl = Self then SetCaptureControl(nil);
FCanvas.Free;
inherited
Destroy;
end;

procedure TDonatoWinControlGraphic.WMPaint(var Message: TWMPaint);
begin
// if Message.DC 0 then
// begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint;
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
// end;
end;

procedure TDonatoWinControlGraphic.Paint;
begin
//sem codigo
end;

{ TDonatoCustomLabel }
constructor TDonatoCustomLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque, csReplicatable];
Width := 65;
Height := 17;
FAutoSize := True;
FShowAccelChar := True;
end;

function TDonatoCustomLabel.GetLabelText: string;
begin
Result := Caption;
end;

procedure TDonatoCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var
Text: string;
begin
Text := GetLabelText;
if (Flags and DT_CALCRECT 0) and ((Text = ´´) or FShowAccelChar and
(Text[1] = ´&´) and (Text[2] = #0)) then Text := Text + ´ ´;
if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
Flags := DrawTextBiDiModeFlags(Flags);
Canvas.Font := Font;
if not Enabled then
begin
OffsetRect(Rect, 1, 1);
Canvas.Font.Color := clBtnHighlight;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end
else
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;

procedure TDonatoCustomLabel.Paint;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
Rect, CalcRect: TRect;
DrawStyle: Longint;
begin
with Canvas do
begin
if not Transparent then
begin
Brush.Color := Self.Color;
Brush.Style := bsSolid;
// FillRect(ClientRect);
FillRect(PegarClientRect);
end;
Brush.Style := bsClear;
// Rect := ClientRect;
Rect := PegarClientRect;
{ DoDrawText takes care of BiDi alignments }
DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
{ Calculate vertical layout }
if FLayout tlTop then
begin
CalcRect := Rect;
DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
if FLayout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
end;
DoDrawText(Rect, DrawStyle);
end;
end;

procedure TDonatoCustomLabel.Loaded;
begin
inherited Loaded;
AdjustBounds;
end;
//funcao adpatada para corrigir o erro has not parent
function TDonatoCustomLabel.PegarClientRect: TRect;
begin
Result.Left := 0;
Result.Top := 0;
Result.Right := Width;
Result.Bottom := Height;
end;

procedure TDonatoCustomLabel.AdjustBounds;
const
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
DC: HDC;
X: Integer;
Rect: TRect;
AAlignment: TAlignment;
begin
if not (csReading in ComponentState) and FAutoSize then
begin
// Rect := ClientRect;
Rect := PegarClientRect;
DC := GetDC(0);
Canvas.Handle := DC;
DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
Canvas.Handle := 0;
ReleaseDC(0, DC);
X := Left;
AAlignment := FAlignment;
if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
SetBounds(X, Top, Rect.Right, Rect.Bottom);
end;
end;

procedure TDonatoCustomLabel.SetAlignment(Value: TAlignment);
begin
if FAlignment Value then
begin
FAlignment := Value;
Invalidate;
end;
end;

procedure TDonatoCustomLabel.SetAutoSize(Value: Boolean);
begin
if FAutoSize Value then
begin
FAutoSize := Value;
AdjustBounds;
end;
end;

function TDonatoCustomLabel.GetTransparent: Boolean;
begin
Result := not (csOpaque in ControlStyle);
end;

procedure TDonatoCustomLabel.SetFocusControl(Value: TWinControl);
begin
FFocusControl := Value;
if Value nil then Value.FreeNotification(Self);
end;

procedure TDonatoCustomLabel.SetShowAccelChar(Value: Boolean);
begin
if FShowAccelChar Value then
begin
FShowAccelChar := Value;
Invalidate;
end;
end;

procedure TDonatoCustomLabel.SetTransparent(Value: Boolean);
begin

if Transparent Value then
begin
if Value then
ControlStyle := ControlStyle - [csOpaque] else
ControlStyle := ControlStyle + [csOpaque];
Invalidate;
end;
end;

procedure TDonatoCustomLabel.SetLayout(Value: TTextLayout);
begin
if FLayout Value then
begin
FLayout := Value;
Invalidate;
end;
end;

procedure TDonatoCustomLabel.SetWordWrap(Value: Boolean);
begin
if FWordWrap Value then
begin
FWordWrap := Value;
AdjustBounds;
Invalidate;
end;
end;

procedure TDonatoCustomLabel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FFocusControl) then
begin
FFocusControl := nil;
end;
end;

procedure TDonatoCustomLabel.CMTextChanged(var Message: TMessage);
begin
Invalidate;
AdjustBounds;
end;

procedure TDonatoCustomLabel.CMFontChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
end;

procedure TDonatoCustomLabel.CMDialogChar(var Message: TCMDialogChar);
begin
if (FFocusControl nil) and Enabled and ShowAccelChar and
IsAccel(Message.CharCode, Caption) then
with FFocusControl do
if CanFocus then
begin
SetFocus;
Message.Result := 1;
end;
end;

{ TDonatoLabel }


end.