spiegel-keyman/common/windows/delphi/components/PaintPanel.pas

(*
  Name:             PaintPanel
  Copyright:        Copyright (C) SIL International.
  Documentation:    
  Description:      
  Create Date:      14 Sep 2006

  Modified Date:    10 Aug 2015
  Authors:          mcdurdin
  Related Files:    
  Dependencies:     

  Bugs:             
  Todo:             
  Notes:            
  History:          14 Sep 2006 - mcdurdin - Add DrawText, EraseBackground and OnEraseBackground
                    18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
                    24 Jul 2015 - mcdurdin - I4796 - Refresh Keyman Developer look and feel for release
                    10 Aug 2015 - mcdurdin - I4851 - Consolidate DrawText and ShowCaption in TPaintPanel
*)
unit PaintPanel;  // I3306

interface

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

type
  TPaintPanel = class(TCustomPanel)
  private
    FOnPaint: TNotifyEvent;
    FEraseBackground: Boolean;
    FOnEraseBackground: TNotifyEvent;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property DockManager;

    property Canvas;
  published
    property EraseBackground: Boolean read FEraseBackground write FEraseBackground default True;
    property OnEraseBackground: TNotifyEvent read FOnEraseBackground write FOnEraseBackground;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;

    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowCaption;   // I4851
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

uses
  System.Types;

procedure Register;
begin
  RegisterComponents('Keyman', [TPaintPanel]);
end;

{ TPaintPanel }

constructor TPaintPanel.Create(AOwner: TComponent);
begin
  FEraseBackground := True;
  inherited Create(AOwner);
end;

procedure TPaintPanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  VerticalAlignments: array[TVerticalAlignment] of Longint = (DT_TOP, DT_BOTTOM, DT_VCENTER);   // I4796
var
  Rect: TRect;
  Flags: Longint;
begin
  Rect := GetClientRect;   // I4796

  if not Assigned(FOnPaint) then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(Rect);
  end
  else
    FOnPaint(Self);

  if ShowCaption and (Caption <> '') then   // I4851
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Font := Self.Font;
    Flags := DT_EXPANDTABS or DT_SINGLELINE or
      VerticalAlignments[VerticalAlignment] or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    Windows.DrawText(Canvas.Handle, Caption, -1, Rect, Flags);
  end;
end;

procedure TPaintPanel.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if Assigned(FOnEraseBackground) then
  begin
    Canvas.Lock;
    try
      Canvas.Handle := Message.DC;
      try
        FOnEraseBackground(Self);
      finally
        Canvas.Handle := 0;
      end;
    finally
      Canvas.Unlock;
    end;
  end
  else if FEraseBackground then
    inherited
  else
    Message.Result := 1;
end;

end.