Delphi 编写IC控件

编写控件的基本步骤

1.确定一个祖先类

2.创建一个组件单元

3.在新控件中添加属性、方法和事件

事件定义方法如下：

type

private

FOnClick:TNotifyEvent ;//( 声明事件变量以保存过程指针)

published

property OnClick:TNotifyEvent read FOnClick write FOnClick;

Delphi 预定义了所有标准事件的过程类型及标准事件引发的虚方法。

虚方法：

procedureTControl.Click;

begin

if Assigned(OnClick) then OnClick(self);

{以下是默认处理部分}

end;

其中Assigned函数检验OnClick是否已分配 了事件处理过程。

添加方法注意：

1）保持相互独立

2）方法的可见性

4.测试该控件

5.在Delphi中注册该控件

6.为该控件建立帮助文件

编写IC控件类

单元文件：

unit MyIC;
interface
uses
  SysUtils, Classes, Controls, Windows, Messages, Graphics, Forms, Math;
type
  TTextStyle = (txNone, txLowered, txRaised, txShadowed); // 标题文本样式的类声明
  TShape = (shRectangle, shSquare); // 封装方式的类声明
  TGradientKind = (gkNone, gkLinear); // 渐变方式在类声明

  TMyIC = class(TGraphicControl)
  private
    { Private declarations }
    FButtonColor: TColor; // 光影效果的起始颜色
    FButtonColor1: TColor; // 光影终止色
    FGradientKind: TGradientKind; // 是否打开光影效果
    FGradientAngle: Integer; // 光照的角度
    FPinNum: Integer; // 管脚总数
    FPinFrameColor: TColor; // 管脚边框颜色
    FPinColor: TColor; // 管脚颜色
    FShape: TShape; // 封装类型
    FTextStyle: TTextStyle; // 文本标题的显示样式

    FIsDown: Boolean; // 用于指示控件是否按下的布尔量
    FFrameWidth: Integer; // 集成块表面的边界宽度
    FRgn, MRgn: HRGN; // 区域用于检测鼠标的位置
    FTextColor: TColor; // 控件表面标题的颜色

    SidePinNum: Integer; // 单列上的管脚数
    BackBitMap: TBitmap; // 光影背景
    FPinHeight: Integer; // 管脚高度
    FPinWidth: Integer; // 管脚宽度
    r Integer; // 背景宽度
    rHeight: Integer; // 背景高度
    PinSpan: Integer; // 管脚间距

    // 组件消息处理
    procedure CMEnabledChanged(var msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED;
    procedure CMDialogChar(var msg: TCMDialogChar); message CM_DIALOGCHAR;
    procedure WMSize(var msg: TWMSize); message WM_PAINT;
  protected
    { Protected declarations }
    procedure Click; override;
    procedure DrawShape;
    procedure Paint; override;
    // 控件的管脚数、颜色、间距、高度、宽度和表面效果等属性方法声明
    procedure SetButtonColor(const Value: TColor);
    procedure SetButtonColor1(const Value: TColor);
    procedure SetGradientKind(const Value: TGradientKind);
    procedure SetGradientAngle(const Value: Integer);
    procedure SetPinNum(const Value: Integer);
    procedure SetPinFrameColor(const Value: TColor);
    procedure SetPinColor(const Value: TColor);
    procedure SetShape(const Value: TShape);
    procedure SetTextStyle(const Value: TTextStyle);
    procedure SetPinParam;

    procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WriteCaption;
    function GetCColor(Color01, Color02: TColor; R, i: Integer): TColor;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    // 声明属性
    property ButtonColor: TColor read FButtonColor write SetButtonColor;
    property ButtonColor1: TColor read FButtonColor1 write SetButtonColor1;
    property GradientKind: TGradientKind read FGradientKind
      write SetGradientKind default gkLinear;
    property GradientAngle: Integer read FGradientAngle write SetGradientAngle
      default 900;
    property Caption;
    property PinNum: Integer read FPinNum write SetPinNum;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property PinFrameColor: TColor read FPinFrameColor write SetPinFrameColor;
    property PinColor: TColor read FPinColor write SetPinColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Shape: TShape read FShape write SetShape default shRectangle;
    property ShowHint;
    property TextStyle: TTextStyle read FTextStyle write SetTextStyle;
    property Visible;
    // 事件属性的声明
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('IC', [TMyIC]);
end;
{ TMyIC }
constructor TMyIC.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // 设置控件的样式，允许控件捕获鼠标事件，点击控件会产生OnClick事件
  ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption];

  // 设置缺少绘制参数
  Enabled := True;
  FButtonColor := clBtnFace;
  FButtonColor1 := clBtnShadow;
  FIsDown := False;
  FPinFrameColor := clGray;
  FPinColor := clBtnFace;
  FFrameWidth := 1;
  FRgn := 0;
  FShape := shRectangle; // 采用双列直插封装
  FTextStyle := txRaised;
  Height := 50;
  Visible := True;
  Width := 120;
  // 将控件拖到窗体上将是一个双列直插14脚的集成电路块
  FPinHeight := 10;
  FPinWidth := 10;
  FPinNum := 14;
  SidePinNum := 7;
  FGradientKind := gkLinear;
  FGradientAngle := 900;
  BackBitMap := TBitmap.Create;
