Delphi 编写IC控件
编写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; // 管脚宽度
rwidth: 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
Delphi 编写IC控件的更多相关文章
- Delphi 编写ActiveX控件(OCX控件)的知识和样例(有详细步骤)
一.ActiveX应用情况简介: ActiveX控件也就是一般所说的OCX控件,它是 ActiveX技术的一部分.ActiveX是微软公司推出的基于组件对象模型COM的技术,包括对Windows 32 ...
- 用delphi的THTTPRIO控件调用了c#写的webservice。
用delphi的THTTPRIO控件调用了c#写的webservice. 下面是我调试时遇到的一些问题: 1,导入wsdl文件:file--new----other----wenservice---W ...
- 制作用于日期时间型字段的DELPHI数据感知控件
用DELPHI开发C/S应用方便而快速,因为它拥有大量易于使用的数据访问和数据感知控件.然而万事总是难以完美,DELPHI的DBEdit控件用于输入日期时间型字段却很不方便,为了改善这一缺点,笔者开发 ...
- Delphi连接Oracle控件ODAC的安装及使用(轉載)
Delphi连接Oracle控件ODAC的安装及使用 2010-08-13 01:13:37 标签:Oracle Delphi 控件 休闲 ODAC 原创作品,允许转载,转载时请务必以超链接形式标明 ...
- Delphi的TListView控件拖放选定行操作
http://www.tansoo.cn/?p=401 Delphi的TListView控件拖放选定行操作的例子,效果图如下:TListView控件拖动选定行到指定位置 具体实现步骤: 一.新建一个D ...
- 用Delphi的TIdHttp控件发起POST请求和Java的Servlet响应
http://blog.csdn.net/panjunbiao/article/details/8615880 用Delphi的TIdHttp控件发起POST请求和Java的Servlet响应
- Delphi创建ActiveX控件,实现安全接口及无界面代码
Delphi创建OCX控件非常的方便,但IE调用时弹出的安全认证非常麻烦,有时OCX也不需要界面,IE调用时需要隐藏,非常不方便.在DELPHI中创建OCX实现安全接口和创建事件中修改部分代码 实现安 ...
- Delphi 开发ActiveX控件(非ActiveForm)
Delphi 开发ActiveX控件(非ActiveForm) Q:为什么不采用ActiveForm工程?通过它可以快速开发带窗体控件,创建过程也非常简单(都不用考虑安全接口问题),很省事! A:如果 ...
- delphi 使用工控机控件 iThreadTimes 出现问题, 导致主程序创建页面的时候, 阻塞消息, 不能正常执行。
delphi 使用工控机控件 iThreadTimes 出现问题, 导致主程序创建页面的时候, 阻塞消息, 不能正常执行. 使用这个控件需要小心 function Tfrm_MainIPC.Open ...
随机推荐
- js进阶 10-4 jquery中基础选择器有哪些
js进阶 10-4 jquery中基础选择器有哪些 一.总结 一句话总结: 1.群组选择器用的符号是什么? 群组选择器,中间是逗号 2.jquery中基础选择器有哪些? 5种,类,id,tag,群组, ...
- 为什么java的web开发中URLEncoder.encode方法要为什么要调用两次
一: 我们先看2个编码的情况 String name=java.net.URLEncoder.encode("测试", "UTF-8"); System.out ...
- C#MVC中创建多模块web应用程序
当一个应用程序有越来越多的子模块后,应用程序将变得越来越大,复杂度也越来越高,应用程序也越来越难维护.如果把每个子模块,独立分成不同的web应用程序,则这个项目将易于维护.关于这个的好处,我也描述得不 ...
- 【u253】售货厅
Time Limit: 1 second Memory Limit: 128 MB [问题描述] 售票厅出售关于音乐会的票,取代原来的卖一张票的形式,而是一组座号连续的票.售票室已经收到很多预订.每个 ...
- GammaRay is a tool to poke around in a Qt-application(确实很多功能)
GammaRay is a tool to poke around in a Qt-application and also to manipulate the application to some ...
- DELPHI高性能大容量SOCKET并发(八):断点续传(上传也可以续传)
断点续传 断点续传主要是用在上传或下载文件,一般做法是开始上传的时候,服务器返回上次已经上传的大小,如果上传完成,则返回-1:下载开始的时候,由客户端上报本地已经下载大小,服务器根据位置信息下发数据, ...
- Android Handler、Message完全解析,带你从源码的角度彻底理解
之前也是由于周末通宵看TI3比赛,一直没找到时间写博客,导致已经有好久没更新了.惭愧!后面还会恢复进度,尽量保证每周都写吧.这里也是先恭喜一下来自瑞典的Alliance战队夺得了TI3的冠军,希望明年 ...
- adb删除系统软件
ZTE V970Android OS 4.1.2OS version: LeWa_13.04.03系统内存划分很小,才500M. 幸好开发者设置里面有一项:ROOT 授权管理adb root // 没 ...
- Maven软件项目管理工具
http://my.oschina.net/jgy/blog/125503 拷贝mavne安装文件夹conf以下的settings.xml到用户主文件夹下 改动改文件 <localReposit ...
- 【转】NIO与传统IO的区别
转自:http://blog.csdn.net/zhouhl_cn/article/details/6568119 传统的socket IO中,需要为每个连接创建一个线程,当并发的连接数量非常巨大时, ...