skinexctrls.pas

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

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

procedure TspSkinFrameRegulator.CalcValue;
var
  Offset: Integer;
  Plus: Boolean;
  FW: Integer;
  FC: Integer;
begin
  if (FIndex = -1) and not FDefaultImage.Empty then CalcDefaultFrameSize;

  FW := 0;

  case Kind of
    rkRound: if FrameW > FrameH then FW := FrameH else FW := FrameW;
    rkVertical: FW := FrameH;
    rkHorizontal: FW := FrameW;
  end;

  if FramesCount - 1 > 0 then FC := FramesCount - 1 else FC := 1;

  FPixInc := FW div FC;
  FValInc := (FMaxValue - FMinValue) div FC;

  if FPixInc = 0 then FPixInc := 1;
  if FValInc = 0 then FValInc := 1;

  Plus := CurV >= StartV;

  if Plus
  then Offset := CurV - StartV
  else Offset := StartV - CurV;

  if Offset >= FPixInc
  then
    begin
      StartV := CurV;
      if Plus
      then TempValue := TempValue + FValInc
      else TempValue := TempValue - FValInc;

      if TempValue < FMinValue then TempValue := FMinValue;
      if TempValue > FMaxValue then TempValue := FMaxValue;

      Value := TempValue;
    end;
end;

procedure TspSkinFrameRegulator.CalcRoundValue;
var
  Offset: Integer;
  Plus: Boolean;
  FW: Integer;
  FC: Integer;
  OffsetCount: Integer;
begin
  if (FIndex = -1) and not FDefaultImage.Empty then CalcDefaultFrameSize;
  if FramesCount - 1 > 0 then FC := FramesCount - 1 else FC := 1;

  FPixInc := 360 div FC;
  FValInc := (FMaxValue - FMinValue) div FC;

  if FPixInc = 0 then FPixInc := 1;
  if FValInc = 0 then FValInc := 1;

  if Abs(CurV - OldCurV) > 300
  then
    begin
      StartV := CurV;
      Offset := FPixInc;
      Plus := CurV < OldCurV
    end
  else
    begin
      Plus := CurV >= StartV;
      if Plus
      then Offset := CurV - StartV
      else Offset := StartV - CurV;
    end;

  if Offset >= FPixInc
  then
    begin
      StartV := CurV;
      if Plus
      then TempValue := TempValue + FValInc
      else TempValue := TempValue - FValInc;
      if TempValue < FMinValue then TempValue := FMinValue;
      if TempValue > FMaxValue then TempValue := FMaxValue;
      Value := TempValue;
    end;

end;

procedure TspSkinFrameRegulator.CalcFrame;
var
  FC: Integer;
begin
  if (FIndex = -1) and not FDefaultImage.Empty then CalcDefaultFrameSize;
  if FramesCount - 1 > 0 then FC := FramesCount - 1 else FC := 1;
  FValInc := (FMaxValue - FMinValue) div FC;
  Frame := Abs(FValue - FMinValue) div FValInc + 1;
end;

procedure TspSkinFrameRegulator.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 TspSkinFrameRegulator.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 TspSkinFrameRegulator.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;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TspSkinFrameRegulator.GetSkinData;
begin
  inherited;
  if (FIndex <> -1) 
  then
    if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinFrameRegulator
    then
      with TspDataSkinFrameRegulator(FSD.CtrlList.Items[FIndex]) do
      begin
        Self.Kind := Kind;
      end;
end;

procedure TspSkinFrameRegulator.MouseDown;
begin
  FDown := True;
  TempValue := FValue;
  case Kind of
    rkRound:
      begin
        StartV := GetRoundValue(X, Y);
        OldCurV := StartV;
      end;
    rkVertical: StartV := -Y;
    rkHorizontal: StartV := X;
  end;
  inherited;
end;

procedure TspSkinFrameRegulator.MouseUp;
begin
  FDown := False;
  inherited;
end;

function TspSkinFrameRegulator.GetRoundValue(X, Y: Integer): Integer;
var
  CX, CY: Integer;
  X1, Y1: Integer;
  midAngle: Integer;
  sinMidAngle, MidAngle1: Double;