end;

destructor TMyIC.Destroy;
begin
  // 删除所创建的区域
  DeleteObject(FRgn);
  DeleteObject(MRgn);
  BackBitMap.Free;
  inherited Destroy;
end;
procedure TMyIC.Click;
begin
  FIsDown := False;
  Invalidate;
  inherited Click;
end;
procedure TMyIC.CMDialogChar(var msg: TCMDialogChar);
begin
  //
  with msg do
  begin
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end
    else
      inherited;
  end;
end;
procedure TMyIC.CMEnabledChanged(var msg: TMessage);
begin
  //
  inherited;
  Invalidate;
end;
procedure TMyIC.CMTextChanged(var msg: TMessage);
begin
  Invalidate;
end;
procedure TMyIC.DrawShape;
var
  n, t, Dia: Integer;
  i: Integer;
  NofLines, Q: Integer;
  L, dx, dy, x0, y0, L0, Cs, Sn: Double;
  R0: TRect;
begin
  if FGradientKind = gkLinear then
  begin
    BackBitMap.Width := Self.rwidth;
    BackBitMap.Height := Self.rHeight;
    BackBitMap.PixelFormat := pf24bit;
    BackBitMap.Canvas.Pen.Width := 3;
    Cs := Cos(FGradientAngle * pi / 1800);
    Sn := Sin(FGradientAngle * pi / 1800);
    L := Abs(rwidth * Sn) + Abs(rHeight * Cs);
    L0 := Sqrt(Sqr(rwidth) + Sqr(rHeight));
    NofLines := Round(L / 3);
    if (Cs >= 0) and (Sn >= 0) then
      Q := 1;
    if (Cs >= 0) and (Sn < 0) then
      Q := 4;
    if (Cs < 0) and (Sn >= 0) then
      Q := 2;
    if (Cs < 0) and (Sn < 0) then
      Q := 3;
    dx := 3 * Sn;
    dy := 3 * Cs;
    if Q = 1 then
    begin
      x0 := rwidth * (1 - Sqr(Sn));
      y0 := rwidth * Sn * Cs;
    end;
    if Q = 2 then
    begin
      x0 := rHeight * Sn * Cs;
      y0 := rHeight * (1 - Sqr(Sn));
    end;
    if Q = 3 then
    begin
      x0 := rwidth * Sqr(Sn);
      y0 := rHeight + rwidth * Sn * Cs;
    end;
    if Q = 4 then
    begin
      x0 := rwidth - rHeight * Sn * Cs;
      y0 := rHeight * (1 - Sqr(Cs));
    end;
    for i := 0 to NofLines do
    begin
      BackBitMap.Canvas.Pen.Color := GetCColor(FButtonColor, FButtonColor1,
        NofLines, i);
      BackBitMap.Canvas.MoveTo(Round(x0 + i * dx), Round(y0 + i * dy));
      BackBitMap.Canvas.LineTo(Round(x0 + i * dx - L0 * Cs),
        Round(y0 + i * dy + L0 * Sn));
    end;
  end
  else
  begin
    // 若不使用光影效果，则直接用相关属性的颜色值填充位图
    BackBitMap.Canvas.Brush.Color := FButtonColor;
    BackBitMap.Canvas.FillRect(ClientRect);
  end;
  with Canvas do
  begin
    if FShape = shRectangle then
    begin
      Draw(FFrameWidth, FPinHeight + FFrameWidth, BackBitMap); // 贴上光影效果图
      Pen.Color := FPinFrameColor;
      Dia := Floor((Height - 2 * FPinHeight) div 4);
      // 绘制半圆标志
      Arc(-Dia, FPinHeight + Dia, Dia, FPinHeight + 3 * Dia, 0,
        FPinHeight + 3 * Dia, 0, FPinHeight + Dia);
      // 绘制管脚
      Brush.Color := FPinColor;
      Pen.Color := FPinColor;
      for i := 1 to SidePinNum do
      begin
        // 绘制集成块上侧的管脚
        Rectangle(i * PinSpan + (i - 1) * FPinWidth, 0,
          i * PinSpan + i * FPinWidth, FPinHeight);
        // 绘制集成块下侧的管脚
        Rectangle(i * PinSpan + (i - 1) * FPinWidth, Height - FPinHeight,
          i * PinSpan + i * FPinWidth, Height - 1);
      end;
    end // end REctangle
    else // 正方形(PLCC封装)
    begin
      Draw(FPinHeight + FFrameWidth, FPinHeight + FFrameWidth, BackBitMap);
      Brush.Color := FPinColor;
      // 绘制管脚
      Pen.Color := FPinFrameColor;
      for i := 1 to SidePinNum do
      begin
        Rectangle(FPinHeight + i * PinSpan + (i - 1) * FPinWidth, 0,
          i * PinSpan + i * FPinWidth + FPinHeight, FPinHeight); // 绘制上方管脚
        Rectangle(FPinHeight + i * PinSpan + (i - 1) * FPinWidth,
          Height - FPinHeight, i * PinSpan + i * FPinWidth + FPinHeight,
          Height); // 绘制下方管脚
        Rectangle(0, FPinHeight + i * PinSpan + (i - 1) * FPinWidth, FPinHeight,
          i * PinSpan + i * FPinWidth + FPinHeight); // 绘制左方管脚
        Rectangle(Height - FPinHeight, FPinHeight + i * PinSpan +(i - 1) *
          FPinWidth, Height, i * PinSpan + i * FPinWidth + FPinHeight);
        // 绘制右方管脚
      end;
    end;
  end; // canvas
