TmbColorPreview - need some modification

[WojTec]

Do you know mbColorLib? In this free and dead package is nice component to preview color, you know, rectangle where color is visible. Here is part of this unit.

Delphi-Quellcode:

unit mbColorPreview;

interface

uses {...};

type
  TmbColorPreview = class(TCustomControl)
  private
   FSelColor: TColor;
   FOpacity: integer;
   FOnColorChange: TNotifyEvent;
   FOnOpacityChange: TNotifyEvent;
   FBlockSize: integer;
   FSwatchStyle: boolean;

   procedure SetSwatchStyle(Value: boolean);
   procedure SetSelColor(c: TColor);
   procedure SetOpacity(o: integer);
   procedure SetBlockSize(s: integer);
   function MakeBmp: TBitmap;
  protected
   procedure Paint; override;
   procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
   constructor Create(AOwner: TComponent); override;
  published
   property Color: TColor read FSelColor write SetSelColor default clWhite;
   property Opacity: integer read FOpacity write SetOpacity default 100;
   property BlockSize: integer read FBlockSize write SetBlockSize default 6;
   property SwatchStyle: boolean read FSwatchStyle write SetSwatchStyle default false;
   property {...}
  end;

procedure Register;

implementation

{...}

constructor TmbColorPreview.Create(AOwner: TComponent);
begin
 inherited;
 DoubleBuffered := true;
 ControlStyle := COntrolStyle - [csAcceptsControls] + [csOpaque];
 FSelColor := clWhite;
 Width := 68;
 Height := 32;
 TabStop := false;
 FOpacity := 100;
 FBlockSize := 6;
 FSwatchStyle := false;
end;

function TmbColorPreview.MakeBmp: TBitmap;
 begin
  Result := TBitmap.Create;
  Result.Width := FBlockSize;
  Result.Height := FBlockSize;
  if (FSelColor = clNone) or (FOpacity = 0) then
   Result.Canvas.Brush.Color := clSilver
  else
   Result.Canvas.Brush.Color := Blend(FSelColor, clSilver, FOpacity);
  Result.Canvas.FillRect(Result.Canvas.ClipRect);
 end;

procedure TmbColorPreview.Paint;
var
 TempBMP, cBMP: TBitmap;
 i, j: integer;
 R: TRect;
 rgn: HRgn;
 c: TColor;
begin
 TempBMP := TBitmap.Create;
 cBMP := nil;
 rgn := 0;
 try
  TempBMP.Width := Width + FBlockSize;
  TempBMP.Height := Height + FBlockSize;
  TempBMP.PixelFormat := pf24bit;
  TempBmp.Canvas.Pen.Color := clBtnShadow;
  TempBmp.Canvas.Brush.Color := FSelColor;
  R := ClientRect;
  with TempBmp.Canvas do
   if (FSelColor <> clNone) and (FOpacity = 100) then
    begin
     if not FSwatchStyle then
      Rectangle(R)
     else
      begin
       Brush.Color := clWindow;
       Rectangle(R);
       InflateRect(R, -1, -1);
       FillRect(R);
       InflateRect(R, 1, 1);
       InflateRect(R, -2, -2);
       Brush.Color := Blend(FSelColor, clBlack, 75);
       FillRect(R);
       InflateRect(R, -1, -1);
       Brush.Color := Blend(FSelColor, clBlack, 87);
       FillRect(R);
       InflateRect(R, -1, -1);
       Brush.Color := FSelColor;
       FillRect(R);
      end;
    end
   else
    begin
     cBMP := MakeBmp;
     if (FSelColor = clNone) or (FOpacity = 0) then
      c := clWhite
     else
      c := Blend(FSelColor, clWhite, FOpacity);
     Brush.Color := c;
     Rectangle(R);
     if FSwatchStyle then
      begin
       InflateRect(R, -1, -1);
       FillRect(R);
       InflateRect(R, 1, 1);
       InflateRect(R, -2, -2);
       Brush.Color := Blend(c, clBlack, 75);
       FillRect(R);
       InflateRect(R, -1, -1);
       Brush.Color := Blend(c, clBlack, 87);
       FillRect(R);
       InflateRect(R, -1, -1);
       Brush.Color := c;
       FillRect(R);
      end;
     InflateRect(R, -1, -1);
     rgn := CreateRectRgnIndirect(R);
     SelectClipRgn(TempBmp.Canvas.Handle, rgn);
     for i := 0 to (Height div FBlockSize) do
      for j := 0 to (Width div FBlockSize) do
       begin
        if i mod 2 = 0 then
         begin
          if j mod 2 > 0 then
           TempBmp.Canvas.Draw(j*FBlockSize, i*FBlockSize, cBMP);
         end
        else
         begin
          if j mod 2 = 0 then
           TempBmp.Canvas.Draw(j*FBlockSize, i*FBlockSize, cBMP);
         end;
       end;
    end;
  Canvas.Draw(0, 0, TempBmp);
 finally
  DeleteObject(rgn);
  cBMP.Free;
  TempBMP.Free;
 end;
end;

procedure TmbColorPreview.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
 Message.Result := 1;
end;

{...}

end.

I want to change tiles colors (if opacity is not 100 then tiles are visible), but I don't understand where is tiled background painted Could you help detect right place where can change these colors, please?

BTW: Do you have 3rd party updates for this package? Maybe it exists?

[Tryer]

Search for "Blend(":
The selected color is blended to clWhite (see Paint()) or to clSilver (see MakeBmp()).
The background is filled "blended to white", then at "each second" tile the bitmap (blended to clSilver) is drawn (see end of Paint(), "mod 2 = 0(..)".

-> simply blend to other colors.

Greets,
Dirk

[WojTec]

Thanks, I will try change it