spcolorctrls.pas

一款支持Delphi和C++ Builder的VCL控件

     t := L * ( 1 - S * ( 1 - f ) );
     case SectionIndex of
      0:
        begin
          R := Round(L);
          G := Round(t);
          B := Round(p);
        end;
      1:
        begin
          R := Round(q);
          G := Round(L);
          B := Round(p);
        end;
      2:
        begin
          R := Round(p);
          G := Round(L);
          B := Round(t);
        end;
      3:
        begin
          R := Round(p);
          G := Round(q);
          B := Round(L);
        end;
      4:
        begin
          R := Round(t);
          G := Round(p);
          B := Round(L);
        end;
    else
      R := Round(L);
      G := Round(p);
      B := Round(q);
    end;
  end;
end;

procedure TspEmptyControl.WMEraseBkgnd;
begin
  Msg.Result := 1;
end;

procedure TspEmptyControl.Paint;
begin
end;

constructor TspSkinColorGrid.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csAcceptsControls];
  FForceBackground := False;
  CaptionMode := True;
  Caption := SP_COLORGRID_CAP;
  BorderStyle := bvFrame;
  Width := 280;
  Height := 115;
  FColorValue := 0;
  FColCount := 12;
  FRowCount := 4;
end;

procedure TspSkinColorGrid.WMEraseBkgnd;
begin
  if not FromWMPaint
  then
    begin
      PaintWindow(Msg.DC);
    end;
end;

procedure TspSkinColorGrid.PaintTransparent;
begin
  PaintGrid(C);
end;


destructor TspSkinColorGrid.Destroy;
begin
  inherited;
end;

procedure TspSkinColorGrid.SetColCount(Value: Integer);
begin
  if Value < 1 then Exit;
  FColCount := Value;
  RePaint;
end;

procedure TspSkinColorGrid.SetRowCount(Value: Integer);
begin
  FRowCount := Value;
  RePaint;
end;

procedure TspSkinColorGrid.DrawCursor;
var
  Buffer: TBitMap;
  CIndex: Integer;
  ButtonData: TspDataSkinButtonControl;
  BtnSkinPicture: TBitMap;
  BtnLtPoint, BtnRTPoint, BtnLBPoint, BtnRBPoint: TPoint;
  BtnCLRect: TRect;
  XO, YO: Integer;
  SR: TRect;
begin
  if FIndex = -1
  then
    begin
      Buffer := TBitMap.Create;
      Buffer.Width := RectWidth(R);
      Buffer.Height := RectHeight(R);
      with Buffer.Canvas do
      begin
        Brush.Color :=  SP_XP_BTNDOWNCOLOR;
        Pen.Color := SP_XP_BTNFRAMECOLOR;
        Rectangle(0, 0, Buffer.Width, Buffer.Height);
      end;
      Cnvs.Draw(R.Left, R.Top, Buffer);
      Buffer.Free;
      Exit;
    end;
  CIndex := SkinData.GetControlIndex('resizebutton');
  if CIndex = -1
  then
    Exit
  else
    ButtonData := TspDataSkinButtonControl(SkinData.CtrlList[CIndex]);
    
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(R);
  Buffer.Height := RectHeight(R);
  //
  with ButtonData do
  begin
    XO := RectWidth(R) - RectWidth(SkinRect);
    YO := RectHeight(R) - RectHeight(SkinRect);
    BtnLTPoint := LTPoint;
    BtnRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
    BtnLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
    BtnRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
    BtnClRect := Rect(CLRect.Left, ClRect.Top,
      CLRect.Right + XO, ClRect.Bottom + YO);
    BtnSkinPicture := TBitMap(SkinData.FActivePictures.Items[ButtonData.PictureIndex]);
    SR := DownSkinRect;
    if IsNullRect(SR) then SR := ActiveSkinRect;
    CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
        BtnLtPoint, BtnRTPoint, BtnLBPoint, BtnRBPoint, BtnCLRect,
        Buffer, BtnSkinPicture, SR, Buffer.Width, Buffer.Height, True,
        LeftStretch, TopStretch, RightStretch, BottomStretch,
        StretchEffect, StretchType);
  end;
  //
  Cnvs.Draw(R.Left, R.Top, Buffer);
  Buffer.Free;
