神康侠吕

delphi和bcb自定义控件的安装- -

                                      

用delphi写了个控件，无论如何也装不到bcb上，折腾了一天，终于有答案了。原来是包的名称不能和单元名称相同。包编译通过后，会在单元文件目录中产生一个同名的.hpp文件，把它拷贝到CBuilder下的include目录下，就可以象其他控件一样使用了。

下面是我用delphi开发的一个控件，主要是加进了激活时会产生八个拾取点和边框的功能，该控件在bcb6.0和delphi7.0下运行都没有问题。

unit MyRect;

interface

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

type
  TMyRect = class(TCustomControl)
  private
    { Private declarations }
    fActive:boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
    FBitmap:TBitmap;
    FHotRect:Array[0..7] of TRect;
    Constructor Create(AOwner:TComponent);Override;
    destructor Destroy;Override;
    procedure Paint;Override;
    procedure DrawRect;
    procedure SetActive(const Value:Boolean);
    procedure WmNcHitTest(Var Msg:TWmNcHitTest);Message Wm_NcHitTest;
  published
    { Published declarations }
    property Active:boolean read fActive write SetActive;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('System', [TMyRect]);
end;

constructor TMyRect.Create(AOwner:TComponent);
begin
    Inherited;
    Height:=38;
    Width:=38;
    FBitmap:=TBitmap.Create();
    FBitmap.Height :=30;
    FBitmap.Width:=30;
    FHotRect[0]:=Rect(0,0,4,4);      //初始时的八个点位置
    FHotRect[1]:=Rect(34,0,38,4);
    FHotRect[2]:=Rect(0,34,4,38);
    FHotRect[3]:=Rect(34,34,38,38);
    //TopMid lefttop= width/2-2  rightbottom=width/2+2
    FHotRect[4]:=Rect(17,0,21,4);
    //BottomMid
    FHotRect[5]:=Rect(17,34,21,38);
    //LeftMid
    FHotRect[6]:=Rect(0,17,4,21);
    //RightMid
    FHotRect[7]:=Rect(34,17,38,21);
end;

procedure TMyRect.WmNcHitTest(var Msg :TWmNcHitTest);//处理拉伸消息
var
    i : integer;
    pt : TPoint;
begin
    pt := Point(Msg.XPos, Msg.YPos);
    pt := ScreenToClient(pt);
    Msg.Result := 0;
    for i := 0 to 7 do
    begin
        if ptInRect(FHotRect[i], pt) then
        case i of
            0:Msg.Result := htTopLeft;       //鼠标形状
            1:Msg.Result := htTopRight;
            2:Msg.Result := htBottomLeft;
            3:Msg.Result := htBottomRight;
            4:Msg.Result := htTop;
            5:Msg.Result := htBottom;
            6:Msg.Result := htLeft;
            7:Msg.Result := htRight;
        end;
    end;
    if Msg.Result = 0 then
        inherited;
end;

destructor TMyRect.Destroy;
begin
    FBitmap.Free;
    inherited Destroy;
end;

procedure TMyRect.DrawRect;   //显示边框和八点
var
    i:integer;
begin
    Canvas.Pen.Width := 2;
    if fActive then
    begin
        Canvas.Brush.Color:=clRed;
        Canvas.Pen.Color := clRed;
    end
    else
    begin
        Canvas.Pen.Color := Parent.Brush.Color;;
        Canvas.Brush.Color := Parent.Brush.Color;
    end;
    Canvas.MoveTo(4, 4);
    Canvas.LineTo(Width-4, 4);
    Canvas.LineTo(Width-4, Height-4);
    Canvas.LineTo(4, Height-4);
    Canvas.LineTo(4, 4);
    for i:=0 to 7 do
    begin
        Canvas.FillRect(FHotRect[i]);
    end;
end;

procedure TMyRect.Paint;       //拉伸后的显示
var
    TempWidth, TempHeight : Integer;
begin
    inherited Paint;
    Canvas.StretchDraw(Rect(4,4, width-4,height-4), FBitmap);
    FHotRect[1] := Rect(width-4,0,width,4);
    FHotRect[2] := Rect(0, height-4, 4, height);
    FHotRect[3] := Rect(width-4, height-4, width, height);
    TempWidth := width div 2;
    FHotRect[4] := Rect(TempWidth-2, 0, TempWidth+2, 4);
    FHotRect[5] := Rect(TempWidth-2, height-4, TempWidth+2, height);
    TempHeight := height div 2;
    FHotRect[6] := Rect(0, TempHeight-2, 4, TempHeight+2);
    FHotRect[7] := Rect(width-4, TempHeight-2, width, TempHeight+2);
    DrawRect;
end;

procedure TMyRect.SetActive(const Value:boolean);
begin
    fActive:=Value;
    DrawRect;
end;
end.

- 作者： 神康侠吕 访问统计：　2005年10月5日, 星期三 11:17 加入博采