cdibdial.pas

Delphi控件

  if Result < Min then Result := Min;
end;

function TAbstractDIBDial.ConstrainPosition(APosition: Integer): Integer;
begin
  if APosition > Max then Result := Max
  else if APosition < Min then Result := Min
  else Result := APosition;
end;

constructor TAbstractDIBDial.Create(AOwner: TComponent);
begin
  inherited;
  FIndexMain := TDIBImageLink.Create(Self);
  AddIndexProperty(FIndexMain);
  FIndexPointer := TDIBImageLink.Create(Self);
  AddIndexProperty(FIndexPointer);
  FPointerAngles := CreatePointerAngles;
  FPointerAngles.OnChange := SettingsChanged;
  FPointerOpacities := CreatePointerOpacities;
  FPointerOpacities.OnChange := SettingsChanged;
  FSmallChange := 1;
  FPageSize := 1;
  FMin := 0;
  FMax := 100;
  FPosition := 0;
  FPointerNumGlyphs := 1;
  FPointerRotate := False;
  FPointerRadius := -1;
  FHorizontalPixelsPerPosition := 1;
  FVerticalPixelsPerPosition := 1;
  FMouseControlStyle := mcsCircular;
  FMouseLinearSensitivity := mlsBoth;
  AutoSize := True;
  MouseRepeat := True;
  MouseRepeatInterval := 50;
end;

destructor TAbstractDIBDial.Destroy;
begin
  FreeAndNil(FPointerOpacities);
  FreeAndNil(FPointerAngles);
  FreeAndNil(FIndexPointer);
  FreeAndNil(FIndexMain);
  inherited;
end;

function TAbstractDIBDial.DialHitTest(X, Y: Integer): Integer;
var
  PR: TRect;
  PositionDelta: Integer;
begin
  if MouseControlStyle = mcsLinear then
    Result := DHT_POINTER
  else
  begin
    PR := GetPointerRect;
    if PtInRect(PR, Point(X, Y)) then
      Result := DHT_POINTER
    else
    begin
      PositionDelta := MouseToPosition(X, Y) - Position;
      if Abs(PositionDelta) > (Max - Min) div 4 then
      begin
        if PositionDelta < 0 then
          Result := DHT_PAGECHANGEDOWN
        else
          Result := DHT_PAGECHANGEUP;
      end else
        if PositionDelta < 0 then
          Result := DHT_SMALLCHANGEDOWN
        else
          Result := DHT_SMALLCHANGEUP;
    end;
  end;
end;

function TAbstractDIBDial.GetPointerRect: TRect;
var
  Angle: Extended;
  Radius: Integer;
  CenterPoint: TPoint;
  RotatedSizes: TPoint;
  SmallestDimension: Integer;
  PointerDIB: TMemoryDIB;
begin
  Result := Rect(0, 0, 0, 0);
  Angle := SafeAngle(PositionToAngle);
  SmallestDimension := Smallest(Width, Height);
  if IndexPointer.GetImage(PointerDIB) then
  begin
    if PointerRadius > 0 then
      Radius := PointerRadius
    else
      Radius := SmallestDimension + PointerRadius - PointerDIB.Height;
    CenterPoint := GetRotatedPoint(Width div 2, Height div 2, Radius, Angle);
    if not PointerRotate then Angle := 0;
    RotatedSizes := GetRotatedSize(PointerDIB.Width div PointerNumGlyphs, PointerDIB.Height, Angle, 100, 100);

    Result.Left := CenterPoint.X - (RotatedSizes.X div 2);
    Result.Top := CenterPoint.Y - (RotatedSizes.Y div 2);
    Result.Right := Result.Left + RotatedSizes.X - 1;
    Result.Bottom := Result.Top + RotatedSizes.Y - 1;
  end;
end;

procedure TAbstractDIBDial.ImageChanged(Index: Integer;
  Operation: TDIBOperation);
begin
  if AutoSize then AdjustSize;
  Invalidate;
end;

function TAbstractDIBDial.LinearMouseToPosition(X, Y: Integer): Integer;
var
  XDistance: Integer;
  YDistance: Integer;
  MovementSize: Extended;
