skinexctrls.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

        with TspDataSkinFrameControl(FSD.CtrlList.Items[FIndex]) do
        begin
          Self.SkinRect := SkinRect;
          Self.CursorIndex := CursorIndex;
          if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
          then
            Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
          else
            Picture := nil;
          if (MaskPictureIndex <> -1) and (MaskPictureIndex < FSD.FActivePictures.Count)
          then
            MaskPicture := TBitMap(FSD.FActivePictures.Items[MaskPictureIndex])
          else
            MaskPicture := nil;
          Self.FramesCount := FramesCount;
          Self.FramesPlacement := FramesPlacement;
        end;
        if FramesCount < 2 then FramesCount := 2;
        case FramesPlacement of
          fpHorizontal:
             begin
               FrameW := RectWidth(SkinRect) div FramesCount;
               FrameH := RectHeight(SkinRect);
             end;
          fpVertical:
            begin
              FrameH := RectHeight(SkinRect) div FramesCount;
              FrameW := RectWidth(SkinRect);
            end;
        end;
      end;
end;

procedure TspFrameSkinControl.SetBounds;
var
  UpDate: Boolean;
begin
  GetSkinData;
  UpDate := ((Width <> AWidth) or (Height <> AHeight)) and
  ((FIndex <> -1) or (not FDefaultImage.Empty and (FIndex = -1)));

  if UpDate
  then
    begin
      AWidth := FrameW;
      AHeight := FrameH;
    end;  

  inherited;

  if UpDate
  then
    begin
      SetControlRegion;
      RePaint;
    end;
end;

procedure TspFrameSkinControl.ChangeSkinData;
var
  UpDate: Boolean;
begin
  GetSkinData;

  if (FIndex = -1) and (not FDefaultImage.Empty)
  then
    begin
      CalcDefaultFrameSize;
      SetControlRegion;
      if not FDefaultImage.Empty
      then
        SetBounds(Left, Top, FrameW, FrameH);
      RePaint;
      Exit;
    end;

  if (FIndex <> -1) and (FFrame > FramesCount)
  then FFrame := FramesCount;

  if FUseSkinCursor
  then
  if (CursorIndex <> -1) and (FIndex <> -1)
  then
    Cursor := FSD.StartCursorIndex + CursorIndex
  else
    Cursor := crDefault;

  if FIndex <> -1
  then
    begin
      UpDate := (Width <> FrameW) or (Height <> FrameH);
      SetBounds(Left, Top, FrameW, FrameH);
    end
  else
    UpDate := False;

  if not UpDate
  then
    begin
      SetControlRegion;
      RePaint;
    end;
end;

procedure TspFrameSkinControl.CreateControlDefaultImage;
var
  R: TRect;
begin
  if FDefaultImage.Empty
  then
    begin
      with B.Canvas do
      begin
        R := ClientRect;
        Brush.Color := clBtnFace;
        FillRect(R);
      end;
      Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
    end
  else
    begin
      CalcDefaultFrameSize;
      if B.Width <> FrameW then B.Width := FrameW;
      if B.Height <> FrameH then B.Height := FrameH;
      case FramesPlacement of
         fpHorizontal:
           R := Rect((FFrame - 1) * FrameW, 0,
                      FFrame * FrameW, FrameH);
         fpVertical:
           R := Rect(0, (FFrame - 1) * FrameH,
                     FrameW, FFrame * FrameH);
      end;
      B.Canvas.CopyRect(Rect(0, 0, FrameW, FrameH), FDefaultImage.Canvas, R);
    end;
end;

procedure TspFrameSkinControl.CreateControlSkinImage;
var
  R: TRect;
begin
  if B.Width <> FrameW then B.Width := FrameW;
  if B.Height <> FrameH then B.Height := FrameH;
  case FramesPlacement of
    fpHorizontal:
       R := Rect(SkinRect.Left + (FFrame - 1) * FrameW, SkinRect.Top,
                 SkinRect.Left + FFrame * FrameW, SkinRect.Top + FrameH);
   fpVertical:
       R := Rect(SkinRect.Left, SkinRect.Top + (FFrame - 1) * FrameH,
                 SkinRect.Left + FrameW, SkinRect.Top + FFrame * FrameH);
  end;
  B.Canvas.CopyRect(Rect(0, 0, FrameW, FrameH), Picture.Canvas, R);
