unit Proba;

interface

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

type
  TWinControl1 = class(TWinControl)
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 end;

 TA=Class(TComponent)
 private
 procedure WMNCMOUSEMOVE(var Message: TMessage);message WM_NCMOUSEMOVE;
 protected
   { Protected declarations }
 public

   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterClasses([TWinControl1]);
 RegisterComponents('Standard', [TA]);
end;
//********** constructor and destructor **********************

constructor TWinControl1.Create(AOwner: TComponent);
begin
 inherited Create(Aowner);
end;

destructor TWinControl1.Destroy;
begin
  inherited Destroy;
end;
///////////////
constructor TA.Create(AOwner: TComponent);
begin
 inherited Create(Aowner);

end;

destructor TA.Destroy;
begin
  inherited Destroy;
end;

procedure TA.WMNCMOUSEMOVE(var Message: TMessage);
var
s : string;
begin
case Message.wParam of
 HTERROR:
  s:= 'HTERROR';
 HTTRANSPARENT:
  s:= 'HTTRANSPARENT';
 HTNOWHERE:
  s:= 'HTNOWHERE';
 HTCLIENT:
  s:= 'HTCLIENT';
 HTCAPTION:
  s:= 'HTCAPTION';
 HTSYSMENU:
  s:= 'HTSYSMENU';
 HTSIZE:
  s:= 'HTSIZE';
 HTMENU:
  s:= 'HTMENU';
 HTHSCROLL:
  s:= 'HTHSCROLL';
 HTVSCROLL:
  s:= 'HTVSCROLL';
 HTMINBUTTON:
  s:= 'HTMINBUTTON';
 HTMAXBUTTON:
  s:= 'HTMAXBUTTON';
 HTLEFT:
  s:= 'HTLEFT';
 HTRIGHT:
  s:= 'HTRIGHT';
 HTTOP:
  s := 'HTTOP';
 HTTOPLEFT:
  s:= 'HTTOPLEFT';
 HTTOPRIGHT:
  s:= 'HTTOPRIGHT';
 HTBOTTOM:
  s:= 'HTBOTTOM';
 HTBOTTOMLEFT:
  s:= 'HTBOTTOMLEFT';
 HTBOTTOMRIGHT:
  s:= 'HTBOTTOMRIGHT';
 HTBORDER:
  s:= 'HTBORDER';
 HTOBJECT:
  s:= 'HTOBJECT';
 HTCLOSE:
  s:= 'HTCLOSE';
 HTHELP:
  s:= 'HTHELP';
 else s:= '';
end;
TForm(Owner).Caption := s;
Message.Result := 0;
end;

end.

unit newCaption;

interface

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

type

 TPoz = (P_RIGHT,P_CENTER,P_LEFT);

   TnewCaption=Class(TComponent)
 private
   fOldWndProc: TWndMethod;
   Form: TCustomForm;
   FColorFond: TColor;
   FSizeFont : Integer;
   FStyleFont: TFontStyles;
   FPozition : TPoz;
   FCaption: String;
   procedure SetColorFond(Value: TColor);
   Procedure SetSelect(const Val:TPoz);

 protected

 public
   procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
   procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   Property ColorFond: TColor Read FColorFond Write SetColorFond;
   Property StyleFont: TFontStyles Read FStyleFont Write FStyleFont;
   Property Caption: String Read FCaption Write FCaption;
   Property SizeFont : Integer Read FSizeFont Write FSizeFont;
   Property Pozition : TPoz Read FPozition Write SetSelect;
 end;

var

 Selek:DWord;
 x,y  : Integer;
 ACanvas: TCanvas;
 LabelHeight, LabelWidth, LabelTop: Integer;
 caption_height, border3d_y, button_width, border_thickness: Integer;
 CaptionBarRect: TRect;
 Msg: TWMNCPaint;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Standard', [TnewCaption]);
end;

////////////////  TnewCaption  //////////////////////////
constructor TnewCaption.Create(AOwner: TComponent);
begin
 inherited Create(Aowner);
 while (AOwner.Owner <> nil) and not (AOwner is TCustomForm) do AOwner := AOwner.Owner;
if AOwner is TCustomForm then begin
 Form := TCustomForm(AOwner);
 fOldWndProc := Form.WindowProc;
 Form.WindowProc := WMNCPaint;
end;

 FPozition := P_LEFT;
 FColorFond:=clred;
 FStyleFont:=[fsBold];
 FSizeFont := 10;
 Selek := DT_LEFT;

 FCaption:= Form.Caption;Form.Caption:= '';
// UpdateWindow((Owner as TForm).Handle);

