dynamicskinform.pas

DynamicSkinForm Finial 6.85_完全汉化版_for CB_D5-9 特点： 完全source 完全汉化真正奉献！ 本汉化只供研究和学习用

      CreateObjectImage(Buffer, False);
      CreateObjectImage(ABuffer, True);
      PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
      APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
      case MorphKind of
        mkDefault: PBuffer.Morph(APBuffer, MorphKf);
        mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
        mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
        mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
        mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
        mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
        mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
      end;
      PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
      PBuffer.Free;
      APBuffer.Free;
      Buffer.Free;
      ABuffer.Free;
    end;
end;

procedure TspActiveSkinObject.SetMorphKf(Value: Double);
begin
  FMorphKf := Value;
  if FMorphKf < 0 then FMorphKf := 0 else
  if FMorphKf > 1 then FMorphKf := 1;
end;

procedure TspUserObject.Draw;
begin
  Parent.PaintEvent(IDName, Cnvs, ObjectRect);
end;

//============= TspSkinTrackBarObject ============//
constructor TspSkinTrackBarObject.Create;
begin
  inherited Create(AParent, AData);
  with TspDataSkinTrackBar(AData) do
  begin
    Self.ButtonRect := ButtonRect;
    Self.ActiveButtonRect := ActiveButtonRect;
    Self.BeginPoint := BeginPoint;
    Self.EndPoint := EndPoint;
    Self.MinValue := MinValue;
    Self.MaxValue := MaxValue;
    Self.MouseDownChangeValue := MouseDownChangeValue;
    Self.ButtonTransparent := ButtonTransparent;
    Self.ButtonTransparentColor := ButtonTransparentColor;
  end;
  if abs(BeginPoint.Y - EndPoint.Y) < abs(EndPoint.X - BeginPoint.X)
  then
    TrackKind := tkHorizontal
  else
    TrackKind := tkVertical;
  FValue := MinValue;
  FButtonPos := CalcButtonPos(FValue);
end;

function TspSkinTrackBarObject.CalcButtonRect;
var
  L, T: Integer;
begin
  L := P.X - RectWidth(ButtonRect) div 2;
  T := P.Y - RectHeight(ButtonRect) div 2;
  Result := Rect(L, T,
                 L + RectWidth(ButtonRect), T + RectHeight(ButtonRect));
end;

function TspSkinTrackBarObject.CalcValue;
var
  kf: Double;
begin
  kf := 0;
  case TrackKind of
    tkHorizontal:
      kf := (FButtonPos.X - BeginPoint.X) / (EndPoint.X - BeginPoint.X);
    tkVertical:
      kf := 1 - (FButtonPos.Y - EndPoint.Y) / (BeginPoint.Y - EndPoint.Y);
  end;
  Result := MinValue + Round((MaxValue - MinValue) * kf);
end;

function TspSkinTrackBarObject.CalcButtonPos;
var
  kf: Double;
begin
  kf := (Value - MinValue) / (MaxValue - MinValue);
  case TrackKind of
    tkHorizontal:
      Result := Point(BeginPoint.X + Round((EndPoint.X - BeginPoint.X) * kf),
                      BeginPoint.Y);
    tkVertical:
      Result := Point(BeginPoint.X,
                      EndPoint.Y + Round((BeginPoint.Y - EndPoint.Y) *
                      (1 - kf)));
  end;
end;

procedure TspSkinTrackBarObject.SimplySetValue;
begin
  FValue := AValue;
  if FValue < MinValue then FValue := MinValue;
  if FValue > MaxValue then FValue := MaxValue;
  FOldButtonPos := FbuttonPos;
  FButtonPos := CalcButtonPos(Value);
  Parent.TrackBarChangeValueEvent(IDName, FValue);
end;

procedure TspSkinTrackBarObject.SetValue;
begin
  if FValue <> AValue
  then
    begin
      FValue := AValue;
      if FValue < MinValue then FValue := MinValue;
      if FValue > MaxValue then FValue := MaxValue;
      FOldButtonPos := FbuttonPos;
      FButtonPos := CalcButtonPos(Value);
      Parent.DrawSkinObject(Self);
      Parent.TrackBarChangeValueEvent(IDName, FValue);
    end;