end;

procedure TspFrameSkinControl.SetControlRegion;
var
  TempRgn: HRgn;
begin
  if (FIndex = -1) and not FDefaultMask.Empty
  then
    begin
      TempRgn := FRgn;
      CreateSkinSimplyRegion(FRgn, FDefaultMask);
      SetWindowRgn(Handle, FRgn, True);
      if TempRgn <> 0 then DeleteObject(TempRgn);
    end
  else  
  if ((MaskPicture = nil) or (FIndex = -1)) and (FRgn <> 0)
  then
    begin
      SetWindowRgn(Handle, 0, True);
      DeleteObject(FRgn);
      FRgn := 0;
    end
  else
    if (MaskPicture <> nil) and (FIndex <> -1)
    then
      begin
        TempRgn := FRgn;
        CreateSkinSimplyRegion(FRgn, MaskPicture);
        SetWindowRgn(Handle, FRgn, True);
        if TempRgn <> 0 then DeleteObject(TempRgn);
      end;
end;

procedure TspFrameSkinControl.SetFrame;
begin
  if (FIndex = -1) and FDefaultImage.Empty then Exit;
  if Value < 1 then Value := 1 else
  if Value > FramesCount then Value := FramesCount;
  if FFrame <> Value
  then
    begin
      FFrame := Value;
      RePaint;
    end;
end;

constructor TspSkinSwitch.Create;
begin
  inherited Create(AOwner);
  Width := 25;
  Height := 50;
  FMouseIn := False;
  FAnimateTimer := TTimer.Create(Self);
  FAnimateTimer.Interval := 50;
  FAnimateTimer.Enabled := False;
  FAnimateTimer.OnTimer := DoAnimate;
end;

destructor TspSkinSwitch.Destroy;
begin
  FAnimateTimer.Free;
  inherited;
end;

procedure TspSkinSwitch.DoAnimate;
begin
  if (FIndex = -1) and FDefaultImage.Empty then Exit;
  if State = swOff
  then
    begin
      if Frame > 0 then Frame := Frame - 1 else Stop;
    end
  else
    begin
      if Frame < FramesCount then Frame := Frame + 1 else Stop;
    end;
end;

procedure TspSkinSwitch.Start;
begin
  FAnimateTimer.Enabled := True;
end;

procedure TspSkinSwitch.Stop;
begin
  FAnimateTimer.Enabled := False;
end;

procedure TspSkinSwitch.CMMouseEnter;
begin
  inherited;
  if (csDesigning in ComponentState) then Exit;
  FMouseIn := True;
end;

procedure TspSkinSwitch.CMMouseLeave;
begin
  inherited;
  if (csDesigning in ComponentState) then Exit;
  FMouseIn := False;
end;


procedure TspSkinSwitch.MouseUp(Button: TMouseButton; Shift: TShiftState;
                                X, Y: Integer);
begin
  if (Button = mbLeft) and FMouseIn
  then
    begin
      if State = swOff then State := swOn else State := swOff;
    end;
  inherited;
end;

procedure TspSkinSwitch.ChangeSkinData;
begin
  inherited;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then
    if FState = swOn
    then Frame := FramesCount
    else Frame := 1;
end;

procedure TspSkinSwitch.ChangeState;
begin
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then
    begin
      if FramesCount = 2
      then
        begin
          if FState = swOn
          then Frame := 2
          else Frame := 1;
        end
      else
        Start;  
    end
  else
    RePaint;
end;

procedure TspSkinSwitch.SetState;
begin
  FState := Value;
  ChangeState(Value);
  if not (csDesigning in ComponentState)
  then
    if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TspSkinSwitch.SetTimerInterval;
begin
  FAnimateTimer.Interval := Value;
end;

