Einzelnen Beitrag anzeigen

WojTec

Registriert seit: 17. Mai 2007
480 Beiträge
 
Delphi XE6 Professional
 
#1

TmbColorPreview - need some modification

  Alt 1. Aug 2011, 17:44
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?
  Mit Zitat antworten Zitat