sccheung
asked on
Why not background?
Hello, thank you for solving my last problem. I've got another problem while writing my component. This is the third question I ask for the same component. I hope that you can help me to finish it. I is the most difficult project I've ever done. I want my component to display the clBtnFace as the background when the property BackgroundPic is empty. But it display the original picture instead. Can anyone help me? Here is the component.
unit ButtonPro;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus;
type
TCurrentState = set of (MActive, KActive, Pressing, Disabled, dDown);
TButtonPro = class(TCustomControl)
private
{ Private declarations }
FNormalPic, FActivePic, FPressingPic, FDisabledPic, FDownPic, FBackPic, FMaskPic: TBitmap;
FBtnDown, FStretch, FAutosize, FCancel, FDefault: Boolean;
FTranspColor, FBkColor: TColor;
FMDResult: TModalResult;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
CurrentState: TCurrentState;
procedure SetNormalPic(Value: TBitmap);
procedure SetActivePic(Value: TBitmap);
procedure SetPressingPic(Value: TBitmap);
procedure SetDisabledPic(Value: TBitmap);
procedure SetDownPic(Value: TBitmap);
procedure SetBackPic(Value: TBitmap);
procedure SetMaskPic(Value: TBitmap);
procedure SetTranspColor(Value: TColor);
procedure SetBkColor(Value: TColor);
procedure SetStretch(Value: Boolean);
procedure SetAutosize(Value: Boolean);
procedure SetBtnDown(Value: Boolean);
procedure MaskIt(var TheResult: TBitmap; ThePic, TheMask, TheBackgPic: TBitmap; TheTranspColor: TColor);
protected
{ Protected declarations }
procedure Paint; override;
procedure Click; override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure GotFocus(var Message: TMessage); message CM_ENTER;
procedure LostFocus(var Message: TMessage); message CM_EXIT;
procedure WMChar(var Message: TWMChar); message WM_CHAR;
procedure CMEnabledChanged(var Message: TWMChar); message CM_ENABLEDCHANGED;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property NormalPicture: TBitmap read FNormalPic write SetNormalPic;
Property ActivePicture: TBitmap read FActivePic write SetActivePic;
Property PressingPicture: TBitmap read FPressingPic write SetPressingPic;
Property DisabledPicture: TBitmap read FDisabledPic write SetDisabledPic;
Property DownPicture: TBitmap read FDownPic write SetDownPic;
Property BackgroundPicture: TBitmap read FBackPic write SetBackPic;
Property MaskPicture: TBitmap read FMaskPic write SetMaskPic;
Property Down: Boolean read FBtnDown write SetBtnDown;
Property Stretch: Boolean read FStretch write SetStretch;
Property TransparentColor: TColor read FTranspColor write SetTranspColor default clWhite;
Property BackgroundColor: TColor read FBkColor write SetBkColor default clBtnFace;
Property Height default 50;
Property Width default 50;
Property Visible;
Property Autosize: Boolean read FAutosize write SetAutosize;
Property TabStop;
Property TabOrder;
Property OnEnter;
Property Cursor;
Property Enabled;
Property ModalResult: TModalResult read FMDResult write FMDResult;
Property ParentShowHint;
Property ShowHint;
Property Cancel: Boolean read FCancel write FCancel;
Property Default: Boolean read FDefault write FDefault;
Property PopupMenu;
Property Hint;
Property OnExit;
Property OnClick;
Property OnMouseUp;
Property OnMouseDown;
Property OnMouseMove;
Property OnKeyDown;
Property OnKeyPress;
Property OnKeyUp;
Property OnDragDrop;
Property OnDragOver;
Property OnEndDrag;
Property OnStartDrag;
Property Tag;
Property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
Property OnMOuseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
Property DragMode;
Property DragCursor;
Property Caption;
Property Font;
Property ParentFont;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('My Components', [TButtonPro]);
end;
procedure TButtonPro.CMMouseEnter(va r Message: TMessage);
begin
CurrentState := CurrentState + [MActive];
Invalidate;
If Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
inherited;
end;
procedure TButtonPro.CMMouseLeave(va r Message: TMessage);
begin
CurrentState := CurrentState - [MActive];
Invalidate;
If Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
inherited;
end;
procedure TButtonPro.WMLButtonDown(v ar Message: TMessage);
begin
inherited;
CurrentState := CurrentState + [Pressing];
Invalidate;
end;
procedure TButtonPro.WMLButtonUp(var Message: TMessage);
begin
inherited;
CurrentState := CurrentState - [Pressing];
Invalidate;
end;
constructor TButtonPro.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 50;
Width := 50;
FNormalPic := TBitmap.Create;
FActivePic := TBitmap.Create;
FPressingPic := TBitmap.Create;
FDisabledPic := TBitmap.Create;
FBackPic := TBitmap.Create;
FBackPic.Canvas.Brush.Colo r := clBtnFace;
FDownPic := TBitmap.Create;
FMaskPic := TBitmap.Create;
FBtnDown := False;
FTranspColor := clBackground;
FBkColor := clBackground;
end;
destructor TButtonPro.Destroy;
begin
FNormalPic.Free;
FActivePic.Free;
FPressingPic.Free;
FDisabledPic.Free;
FDownPic.Free;
inherited Destroy;
end;
procedure TButtonPro.SetBkColor(Valu e: TColor);
begin
FBkColor := Value;
FBackPic.Canvas.Brush.Colo r := Value;
Invalidate;
end;
procedure TButtonPro.SetTranspColor( Value: TColor);
begin
FTranspColor := Value;
Invalidate;
end;
procedure TButtonPro.SetNormalPic(Va lue: TBitmap);
begin
FNormalPic.Assign(Value);
If (FAutosize) and (not FNormalPic.Empty) then
begin
Height := FNormalPic.Height;
Width := FNormalPic.Width;
end;
Invalidate;
end;
procedure TButtonPro.SetActivePic(Va lue: TBitmap);
begin
FActivePic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.SetPressingPic( Value: TBitmap);
begin
FPressingPic.Assign(Value) ;
Invalidate;
end;
procedure TButtonPro.SetDisabledPic( Value: TBitmap);
begin
FDisabledPic.Assign(Value) ;
Invalidate;
end;
procedure TButtonPro.SetDownPic(Valu e: TBitmap);
begin
FDownPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.Paint;
var TmpRect, BndRect: TRect;
CurrentPic, TmpPic: TBitmap;
begin
CurrentPic := TBitmap.Create;
CurrentPic.Assign(FNormalP ic);
If (MActive in CurrentState) or (KActive in CurrentState) then
CurrentPic.Assign(FActiveP ic);
If Pressing in CurrentState then CurrentPic.Assign(FPressin gPic);
If dDown in CurrentState then CurrentPic.Assign(FDownPic );
If Disabled in CurrentState then CurrentPic.Assign(FDisable dPic);
If (FAutosize) and (not CurrentPic.Empty) then
begin
Width := CurrentPic.Width;
Height := CurrentPic.Height;
end;
TmpPic := TBitmap.Create;
TmpPic.Assign(CurrentPic);
MaskIt(CurrentPic,TmpPic,F MaskPic,FB ackPic,FTr anspColor) ;
TmpPic.Free;
TmpRect := Rect(0,0,CurrentPic.Width, CurrentPic .Height);
BndRect := Rect(0,0,Width,Height);
Canvas.Brush.Color := FBkColor;
Canvas.Pen.Style := psDash;
If CurrentPic.Empty then begin
Canvas.FillRect(BndRect);
Canvas.TextOut(0,0,'Empty' );
end
else If FStretch then Canvas.CopyRect(BndRect,Cu rrentPic.C anvas,TmpR ect)
else Canvas.CopyRect(TmpRect,Cu rrentPic.C anvas,TmpR ect);
CurrentPic.Free;
end;
procedure TButtonPro.SetStretch(Valu e: Boolean);
begin
FStretch := Value;
If FStretch then FAutosize := False;
Invalidate;
end;
procedure TButtonPro.SetAutosize(Val ue: Boolean);
begin
FAutosize := Value;
If FAutosize then FStretch := False;
Invalidate;
end;
procedure TButtonPro.GotFocus(var Message: TMessage);
begin
CurrentState := CurrentState + [KActive];
Invalidate;
inherited
end;
procedure TButtonPro.LostFocus(var Message: TMessage);
begin
CurrentState := CurrentState - [KActive];
Invalidate;
inherited;
end;
procedure TButtonPro.Click;
begin
inherited;
If (Owner is TForm) and (FMDResult <> mrNone) then With Owner As TForm do ModalResult := FMDResult;
end;
procedure TButtonPro.WMChar(var Message: TWMChar);
begin
inherited;
If (Message.CharCode = 27) and FCancel then Click;
If (Message.CharCode = 13) and FDefault then Click;
end;
procedure TButtonPro.SetBtnDown(Valu e: Boolean);
begin
FBtnDown := Value;
If FBtnDown then
CurrentState := CurrentState + [dDown]
else CurrentState := CurrentState - [dDown];
Invalidate;
end;
procedure TButtonPro.CMEnabledChange d(var Message: TWMChar);
begin
If Self.Enabled then CurrentState := CurrentState - [Disabled]
else CurrentState := CurrentState + [Disabled];
end;
procedure TButtonPro.SetBackPic(Valu e: TBitmap);
begin
FBackPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.SetMaskPic(Valu e: TBitmap);
begin
FMaskPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.MaskIt(var TheResult: TBitmap; ThePic, TheMask, TheBackgPic: TBitmap; TheTranspColor: TColor);
var i,j: integer;
TmpPic1, TmpPic2: TBitmap;
begin
If (ThePic.Empty) and (not TheBackgPic.Empty) then
TheResult.Assign(TheBackgP ic);
If (not ThePic.Empty) and (TheBackgPic.Empty) then
TheBackgPic.Canvas.FillRec t(Rect(0,0 ,ThePic.Wi dth,ThePic .Height));
If (not ThePic.Empty) and (not TheBackgPic.Empty) then
begin
TmpPic1 := TBitmap.Create;
TmpPic2 := TBitmap.Create;
If TheMask.Empty then
begin
TheMask.Assign(ThePic);
With TheMask.Canvas do
for i := 0 to TheMask.Width do
for j := 0 to TheMask.Height do
If Pixels[i,j] = TheTranspColor then
Pixels[i,j] := clBlack
else Pixels[i,j] := clWhite;
end;
TmpPic1.Assign(ThePic);
With TmpPic1.Canvas do
begin
CopyMode := cmSrcAnd;
CopyRect(Rect(0,0,ThePic.W idth,ThePi c.Height), TheMask.Ca nvas,Rect( 0,0,TheMas k.Width,Th eMask.Heig ht));
end;
TmpPic2.Assign(TheMask);
With TmpPic2.Canvas do
begin
CopyMode := cmSrcErase;
CopyRect(Rect(0,0,TheBackg Pic.Width, TheBackgPi c.Height), TheBackgPi c.Canvas,R ect(0,0,Th eBackgPic. Width,TheB ackgPic.He ight));
end;
TheResult.Assign(TmpPic1);
With TheResult.Canvas do
begin
CopyMode := cmSrcPaint;
CopyRect(Rect(0,0,TmpPic1. Width,TmpP ic1.Height ),TmpPic2. Canvas,Rec t(0,0,TmpP ic1.Width, TmpPic1.He ight));
end;
TmpPic1.Free;
TmpPic2.Free;
end;
end;
end.
unit ButtonPro;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus;
type
TCurrentState = set of (MActive, KActive, Pressing, Disabled, dDown);
TButtonPro = class(TCustomControl)
private
{ Private declarations }
FNormalPic, FActivePic, FPressingPic, FDisabledPic, FDownPic, FBackPic, FMaskPic: TBitmap;
FBtnDown, FStretch, FAutosize, FCancel, FDefault: Boolean;
FTranspColor, FBkColor: TColor;
FMDResult: TModalResult;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
CurrentState: TCurrentState;
procedure SetNormalPic(Value: TBitmap);
procedure SetActivePic(Value: TBitmap);
procedure SetPressingPic(Value: TBitmap);
procedure SetDisabledPic(Value: TBitmap);
procedure SetDownPic(Value: TBitmap);
procedure SetBackPic(Value: TBitmap);
procedure SetMaskPic(Value: TBitmap);
procedure SetTranspColor(Value: TColor);
procedure SetBkColor(Value: TColor);
procedure SetStretch(Value: Boolean);
procedure SetAutosize(Value: Boolean);
procedure SetBtnDown(Value: Boolean);
procedure MaskIt(var TheResult: TBitmap; ThePic, TheMask, TheBackgPic: TBitmap; TheTranspColor: TColor);
protected
{ Protected declarations }
procedure Paint; override;
procedure Click; override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure GotFocus(var Message: TMessage); message CM_ENTER;
procedure LostFocus(var Message: TMessage); message CM_EXIT;
procedure WMChar(var Message: TWMChar); message WM_CHAR;
procedure CMEnabledChanged(var Message: TWMChar); message CM_ENABLEDCHANGED;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property NormalPicture: TBitmap read FNormalPic write SetNormalPic;
Property ActivePicture: TBitmap read FActivePic write SetActivePic;
Property PressingPicture: TBitmap read FPressingPic write SetPressingPic;
Property DisabledPicture: TBitmap read FDisabledPic write SetDisabledPic;
Property DownPicture: TBitmap read FDownPic write SetDownPic;
Property BackgroundPicture: TBitmap read FBackPic write SetBackPic;
Property MaskPicture: TBitmap read FMaskPic write SetMaskPic;
Property Down: Boolean read FBtnDown write SetBtnDown;
Property Stretch: Boolean read FStretch write SetStretch;
Property TransparentColor: TColor read FTranspColor write SetTranspColor default clWhite;
Property BackgroundColor: TColor read FBkColor write SetBkColor default clBtnFace;
Property Height default 50;
Property Width default 50;
Property Visible;
Property Autosize: Boolean read FAutosize write SetAutosize;
Property TabStop;
Property TabOrder;
Property OnEnter;
Property Cursor;
Property Enabled;
Property ModalResult: TModalResult read FMDResult write FMDResult;
Property ParentShowHint;
Property ShowHint;
Property Cancel: Boolean read FCancel write FCancel;
Property Default: Boolean read FDefault write FDefault;
Property PopupMenu;
Property Hint;
Property OnExit;
Property OnClick;
Property OnMouseUp;
Property OnMouseDown;
Property OnMouseMove;
Property OnKeyDown;
Property OnKeyPress;
Property OnKeyUp;
Property OnDragDrop;
Property OnDragOver;
Property OnEndDrag;
Property OnStartDrag;
Property Tag;
Property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
Property OnMOuseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
Property DragMode;
Property DragCursor;
Property Caption;
Property Font;
Property ParentFont;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('My Components', [TButtonPro]);
end;
procedure TButtonPro.CMMouseEnter(va
begin
CurrentState := CurrentState + [MActive];
Invalidate;
If Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
inherited;
end;
procedure TButtonPro.CMMouseLeave(va
begin
CurrentState := CurrentState - [MActive];
Invalidate;
If Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
inherited;
end;
procedure TButtonPro.WMLButtonDown(v
begin
inherited;
CurrentState := CurrentState + [Pressing];
Invalidate;
end;
procedure TButtonPro.WMLButtonUp(var
begin
inherited;
CurrentState := CurrentState - [Pressing];
Invalidate;
end;
constructor TButtonPro.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 50;
Width := 50;
FNormalPic := TBitmap.Create;
FActivePic := TBitmap.Create;
FPressingPic := TBitmap.Create;
FDisabledPic := TBitmap.Create;
FBackPic := TBitmap.Create;
FBackPic.Canvas.Brush.Colo
FDownPic := TBitmap.Create;
FMaskPic := TBitmap.Create;
FBtnDown := False;
FTranspColor := clBackground;
FBkColor := clBackground;
end;
destructor TButtonPro.Destroy;
begin
FNormalPic.Free;
FActivePic.Free;
FPressingPic.Free;
FDisabledPic.Free;
FDownPic.Free;
inherited Destroy;
end;
procedure TButtonPro.SetBkColor(Valu
begin
FBkColor := Value;
FBackPic.Canvas.Brush.Colo
Invalidate;
end;
procedure TButtonPro.SetTranspColor(
begin
FTranspColor := Value;
Invalidate;
end;
procedure TButtonPro.SetNormalPic(Va
begin
FNormalPic.Assign(Value);
If (FAutosize) and (not FNormalPic.Empty) then
begin
Height := FNormalPic.Height;
Width := FNormalPic.Width;
end;
Invalidate;
end;
procedure TButtonPro.SetActivePic(Va
begin
FActivePic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.SetPressingPic(
begin
FPressingPic.Assign(Value)
Invalidate;
end;
procedure TButtonPro.SetDisabledPic(
begin
FDisabledPic.Assign(Value)
Invalidate;
end;
procedure TButtonPro.SetDownPic(Valu
begin
FDownPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.Paint;
var TmpRect, BndRect: TRect;
CurrentPic, TmpPic: TBitmap;
begin
CurrentPic := TBitmap.Create;
CurrentPic.Assign(FNormalP
If (MActive in CurrentState) or (KActive in CurrentState) then
CurrentPic.Assign(FActiveP
If Pressing in CurrentState then CurrentPic.Assign(FPressin
If dDown in CurrentState then CurrentPic.Assign(FDownPic
If Disabled in CurrentState then CurrentPic.Assign(FDisable
If (FAutosize) and (not CurrentPic.Empty) then
begin
Width := CurrentPic.Width;
Height := CurrentPic.Height;
end;
TmpPic := TBitmap.Create;
TmpPic.Assign(CurrentPic);
MaskIt(CurrentPic,TmpPic,F
TmpPic.Free;
TmpRect := Rect(0,0,CurrentPic.Width,
BndRect := Rect(0,0,Width,Height);
Canvas.Brush.Color := FBkColor;
Canvas.Pen.Style := psDash;
If CurrentPic.Empty then begin
Canvas.FillRect(BndRect);
Canvas.TextOut(0,0,'Empty'
end
else If FStretch then Canvas.CopyRect(BndRect,Cu
else Canvas.CopyRect(TmpRect,Cu
CurrentPic.Free;
end;
procedure TButtonPro.SetStretch(Valu
begin
FStretch := Value;
If FStretch then FAutosize := False;
Invalidate;
end;
procedure TButtonPro.SetAutosize(Val
begin
FAutosize := Value;
If FAutosize then FStretch := False;
Invalidate;
end;
procedure TButtonPro.GotFocus(var Message: TMessage);
begin
CurrentState := CurrentState + [KActive];
Invalidate;
inherited
end;
procedure TButtonPro.LostFocus(var Message: TMessage);
begin
CurrentState := CurrentState - [KActive];
Invalidate;
inherited;
end;
procedure TButtonPro.Click;
begin
inherited;
If (Owner is TForm) and (FMDResult <> mrNone) then With Owner As TForm do ModalResult := FMDResult;
end;
procedure TButtonPro.WMChar(var Message: TWMChar);
begin
inherited;
If (Message.CharCode = 27) and FCancel then Click;
If (Message.CharCode = 13) and FDefault then Click;
end;
procedure TButtonPro.SetBtnDown(Valu
begin
FBtnDown := Value;
If FBtnDown then
CurrentState := CurrentState + [dDown]
else CurrentState := CurrentState - [dDown];
Invalidate;
end;
procedure TButtonPro.CMEnabledChange
begin
If Self.Enabled then CurrentState := CurrentState - [Disabled]
else CurrentState := CurrentState + [Disabled];
end;
procedure TButtonPro.SetBackPic(Valu
begin
FBackPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.SetMaskPic(Valu
begin
FMaskPic.Assign(Value);
Invalidate;
end;
procedure TButtonPro.MaskIt(var TheResult: TBitmap; ThePic, TheMask, TheBackgPic: TBitmap; TheTranspColor: TColor);
var i,j: integer;
TmpPic1, TmpPic2: TBitmap;
begin
If (ThePic.Empty) and (not TheBackgPic.Empty) then
TheResult.Assign(TheBackgP
If (not ThePic.Empty) and (TheBackgPic.Empty) then
TheBackgPic.Canvas.FillRec
If (not ThePic.Empty) and (not TheBackgPic.Empty) then
begin
TmpPic1 := TBitmap.Create;
TmpPic2 := TBitmap.Create;
If TheMask.Empty then
begin
TheMask.Assign(ThePic);
With TheMask.Canvas do
for i := 0 to TheMask.Width do
for j := 0 to TheMask.Height do
If Pixels[i,j] = TheTranspColor then
Pixels[i,j] := clBlack
else Pixels[i,j] := clWhite;
end;
TmpPic1.Assign(ThePic);
With TmpPic1.Canvas do
begin
CopyMode := cmSrcAnd;
CopyRect(Rect(0,0,ThePic.W
end;
TmpPic2.Assign(TheMask);
With TmpPic2.Canvas do
begin
CopyMode := cmSrcErase;
CopyRect(Rect(0,0,TheBackg
end;
TheResult.Assign(TmpPic1);
With TheResult.Canvas do
begin
CopyMode := cmSrcPaint;
CopyRect(Rect(0,0,TmpPic1.
end;
TmpPic1.Free;
TmpPic2.Free;
end;
end;
end.
ASKER
Adjusted points to 50
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
For 10 points i can't even read your code.
Wouldn't it be 100 points ?