end;

destructor TnewCaption.Destroy;
begin
  if Assigned(fOldWndProc) then Form.WindowProc := fOldWndProc;
  inherited Destroy;
end;

procedure TnewCaption.SetColorFond(Value: TColor);
begin
 if FColorFond <> Value then
 begin
   FColorFond := Value;
 end;
end;

procedure TnewCaption.SetSelect(const Val:TPoz);

begin

  if Val = P_RIGHT then begin FPozition:= P_RIGHT; Selek:= DT_RIGHT; end;
  if Val = P_CENTER then begin FPozition:= P_CENTER; Selek:= DT_CENTER; end;
  if Val = P_LEFT then begin FPozition:= P_LEFT; Selek:= DT_LEFT; end;

end;

procedure TnewCaption.WMPaint(var Msg: TWMPaint);

begin

 border3d_y := GetSystemMetrics(SM_CYEDGE);
 button_width := GetSystemMetrics(SM_CXSIZE);
 border_thickness := GetSystemMetrics(SM_CYSIZEFRAME);
 caption_height := GetSystemMetrics(SM_CYCAPTION)+10;
 LabelWidth :=  (Owner as TForm).Canvas.TextWidth((Owner as TForm).Caption);
 LabelHeight := (Owner as TForm).Canvas.TextHeight((Owner as TForm).Caption);
 LabelTop := LabelHeight - (caption_height div 2);
 CaptionBarRect.Left := border_thickness + border3d_y + button_width;
 CaptionBarRect.Right := (Owner as TForm).Width - (border_thickness + border3d_y)
     - (button_width * 4);
 CaptionBarRect.Top := border_thickness + border3d_y -10;
 CaptionBarRect.Bottom := caption_height;

 inherited;
 ACanvas := TCanvas.Create;
 try
   ACanvas.Handle := GetWindowDC((Owner as TForm).Handle);
   with ACanvas do
   begin
     Brush.Color := $00DABFA5;     //clActiveCaption;        //$00FFD5C7
     Font.Name := 'Tahoma';
     Font.Size := FSizeFont;
     Font.Color := FColorFond;
     Font.Style := FStyleFont;

    DrawText(ACanvas.Handle, PChar(' ' + FCaption), Length(FCaption) + 1,
   CaptionBarRect, Selek or DT_SINGLELINE or DT_VCENTER);

   end;
 finally
   ReleaseDC((Owner as TForm).Handle, ACanvas.Handle);
   ACanvas.Free;
 end;
 if (Owner as TForm).WindowState = wsMinimized then begin
      (Owner as TForm).Caption:= FCaption;
end else begin (Owner as TForm).Caption:= ''; end;

end;

procedure TnewCaption.WMNCPaint(var Msg: TMessage);

begin
if Assigned(fOldWndProc) then fOldWndProc(Msg);

 border3d_y := GetSystemMetrics(SM_CYEDGE);
 button_width := GetSystemMetrics(SM_CXSIZE);
 border_thickness := GetSystemMetrics(SM_CYSIZEFRAME);
 caption_height := GetSystemMetrics(SM_CYCAPTION)+10;
 LabelWidth :=  Form.Canvas.TextWidth(Form.Caption);
 LabelHeight := Form.Canvas.TextHeight(Form.Caption);
 LabelTop := LabelHeight - (caption_height div 2);
 CaptionBarRect.Left := border_thickness + border3d_y + button_width;
 CaptionBarRect.Right := Form.Width - (border_thickness + border3d_y)
     - (button_width * 4);
 CaptionBarRect.Top := border_thickness + border3d_y -10;
 CaptionBarRect.Bottom := caption_height;

 inherited;
 ACanvas := TCanvas.Create;
 try
   ACanvas.Handle := GetWindowDC(Form.Handle);
   with ACanvas do
   begin
     Brush.Color := $00DABFA5;     //clActiveCaption;
     Font.Name := 'Tahoma';
     Font.Size :=  FSizeFont;                        //GetSystemMetrics(SM_CYMENU)
     Font.Color := FColorFond;//clred;
     Font.Style := FStyleFont;//[fsBold];

    DrawText(ACanvas.Handle, PChar(' ' + FCaption), Length(FCaption) + 1,
   CaptionBarRect, Selek or DT_SINGLELINE or DT_VCENTER);

   end;
 finally
   ReleaseDC(Form.Handle, ACanvas.Handle);
   ACanvas.Free;
 end;
 if Form.WindowState = wsMinimized then begin
      Form.Caption:= FCaption;
end else begin Form.Caption:= ''; end;
end;

end.