end;

procedure TspSkinTrackBarObject.SetButtonPos;
begin
  if (FButtonPos.X <> AValue.X) or (FButtonPos.Y <> AValue.Y)
  then
    begin
      FOldButtonPos := FbuttonPos;
      FButtonPos := AValue;
      FValue := CalcValue(FButtonPos);
      Parent.DrawSkinObject(Self);
      Parent.TrackBarChangeValueEvent(IDName, FValue);
    end;
end;

procedure TspSkinTrackBarObject.Draw;
var
  BRect: TRect;
  Buffer: TBitMap;
  BR: TRect;
  B: TBitMap;
begin
  if MoveActive and not IsNullRect(ActiveButtonRect)
  then BRect := ActiveButtonRect
  else BRect := ButtonRect;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(SkinRect);
  Buffer.Height := RectHeight(SkinRect);
  BR := CalcButtonRect(FButtonPos);
  //
  with Buffer.Canvas do
  begin
    case TrackKind of
      tkHorizontal:
        begin
          if IsNullRect(ActiveSkinRect)
          then
            CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
                     Picture.Canvas, SkinRect)
          else
            begin
              CopyRect(Rect(0, 0, FButtonPos.X, Buffer.Height),
                       ActivePicture.Canvas,
                       Rect(ActiveSkinRect.Left, ActiveSkinRect.Top,
                            ActiveSkinRect.Left + FButtonPos.X, ActiveSkinRect.Bottom));
              CopyRect(Rect(FButtonPos.X, 0, Buffer.Width, Buffer.Height),
                       Picture.Canvas,
                       Rect(SkinRect.Left + FButtonPos.X, SkinRect.Top,
                            SkinRect.Right, SkinRect.Bottom));
            end;
        end;
      tkVertical:
        begin
          if IsNullRect(ActiveSkinRect)
          then
            CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
                     Picture.Canvas, SkinRect)
          else
            begin
              CopyRect(Rect(0, 0, Buffer.Width, FButtonPos.Y),
                       Picture.Canvas,
                       Rect(SkinRect.Left, SkinRect.Top,
                            SkinRect.Right, SkinRect.Top + FButtonPos.Y));
              CopyRect(Rect(0, FButtonPos.Y, Buffer.Width, Buffer.Height),
                       ActivePicture.Canvas,
                       Rect(ActiveSkinRect.Left, ActiveSkinRect.Top + FButtonPos.Y,
                            ActiveSkinRect.Right, ActiveSkinRect.Bottom));
            end;
        end;
    end;
    //
    if ButtonTransparent
    then
      begin
        B := TBitMap.Create;
        B.Width := RectWidth(BRect);
        B.Height := RectHeight(BRect);
        B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height),
          ActivePicture.Canvas, BRect);
        B.Transparent := True;
        B.TransparentMode := tmFixed;
        B.TransparentColor := ButtonTransparentColor;
        Draw(BR.Left, BR.Top, B);
        B.Free;
      end
    else
      CopyRect(BR, ActivePicture.Canvas, BRect);
    //
  end;
  Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
  Buffer.Free;
end;

procedure TspSkinTrackBarObject.MouseDown(X, Y: Integer; Button: TMouseButton);
var
  X1, Y1: Integer;
begin
  X1 := X - ObjectRect.Left;
  Y1 := Y - ObjectRect.Top;
  if PtInRect(CalcButtonRect(FButtonPos), Point(X1, Y1)) and (Button = mbLeft)
  then
    begin
      MoveActive := True;
      FOldMPoint.X := X1;
      FOldMPoint.Y := Y1;
      if not IsNullRect(ActiveButtonRect)
      then Parent.DrawSkinObject(Self);
    end
  else
    if MouseDownChangeValue and (Button = mbLeft)
    then
      case TrackKind of
        tkHorizontal:
          begin
            if X1 < BeginPoint.X then X1 := BeginPoint.X;
            if X1 > EndPoint.X then X1 := EndPoint.X;
            ButtonPos := Point(X1, BeginPoint.Y);
          end;
        tkVertical:
          begin
            if Y1 < EndPoint.Y then Y1 := EndPoint.Y;
            if Y1 > BeginPoint.Y then Y1 := BeginPoint.Y;
            ButtonPos := Point(BeginPoint.X, Y1);
          end;
     end;
  inherited MouseDown(X, Y, Button);
