{ 
  マウスでぐりぐりまわすタイプのつまみコンポ原形
}
unit RotKnob;
interface
uses
  math,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type  //Rotary knob Class
  TRotKnobTyp=(rknSimple,rknDbl,rknCirSimple,rknCirDbl);
  TRotKnob = class(TCustomControl)
  private
    { Private 宣言 }
     hrgn:HRgn;
     Fdeg100:integer;
     mouseS:double;
     mouseX,mouseY:integer;
     mouseF1:boolean;
     mouseF2:boolean;
     FKnobTyp:TRotKnobTyp;
   procedure rgnSet;
   procedure SetFdeg100(const Value: integer);
   procedure SetFKnobTyp(const Value: TRotKnobTyp);
  protected
    { Protected 宣言 }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift: TShiftState;
      X,Y:Integer); override;

  public
    { Public 宣言 }
    destructor Destroy;override;
     constructor Create(AOwner: TComponent); override;
    procedure ShowControl(AControl: TControl);override;
    procedure CreateWnd; override;
    procedure Resize;override;
  published
    { Published 宣言 }
    property KnobTyp:TRotKnobTyp read FKnobTyp write SetFKnobTyp;
    property deg100:integer read fdeg100 write SetFdeg100;
    property color;
    property Align;
  end;
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TRotKnob]);
end;

constructor TRotKnob.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   width :=64;
   height:=64;
   hRgn:=0;
end;

procedure TRotKnob.CreateWnd;
begin
  inherited;
 rgnSet;
end;

destructor TRotKnob.Destroy;
begin
  Windows.DeleteObject(hRgn);
  inherited;
end;

procedure TRotKnob.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var x0,y0:integer;
begin
   mouseX:=X;
   mouseY:=Y;
   x0:=width   div 2;
   y0:=height  div 2;
   mouseS:=round(arctan2(mouseY-y0,mouseX-X0)*18000.0/PI);
    mouseF1:= mbLeft=Button ;
    mouseF2:=hypot(x-x0,y-y0)<((x0*3) div 4);

end;

procedure TRotKnob.MouseMove(Shift: TShiftState; X, Y: Integer);
var x0,y0:integer;
var dx1,dy1,dx2,dy2:integer;
var w:double;
begin
  x0:=width   div 2;  y0:=height  div 2;
  dx1:=X-x0;  dy1:=Y-y0;
  dx2:=mouseX-x0;  dy2:=mouseY-y0;

  w:=round(-arctan2(dx1*dy2-dy1*dx2,dx1*dx2+dy1*dy2)*18000.0/PI);
  if  mouseF1  then
  begin
    if  mouseF2 and (KnobTyp in[rknDbl,rknCirDbl])  then
      deg100:=deg100+round((w)/10)
    else
      deg100:=deg100+round(w);
  end;
  mouseS:=w;
   mouseX:=X;
   mouseY:=Y;
end;

procedure TRotKnob.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  mouseF1:=False;
  mouseF2:=False;
end;

procedure TRotKnob.Paint;
var x0,y0:integer;
var c,s,w:double;
var dx,dy:integer;
 procedure ViewMark ;
  var OldPen:TPen;
 begin
  OldPen:=TPen.Create;

  OldPen.Assign(Canvas.Pen);
  try
  Canvas.Pen.Width:=5;
  dx:=round( s*x0);
  dy:=round(-c*y0);
  canvas.MoveTo(x0+(dx div 2),y0+(dy div 2));
  canvas.LineTo(x0+dx,y0+dy);
  finally
   Canvas.Pen:=OldPen;
   OldPen.Free;
  end;
 end;
begin
w:=deg100*PI/18000.0;
c:=cos(w);
s:=sin(w);

x0:=width   div 2;
y0:=height div 2;

  if   (KnobTyp in[rknDbl,rknCirDbl])  then
   canvas.Ellipse(x0-((x0*3)div 4),y0-((y0*3)div 4),
                  x0+((x0*3)div 4),y0+((y0*3)div 4) );
  ViewMark;
end;

procedure TRotKnob.Resize;
begin
 if  KnobTyp in [rknCirSimple,rknCirDbl] then
  begin
   height:=width;
  end;
  rgnSet;
inherited;
end;

procedure TRotKnob.rgnSet;
begin
  SetWindowRgn(Handle , 0, False);
  DeleteObject(hRgn);
  hrgn:=CreateEllipticRgn(0, 0,width, height);
  SetWindowRgn(Handle,hrgn, True);
end;


procedure TRotKnob.SetFdeg100(const Value: integer);
begin
if Fdeg100<>Value then  Invalidate;
  fdeg100 := Value;
end;

procedure TRotKnob.SetFKnobTyp(const Value: TRotKnobTyp);
begin
 if FKnobTyp <> Value then Invalidate;
  FKnobTyp := Value;
  Resize;
end;

procedure TRotKnob.ShowControl(AControl: TControl);
begin
inherited;
   if not (csDesigning in ComponentState ) then rgnSet;
end;
end.
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 00/07/31 -

Original document by 裏目小僧        氏 ID:(GGA03463)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。