Newsgroup: it.comp.lang.delphi
Titolo: Label con immagine: STEP 2

Ciao a tutti,
sono ancora alle prese nella creazione del componente che mi serve
però ho fatto buoni progressi. Alla fine ho creato il componente
partendo dalla classe TPaintBox e con un po' di codice sono arrivato a
buon punto. Posto in fondo del messaggio il codice da me scritto.
Ora però vorrei aggiungere alcune cosette e qui chiedo il vostro
supporto.
In primis vorrei aggiungere che quando il mouse passa sopra il
componente il font mi diventa sottolineato e cambiare colore.
Poi vorrei controllare la trasparenza del componente. Qualcosa ho già
scritto però se setto Transparent = True nell'evento OnPaint il
componente inizia a loopare.
Grazie per l'aiuto,
Dario
unit XPLabel;
interface
uses
  Classes, Controls, ExtCtrls, Graphics, Types;
type
  TXPLabel = class(TPaintBox)
  private
    FCaption: String;
    FPicture: TBitmap;
    FSpace: Integer;
    FTransparent: Boolean;
    procedure SetPicture(Value: TBitmap);
    procedure SetCaption(Value: String);
    procedure SetSpace(Value: integer);
    procedure SetTransparent(Value: Boolean);
  protected
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption: String read FCaption write SetCaption;
    property Picture: TBitmap read FPicture write SetPicture;
    property Space: integer read FSpace write SetSpace default 4;
    property Transparent: boolean read FTransparent write
SetTransparent default True;
    property OnPaint;
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Standard', [TXPLabel]);
end;
constructor TXPLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Cursor := crHandPoint;
  Height := 19;
  FPicture := TBitmap.Create;
  FPicture.TransparentColor := clFuchsia;
  FPicture.Transparent := True;
  Transparent := True;
  FPicture.Height := 16;
  FPicture.Width  := 16;
  FSpace := 4;
  FTransparent := True;
  Self.Repaint;
end;
procedure TXPLabel.Paint;
var XP, XC, YP, YC: Integer;
begin
  inherited;
  if FPicture.Height > 0 then
    Height := FPicture.Height;
  with Self.Canvas do begin
    Width := FPicture.Width + TextWidth(FCaption) + FSpace;
    Brush.Color := Self.Color;
    Font := Self.Font;
    FillRect(Self.ClientRect);
    XP := 0;
    YP := 0; // (Self.Height div 2) - (FPicture.Height div 2);
    Draw(XP, YP, FPicture);
    XC := FPicture.Width + FSpace;
    YC := (Self.Height div 2) - (TextHeight(FCaption) div 2);
    Brush.Style := bsClear;
    TextOut(XC, YC, FCaption);
  end;
end;
procedure TXPLabel.SetPicture(Value: TBitmap);
begin
  FPicture.Assign(Value);
  Self.Repaint;
end;
procedure TXPLabel.SetCaption(Value: String);
begin
  FCaption := Value;
  Self.Repaint;
end;
procedure TXPLabel.SetSpace(Value: integer);
begin
  FSpace := Value;
  Self.Repaint;
end;
procedure TXPLabel.SetTransparent(Value: Boolean);
begin
  FTransparent := Value;
  Self.Repaint;
end;
procedure TXPLabel.MouseMove(Shift: TShiftState; X, Y: Integer);
var R: TRect;
begin
{
  inherited MouseMove(Shift, X, Y);
  MouseCapture := True;
  R := Canvas.ClipRect;
  if (X > R.Left) and (X < R.Right) and (Y > R.Top) and (Y < R.Bottom)
then begin
    Font.Style := [fsUnderline];
  end else begin
    Font.Style := [];
  end;
//  Self.Repaint;
  MouseCapture := False;
}
end;
end.

 Dario
la prima cosa che mi viene in mente, per il font di ingresso e uscita
procedure TXPLabel.CMMouseEnter(Var Msg : TMessage);
Begin
   Inherited;
   Font.Style := [fsUnderline];
End;
procedure TXPLabel.CMMouseLeave(Var Msg : TMessage);
Begin
   Inherited;
   Font.Style := [];
End;
dichiarate in questo modo:
  procedure CMMouseEnter(Var Msg : TMessage); message CM_MOUSEENTER;
  procedure CMMouseLeave(Var Msg : TMessage); message CM_MOUSELEAVE;
ciao
-- 
-------------------------------
per scrivere in privato
togliere "1975nosp"
to reply remove "1975nosp"

 la prima cosa che mi viene in mente, per il font di ingresso e uscita
...e la prima cosa che ti è venuta in mente funziona, grazie
mille!!! :-)
Approfitto di te per chiederti ancora una cosa: come faccio a far
apparire nella caption componente il nome del componente stesso (così
come avviene con tutti i componenti testo) quando lo inserisco nel
form?
Intendo: se inserisco una TLabel la caption è uguale al nome
( Label1 ). Nel moi caso la caption è invece blank!!
Grazie mille ancora
Dario

 ( Label1 ). Nel moi caso la caption č invece blank!!
al momento non saprei dirti, ti consiglierei di usare la caption 
predefinita del componente.
Che toericamente č anche piů comoda :)
la dichiari:
property Caption;