begin
  XDistance := X - CapturePosition.X;
  YDistance := CapturePosition.Y - Y;
  if MouseLinearSensitivity in [mlsVertical, mlsBoth] then
    MovementSize := YDistance / VerticalPixelsPerPosition
  else
    MovementSize := 0;
  if MouseLinearSensitivity in [mlsHorizontal, mlsBoth] then
    MovementSize := MovementSize + XDistance / HorizontalPixelsPerPosition;
  Result := MouseDownPosition + Trunc(MovementSize);
end;

procedure TAbstractDIBDial.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ActualPosition: Integer;
begin
  inherited;
  if Button = mbLeft then
  begin
    FMouseDownPosition := Position;
    FCapturePosition := Point(X, Y);
    ActualPosition := MouseToPosition(X, Y);
    case DialHitTest(X, Y) of
      DHT_POINTER: CapturePointer;
      DHT_SMALLCHANGEDOWN:
        if Position - SmallChange < ActualPosition then
          Position := ActualPosition
        else
          Position := Position - SmallChange;
      DHT_SMALLCHANGEUP:
        if Position + SmallChange > ActualPosition then
          Position := ActualPosition
        else
          Position := Position + SmallChange;
      DHT_PAGECHANGEDOWN:
        if Position - PageSize < ActualPosition then
          Position := ActualPosition
        else
          Position := Position - PageSize;
      DHT_PAGECHANGEUP:
        if Position + PageSize > ActualPosition then
          Position := ActualPosition
        else
          Position := Position + PageSize;
    end;
  end;
end;

procedure TAbstractDIBDial.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if FPointerCaptured then
    Position := MouseToPosition(X, Y);
end;

function TAbstractDIBDial.MouseToPosition(X, Y: Integer): Integer;
begin
  if MouseControlStyle = mcsCircular then
    Result := CircularMouseToPosition(X, Y)
  else
    Result := LinearMouseToPosition(X, Y);
end;

procedure TAbstractDIBDial.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) and FPointerCaptured then ReleasePointer;
end;

procedure TAbstractDIBDial.Paint;
var
  PointerRect: TRect;
  MainDIB, PointerDIB: TMemoryDIB;
begin
  inherited;
  if IndexMain.GetImage(MainDIB) then
  begin
    MainDIB.Draw(Width div 2 - (MainDIB.Width div 2), Height div 2 - (MainDIB.Height div 2),
      MainDIB.Width, MainDIB.Height, ControlDIB, 0, 0);
    if IndexPointer.GetImage(PointerDIB) then
    begin
      PointerRect := GetPointerRect;
      if PointerRotate then PointerDIB.Angle := PositionToAngle;
      PointerDIB.AutoSize := True;
      if FPointerCaptured then
        PointerDIB.Opacity := PointerOpacities.Active
      else
        PointerDIB.Opacity := PointerOpacities.Normal;
      PointerDIB.DrawGlyphTween(PointerRect.Left, PointerRect.Top, PointerNumGlyphs,
        ControlDIB, 0, 359, PositionToAngle, True);
    end;
  end;
end;

procedure TAbstractDIBDial.ReleasePointer;
begin
  FPointerCaptured := False;
  Invalidate;  
end;

procedure TAbstractDIBDial.SetHorizontalPixelsPerPosition(const Value: Extended);
begin
  if (Value <= 0) then
    raise EDIBDialError.Create('HorizontalPixelsPerPosition must be greater than zero');
  FHorizontalPixelsPerPosition := Value;
end;

procedure TAbstractDIBDial.SetMax(const Value: Integer);
begin
  if not (csLoading in ComponentState) then
    if (Value <= Min) then
      raise EDIBDialError.Create('Max must be greater than min');
  FMax := Value;
  if Position > Max then Position := Max;
  Invalidate;
end;

procedure TAbstractDIBDial.SetMin(const Value: Integer);
begin
  if not (csLoading in ComponentState) then
    if (Value >= Max) then
      raise EDIBDialError.Create('Min must be less than max');
  FMin := Value;
  if Position < Min then Position := Min;
  Invalidate;
end;

procedure TAbstractDIBDial.SetPageSize(const Value: Integer);
begin
  if not (csLoading in ComponentState) then
    if (Value < 0) then
      raise EDIBDialError.Create('PageSize cannot be less than 0');
  FPageSize := Value;
