dxcontainer.pas

功能强大的报表生成和管理工具

{*******************************************************************}
{                                                                   }
{   dxContainer (Design eXperience)                                 }
{                                                                   }
{   Copyright (c) 2002 APRIORI business solutions AG                }
{   (W)ritten by M. Hoffmann - ALL RIGHTS RESERVED.                 }
{                                                                   }
{   DEVELOPER NOTES:                                                }
{   ==========================================================      }
{   This file is part of a component suite called Design            }
{   eXperience and may be used in freeware- or commercial           }
{   applications. The package itself is distributed as              }
{   freeware with full sourcecodes.                                 }
{                                                                   }
{   Feel free to fix bugs or include new features if you are        }
{   familiar with component programming. If so, please email        }
{   me your modifications, so it will be possible for me to         }
{   include nice improvements in further releases:                  }
{                                                                   }
{   Contact: [e-mail]                                   }
{                                                                   }
{   History:                                                        }
{   =============================================================== }
{                                                                   }
{   Version 1.0.0                                                   }
{     + First Release                                               }
{                                                                   }
{*******************************************************************}

unit dxContainer;

interface

uses
  Windows, Messages, Classes, Controls, Graphics, dxCore;

resourcestring
  SVersion = '1.0.0'; // always increase version number on new releases!

type
{ TdxPaintEvent }

  TdxPaintEvent = procedure(Sender: TObject; Rect: TRect; ACanvas: TCanvas;
    AFont: TFont) of object;

{ TdxChildOffset }

  TdxChildOffset = 0..MAXINT;

{ TdxContainer }

  TdxContainer = class(TdxCustomControl)
  private
    { Private declarations }
    FAlignment: TAlignment;
    FChildOffset: TdxChildOffset;
    FBoundColor: TColor;
    FBoundLines: TdxBoundLines;
    FHotTrack: Boolean;
    FHotTrackColor: TColor;
    FShowCaption: Boolean;
    FSpacing: Byte;
    FWordWrap: Boolean;
    FOnPaint: TdxPaintEvent;
    procedure RealignControls;
  protected
    { Protected declarations }
    function GetVersion: string; override;
    procedure HookResized; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure SetAlignment(Value: TAlignment); virtual;
    procedure SetChildOffset(Value: TdxChildOffset); virtual;
    procedure SetBoundColor(Value: TColor); virtual;
    procedure SetBoundLines(Value: TdxBoundLines); virtual;
    procedure SetHotTrack(Value: Boolean); virtual;
    procedure SetHotTrackColor(Value: TColor); virtual;
    procedure SetShowCaption(Value: Boolean); virtual;
    procedure SetSpacing(Value: Byte); virtual;
    procedure SetWordWrap(Value: Boolean); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    { Published declarations }
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Caption;
    property ChildOffset: TdxChildOffset read FChildOffset write SetChildOffset default 0;
    property BoundColor: TColor read FBoundColor write SetBoundColor default clGray;
    property BoundLines: TdxBoundLines read FBoundLines write SetBoundLines default [];
    property Height default 41;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor default clBlack;
    property ShowCaption: Boolean read FShowCaption write SetShowCaption default False;
    property Spacing: Byte read FSpacing write SetSpacing default 3;
    property Width default 185;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
    property OnPaint: TdxPaintEvent read FOnPaint write FOnPaint;
  end;

procedure Register;

implementation

{-----------------------------------------------------------------------------
  Procedure: Register
  Author:    mh
  Date:      02-Mai-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure Register;
begin
  RegisterComponents('Design eXperience', [TdxContainer]);
end;

{ TdxContainer }

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.Create
  Author:    mh
  Date:      02-Mai-2002
  Arguments: AOwner: TComponent
  Result:    None
-----------------------------------------------------------------------------}