end;

procedure TspSkinColorGrid.PaintGrid(Cnvs: TCanvas);
var
  RX, RY, X, Y, CW, CH, i, j, k: Integer;
  R, R1, Rct: TRect;
begin
  R := Rect(0, 0, Width, Height);
  AdjustClientRect(R);
  CW := (RectWidth(R) - ColCount * 2) div ColCount;
  CH := (RectHeight(R) - RowCount * 2) div RowCount;
  //
  R1 := Rect(0, 0, (CW + 2) * ColCount, (CH + 2) * RowCount);
  RX := R.Left + RectWidth(R) div 2 - RectWidth(R1) div 2;
  RY := R.Top + RectHeight(R) div 2 - RectHeight(R1) div 2;
  R := Rect(RX, RY, RX + RectWidth(R1), RectHeight(R1));
  //
  Y := R.Top + 1;
  k := 0;
  for i := 1 to RowCount do
  begin
    X := R.Left + 1;
    for j := 1 to ColCount do
    begin
      Inc(k);
      with Cnvs do
      begin
        Rct := Rect(X - 1, Y - 1, X + CW + 1, Y + CH + 1);

        if FColorValue = ColorValues[k]
        then
          begin
            DrawCursor(Cnvs, Rct);
          end;

        Brush.Color := ColorValues[k];

        if FColorValue = ColorValues[k]
        then
          Rct := Rect(X + 3, Y + 3 , X + CW - 3, Y + CH - 3)
        else
          Rct := Rect(X + 2, Y + 2 , X + CW - 2, Y + CH - 2);

        InflateRect(Rct, -1, -1);
        FillRect(Rct);
        InflateRect(Rct, 1, 1);
      end;
      Inc(X, CW + 2);
    end;
    Inc(Y, CH + 2);
  end;
end;

procedure TspSkinColorGrid.CreateControlDefaultImage;
begin
  inherited;
  PaintGrid(B.Canvas);
end;

procedure TspSkinColorGrid.CreateControlSkinImage;
begin
  inherited;
  PaintGrid(B.Canvas);
end;

function TspSkinColorGrid.CheckColor(Value: TColor): boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 1 to 48 do
    if ColorValues[I] = Value
    then
      begin
        Result := True;
        Break;
      end;
end;

procedure TspSkinColorGrid.SetColorValue(Value: TColor);
begin
  FColorValue := Value;
  if CheckColor(FColorValue)
  then
    begin
      if Assigned(FOnChange) then FOnChange(Self);
      RePaint;
    end;
end;

procedure TspSkinColorGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                     X, Y: Integer);
var
  RX, RY, X1, Y1, CW, CH, i, j, k: Integer;
  R, R1, Rct: TRect;
begin
  inherited;
  R := Rect(0, 0, Width, Height);
  AdjustClientRect(R);
  CW := (RectWidth(R) - ColCount * 2) div ColCount;
  CH := (RectHeight(R) - RowCount * 2) div RowCount;

  R1 := Rect(0, 0, (CW + 2) * ColCount, (CH + 2) * RowCount);
  RX := R.Left + RectWidth(R) div 2 - RectWidth(R1) div 2;
  RY := R.Top + RectHeight(R) div 2 - RectHeight(R1) div 2;
  R := Rect(RX, RY, RX + RectWidth(R1), RectHeight(R1));

  Y1 := R.Top + 1;
  k := 0;
  for i := 1 to RowCount do
  begin
    X1 := R.Left + 1;
    for j := 1 to ColCount do
    begin
      Inc(k);
      Rct := Rect(X1, Y1, X1 + CW, Y1 + CH);
      if PtInRect(Rct, Point(X, Y))
      then
        begin
          ColorValue := ColorValues[k];
          Break;
        end;
      Inc(X1, CW + 2);
    end;
    Inc(Y1, CH + 2);
  end;  
end;


constructor TspColorViewer.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOpaque];
  FColorValue := 0;
end;

procedure TspColorViewer.Paint;
var
  B: TBitMap;
begin
  B := TBitMap.Create;
  B.Width := Width;
  B.Height := Height;
  with B.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := FColorValue;
    Rectangle(0, 0, Width, Height);
  end;
  Canvas.Draw(0, 0, B);
  B.Free;
