不知这是否算一个组件,安装可以成功,但没有在面板上显示出来,dcr文件也做了,在不用安装时,在一个工程中动态创建测试成功,就是安装了,没显示出来在面板上,是不是这种组合的方法不行呢
unit QQcoolbar;interfaceuses
windows,sysutils,Classes, Controls, StdCtrls, ComCtrls, Messages,graphics,
Dialogs, ExtCtrls;type
torient=(horizontal,vertical);type
TQQCoolBar=class(tcustomcontrol) private
pt1,pt2:tpaintbox;
posx,posy:integer;
sld1,sld2,sld3:tpoint; forient:torient;
mbdown:boolean;
frcl,fbcl,fgcl:byte;
fcl:tcolor;
fbarwidth,fbarheight:integer;
fslider:tcolor; procedure checkbounds(xpos,ypos:integer);
procedure pt1Paint(Sender: TObject);
procedure pt1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pt2Paint(Sender: TObject);
procedure pt2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure changesize; procedure setorientvalue(value:torient);
procedure setclvalue(value:tcolor);
procedure setbarwidth(value:integer);
procedure setbarheight(value:integer);
procedure setslidercolor(value:tcolor);
public
constructor create(aowner:tcomponent);override;
destructor destroy;override; published
property orientation:torient read forient write setorientvalue;
property icolor:tcolor read fcl write setclvalue;
property barwidth:integer read fbarwidth write setbarwidth;
property barheight:Integer read fbarheight write setbarheight;
property slidercolor:tcolor read fslider write setslidercolor;
protected
property redvalue:byte read frcl;
property greenvalue:byte read fgcl;
property bluevalue:byte read fbcl; end;procedure register;implementationprocedure Register;
begin
RegisterComponents('Samples', [TQQCoolBar]);
end;constructor TQQCoolBar.create(aowner:tcomponent);
begin
inherited create(aowner);
pt1:=tpaintbox.Create(self);
pt1.Left:=0;
pt1.Top:=0;
pt1.Width:=140;
pt1.Height:=6;
pt1.Parent:=self;
pt1.OnPaint:=pt1paint;
pt1.OnMouseDown:=pt1mousedown;
pt1.OnMouseMove:=pt1mousemove;
pt1.OnMouseUp:=pt1mouseup; pt2:=tpaintbox.Create(self);
pt2.Left:=10;
pt2.Top:=pt1.Height ;
pt2.Width:=120;
pt2.Height:=20;
pt2.Parent:=self;
pt2.OnPaint:=pt2paint;
pt2.OnMouseDown:=pt2mousedown;
pt2.OnMouseMove:=pt2mousemove;
pt2.OnMouseUp:=pt2mouseup; forient:=horizontal;
posy:=10;
posx:=10;
fcl:=clgreen; width:=pt1.Width ;
height:=pt1.Height+pt2.Height ;
fbarwidth:=120;
fbarheight:=20;end;
unit QQcoolbar;interfaceuses
windows,sysutils,Classes, Controls, StdCtrls, ComCtrls, Messages,graphics,
Dialogs, ExtCtrls;type
torient=(horizontal,vertical);type
TQQCoolBar=class(tcustomcontrol) private
pt1,pt2:tpaintbox;
posx,posy:integer;
sld1,sld2,sld3:tpoint; forient:torient;
mbdown:boolean;
frcl,fbcl,fgcl:byte;
fcl:tcolor;
fbarwidth,fbarheight:integer;
fslider:tcolor; procedure checkbounds(xpos,ypos:integer);
procedure pt1Paint(Sender: TObject);
procedure pt1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pt2Paint(Sender: TObject);
procedure pt2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pt2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure changesize; procedure setorientvalue(value:torient);
procedure setclvalue(value:tcolor);
procedure setbarwidth(value:integer);
procedure setbarheight(value:integer);
procedure setslidercolor(value:tcolor);
public
constructor create(aowner:tcomponent);override;
destructor destroy;override; published
property orientation:torient read forient write setorientvalue;
property icolor:tcolor read fcl write setclvalue;
property barwidth:integer read fbarwidth write setbarwidth;
property barheight:Integer read fbarheight write setbarheight;
property slidercolor:tcolor read fslider write setslidercolor;
protected
property redvalue:byte read frcl;
property greenvalue:byte read fgcl;
property bluevalue:byte read fbcl; end;procedure register;implementationprocedure Register;
begin
RegisterComponents('Samples', [TQQCoolBar]);
end;constructor TQQCoolBar.create(aowner:tcomponent);
begin
inherited create(aowner);
pt1:=tpaintbox.Create(self);
pt1.Left:=0;
pt1.Top:=0;
pt1.Width:=140;
pt1.Height:=6;
pt1.Parent:=self;
pt1.OnPaint:=pt1paint;
pt1.OnMouseDown:=pt1mousedown;
pt1.OnMouseMove:=pt1mousemove;
pt1.OnMouseUp:=pt1mouseup; pt2:=tpaintbox.Create(self);
pt2.Left:=10;
pt2.Top:=pt1.Height ;
pt2.Width:=120;
pt2.Height:=20;
pt2.Parent:=self;
pt2.OnPaint:=pt2paint;
pt2.OnMouseDown:=pt2mousedown;
pt2.OnMouseMove:=pt2mousemove;
pt2.OnMouseUp:=pt2mouseup; forient:=horizontal;
posy:=10;
posx:=10;
fcl:=clgreen; width:=pt1.Width ;
height:=pt1.Height+pt2.Height ;
fbarwidth:=120;
fbarheight:=20;end;
解决方案 »
- 关于delphi下modbusRTU应用问题中关键CRC校验计算
- fastreport 用法
- NT下文件可读性设置问题!!!!急急急急急急急急急
- 请问在一个MDI窗体菜单中,如何做一个DLL
- Acces插入数据的问题。(分少可以加,只要能解决)
- 怎样才能获得所有数据库服务器的名称列表???
- 高手请进,如何抓住com+抛出的错误?
- 打听打听有关工作的情况
- 发现个很大的秘密:大家快来看啊!!!
- 有在FORM1上放了一个SPEEDBUTTON按键。我想样mouse移动到这个按键上时它的GLYPH用的图票变成我指定的。下面程序那李有错?
- 是否有这种函数, 写存储过程~~~
- 请问路径和全路径有什么区别?
begin
posy:=ypos;
posx:=xpos;
if posy>pt2.height+pt2.Top then
posy:=pt2.height+pt2.Top
else if posy<pt2.Top then
posy:=pt2.Top;if posx>pt2.width+pt2.left then
posx:=pt2.width+pt2.left
else if posx<pt2.left then
posx:=pt2.left;end;procedure TQQCoolBar.pt1Paint(Sender: TObject);
begin
{draw slider}
with pt1.canvas,pt1 do
begin
if forient=vertical then
begin
sld1:=point(0,posy);
sld2:=point(width,posy-6);
sld3:=point(width,posy+6);
end
else if forient=horizontal then
begin
sld1:=point(posx,height);
sld2:=point(posx-6,0);
sld3:=point(posx+6,0);
end; pen.Color:=fslider;
pen.Width:=1;
brush.Color:=fslider;
polygon([sld1,sld2,sld3]);
end;end;procedure TQQCoolBar.pt1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
with pt1.canvas,pt1 do
begin
mbdown:=true; checkbounds(x,y);
invalidate;
end;end;procedure TQQCoolBar.pt1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
mbdown:=false;end;procedure TQQCoolBar.pt1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mbdown then
begin
with pt1.canvas,pt1 do
begin
checkbounds(x,y);
invalidate;
end;
with pt2.canvas,pt2 do
begin
if forient=vertical then
begin
if y>=height+top then y:=height-1;
if y<=top then y:=0; frcl:=getrvalue(pixels[1,y]);
fgcl:=getgvalue(pixels[1,y]);
fbcl:=getbvalue(pixels[1,y]);
end
else if forient=horizontal then
begin
if x>=width+left then x:=width-1;
if x<=left then x:=0; frcl:=getrvalue(pixels[x,1]);
fgcl:=getgvalue(pixels[x,1]);
fbcl:=getbvalue(pixels[x,1]);
end; end;
end;end;procedure TQQCoolBar.setorientvalue(value:torient);
begin
forient:=value; pt1.Tag:=pt1.Width;
pt1.Width:=pt1.Height;
pt1.Height:=pt1.Tag; pt2.Tag:=pt2.Width;
pt2.Width:=pt2.Height;
pt2.Height:=pt2.Tag; fbarwidth:=pt2.Width;
fbarheight:=pt2.Height;
changesize;
invalidate;end;procedure TQQCoolBar.Pt2Paint(Sender: TObject);
{ draw coolbar }
var
r,g,b,r1,g1,b1:byte;
i,j,w,h:integer;
begin
w:=pt2.Width;
h:=pt2.Height;r:=getrvalue(fcl);
g:=getgvalue(fcl);
b:=getbvalue(fcl);
with pt2.Canvas do
begin
if forient=vertical then
begin
j:=h div 2;
for i:=0 to j do
begin
r1:=255-round((i/j)*(255-r));
g1:=255-round((i/j)*(255-g));
b1:=255-round((i/j)*(255-b)); pen.Color:=rgb(r1,g1,b1);
penpos:=point(0,i);
lineto(w,i); r1:=r-round((i/j)*r);
g1:=g-round((i/j)*g);
b1:=b-round((i/j)*b); pen.Color:=rgb(r1,g1,b1);
penpos:=point(0,i+j);
lineto(w,i+j);
end;
end
else if forient=horizontal then
begin
j:=w div 2;
for i:=0 to j do
begin
r1:=255-round((i/j)*(255-r));
g1:=255-round((i/j)*(255-g));
b1:=255-round((i/j)*(255-b)); pen.Color:=rgb(r1,g1,b1);
penpos:=point(i,0);
lineto(i,h); r1:=r-round((i/j)*r);
g1:=g-round((i/j)*g);
b1:=b-round((i/j)*b); pen.Color:=rgb(r1,g1,b1);
penpos:=point(i+j,0);
lineto(i+j,h);
end;
end;
end;end;procedure TQQCoolBar.Pt2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mbdown then
with pt2.canvas,pt2 do
begin
if y>=height then y:=height-1;
if y<=0 then y:=0;
if x<=0 then x:=0;
if x>=width then x:=width-1; frcl:=getrvalue(pixels[x,y]);
fgcl:=getgvalue(pixels[x,y]);
fbcl:=getbvalue(pixels[x,y]); checkbounds(x+left,y+top);
pt1.invalidate;
end;end;procedure TQQCoolBar.Pt2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
with pt2.canvas,pt2 do
begin
mbdown:=true; checkbounds(x+left,y+top);
pt1.invalidate; end;end;procedure TQQCoolBar.Pt2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
mbdown:=false;end;procedure TQQCoolBar.setclvalue(value:tcolor);
begin
fcl:=value;
invalidate;
end;destructor TQQCoolBar.destroy;
begin
pt1.Free;
pt2.Free;
inherited destroy;end;procedure TQQCoolBar.setbarwidth(value:integer);
begin
fbarwidth:=value;
changesize;
invalidate;end;procedure TQQCoolBar.setbarheight(value:integer);
begin
fbarheight:=value;
changesize;
invalidate;end;procedure TQQCoolBar.changesize;
begin
pt1.Top:=0;
pt2.Width:=fbarwidth;
pt2.Height:=fbarheight;
if forient=vertical then
begin
pt1.Left:=pt2.Width;
pt1.Width:=6;
pt1.Height:=pt2.Height+20; pt2.Top:=10;
pt2.Left:=0; width:=pt1.Width+pt2.Width;
height:=pt1.Height; end
else if forient=horizontal then
begin
pt1.Left:=0;
pt1.Height:=6;
pt1.Width:=pt1.Width+20; pt2.Left:=10;
pt2.Top:=pt1.Height; width:=pt1.Width;
height:=pt1.Height+pt2.Height;
end;end;procedure TQQCoolBar.setslidercolor(value:tcolor);
begin
fslider:=value;
invalidate;end;
end.
我用D7,安装成功了,显示在Samples面板上
写一个测试程序,在窗口上放置这个控件,也能正常显示的