end;
function TMyIC.GetCColor(Color01, Color02: TColor; R, i: Integer): TColor;
var
  C1, C2: TColor;
  R1, G1, B1, R2, G2, B2: Byte;
begin
  // 将TColor颜色值转化为RGB值
  C1 := ColorToRGB(Color01);
  C2 := ColorToRGB(Color02);
  R1 := PByte(@C1)^;
  G1 := PByte(Integer(@C1) + 1)^;
  B1 := PByte(Integer(@C1) + 2)^;
  R2 := PByte(@C2)^;
  G2 := PByte(Integer(@C2) + 1)^;
  B2 := PByte(Integer(@C2) + 2)^;
  // 根据相应算法求出渐变颜色值
  if R <> 0 then
    Result := RGB((R1 + (R2 - R1) * i div R), (G1 + (G2 - G1) * i div R),
      (B1 + (B2 - B1) * i div R))
  else
    Result := Color01;
end;
procedure TMyIC.Paint;
var
  ClrUp, ClrDown: TColor;
begin
  SetPinParam;
  Canvas.Brush.Style := bsClear;
  // 判断按钮的状态，若按下将改变线的颜色以产生按下的效果
  if FIsDown then
  begin
    ClrUp := clBtnShadow;
    ClrDown := clBtnHighlight;
  end
  else
  begin
    ClrUp := clBtnHighlight;
    ClrDown := clBtnShadow;
  end;
  with Canvas do
  begin
    MRgn := CreateRectRgn(0, 0, Width, Height); // 创建检测区域
    // 绘制集成块表面的立体效果
    if FShape = shSquare then
      FRgn := CreateRectRgn(FPinHeight, FPinHeight, Width - FPinHeight - 1,
        Height - FPinHeight - 1)
    else
      FRgn := CreateRectRgn(0, FPinHeight, Width - 1, Height - FPinHeight - 1);
    Canvas.Brush.Color := FButtonColor;
    FillRgn(Handle, FRgn, Brush.Handle);
    Brush.Color := ClrUp;
    FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
    OffsetRgn(FRgn, 1, 1);
    Brush.Color := ClrDown;
    FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
  end;
  DrawShape; // 绘制表面部分和管脚
  WriteCaption; // 标题显示
  inherited;