function TspSkinSwitch.GetTimerInterval;
begin
  Result := FAnimateTimer.Interval;
end;

constructor TspSkinAnimate.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAnimateTimer := TTimer.Create(Self);
  FAnimateTimer.Interval := 50;
  FAnimateTimer.Enabled := False;
  FAnimateTimer.OnTimer := DoAnimate;
  Width := 50;
  Height := 50;
end;

destructor TspSkinAnimate.Destroy;
begin
  FAnimateTimer.Enabled := False;
  FAnimateTimer.Free;
  inherited;
end;

procedure TspSkinAnimate.SetActive;
begin
  FActive := Value;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then
    if FActive then Start else Stop;
end;

procedure TspSkinAnimate.SetTimerInterval;
begin
  FAnimateTimer.Interval := Value;
end;

function TspSkinAnimate.GetTimerInterval;
begin
  Result := FAnimateTimer.Interval;
end;

procedure TspSkinAnimate.DoAnimate;
begin
  if (FIndex = -1) and FDefaultImage.Empty then Exit;

  if FButtonMode and not FMouseIn
  then
    begin
      if Frame > 0 then Frame := Frame - 1 else Stop;
    end
  else
    begin
      if Frame = FramesCount
      then
        begin
          if FCycleMode then Frame := 0
        end
      else
        begin
          if Frame < FramesCount then Frame := Frame + 1 else Stop;
        end;
    end;
end;

procedure TspSkinAnimate.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (csDesigning in ComponentState) then Exit;
  if (FIndex = -1) and FDefaultImage.Empty then Exit;
  FMouseIn := True;
  if FButtonMode then Start;
end;

procedure TspSkinAnimate.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if (csDesigning in ComponentState) then Exit;
  if (FIndex = -1) and FDefaultImage.Empty then Exit;
  FMouseIn := False;
  if FButtonMode then Start;
end;

procedure TspSkinAnimate.Start;
begin
  if not FCycleMode and not FButtonMode then FFrame := 1;
  FAnimateTimer.Enabled := True;
  if Assigned(FOnStart) then FOnStart(Self);
end;

procedure TspSkinAnimate.Stop;
begin
  FAnimateTimer.Enabled := False;
  if Assigned(FOnStop) then FOnStop(Self);
end;

constructor TspSkinFrameGauge.Create;
begin
  inherited;
  FMinValue := 0;
  FMaxValue := 100;
  FValue := 50;
  Width := 50;
  Height := 50;
end;

procedure TspSkinFrameGauge.ChangeSkinData;
begin
  inherited;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then CalcFrame;
end;

procedure TspSkinFrameGauge.CalcFrame;
var
  FValInc: Integer;
begin
  FValInc := (FMaxValue - FMinValue) div (FramesCount - 1);
  Frame := Abs(FValue - FMinValue) div FValInc + 1;
end;

procedure TspSkinFrameGauge.SetMinValue;
begin
  FMinValue := AValue;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then
    begin
      if FValue < FMinValue then FValue := FMinValue;
      CalcFrame;
    end;
end;

procedure TspSkinFrameGauge.SetMaxValue;
begin
  FMaxValue := AValue;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty)
  then
    begin
      if FValue > FMaxValue then FValue := FMaxValue;
      CalcFrame;
    end;
end;

procedure TspSkinFrameGauge.SetValue;
begin
  if (FValue = AValue) or (AValue > FMaxValue) or
     (AValue < FMinValue) then Exit;
  FValue := AValue;
  if (FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty) then CalcFrame;
end;

constructor TspSkinFrameRegulator.Create;
begin
  inherited;
  FMinValue := 0;
  FMaxValue := 100;
  FValue := 50;
  Width := 50;
  Height := 50;
  FDown := False;
  FFrame := 1;
  Kind := rkRound;
end;

procedure TspSkinFrameRegulator.SetDefaultKind;
begin
  FDefaultKind := Value;
  Kind := FDefaultKind;
end;

procedure TspSkinFrameRegulator.CalcDefaultFrameSize;
begin
  inherited;
  Kind := FDefaultKind;
end;