begin
  CX := Width div 2;
  CY := Height div 2;
  X1 := CX - X;
  Y1 := CY - Y;
  if (X <= CX) and (Y < CY) then midAngle := 90;
  if (X < CX) and (Y >= CY) then midAngle := 180;
  If (X >= CX) and (Y > CY) then midAngle := 270;
  If (X > CX) and (Y <= CY) Then midAngle := 0;
  if (midAngle = 0) or (midAngle = 180)
  then sinMidAngle := Abs(Trunc(Y1))/(Sqrt(Sqr(X1)+Sqr(Y1)));
  if (midAngle = 90) or (midAngle = 270)
  then sinMidAngle:= Abs(Trunc(X1))/(Sqrt(Sqr(X1)+Sqr(Y1)));
  midAngle1 := ArcTan(sinMidAngle/Sqrt(1-sqr(sinMidAngle)));
  midAngle1 := (midAngle1/Pi) * 180;
  midAngle := Trunc(midAngle + midAngle1);
  Result := 270 - MidAngle;
  if Result < 0 then Result := Result + 360;
end;

procedure TspSkinFrameRegulator.MouseMove;
begin
  if FDown and ((FIndex <> -1) or ((FIndex = -1) and not FDefaultImage.Empty))
  then
    begin
      case Kind of
        rkRound: CurV := GetRoundValue(X, Y);
        rkVertical: CurV := -Y;
        rkHorizontal: CurV := X;
      end;
      if Kind = rkRound then CalcRoundValue else CalcValue;
      OldCurV := CurV;
    end;
  inherited;
end;

constructor TspSkinBitLabel.Create;
begin
  inherited;
  Symbols := nil;
  Width := 100;
  Height := 20;
  FSkinDataName := 'bitlabel';
end;

function TspSkinBitLabel.GetFixWidth;
var
  LO, RO: Integer;
begin
  LO := ClRect.Left;
  RO := RectWidth(SkinRect) - ClRect.Right;
  Result := SymbolWidth * FFixLength + LO + RO;
end;

procedure TspSkinBitLabel.SetFixLength;
begin
  FFixLength := Value;
  if FFixLength > 0
  then
    begin
      FAutoSize := False;
      if FIndex <> -1
      then
        Width := GetFixWidth;
    end;
end;

procedure TspSkinBitLabel.CMTextChanged(var Message: TMessage);
begin
  if FAutoSize then AdjustBounds;
  RePaint;
end;

procedure TspSkinBitLabel.AdjustBounds;
var
  Offset: Integer;
begin
  if Align <> alNone then Exit;
  if FIndex = -1
  then Offset := 0
  else Offset := Length(Caption) * SymbolWidth - RectWidth(NewClRect);
  if Offset <> 0 then Width := Width + Offset;
end;

procedure TspSkinBitLabel.CalcSize;
var
  Offset: Integer;
begin
  inherited;
  if FFixLength > 0
  then
    begin
      if FIndex <> -1
      then
        W := GetFixWidth;
    end
  else
    begin
      if FIndex = -1
      then Offset := 0
      else Offset := Length(Caption) * SymbolWidth - RectWidth(NewClRect);
      if (Offset > 0) or FAutoSize then W := W + Offset;
    end;  
end;

procedure TspSkinBitLabel.CreateControlDefaultImage;
begin
  inherited;
  with B.Canvas do
  begin
    Brush.Style := bsClear;
    TextRect(Rect(1, 1, Width - 1, Height - 1), 2,
             Height div 2 - TextHeight(Caption) div 2,
             Caption);
  end;
end;

procedure TspSkinBitLabel.PaintLabel;
begin
  CreateSkinControlImage(B, Picture, SkinRect);
end;

procedure TspSkinBitLabel.GetSkinData;
begin
  inherited;
  if FIndex <> -1
  then
    if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinBitLabelControl
    then
      begin
        with TspDataSkinBitLabelControl(FSD.CtrlList.Items[FIndex]) do
        begin
          Self.SkinTextRect := SkinTextRect;
          Self.SymbolWidth := SymbolWidth;
          Self.SymbolHeight := SymbolHeight;
          Self.Symbols := Symbols;
        end;
      end;
end;

procedure TspSkinBitLabel.CreateControlSkinImage;
var
  SymbolX, SymbolY: Integer;
  i: Integer;
  XO: Integer;
  LO, RO: Integer;

procedure GetSymbolPos(Ch: Char);
var
  i, j: Integer;