end;
procedure TMyIC.SetButtonColor(const Value: TColor);
begin
  if Value <> FButtonColor then
  begin
    FButtonColor := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetButtonColor1(const Value: TColor);
begin
  if Value <> FButtonColor1 then
  begin
    FButtonColor1 := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetGradientAngle(const Value: Integer);
begin
  if FGradientAngle <> Value then
  begin
    FGradientAngle := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetGradientKind(const Value: TGradientKind);
begin
  if Value <> FGradientKind then
  begin
    FGradientKind := Value;
    Invalidate;
    update;
  end;
end;
procedure TMyIC.SetPinColor(const Value: TColor);
begin
  if Value <> FPinColor then
  begin
    FPinColor := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetPinFrameColor(const Value: TColor);
begin
  if Value <> FPinFrameColor then
  begin
    FPinFrameColor := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetPinNum(const Value: Integer);
var
  Value1: Integer;
begin
  Value1 := Value;
  if FShape = shSquare then
  begin
    Value1 := (Value div 4) * 4;
    if Value < 40 then
      Value1 := 40;
  end
  else if Odd(Value1) then
    Inc(Value1);
  if Value1 <> FPinNum then
  begin
    FPinNum := Value1;
    Invalidate;
  end;
end;
{ 设置和调整集成块组成的比例，计算出管脚高度、宽度、间距等各参数 }
procedure TMyIC.SetPinParam;
begin
  // 长方形(dip 封装)
  if FShape = shRectangle then
  begin
    FPinHeight := Height div 6;
    FPinWidth := Floor(Width / (FPinNum + 1));
    if FPinWidth < 1 then
    begin
      FPinWidth := 1;
      Width := FPinNum + 1;
    end;
    // 单列管脚数
    SidePinNum := FPinNum div 2;
    // 求算管脚间距
    PinSpan := Floor((Width - SidePinNum * FPinWidth) / (SidePinNum + 1));
    if (Width - PinSpan * (SidePinNum + 1) - SidePinNum * FPinWidth) >
      PinSpan then
      Width := PinSpan * (SidePinNum + 1) + SidePinNum * FPinWidth + PinSpan;
    rwidth := Width - 1;
    rHeight := Height - 2 * FPinHeight - 1;
  end
  else // 正方形(PLCC封装)
  begin
    if FPinNum < 40 then
      FPinNum := 40;
    SidePinNum := FPinNum div 4;
    FPinHeight := (Height div 15) + 1;
    Width := Max(Width, Height);
    Height := Width;
    SidePinNum := FPinNum div 4;
    FPinWidth := Floor((Width - 2 * FPinHeight) / (FPinNum + 2) * 2);
    if FPinWidth < 1 then
    begin
      FPinWidth := 1;
      Width := ((FPinNum + 2) div 2) + 2 * FPinHeight;
    end;
    PinSpan := Floor((Width - 2 * FPinHeight - SidePinNum * FPinWidth) /
      (SidePinNum + 1));
    if (Width - PinSpan * (SidePinNum + 1) - SidePinNum * FPinWidth - 2 *
      FPinHeight) > PinSpan then
      Width := PinSpan * (SidePinNum + 1) + SidePinNum * FPinWidth + 2 *
        FPinHeight;
    // 计算集成表面的尺寸
    Height := Width;
    rwidth := Width - 2 * FPinHeight - 1;
    rHeight := Height - 2 * FPinHeight - 1;
  end;
