//------------------------------------------------------------------------------
// TSizeBtn methods
//------------------------------------------------------------------------------
constructor TSizeBtn.Create(TargetObj: TTargetObj; BtnPos: TBtnPos);
begin
inherited CreateNew(nil);
Loaded; //to prevent Delphi, and maybe Lazarus from multiple warnings
fTargetObj := TargetObj;
AutoSize := False;
Visible := False;//Changes when necessary
Position := poDesigned;
Width := fTargetObj.fSizeCtrl.BtnSize;
Height := fTargetObj.fSizeCtrl.BtnSize;
FormStyle := fsStayOnTop;
BorderIcons := [];
BorderStyle := bsNone;
fHover := false;
fHoverDown := false;
OnPaint := doPaint;
{
OnMouseEnter := mEnter;
OnMouseLeave := mLeave;
} //<--does not matter, just color changing
fPos := BtnPos;
UpdateBtnCursorAndColor;//Just procedure, which checking is it disabled or not, and then calling Repaint method
end;
//------------------------------------------------------------------------------
procedure TSizeBtn.PaintAs(l,t:integer);
{$IFDEF FPC}
var b:Graphics.TBitmap;
{$ENDIF}
begin
if Assigned(fImage.Graphic) and not(fImage.Graphic.Empty) then
begin
if fTargetObj.fSizeCtrl.StretchBtnImage then
Canvas.StretchDraw(Rect(l,t, width, height), fImage.Graphic)
else
begin
Canvas.Draw(l,t, fImage.Graphic);
{$IFDEF FPC}
Self.SetShape(fImage.Bitmap);
{$ENDIF}
end;
end
else
{$IFDEF FPC}
begin
b := Graphics.TBitmap.Create;
b.Width := Self.Width;
b.Height:= Self.Height;
b.Transparent:=True;
b.TransparentColor := clBlack;
b.Canvas.Brush.Assign(Self.Canvas.Brush);
b.Canvas.Pen.Assign(Self.Canvas.Pen);
{$ENDIF}
case fTargetObj.fSizeCtrl.BtnShape of
tszbSquare:
{$IFDEF FPC}b.{$ENDIF}
Canvas.Rectangle(l,t, l+Width, t+Height);
tszbTriangle:
DrawTriangle({$IFDEF FPC}b,{$ENDIF}l,t);
tszbCircle:
{$IFDEF FPC}b.{$ENDIF}
Canvas.Ellipse(l,t, l+Width, t+Height);
tszbMockTube:
begin
{$IFDEF FPC}b.{$ENDIF}
Canvas.Ellipse(l,t,l+Width,t+Height);
DrawTriangle({$IFDEF FPC}b,{$ENDIF}l,t);
end;
tszbRoundRect:
{$IFDEF FPC}b.{$ENDIF}
Canvas.RoundRect(l,t,l+Width,t+Height, (Width+Height) div 4,(Width+Height) div 4);
tszbRhombus:
{$IFDEF FPC}b.{$ENDIF}
Canvas.Polygon(
[Point(l,t+Ceil(Height/2)-1),
Point(l+Ceil(Width/2)-1, t),
Point(l+Width-1,t+Ceil(Height/2)-1),
Point(l+Ceil(Width/2)-1, t+Height-1)]);
end;
{$IFDEF FPC}
Canvas.Draw(0,0,b);
b.Monochrome:=True;//Crash is gone, but problems is not
Self.SetShape(b);//<--Causes crash
b.Free;
end;
{$ENDIF}
end;
Recent