constructor TdxContainer.Create(AOwner: TComponent);
begin
  inherited;

  // set default properties.
  ControlStyle := ControlStyle + [csAcceptsControls];
  DoubleBuffered := True;
  Height := 45;
  Width := 185;

  // set custom properties.
  FAlignment := taLeftJustify;
  FBoundColor := clGray;
  FBoundLines := [];
  FChildOffset := 0;
  FHotTrack := False;
  FHotTrackColor := clBlack;
  FShowCaption := False;
  FSpacing := 3;
  FWordWrap := False;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.GetVersion
  Author:    mh
  Date:      02-Mai-2002
  Arguments: None
  Result:    string
-----------------------------------------------------------------------------}

function TdxContainer.GetVersion: string;
begin
  Result := SVersion;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.HookResized
  Author:    mh
  Date:      02-Mai-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.HookResized;
begin
  inherited;
  RealignControls;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.AdjustClientRect
  Author:    mh
  Date:      02-Mai-2002
  Arguments: var Rect: TRect
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.AdjustClientRect(var Rect: TRect);
begin
  if blLeft in FBoundLines then
    Inc(Rect.Left);
  if blRight in FBoundLines then
    Dec(Rect.Right);
  if blTop in FBoundLines then
    Inc(Rect.Top);
  if blBottom in FBoundLines then
    Dec(Rect.Bottom);
  InflateRect(Rect, -ChildOffset, -ChildOffset);
  inherited AdjustClientRect(Rect);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.RealignControls
  Author:    mh
  Date:      02-Mai-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.RealignControls;
var
  R: TRect;
begin
  AlignControls(nil, R);
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetAlignment
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: TAlignment
  Result:    None
-----------------------------------------------------------------------------}

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

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetChildOffset
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: TdxChildOffset
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetChildOffset(Value: TdxChildOffset);
begin
  if Value <> FChildOffset then
  begin
    FChildOffset := Value;
    RealignControls;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetBoundColor
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: TColor
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetBoundColor(Value: TColor);
begin
  if Value <> FBoundColor then
  begin
    FBoundColor := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetBoundLines
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: TdxBoundLines
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetBoundLines(Value: TdxBoundLines);
begin
  if Value <> FBoundLines then
  begin
    FBoundLines := Value;
    RealignControls;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetHotTrack
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetHotTrack(Value: Boolean);
begin
  if Value <> FHotTrack then
  begin
    FHotTrack := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetHotTrackColor
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: TColor
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetHotTrackColor(Value: TColor);
begin
  if Value <> FHotTrackColor then
  begin
    FHotTrackColor := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetShowCaption
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetShowCaption(Value: Boolean);
begin
  if Value <> FShowCaption then
  begin
    FShowCaption := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetSpacing
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: Byte
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetSpacing(Value: Byte);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.SetWordWrap
  Author:    mh
  Date:      02-Mai-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.SetWordWrap(Value: Boolean);
begin
  if Value <> FWordWrap then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxContainer.Paint
  Author:    mh
  Date:      02-Mai-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxContainer.Paint;
var
  R: TRect;
begin
  inherited;
  with Canvas do
  begin
    // draw designtime rect.
    R := GetClientRect;
    if csDesigning in ComponentState then
      DrawFocusRect(R);

    // draw boundlines.
    if FBoundLines <> [] then
    begin
      if (FHotTrack) and (dsHotLight in DrawState) then
        dxDrawBoundLines(Self.Canvas, FBoundLines, FHotTrackColor, R)
      else
        dxDrawBoundLines(Self.Canvas, FBoundLines, FBoundColor, R);
    end;

    // assign spacing.
    InflateRect(R, -FSpacing, 0);

    // draw caption.
    SetBkMode(Handle, Transparent);
    Font.Assign(Self.Font);
    if FShowCaption then
      dxPlaceText(Self, Canvas, Caption, Font, Enabled, False, FAlignment,
        FWordWrap, R);

    // call user paint-method (if assigned).
    if Assigned(FOnPaint) then
      FOnPaint(Self, R, Self.Canvas, Font);
  end;
end;

end.