(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBLabel;
interface
{$I AHM.INC}
uses
  SysUtils, Windows, Controls,Dialogs,Messages,AHMTBackground,
  StdCtrls, Classes, Graphics,DB, DBTables,DBCtrls, Menus,AHMEnhancedClass;
type
  TAHMDBLabel = class(TCustomLabel)
  private
    FAHMAboutStr : TAHMAboutEnhancedStr;
    FDataLink: TFieldDataLink;
    fback,fback2 : TAHMBackground;
    f3d : TAHMFont3D;
    fframe : TAHMFrame;
    procedure DataChange(Sender: TObject);
    procedure Setback(value : TAHMBackground);
    procedure Setback2(value : TAHMBackground);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetFieldText: string;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure Set3D(value : TAHMFont3D);
    procedure SetFrame(value : TAHMFrame);
  protected
    function GetLabelText: string; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetAutoSize(Value: Boolean); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    procedure Loaded; override;
    property AutoSize default False;
  published
    property About : TAHMAboutEnhancedStr read FAHMAboutStr write FAHMAboutStr stored False;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    {$ENDIF}
    property Align;
    property Alignment;
    property Frame : TAHMFrame read fframe write setframe stored false;
    property FontBackground : TAHMBackground read fback write Setback;
    property Background : TAHMBackground read fback2 write Setback2;
    property Caption;
    property Color;
    property Enabled;
    property FocusControl;
    property Font;
    property Font3D : TAHMFont3D read f3d write Set3d stored false;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ShowAccelChar;
    property Transparent;
    property ShowHint;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;


implementation

constructor TAHMDBLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  f3d:=TAHMFont3D.create(Self);
  font.style:=[fsbold];
  font.size:=12;
  fframe:=TAHMFrame.create(self);
  fframe.framestyle:=framenone;
  ControlStyle := ControlStyle + [csReplicatable];
  AutoSize := False;
  ShowAccelChar := False;
  FDataLink := TFieldDataLink.Create;
  FDataLink.OnDataChange := DataChange;
end;

procedure TAHMDBLabel.Loaded;
begin
  inherited Loaded;
end;

destructor TAHMDBLabel.Destroy;
begin
  if fback<>nil then fback.OList.remove(self);
  if fback2<>nil then fback2.OList.remove(self);
  FDataLink.Free;
  FDataLink := nil;
  F3d.free;
  fframe.free;
  inherited Destroy;
end;

procedure TAHMDBLabel.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil;
  if (Operation = opRemove) and  (AComponent = FontBackground) then SetBack(nil);
  if (Operation = opRemove) and  (AComponent = Background) then SetBack2(nil);
end;

procedure TAHMDBLabel.SetAutoSize(Value: Boolean);
begin
  if AutoSize <> Value then inherited SetAutoSize(Value);
end;

function TAHMDBLabel.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAHMDBLabel.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TAHMDBLabel.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAHMDBLabel.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAHMDBLabel.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TAHMDBLabel.GetFieldText: string;
begin
  if FDataLink.Field<>nil then Result:=FDataLink.Field.DisplayText else
     if csDesigning in ComponentState then Result:=Name else Result:='';
end;

procedure TAHMDBLabel.DataChange(Sender: TObject);
begin
  Caption := GetFieldText;
end;

function TAHMDBLabel.GetLabelText: string;
begin
  if csPaintCopy in ControlState then Result:=GetFieldText else Result:=Caption;
end;

procedure TAHMDBLabel.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TAHMDBLabel.Paint;
const Alignments: array[TAlignment] of Word=(DT_LEFT, DT_RIGHT, DT_CENTER);
var TempRect:TRect;
    flags : Longint;
begin
  TempRect:=Clientrect;
  Temprect.Left:=Temprect.Left+FFrame.TotalWidth;
  Temprect.Bottom:=Temprect.Bottom-FFrame.Totalwidth;
  Temprect.Top:=Temprect.Top+FFrame.Totalwidth;
  Temprect.Right:=Temprect.Right-FFrame.Totalwidth;
  if not(Transparent) then
  begin
    Canvas.Brush.Color := Self.Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ClientRect);
    if assigned(fback2) then fback2.draw(Canvas.Handle,width,height,true);
  end;
  Canvas.Brush.Style := bsClear;
  flags:=DT_EXPANDTABS or DT_WORDBREAK or Alignments[Alignment];
  Text := GetFieldText;
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
    (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  inflaterect(Temprect,-fframe.Totalwidth,-fframe.Totalwidth);
  if assigned(fback) then fback.write(f3d,Font,canvas,temprect,text,flags) else
     f3d.write(Font,canvas.handle,temprect,text,flags,enabled);
  Temprect:=Clientrect;
  fframe.draw(Canvas.handle,Temprect);
end;

procedure TAHMDBLabel.Set3d(value : TAHMFont3d);
begin
  f3d:=value;
  invalidate;
end;

procedure TAHMDBLabel.SetBack(Value: TAHMBackground);
Begin
  if fback<>nil then fback.OList.remove(self);
  if value<>nil then value.additem(self);
  fback:=Value;
  Invalidate;
end;

procedure TAHMDBLabel.SetBack2(Value: TAHMBackground);
Begin
  if fback2<>nil then fback2.OList.remove(self);
  if value<>nil then value.additem(self);
  fback2:=Value;
  Invalidate;
end;

procedure TAHMDBLabel.Setframe(value : TAHMFrame);
begin
  fframe:=value;
  invalidate;
end;

end.