end;

procedure TspColorViewer.SetColorValue;
begin
  if FColorValue = Value then Exit;
  FColorValue := Value;
  RePaint;
end;

function TPSPColor.RGBToHSL(Value: TRGB): THSL;
var
  R,
  G,
  B,
  D,
  Cmax,
  Cmin: double;

begin
  R := Value.R / 255;
  G := Value.G / 255;
  B := Value.B / 255;
  Cmax := Max (R, Max (G, B));
  Cmin := Min (R, Min (G, B));

// calculate luminosity
  Result.L := (Cmax + Cmin) / 2;

  if Cmax = Cmin then
  begin
    Result.H := 0; 
    Result.S := 0
  end else begin
    D := Cmax - Cmin;

// calculate Saturation
    if Result.L < 0.5 then
      Result.S := D / (Cmax + Cmin)
    else
      Result.S := D / (2 - Cmax - Cmin);

// calculate Hue
    if R = Cmax then
      Result.H := (G - B) / D
    else
      if G = Cmax then
        Result.H  := 2 + (B - R) /D
      else
        Result.H := 4 + (R - G) / D;

    Result.H := Result.H / 6;
    if Result.H < 0 then
      Result.H := Result.H + 1
  end
end;

function TPSPColor.HSLToRGB(Value: THSL): TRGB;
var
  M1,
  M2: double;

  function HueToColourValue (Hue: double) : byte;
  var
    V : double;
  begin
    if Hue < 0 then
      Hue := Hue + 1
    else
      if Hue > 1 then
        Hue := Hue - 1;

    if 6 * Hue < 1 then
      V := M1 + (M2 - M1) * Hue * 6
    else
    if 2 * Hue < 1 then
      V := M2
    else
    if 3 * Hue < 2 then
      V := M1 + (M2 - M1) * (2/3 - Hue) * 6
    else
      V := M1;
    Result := round (255 * V)
  end;

begin
  if Value.S = 0 then
  begin
    Result.R := round (255 * Value.L);
    Result.G := Result.R;
    Result.B := Result.R
  end else begin
    if Value.L <= 0.5 then
      M2 := Value.L * (1 + Value.S)
    else
      M2 := Value.L + Value.S - Value.L * Value.S;
    M1 := 2 * Value.L - M2;
    Result.R := HueToColourValue (Value.H + 1/3);
    Result.G := HueToColourValue (Value.H);
    Result.B := HueToColourValue (Value.H - 1/3)
  end;
end;

function TPSPColor.HSLToHSLPSP: THSLPSP;
begin
  Result.H := round(FHSL.H*255);
  Result.S := round(FHSL.S*255);
  Result.L := round(FHSL.L*255);
end;

function TPSPColor.HSLPSPToHSL: THSL;
begin
  Result.H := FHSLPSP.H/255;
  Result.S := FHSLPSP.S/255;
  Result.L := FHSLPSP.L/255;
end;

constructor TPSPColor.Create;
begin
  inherited;
end;

destructor TPSPColor.Destroy;
begin

  inherited;
end;

procedure TPSPColor.SetRGB(const Value: TRGB);
begin
  FRGB := Value;
  FHSL := RGBToHSL(FRGB);
  FHSLPSP := HSLToHSLPSP();
end;

procedure TPSPColor.SeTHSL(const Value: THSL);
begin
  FHSL := Value;
  FRGB := HSLToRGB(FHSL);
  FHSLPSP := HSLToHSLPSP;
end;

procedure TPSPColor.SeTHSLPSP(const Value: THSLPSP);
begin
  FHSLPSP := Value;
  FHSL := HSLPSPToHSL;
  FRGB := HSLToRGB(FHSL);
end;

procedure TPSPColor.Assign(const Value: TPSPColor);
begin
  FRGB := Value.FRGB;
  FHSL := Value.FHSL;
  FHSLPSP := Value.FHSLPSP;
end;

constructor TspSkinColorDialog.Create;
var
  I: Integer;
begin
  inherited Create(AOwner);

  FGroupBoxTransparentMode := False;

  RGBStopCheck := False;
  HSLStopCheck := False;
  FromPSP := False;

  FColor := 0;
  PSPColor := TPSPColor.Create;

  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;