Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/nccomp/ncform.pas

Pascal/Delphi Source File | 1995-12-22 | 7.8 KB | 314 lines

unit Ncform;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, NonClt;

type
  TNCComponentForm = class(TForm)
  private
    { Private declarations }
    MouseCapture : boolean;
    CaptureButton : integer;
    MinWidth : integer;
    LeftOffSet,
    RightOffSet,
    CaptionHt,
    VerOffSet : integer;
    FNewCaption : TCaption;
    WindowActive : boolean;
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TMessage); message WM_NCACTIVATE;
    procedure WMNCLButtonDown(var Msg: TMessage); message WM_NCLBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TMessage); message WM_LBUTTONUP;
    procedure WMNCLButtonDblClk(var Msg: TMessage); message WM_NCLBUTTONDBLCLK;
    procedure WMGetMinMaxInfo(var Msg: TMessage); message WM_GETMINMAXINFO;
    procedure WMMouseMove(var Msg: TMessage); message WM_MOUSEMOVE;
    procedure WMActivate(var Msg: TMessage); message WM_ACTIVATE;
    procedure PaintNCComponents;
    procedure PaintCaption;
    function GetNewCaption : TCaption;
    procedure SetNewCaption(value : TCaption);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Caption read GetNewCaption write SetNewCaption;
  end;

var
  NCComponentForm: TNCComponentForm;

implementation

{$R *.DFM}
constructor TNCComponentForm.Create(AOwner : TComponent);
var
  i : integer;
  BorderValid : boolean;
  Wth : integer;
begin
  inherited Create(AOwner);
  SetWindowText(Handle,'');
  WindowActive := False;
  BorderValid := (BorderStyle = bsSizeable) or (BorderStyle = bsSingle);
  LeftOffSet := 0;
  RightOffSet := 0;
  MinWidth := 0;
  wth := GetSystemMetrics(sm_cySize);
  CaptionHt := GetSystemMetrics(sm_cyCaption);
  if biSystemMenu in BorderIcons then inc(LeftOffSet,wth);
  if biMinimize in BorderIcons then inc(RightOffSet,wth+1);
  if biMaximize in BorderIcons then inc(RightOffSet,wth+1);
  case BorderStyle of
    bsSizeable    : VerOffSet := GetSystemMetrics(sm_cyFrame);
    bsSingle      : VerOffSet := GetSystemMetrics(sm_cyBorder);
  else
    VerOffSet := 0;
  end;
  inc(LeftOffSet,VerOffSet);
  inc(RightOffSet,VerOffSet);
  for i := 0 to ComponentCount -1 do
  begin
    wth := TNCComponent(Components[i]).Width;
    if Components[i] is TNCComponent then
    with TNCComponent(Components[i]) do
    begin
      if Position = bpLeft then
      begin
        if BorderValid then
        begin
          ParentRegister(Handle,LeftOffSet,VerOffSet,CaptionHt);
          ParentState(WindowActive);
          inc(LeftOffSet,Wth);
          inc(MinWidth,Wth);
        end
        else
          ParentRegister(Handle,-1,VerOffSet,CaptionHt);
      end
      else
      begin
        if BorderValid then
        begin
          inc(RightOffSet,Wth);
          inc(MinWidth,Wth);
          ParentRegister(Handle,RightOffSet,VerOffSet,CaptionHt);
        end
        else
          ParentRegister(Handle,-1,VerOffSet,CaptionHt);
      end;
    end;
  end;
  MouseCapture := False;
  CaptureButton := -1;
end;

destructor TNCComponentForm.Destroy;
begin
  inherited Destroy;
end;

procedure TNCComponentForm.WMActivate(var Msg: TMessage);
begin
  if Msg.wParam = wa_InActive then WindowActive := False
                              else WindowActive := True;
  inherited;
end;

procedure TNCComponentForm.WMNCPaint(var Msg: TMessage);
begin
  inherited;
  PaintNCComponents;
end;

procedure TNCComponentForm.WMNCActivate(var Msg: TMessage);
begin
  inherited;
  WindowActive := bool(Msg.wParam);
  PaintNCComponents;
end;

procedure TNCComponentForm.PaintNCComponents;
var
  i : integer;
begin
  for i := 0 to ComponentCount -1 do
  begin
    if Components[i] is TNCComponent then
    begin
      TNCComponent(Components[i]).ParentState(WindowActive);
      TNCComponent(Components[i]).RePaint;
    end;
  end;
  PaintCaption;
end;

procedure TNCComponentForm.PaintCaption;
var
  Wth : integer;
  TCol,BCol,OldTCol,OldBCol : TColorRef;
  R : TRect;
  WndDC : hDC;
  Buffer : PChar;
  Brush : HBrush;