end;
procedure TMyIC.SetShape(const Value: TShape);
begin
  if Value <> FShape then
  begin
    FShape := Value;
    Invalidate;
  end;
end;
procedure TMyIC.SetTextStyle(const Value: TTextStyle);
begin
  if Value <> FTextStyle then
  begin
    FTextStyle := Value;
    Invalidate;
  end;
end;
procedure TMyIC.WMLButtonDown(var msg: TWMLButtonDown);
begin
  if not PtInRegion(MRgn, msg.XPos, msg.YPos) then
    Exit;
  FIsDown := True;
  Paint;
  inherited;
end;
procedure TMyIC.WMLButtonUp(var msg: TWMLButtonUp);
begin
  if not FIsDown then
    Exit;
  FIsDown := False;
  Paint;
  inherited;
end;
procedure TMyIC.WMSize(var msg: TWMSize);
begin
  inherited;
end;
{ 绘制集成块表面的标题 }
procedure TMyIC.WriteCaption;
var
  Flags: Word;
  BtnL, BtnT, BtnR, BtnB: Integer;
  R, TR: TRect;
begin
  R := ClientRect;
  TR := ClientRect;
  Canvas.Font := Self.Font;
  Canvas.Brush.Style := bsClear;
  Flags := DT_CENTER or DT_SINGLELINE;
  Canvas.Font := Font;
  if FIsDown then
    FTextColor := clGray
  else
    FTextColor := Self.Font.Color;
  with Canvas do
  begin
    BtnT := (Height - TextHeight(Caption)) div 2;
    BtnB := BtnT + TextHeight(Caption);
    BtnL := (Width - TextWidth(Caption)) div 2;
    BtnR := BtnL + TextWidth(Caption);
    TR := Rect(BtnL, BtnT, BtnR, BtnB);
    R := TR;
    if ((TextStyle = txLowered) and FIsDown) or
      ((TextStyle = txRaised) and not FIsDown) then
    begin
      Font.Color := clBtnHighlight;
      OffsetRect(TR, -1 + 1, -1 + 1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if ((TextStyle = txLowered) and not FIsDown) or
      ((TextStyle = txRaised) and FIsDown) then
    begin
      Font.Color := clBtnHighlight;
      OffsetRect(TR, +2, +2);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (TextStyle = txShadowed) and FIsDown then
    begin
      Font.Color := clBtnShadow;
      OffsetRect(TR, 3 + 1, 3 + 1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (TextStyle = txShadowed) and not FIsDown then
    begin
      Font.Color := clBtnShadow;
      OffsetRect(TR, 2 + 1, 2 + 1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end;
    if Enabled then
      Font.Color := FTextColor
    else if (TextStyle = txShadowed) and not Enabled then
      Font.Color := clBtnFace
    else
      Font.Color := clBtnShadow;
    if FIsDown then
      OffsetRect(R, 1, 1)
    else
      OffsetRect(R, -1, -1);
    DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
  end;
end;
end.

http://blog.csdn.net/zang141588761/article/details/52585054