begin
  SymbolX := -1;
  SymbolY := -1;
  for i := 0 to Symbols.Count - 1 do
  begin
    j := Pos(Ch, Symbols[i]);
    if j <> 0
    then
      begin
        SymbolX := j - 1;
        SymbolY := i;
        Exit;
      end;
  end;
end;

begin
  inherited;
  LO := ClRect.Left;
  RO := RectWidth(SkinRect) - ClRect.Right;
  with B.Canvas do
  begin
    for i := 1 to Length(Caption) do
    begin
      if (i * SymbolWidth) > B.Width
      then XO := i * SymbolWidth - B.Width - LO - RO
      else XO := 0;
      GetSymbolPos(Caption[i]);
      if SymbolX <> -1
      then
        begin
          CopyRect(
            Rect(LO + (i - 1) * SymbolWidth, NewClRect.Top, LO + i * SymbolWidth - XO, NewClRect.Top + SymbolHeight),
            Picture.Canvas,
            Rect(SkinTextRect.Left + SymbolX * SymbolWidth,
                 SkinTextRect.Top + SymbolY * SymbolHeight,
                 SkinTextRect.Left + (SymbolX + 1) * SymbolWidth - XO,
                 SkinTextRect.Top + (SymbolY + 1) * SymbolHeight));
          if XO > 0 then Break;
        end;
    end;
  end;
end;

procedure TspSkinBitLabel.SetAutoSizeX;
begin
  FAutoSize := Value;
  AdjustBounds;
  RePaint;
end;


constructor TspSkinXFormButton.Create(AOwner: TComponent);
begin
  inherited;
  FDefImage := TBitMap.Create;
  FDefActiveImage := TBitMap.Create;
  FDefDownImage := TBitMap.Create;
  FDefMask := TBitMap.Create;
  CanFocused := False;
  FDefActiveFontColor := 0;
  FDefDownFontColor := 0;
end;

destructor TspSkinXFormButton.Destroy;
begin
  FDefImage.Free;
  FDefActiveImage.Free;
  FDefDownImage.Free;
  FDefMask.Free;
  inherited;
end;

procedure TspSkinXFormButton.SetControlRegion;
var
  TempRgn: HRGN;
begin
  if (FIndex = -1) and (FDefImage <> nil) and not FDefImage.Empty
  then
    begin
      TempRgn := FRgn;
      
      if FDefMask.Empty and (FRgn <> 0)
      then
        begin
          SetWindowRgn(Handle, 0, True);
        end
      else
        begin
          CreateSkinSimplyRegion(FRgn, FDefMask);
          SetWindowRgn(Handle, FRgn, True);
        end;
        
      if TempRgn <> 0 then DeleteObject(TempRgn);
    end
  else
    inherited;
end;

procedure TspSkinXFormButton.SetBounds;
begin
  inherited;
  if (FIndex = -1) and (FDefImage <> nil) and not FDefImage.Empty
  then
    begin
      if Width <> FDefImage.Width then Width := FDefImage.Width;
      if Height <> FDefImage.Height then Height := FDefImage.Height;
    end;
end;

procedure TspSkinXFormButton.DrawDefaultButton;
var
  IsDown: Boolean;
  R: TRect;
begin
  with C do
  begin
    R := ClientRect;
    Font.Assign(FDefaultFont);
    if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
    then
      Font.Charset := SkinData.ResourceStrData.CharSet
    else
      Font.Charset := FDefaultFont.CharSet;
    IsDown := FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
             (GroupIndex = 0)) or (GroupIndex  <> 0));
    if IsDown and not FDefDownImage.Empty
    then
      Draw(0, 0, FDefDownImage)
    else
    if (FMouseIn or IsFocused) and not FDefActiveImage.Empty
    then
      Draw(0, 0, FDefActiveImage)
    else
      Draw(0, 0, FDefImage);
    if IsDown
    then
      Font.Color := FDefDownFontColor
    else
    if FMouseIn or IsFocused
    then
      Font.Color := FDefActiveFontColor;
    DrawGlyphAndText(C, ClientRect, FMargin, FSpacing, FLayout,
     Caption, FGlyph, FNumGlyphs, GetGlyphNum(FDown, FMouseIn), IsDown, False, 0);
  end;
end;

procedure TspSkinXFormButton.CreateControlDefaultImage;
begin