end;

procedure TAbstractDIBDial.SetPointerAngles(const Value: TCustomDIBDialPointerAngles);
begin
  FPointerAngles.Assign(Value);
end;

procedure TAbstractDIBDial.SetPointerNumGlyphs(const Value: Integer);
begin
  if Value < 1 then
    raise EDIBDialError.Create('PointerNumGlyphs must be at least 1');
  FPointerNumGlyphs := Value;
  Invalidate;
end;

procedure TAbstractDIBDial.SetPointerOpacities(const Value: TCustomDIBDialPointerOpacities);
begin
  FPointerOpacities.Assign(Value);
end;

procedure TAbstractDIBDial.SetPointerRadius(const Value: Integer);
begin
  FPointerRadius := Value;
  Invalidate;
end;

procedure TAbstractDIBDial.SetPointerRotate(const Value: Boolean);
begin
  FPointerRotate := Value;
  Invalidate;
end;

procedure TAbstractDIBDial.SetPosition(const Value: Integer);
begin
  FPosition := ConstrainPosition(Value);
  Changed;
  if not (csLoading in ComponentState) then
    if Assigned(FOnChange) then
      FOnChange(Self);
  Invalidate;
end;

procedure TAbstractDIBDial.SetSmallChange(const Value: Integer);
begin
  if not (csLoading in ComponentState) then
    if (Value < 0) then
      raise EDIBDialError.Create('SmallChange cannot be less than 0');
  FSmallChange := Value;
end;

procedure TAbstractDIBDial.SettingsChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TAbstractDIBDial.SetVerticalPixelsPerPosition(const Value: Extended);
begin
  if (Value <= 0) then
    raise EDIBDialError.Create('VerticalPixelsPerPosition must be greater than zero');
  FVerticalPixelsPerPosition := Value;
end;

{ TCustomDIBDial }

function TCustomDIBDial.CreatePointerAngles: TCustomDIBDialPointerAngles;
begin
  Result :=  TDIBDialPointerAngles.Create;
end;

function TCustomDIBDial.CreatePointerOpacities: TCustomDIBDialPointerOpacities;
begin
  Result := TDIBDialPointerOpacities.Create;
end;

function TCustomDIBDial.GetPointerAngles: TDIBDialPointerAngles;
begin
  Result := (inherited PointerAngles as TDIBDialPointerAngles);
end;

function TCustomDIBDial.GetPointerOpacities: TDIBDialPointerOpacities;
begin
  Result := (inherited PointerOpacities as TDIBDialPointerOpacities);
end;

function TCustomDIBDial.PositionToAngle: Integer;
var
  Percircle: Extended;
  Range: Extended;
begin
  Range := Max - Min;
  Percircle := (Position - Min) * 360 / Range;
  Result := Round(SafeAngle(PointerAngles.Start + (PointerAngles.Range * Percircle / 360)));
end;

procedure TCustomDIBDial.SetPointerAngles(const Value: TDIBDialPointerAngles);
begin
  inherited PointerAngles := Value;
end;

procedure TCustomDIBDial.SetPointerOpacities(const Value: TDIBDialPointerOpacities);
begin
  inherited PointerOpacities := Value;
end;

{ TDIBDial }

constructor TDIBDial.Create(AOwner: TComponent);
begin
  inherited;
  AddTemplateProperty('AutoSize');
  AddTemplateProperty('Max');
  AddTemplateProperty('Min');
  AddTemplateProperty('Opacity');
  AddTemplateProperty('PageSize');
  AddTemplateProperty('PointerAngles');
  AddTemplateProperty('PointerOpacities');
  AddTemplateProperty('PointerNumGlyphs');
  AddTemplateProperty('PointerRadius');
  AddTemplateProperty('PointerRotate');
  AddTemplateProperty('Position');
  AddTemplateProperty('SmallChange');
  AddTemplateProperty('HorizontalPixelsPerPosition');
  AddTemplateProperty('VerticalPixelsPerPosition');
  AddTemplateProperty('MouseControlStyle');
  AddTemplateProperty('MouseLinearSensitivity');
end;

end.