不知这是否算一个组件,安装可以成功,但没有在面板上显示出来,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;

解决方案 »

  1.   

    procedure TQQCoolBar.checkbounds(xpos,ypos:integer);
    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.
      

  2.   

    LZ的套件,画得不错呀~~~~顶~~~
    我用D7,安装成功了,显示在Samples面板上
    写一个测试程序,在窗口上放置这个控件,也能正常显示的
      

  3.   

    哦,谢谢了,那是我的delphi7的问题了,怪不得还有那个teechart控件装不上