ncp.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit Ncp;

interface

uses
   Windows, Messages, SysUtils, Classes, forms, graphics, Controls;

type
   TNcp = class(TComponent)
   private
      FHandle: Thandle;
      OldWnd: TWndMethod;
      procedure doNcDraw;
   protected
      { Protected declarations }
   public
      procedure myMessage(var Message: TMessage);

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

   published
      { Published declarations }
   end;

procedure Register;

implementation

procedure Register;
begin
   RegisterComponents('HFG', [TNcp]);
end;

{ TNcp }

procedure TNcp.myMessage(var Message: TMessage);
begin
   OldWnd(Message);
   if Message.Msg = WM_NCPAINT then
      begin
         DefWindowProc(FHandle, Message.Msg, Message.WParam, Message.LParam);
         doNcDraw;
      end;

   if Message.Msg = WM_NCACTIVATE then
      begin
         DefWindowProc(FHandle, Message.Msg, Message.WParam, Message.LParam);
         doNcDraw;
      end;
end;

constructor TNcp.Create(AOwner: TComponent);
begin
   FHandle := 0;
   inherited;
   //  if csDesigning in ComponentState then
   if Owner is Tform then
      begin
         FHandle := Tform(Owner).handle;
         OldWnd := Tform(Owner).WindowProc;
         Tform(Owner).WindowProc := myMessage;
         Tform(Owner).BorderIcons := [];
         doNcDraw;
      end;
end;

procedure TNcp.doNcDraw;
var
   mydc: HDC;
   cr, gr, Tr: TRect;
   wc: TCanvas;
   bmp: TBitmap;
begin
   if Owner is Tform then
      with Tform(Owner) do
         begin
            mydc := GetWindowDC(Handle);
            try
               wc := TCanvas.Create;
               wc.Handle := mydc;
               cr.Left := GetSystemMetrics(SM_CXFRAME) - 1;
               cr.Top := GetSystemMetrics(SM_CYFRAME) - 1;
               cr.Right := Width - GetSystemMetrics(SM_CXFRAME) + 1; //- 4 * GetSystemMetrics(SM_CXSIZE);
               cr.Bottom := cr.Top + GetSystemMetrics(SM_CYCAPTION); // - 1;

               wc.Brush.Color := $00DCE1E4; //$00FFFDF5; // $00FCE8D4; // $00ECF0F2; //clmenu; // $00CFF7D6; //
               wc.FillRect(cr);
               tr := cr;
               inc(tr.Left, 4);

               if Application.Icon <> nil then
                  begin
                     bmp := TBitmap.Create;
                     bmp.Width := Application.Icon.Width;
                     bmp.Height := Application.Icon.Height;
                     bmp.Canvas.Draw(0, 0, Application.Icon);
                     bmp.Transparent := true;
                     gr := cr;
                     inc(gr.Left, 2);
                     gr.Top := (cr.Top + cr.Bottom - 16) div 2;
                     gr.Bottom := gr.top + 16;
                     gr.Right := gr.Left + 16;

                     wc.StretchDraw(gr, bmp);
                     freeandnil(bmp);
                     inc(tr.Left, 16);
                  end;
               with wc.Font do
                  begin
                     Name := 'arial';
                     color := clnavy;
                     Style := [fsBold];
                  end;

               wc.TextOut(tr.Left, tr.Top + 3, ' ' + caption);
               {
               wc.Pen.Color := clmaroon; //$008396A0; //clbtnface;//
               wc.MoveTo(cr.Left, cr.Bottom - 1);
               wc.LineTo(cr.Right, cr.Bottom - 1);

               {
                 cr.Top := cr.Bottom;
                 inc(cr.Bottom, 36);

                 wc.Brush.Color := clred; //$00DCE1E4;
                 wc.FillRect(cr);
                // menu := nil;
                // menu := menu;
                 update; }
                 //Application.Icon.

               // 获取标题栏的 Rect 后就可以直接在 wc 画布上画了，直接在标题栏上出效果！
               // 绘画代码省略
               // ... ...
            finally
               ReleaseDC(Handle, mydc);
               if wc <> nil then
                  begin
                     wc.Free;
                     wc := nil;
                  end;
            end;
         end;
end;

destructor TNcp.Destroy;
begin
   //
   if assigned(OldWnd) then
      begin
         if Owner is Tform then
            begin
               Tform(Owner).WindowProc := OldWnd;
               FHandle := 0;
            end;
      end;

   // Tform(Owner).WindowProc := myMessage;
   inherited;
end;

end.