![]() |
TmbColorPreview - need some modification
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:
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?
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. BTW: Do you have 3rd party updates for this package? Maybe it exists? |
AW: TmbColorPreview - need some modification
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 |
Re: TmbColorPreview - need some modification
Thanks, I will try change it :)
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:27 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz