You've already forked lazarus-ccr
mbColorLib: Delphi support removed. Change version number to 2.1 (standard even/odd numbering scheme).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5549 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -5,16 +5,10 @@ unit mbBasicPicker;
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LMessages,
|
||||
{$ELSE}
|
||||
Messages,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, Graphics, Controls, ExtCtrls, Forms;
|
||||
LMessages, Classes, SysUtils, Graphics, Controls, ExtCtrls, Forms;
|
||||
|
||||
type
|
||||
THintState = (hsOff, hsWaitingToShow, hsWaitingToHide);
|
||||
|
||||
TGetHintStrEvent = procedure (Sender: TObject; X, Y: Integer; var AText: String) of object;
|
||||
|
||||
{ TmbBasicPicker }
|
||||
@@ -22,12 +16,6 @@ type
|
||||
TmbBasicPicker = class(TCustomControl)
|
||||
private
|
||||
FOnGetHintStr: TGetHintStrEvent;
|
||||
{
|
||||
FHintWindow: THintWindow;
|
||||
FHintTimer: TTimer;
|
||||
FHintState: THintState;
|
||||
procedure HintTimer(Sender: TObject);
|
||||
}
|
||||
protected
|
||||
FBufferBmp: TBitmap;
|
||||
FGradientWidth: Integer;
|
||||
@@ -39,20 +27,12 @@ type
|
||||
function GetGradientColor2D(X, Y: Integer): TColor; virtual;
|
||||
function GetHintPos(X, Y: Integer): TPoint; virtual;
|
||||
function GetHintStr(X, Y: Integer): String; virtual;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure PaintParentBack; virtual; overload;
|
||||
procedure PaintParentBack(ACanvas: TCanvas); overload;
|
||||
procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
|
||||
procedure PaintParentBack(ABitmap: TBitmap); overload;
|
||||
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
|
||||
{$IFDEF DELPHI}
|
||||
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
|
||||
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
||||
{$ELSE}
|
||||
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
|
||||
// procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
||||
{$ENDIF}
|
||||
property ColorUnderCursor: TColor read GetColorUnderCursor;
|
||||
property OnGetHintStr: TGetHintStrEvent read FOnGetHintStr write FOnGetHintStr;
|
||||
public
|
||||
@@ -61,7 +41,6 @@ type
|
||||
function GetColorAtPoint(X, Y: Integer): TColor; virtual;
|
||||
function GetHexColorAtPoint(X, Y: integer): string;
|
||||
function GetHexColorUnderCursor: string; virtual;
|
||||
// function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override;
|
||||
published
|
||||
property ParentColor default true;
|
||||
end;
|
||||
@@ -72,22 +51,11 @@ uses
|
||||
LCLIntf,
|
||||
HTMLColors, mbUtils;
|
||||
|
||||
const
|
||||
HINT_SHOW_DELAY = 50;
|
||||
HINT_HIDE_DELAY = 3000;
|
||||
|
||||
constructor TmbBasicPicker.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
// ControlStyle := ControlStyle - [csOpaque];
|
||||
ParentColor := true;
|
||||
{
|
||||
FHintTimer := TTimer.Create(self);
|
||||
FHintTimer.Interval := HINT_SHOW_DELAY;
|
||||
FHintTimer.Enabled := false;
|
||||
FHintTimer.OnTimer := @HintTimer;
|
||||
FHintState := hsOff;
|
||||
}
|
||||
end;
|
||||
|
||||
destructor TmbBasicPicker.Destroy;
|
||||
@@ -152,22 +120,6 @@ begin
|
||||
Result := GetColorAtPoint(P.X, P.Y);
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHexColorAtPoint(X, Y: integer): string;
|
||||
begin
|
||||
Result := ColorToHex(GetColorAtPoint(x, y));
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHexColorUnderCursor: string;
|
||||
begin
|
||||
Result := ColorToHex(GetColorUnderCursor);
|
||||
end;
|
||||
|
||||
{
|
||||
function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
|
||||
begin
|
||||
result := inherited GetDefaultColor(DefaultColorType);
|
||||
end; }
|
||||
|
||||
function TmbBasicPicker.GetGradientColor(AValue: Integer): TColor;
|
||||
begin
|
||||
Result := clNone;
|
||||
@@ -178,6 +130,16 @@ begin
|
||||
Result := clNone;
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHexColorAtPoint(X, Y: integer): string;
|
||||
begin
|
||||
Result := ColorToHex(GetColorAtPoint(x, y));
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHexColorUnderCursor: string;
|
||||
begin
|
||||
Result := ColorToHex(GetColorUnderCursor);
|
||||
end;
|
||||
|
||||
function TmbBasicPicker.GetHintPos(X, Y: Integer): TPoint;
|
||||
begin
|
||||
Result := Point(X, Y);
|
||||
@@ -190,58 +152,6 @@ begin
|
||||
FOnGetHintStr(Self, X, Y, Result);
|
||||
end;
|
||||
|
||||
(*
|
||||
function TmbBasicPicker.GetHintText: String;
|
||||
begin
|
||||
Result := Hint;
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.HideHintWindow;
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
FHintState := hsOff;
|
||||
FreeAndNil(FHintWindow);
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.HintTimer(Sender: TObject);
|
||||
begin
|
||||
case FHintState of
|
||||
hsWaitingToShow:
|
||||
ShowHintWindow(Mouse.CursorPos, GetHintText);
|
||||
hsWaitingToHide:
|
||||
HideHintWindow;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
procedure TmbBasicPicker.MouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
{
|
||||
HideHintWindow;
|
||||
FHintTimer.Enabled := false;
|
||||
FHintState := hsOff;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
{
|
||||
if ShowHint and not FHintShown then
|
||||
begin
|
||||
if MouseOnPicker(X, Y) then
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
FHintState := hsWaitingToShow;
|
||||
FHintTimer.Interval := HINT_SHOW_DELAY;
|
||||
FHintTimer.Enabled := true;
|
||||
end
|
||||
else
|
||||
HideHintWindow;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.PaintParentBack;
|
||||
begin
|
||||
PaintParentBack(Canvas);
|
||||
@@ -251,28 +161,13 @@ procedure TmbBasicPicker.PaintParentBack(ABitmap: TBitmap);
|
||||
begin
|
||||
ABitmap.Width := Width;
|
||||
ABitmap.Height := Height;
|
||||
{$IFNDEF DELPHI}
|
||||
if Color = clDefault then begin
|
||||
ABitmap.Transparent := true;
|
||||
ABitmap.TransparentColor := clForm;
|
||||
ABitmap.Canvas.Brush.Color := clForm; //GetDefaultColor(dctBrush)
|
||||
ABitmap.Canvas.Brush.Color := clForm;
|
||||
end else
|
||||
{$ENDIF}
|
||||
ABitmap.Canvas.Brush.Color := Color;
|
||||
ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect);
|
||||
|
||||
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
|
||||
if ParentBackground then
|
||||
with ThemeServices do
|
||||
if ThemesEnabled then
|
||||
begin
|
||||
MemDC := CreateCompatibleDC(0);
|
||||
OldBMP := SelectObject(MemDC, ABitmap.Handle);
|
||||
DrawParentBackground(Handle, MemDC, nil, False);
|
||||
if OldBMP <> 0 then SelectObject(MemDC, OldBMP);
|
||||
if MemDC <> 0 then DeleteDC(MemDC);
|
||||
end;
|
||||
{$ENDIF}{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.PaintParentBack(ACanvas: TCanvas);
|
||||
@@ -281,25 +176,6 @@ var
|
||||
begin
|
||||
R := Rect(0, 0, Width, Height);
|
||||
PaintParentBack(ACanvas, R);
|
||||
(*
|
||||
var
|
||||
OffScreen: TBitmap;
|
||||
begin
|
||||
Offscreen := TBitmap.Create;
|
||||
try
|
||||
// Offscreen.PixelFormat := pf32bit;
|
||||
if Color = clDefault then begin
|
||||
Offscreen.Transparent := true;
|
||||
Offscreen.TransparentColor := clForm; //GetDefaultColor(dctBrush);
|
||||
end;
|
||||
Offscreen.Width := Width;
|
||||
Offscreen.Height := Height;
|
||||
PaintParentBack(Offscreen);
|
||||
ACanvas.Draw(0, 0, Offscreen);
|
||||
finally
|
||||
Offscreen.Free;
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
|
||||
procedure TmbBasicPicker.PaintParentBack(ACanvas: TCanvas; ARect: TRect);
|
||||
@@ -308,10 +184,9 @@ var
|
||||
begin
|
||||
Offscreen := TBitmap.Create;
|
||||
try
|
||||
// Offscreen.PixelFormat := pf32bit;
|
||||
if Color = clDefault then begin
|
||||
Offscreen.Transparent := true;
|
||||
Offscreen.TransparentColor := clForm; //GetDefaultColor(dctBrush);
|
||||
Offscreen.TransparentColor := clForm;
|
||||
end;
|
||||
Offscreen.Width := WidthOfRect(ARect);
|
||||
Offscreen.Height := HeightOfRect(ARect);
|
||||
@@ -321,52 +196,6 @@ begin
|
||||
Offscreen.Free;
|
||||
end;
|
||||
end;
|
||||
(*
|
||||
// Build and show the hint window
|
||||
function TmbBasicPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean;
|
||||
const
|
||||
MAXWIDTH = 400;
|
||||
var
|
||||
RScr, RHint, R: TRect;
|
||||
begin
|
||||
FHintTimer.Enabled := false;
|
||||
|
||||
if AText = '' then
|
||||
begin
|
||||
HideHintWindow;
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
if FHintWindow = nil then
|
||||
FHintWindow := THintWindow.Create(nil);
|
||||
RScr := Screen.WorkAreaRect;
|
||||
RHint := FHintWindow.CalcHintRect(MAXWIDTH, AText, nil);
|
||||
OffsetRect(RHint, APoint.X, APoint.Y);
|
||||
OffsetRect(RHint, 0, -(RHint.Bottom - RHint.Top));
|
||||
R := RHint;
|
||||
if R.Left < RScr.Left then
|
||||
R := RHint;
|
||||
RHint := R;
|
||||
if (R.Bottom > RScr.Bottom) then begin
|
||||
R := RHint;
|
||||
OffsetRect(R, 0, R.Bottom - RScr.Bottom);
|
||||
end;
|
||||
FHintWindow.ActivateHint(R, AText);
|
||||
|
||||
FHintState := hsWaitingToHide;
|
||||
FHintTimer.Interval := HINT_HIDE_DELAY;
|
||||
FHintTimer.Enabled := true;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
*)
|
||||
(* !!!!!!!!!!!!!!!!!
|
||||
procedure TmbBasicPicker.WMEraseBkgnd(
|
||||
var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} );
|
||||
begin
|
||||
inherited;
|
||||
// Message.Result := 1;
|
||||
end; *)
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user