编写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