end;

procedure TspSkinTrackBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
  if MoveActive and (Button = mbLeft)
  then
    begin
      MoveActive := False;
      if not IsNullRect(ActiveButtonRect)
      then
        Parent.DrawSkinObject(Self);
    end;
  inherited MouseUp(X, Y, Button);
end;

procedure TspSkinTrackBarObject.MouseMove(X, Y: Integer);
var
  X1, Y1: Integer;
  TestPos: Integer;
begin
  X1 := X - ObjectRect.Left;
  Y1 := Y - ObjectRect.Top;
  if MoveActive
  then
    case TrackKind of
      tkHorizontal:
        begin
          TestPos := FButtonPos.X + X1 - FOldMPoint.X;
          if (TestPos >= BeginPoint.X) and (TestPos <= EndPoint.X)
          then
            ButtonPos := Point(TestPos, FButtonPos.Y);
        end;

        tkVertical:
          begin
            TestPos := FButtonPos.Y + Y1 - FOldMPoint.Y;
            if (TestPos >= EndPoint.Y) and (TestPos <= BeginPoint.Y)
            then ButtonPos := Point(FButtonPos.X, TestPos);
          end;
    end;
  FOldMPoint := Point(X1, Y1);
  inherited MouseMove(X, Y);
end;

//============= TspSkinSwitchObject ==============//
constructor TspSkinSwitchObject.Create;
begin
  inherited Create(AParent, AData);
  FState := swsOff;
end;

procedure TspSkinSwitchObject.SetState;
begin
  FState := Value;
  if FState = swsOn then Active := True else Active := False;
  ReDraw;
  Parent.SwitchChangeStateEvent(IDName, FState);
end;

procedure TspSkinSwitchObject.SimpleSetState(Value: TSwitchState);
begin
  FState := Value;
  Active := FState = swsOn;
  if Active then FMorphKf := 1;
end;

procedure TspSkinSwitchObject.MouseDown;
begin
  if Button = mbLeft
  then
    if State = swsOff then State := swsOn else State := swsOff;
  inherited MouseDown(X, Y, Button);
end;

procedure TspSkinSwitchObject.MouseEnter;
begin
  FMouseIn := True;
  Parent.MouseEnterEvent(IDName);
end;

procedure TspSkinSwitchObject.MouseLeave;
begin
  FMouseIn := False;
  Parent.MouseLeaveEvent(IDName);
end;

//============= TspSkinButtonObject ============= //
constructor TspSkinButtonObject.Create;
begin
  inherited Create(AParent, AData);
  GroupIndex := -1;
  if AData <> nil
  then 
  with TspDataSkinButton(AData) do
  begin
    Self.DownRect := DownRect;
    Self.DisableSkinRect := DisableSkinRect;
    Self.GroupIndex := GroupIndex;
  end;
  MenuItem := nil;
  FPopupUp := False;
end;

procedure TspSkinButtonObject.Draw;
begin
  if not Enabled and not IsNullRect(DisableSkinRect)
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DisableSkinRect)
  else
  if (FDown and not IsNullRect(DownRect)) and
     ((GroupIndex <> -1) or FMouseIn)
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownRect)
  else
    inherited Draw(Cnvs, UpDate);
end;

procedure TspSkinButtonObject.SetDown;

procedure DoAllUp;
var
  i, j: Integer;
begin
  j := GroupIndex;
  if j <> -1 then
  for i := 0 to Parent.ObjectList.Count - 1 do
    if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinButtonObject) and
       (TspActiveSkinObject(Parent.ObjectList.Items[i]).IDName <> IDName)
    then
      with TspSkinButtonObject(Parent.ObjectList.Items[i]) do
        if (j = GroupIndex) and FDown
        then
          begin