Forum > macOS / Mac OS X

Problem with component under OSX

(1/1)

vbinsbgn:
[using Lazarus 0.9.29 svn 27140, Max OSX Snow Leopard]
I made a new component (herited from TLabel). After installation of the package in Lazarus, I can use it without problems when I create the component during runtime. Placing a component on a form during design time crashes Lazarus: sometimes I got the message: "Cannot assign a Nil to aTFont".

I've searched the web, but nothing found...
With Win32 everything works fine.

A hint would be very appriciated!

skalogryz:
is it possible for you to share component's source code?

vbinsbgn:

--- Quote from: skalogryz on August 24, 2010, 07:58:08 am ---is it possible for you to share component's source code?

--- End quote ---
Yes it is:

--- Code: ---
unit HL;

{----------------------------------------------------------------------------}
{  THintLabel component FOR MacOS X !!                                       }
{  ==================== ===========                                          }
{                                                                            }
{  Properties - published                                                    }
{  ----------------------                                                    }
{  property HintText:Boolean;                                                }
{  - when true then automatic show hint window for items which do not fit    }
{    into Label width                                                        }
{  property HintColor: TColor                                                }
{                                                                            }
{----------------------------------------------------------------------------}

interface

uses
 SysUtils, Forms, Graphics, Classes, LMessages, Controls, StdCtrls,
 ExtCtrls, Dialogs;

type
 THintLabel = class;
 
 THintWindowRk = class(THintWindow)
  procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
 private
  FFont: TFont;
  FColor: TColor;
 public
  procedure SetHFont(Value: TFont);
  procedure SetHColor(Value: TColor);
  procedure Paint; override;
 end;
 
 THintLabel = class(TCustomLabel)
 private
  FHintText: Boolean;
  FHintColor: TColor;
  FHintWin: THintWindowRk;
  FOnMouseExit: TNotifyEvent;
  FOnMouseEnter: TNotifyEvent;
  procedure SetHintText(Value: boolean);
  procedure SetHintColor(Value: TColor);
  procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
  procedure HintClose(Sender: TObject);
 protected
 public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
 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 Font;
  property HintText: Boolean read FHintText write SetHintText default true;
  property HintColor: TColor read FHintColor write SetHintColor;
  property Height;
  property HelpContext;
  property HelpKeyword;
  property HelpType;
  property Hint;
  property Layout;
  property Left;
  property Name;
  property ParentBiDiMode;
  property ParentColor;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property Visible;
  property Transparent;
  property Width;
  property Top;
  property WordWrap;
  property OnClick;
  property OnContextPopup;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDock;
  property OnEndDrag;
  property OnMouseDown;
  property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDock;
  property OnStartDrag;
 end;

procedure Register;

implementation

// THintWindowRk

procedure THintWindowRk.Paint;
var
 Rect: TRect;
begin
 Rect := ClientRect;
 Canvas.Font := FFont;
 Color := FColor;
 Canvas.TextRect(Rect, 0, Rect.Top, Caption);
end;

procedure THintWindowRk.SetHFont(Value: TFont);
begin
 FFont := Value;
end;

procedure THintWindowRk.SetHColor(Value: TColor);
begin
 FColor := Value;
end;

procedure THintWindowRk.CMMouseLeave(var Message: TLMessage);
begin
 inherited;
 ReleaseHandle;
end;

constructor THintLabel.Create(AOwner: TComponent);
begin
 inherited;
 FHintWin := THintWindowRk.Create(Self);
 FHintWin.FFont := TFont.Create;
 FHintWin.AutoHide := False;
 with FHintWin.FFont do
 begin
   Name := 'Lucida Grande';
   Size := 13;
   Style := [];
   Pitch := fpDefault;
   Quality := fqDefault;
 end;
 FHintWin.SetHColor(Color);
 FHintText := True;
 FHintColor := Color;
end;

destructor THintLabel.Destroy;
begin
 FHintWin.FFont.Free;
 inherited;
end;

procedure THintLabel.SetHintText(Value: boolean);
begin
 FHintText := Value;
 if not FHintText then
  HintClose(Self);
end;

procedure THintLabel.SetHintColor(Value: TColor);
begin
 FHintColor := Value;
 FHintWin.SetColor(Value);
end;

procedure THintLabel.CMMouseEnter(var Message: TLMessage);
var
 Wi: integer;
 rct: TRect;
 TL: TPoint;
begin
 inherited;
 if not FHintText or Autosize then
  Exit;
 Wi := Canvas.TextWidth(Caption);
 TL := ClientOrigin;
 rct.Left := TL.X;
 rct.Right := rct.Left + Width;
 rct.Top := TL.Y;
 rct.Bottom := rct.Top + Height;
 if Wi > (Width - 3) then
  begin
  // Stretch it to fit the whole item text
   Rct.Right := Rct.Left + FHintwin.Canvas.TextWidth(Caption) + 7;
   FHintWin.ActivateHint(rct, Caption);
  end
end;

procedure THintLabel.HintClose(Sender: TObject);
begin
 FHintWin.ReleaseHandle;
end;

procedure Register;
begin
 RegisterComponents('Bins', [THintLabel]);
end;


end.

--- End code ---

Thank you for replying!

Navigation

[0] Message Index