www.pudn.com > RxRichEdit2.0.rar > MyFormDivider.pas

(************************************************************************ 
*    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.                                                            * 
*                                                                       * 
*************************************************************************) 
{$D-} 
unit MyFormDivider; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, StdCtrls, Controls; 
 
type 
  TMyDivBorder = (bdrSunken, bdrRaised, bdrEtched, frmSunken, frmRaised, frmEtched); 
  TMyFormDivider = class(TLabel) 
  private 
    { Private declarations } 
    AppHandle, MyOwnerhandle: Hwnd; 
    MyOwner: TWincontrol; 
    FAlignWidth: Boolean; 
    FSideSpace: Integer; 
    FBorderStyle: TMyDivBorder; 
    procedure SetSideSpace(Value: Integer); 
    procedure SetAlignWidth(Value: Boolean); 
    procedure SetBorderStyle(Value: TMyDivBorder); 
  protected 
    { Protected declarations } 
    OldWndProc: TFarProc; 
    NewWndProc: Pointer; 
    procedure Loaded; override; 
    procedure HookWin; 
    procedure UnhookWin; 
  public 
    procedure Hooked(var AMsg: TMessage); virtual; 
    destructor Destroy; override; 
    constructor Create(AOwner: TComponent); override; 
    procedure Paint; override; 
  published 
    property AlignWidth: Boolean read FAlignWidth write SetAlignWidth; 
    property BorderStyle: TMyDivBorder read FBorderStyle write SetBorderStyle default bdrEtched; 
    property SideSpace: Integer read FSideSpace write SetSideSpace default 20; 
    property Width; 
    property Height; 
    property Font; 
    property Caption; 
  end; 
 
procedure Register; 
 
implementation 
uses Forms; 
 
procedure Register; 
begin 
  RegisterComponentsProc('Standard', [TMyFormDivider]); 
end; 
 
constructor TMyFormDivider.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  Transparent := True; 
  AutoSize := False; 
  Alignment := taLeftJustify; 
  FAlignWidth := True; 
  FBorderStyle := bdrEtched; 
  FSideSpace := 20; 
  with (AOwner as TWincontrol) do MyOwner := TWincontrol(AOwner); 
  MyOwnerHandle := MyOwner.Handle; 
  AppHandle := Application.Handle; 
  HookWin; 
end; 
 
procedure TMyFormDivider.HookWin; 
begin 
  MyOwnerHandle := MyOwner.Handle; 
  OldWndProc := TFarProc(GetWindowLong(MyOwnerHandle, GWL_WNDPROC)); 
  NewWndProc := MakeObjectInstance(Hooked); 
  SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(NewWndProc)); 
end; 
 
procedure TMyFormDivider.UnhookWin; 
begin 
  SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(OldWndProc)); 
  if assigned(NewWndProc) then FreeObjectInstance(NewWndProc); 
  NewWndProc := nil; 
end; 
 
procedure TMyFormDivider.Hooked(var AMsg: TMessage); 
begin 
  if (AMsg.Msg = WM_SIZE) then Invalidate; 
  if (AMsg.Msg = WM_PAINT) then Invalidate; 
  AMsg.Result := CallWindowProc(OldWndProc, MyOwnerHandle, AMsg.Msg, AMsg.wParam, AMsg.lParam); 
end; 
 
procedure TMyFormDivider.Loaded; 
begin 
  inherited loaded; 
  if MyOwnerHandle <> MyOwner.Handle then 
  begin 
    UnhookWin; 
    HookWin; 
  end; 
end; 
 
destructor TMyFormDivider.Destroy; 
begin 
  UnHookWin; 
  inherited destroy; 
end; 
 
procedure TMyFormDivider.SetBorderStyle(Value: TMyDivBorder); 
begin 
  FborderStyle := Value; 
  InValidate; 
end; 
 
procedure TMyFormDivider.SetAlignWidth(Value: Boolean); 
begin 
  FAlignWidth := Value; 
  Invalidate; 
end; 
 
procedure TMyFormDivider.SetSideSpace(Value: Integer); 
begin 
  FSideSpace := Value; 
  Invalidate; 
end; 
 
procedure TMyFormDivider.Paint; 
var 
  ControlRect, Labelrect: TRect; 
  ActualPos         : LongInt; 
  TextWidth         : Longint; 
  FCaption          : string; 
  BorderF, BorderSt : LongInt; 
begin 
  inherited; 
  if FBorderStyle in [frmSunken, frmEtched, frmRaised] then 
    BorderF := BF_BOTTOM or BF_TOP else BorderF := BF_Bottom; 
  case Alignment of 
    taCenter: FCaption := ' ' + Caption + ' '; 
    taLeftJustify: FCaption := Caption + ' '; 
    taRightJustify: FCaption := ' ' + Caption; 
  end; 
  if FAlignWidth then 
  begin 
    Left := FSideSpace; 
    Width := (Owner as TWinControl).Width - 9 - 2 * FSideSpace; 
  end; 
  Canvas.Brush.Color := clBtnFace; 
  Canvas.Brush.Style := bsClear; 
  Canvas.FillRect(ClientRect); 
  ControlRect := ClientRect; 
  Canvas.Font := Self.Font; 
  TextWidth := Canvas.TextWidth(FCaption); 
  ActualPos := Round((ControlRect.Bottom - ControlRect.Top) / 2); 
  ControlRect.Top := ActualPos - 1; 
  ControlRect.Bottom := ActualPos + 3; 
  BorderSt := Edge_Etched; 
  case FBorderStyle of 
    bdrsunken, frmSunken: BorderSt := Edge_Sunken; 
    bdrraised, frmRaised: BorderSt := Edge_Raised; 
    bdretched, frmEtched: BorderSt := Edge_Etched; 
  end; 
  case Alignment of 
    taLeftJustify: begin 
        ControlRect.Left := TextWidth; 
        ControlRect.Right := Width; 
        Drawedge(Canvas.Handle, ControlRect, BorderSt, BorderF); 
      end; 
    taRightJustify: begin 
        ControlRect.Left := 0; 
        ControlRect.Right := Width - TextWidth; 
        Drawedge(Canvas.Handle, ControlRect, BorderSt, BorderF); 
      end; 
    taCenter: begin 
        Labelrect := Rect(Round((ControlRect.Right - ControlRect.Left) / 2) - 
          Round(TextWidth / 2), Clientrect.Top, Round((ControlRect.Right - ControlRect.Left) / 2) + 
          Round(TextWidth / 2), Clientrect.Bottom); 
        ControlRect.Right := LabelRect.Left; 
        Drawedge(Canvas.Handle, ControlRect, BorderSt, BorderF); 
        ControlRect.Left := LabelRect.Right; 
        ControlRect.Right := Width; 
        Drawedge(Canvas.Handle, ControlRect, BorderSt, BorderF); 
      end; 
  end; 
end; 
 
end.