begin
  if WindowActive then
  begin
    BCol := GetSysColor(Color_ActiveCaption);
    TCol := GetSysColor(Color_CaptionText);
  end
  else
  begin
    BCol := GetSysColor(Color_InActiveCaption);
    TCol := GetSysColor(Color_InActiveCaptionText);
  end;
  GetWindowRect(Handle,R);
  wth := R.Right - R.Left;
  R.Right := wth - RightOffSet - 1;
  R.Left := LeftOffSet + 1;
  R.Top := VerOffset;
  R.Bottom := CaptionHt + 2;
  try
    WndDC := GetWindowDC(Handle);
    GetMem(Buffer,256);
    StrPCopy(Buffer,FNewCaption);
    OldTCol := SetTextColor(WndDC,TCol);
    OldBCol := SetBkColor(WndDC,BCol);
    Brush := CreateSolidBrush(BCol);
    FillRect(WndDC,R,Brush);
    DrawText(WndDC,Buffer,-1,R,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
  finally
    FreeMem(Buffer,256);
    SetTextColor(WndDC,OldTCol);
    SetBkColor(WndDC,OldBCol);
    DeleteObject(Brush);
    ReleaseDC(Handle,WndDC);
  end;
end;

procedure TNCComponentForm.WMNCLButtonDown(var Msg: TMessage);
var
  i : integer;
  Found : boolean;
  R : TRect;
begin
  Found := False;
  if (Msg.wParam = HTCAPTION) and (IsIconic(Handle) = False) then
  begin
    i := 0;
    GetWindowRect(Handle,R);
    while (i < ComponentCount) and (Found = False) do
    begin
      if Components[i] is TNCComponent then
        Found := TNCComponent(Components[i]).
                    IsCovered(Msg.LParamLo-R.Left,Msg.LParamHi-R.Top);
      inc(i);
    end;
  end;
  if Found then
  begin
    Dec(i);
    MouseCapture := True;
    CaptureButton := i;
    TNCComponent(Components[i]).LButton(csDown);
    if TNCComponent(Components[i]).DragBy then inherited;
  end
  else
    inherited;
end;

procedure TNCComponentForm.WMLButtonUp(var Msg: TMessage);
var
   Hit : longint;
   R : TRect;
   P : TPoint;
begin
  if MouseCapture then
  begin
    MouseCapture := False;
    GetWindowRect(Handle,R);
    P.X := Msg.LParamLo;
    P.Y := Msg.LParamHi;
    P := ClientToScreen(P);
    TNCComponent(Components[CaptureButton]).LButton(csUp)
  end
  else
    inherited;
end;

procedure TNCComponentForm.WMNCLButtonDblClk(var Msg: TMessage);
var
  i : integer;
  Found : boolean;
  R : TRect;
begin
  Found := False;
  if (Msg.wParam = HTCAPTION) and (IsIconic(Handle) = False) then
  begin
    i := 0;
    GetWindowRect(Handle,R);
    while (i < ComponentCount) and (Found = False) do
    begin
      if Components[i] is TNCComponent then
        Found := TNCComponent(Components[i]).
                    IsCovered(Msg.LParamLo-R.Left,Msg.LParamHi-R.Top);
      inc(i);
    end;
  end;
  if Found then
  begin
    Dec(i);
    MouseCapture := True;
    CaptureButton := i;
    TNCComponent(Components[i]).LButton(csDown);
    if TNCComponent(Components[i]).DragBy then inherited;
  end
  else
    inherited;
end;

procedure TNCComponentForm.WMGetMinMaxInfo(var Msg: TMessage);
var
  Info : ^TMinMaxInfo;
begin
  inherited;
  Info := Pointer(Msg.lParam);
  inc(Info^.ptMinTrackSize.X,MinWidth);
end;

procedure TNCComponentForm.WMMouseMove(var Msg: TMessage);
var
  R : TRect;
  P : TPoint;
begin
  if MouseCapture then
  begin
    with TNCComponent(Components[CaptureButton]) do
    begin
      GetWindowRect(Handle,R);
      P.X := Msg.LParamLo;
      P.Y := Msg.LParamHi;
      P := ClientToScreen(P);
      MouseMove(P.X-R.Left,P.Y-R.Top);
    end;
  end
  else
    inherited;
end;

procedure TNCComponentForm.SetNewCaption(Value : TCaption);
begin
  FNewCaption := Value;
  PaintCaption;
end;

function TNCComponentForm.GetNewCaption : TCaption;
begin
  Result := FNewCaption;
end;

end.