Sample Graphics

From Lazarus wiki
Jump to navigationJump to search

│ English (en) │ español (es) │

This gallery is to show the designs can be created from Lazarus and drawing tools, like BGRABitmap.

Most examples are included in BGRABitmap & BGRAControls packages.

You can grab more BGRABitmap demos here https://github.com/bgrabitmap/bgracontest

Gradient Graphics

Description: Shows how to create buttons and gradients with and without transparency in Lazarus using BGRABitmap and an enhanced version of Double Gradient that supports alpha.

Notes: Tested on Win32. Tested on Linux with Kubuntu and Qt, work fine

Win32:

gdgfx.png

Kubuntu 10.04 with Qt:

gdgfx qt.png

Top-Left: 'like flash player setup button' / Top-Right: 'like win7 explorer toolbar' / Bottom: double gradient with alpha / Background: same as bottom.

Flash Player Button

Add a new TPaintBox, set 'btn1' as name. Go OnPaint event and add this code: 

var
  tempbmp1, tempbmp2: TBGRABitmap;
begin
  // Background Gradient
  tempbmp1:=TBGRABitmap.Create(btn1.Width,btn1.Height,BGRA(104,104,104,255));
  tempbmp1.Canvas.GradientFill(Rect(1,Round(btn1.Height*0.25),btn1.Width-1,btn1.Height-1),$686868,$404040,gdVertical);

  // Frame Border
  tempbmp1.Canvas.Brush.Color:=$181818;
  tempbmp1.Canvas.FrameRect(btn1.ClientRect);

  // Light Gradient
  tempbmp2:=TBGRABitmap.Create(btn1.Width,btn1.Height,BGRA(0,0,0,0));
  tempbmp2.GradientFill(1,1,btn1.Width-1,btn1.Height-1,
  BGRA(255,255,255,34),
  BGRA(255,255,255,10), gtLinear,
  PointF(btn1.ClientRect.Right,btn1.ClientRect.Top),
  PointF(btn1.ClientRect.Right,btn1.ClientRect.Bottom),
  dmDrawWithTransparency,True,False);
  tempbmp2.AlphaFillRect(2,2,btn1.Width-2,btn1.Height-2,0);

  // Merge Bitmaps
  //tempbmp1.Canvas.Draw(0,0,tempbmp2.Bitmap);
  tempbmp2.Draw(tempbmp1.Canvas,0,0,False);

  // Paint in Canvas
  //btn1.Canvas.Draw(0,0,tempbmp1.Bitmap);
  tempbmp1.Draw(btn1.Canvas,0,0,False);

  // Free Bitmaps
  tempbmp1.Free;
  tempbmp2.Free;
end;

Windows 7 Explorer Toolbar

skintoolbar.png

Add a new TToolBar with a TToolButton and set this properties:

AutoSize=True; ButtonHeight=48; EdgeBorders=[]; EdgeInner=esNone; EdgeOuter=esNone; ShowCaptions=True; Transparent=True;

Then go Form1 OnPaint event and add this code: 

procedure TForm1.FormPaint(Sender: TObject);
var
  gradBmp: TBGRABitmap;
begin
  with ToolBar1 do begin
    gradBmp := DoubleGradientAlphaFill(ClientRect,BGRA(245,250,255,255),BGRA(230,240,250,255),
    BGRA(220,230,244,255),BGRA(221,233,247,255),gdVertical,gdVertical,gdVertical,0.50);
    gradBmp.Rectangle(0,0,Width,Height-2,BGRA(255,255,255,100),dmDrawWithTransparency);
    gradBmp.SetHorizLine(0,Height-1,Width-1,BGRA(160,175,195,255));
    gradBmp.SetHorizLine(0,Height-2,Width-1,BGRA(205,218,234,255));
  end;
  gradBmp.Draw(Canvas,ToolBar1.ClientRect);
  gradBmp.Free;
end;

Double Gradient with Alpha

Add a new TPaintBox, set 'btn3' as name. Go OnPaint event and add this code: 

var
  myBitmap: TBGRABitmap;
begin
  myBitmap:= DoubleGradientAlphaFill(
  btn3.ClientRect,
  BGRA(0,0,0,100),BGRA(255,255,255,100),
  BGRA(100,100,100,100),BGRA(150,150,150,100),
  gdVertical,gdVertical,gdVertical,0.5);
  //btn3.Canvas.Draw(0,0,myBitmap.Bitmap);
  myBitmap.Draw(btn3.Canvas,0,0,False);
  myBitmap.Free;
end;

Progress Bars

A progress bar is a component in a graphical user interface used to convey the progress of a task, such as a download or file transfer.

Flash Player Progress Bar

flprogressbar.png 'Like flash player setup progress bar'. Requires BGRABitmap and Double Gradient with Alpha.

Notes: Tested on Win32, Kubuntu 10.04 with GTK and Qt.

Add a new TPaintBox, set 'progressbar' as name. Go OnPaint event and add this code: 

var
  ABitmap, ABitmap2: TBGRABitmap; ARect: TRect;
begin
  // Initialization
  // Self.Color:=$004D4D4D;
  ABitmap:=TBGRABitmap.Create(progressbar.Width,progressbar.Height);
  ARect:=progressbar.ClientRect;

  // Percent of Progress
  ARect.Right:=Round(ABitmap.Width*0.75);

  // Background Gradient
  ABitmap.Canvas.GradientFill(progressbar.ClientRect,$303030,$323232,gdVertical);

  // Background Border
  ABitmap.Rectangle(0,0,ABitmap.Width,ABitmap.Height,BGRA(28,28,28,255),dmSet);

  // Progress Gradient
  ABitmap2:=DoubleGradientAlphaFill(
  ARect,
  BGRA(102,163,226,255),BGRA(83,135,186,255),
  BGRA(75,121,175,255),BGRA(56,93,135,255),
  gdVertical,gdVertical,gdVertical,0.5);

  // Progress Border
  ABitmap2.Rectangle(0,0,ARect.Right,ARect.Bottom,BGRA(28,28,28,255),dmSet);

  // Progress Light
  ABitmap2.Rectangle(1,1,ARect.Right-1,ARect.Bottom-1,BGRA(153,212,255,100),dmDrawWithTransparency);

  // Merge Bitmaps
  //ABitmap.Canvas.Draw(0,0,ABitmap2.Bitmap);
  ABitmap2.Draw(ABitmap.Canvas,0,0,False);

  // Draw Bitmap
  //progressbar.Canvas.Draw(0,0,ABitmap.Bitmap);
  ABitmap.Draw(progressbar.Canvas,0,0,False);

  // Free Bitmap
  ABitmap.Free;
  ABitmap2.Free;
end;

You can change the 'Percent' of progress changing this line: 

  // Percent of Progress - 33%
  ARect.Right:=Round(ABitmap.Width*0.33);

  // Percent of Progress - 90%
  ARect.Right:=Round(ABitmap.Width*0.90);

About Dialogs

"The Generic application includes an About dialog box. Every application should include an About dialog box. The dialog box displays such information as the application's name and copyright information." Definition

Lazarus About

Description: Lazarus-like about dialog.

lazlogo.png

Requires BGRABitmap.

  • ToDO:
    • Smooth text
    • Paw
    • Bitmap with leopard

Add a new TPaintBox, and set Width = 450, set Height = 300, set Name = 'logo'

(you can set another width and height, for example 900 x 600)

Go to OnPaint event and add this code: 

uses BGRABitmap, BGRABitmapTypes, BGRAGradients;   

procedure TForm1.logoPaint(Sender: TObject); 
var
  bmp, bmp2, bmp3, bmp4, bmp5, bmp6: TBGRABitmap;
  rct: TRect;

  procedure DrawBackground;
  begin
    // Background
    bmp:= TBGRABitmap.Create(logo.Width,logo.Height,BGRAWhite);

    rct:= logo.ClientRect;
    rct.Left:= 1;
    rct.Top:= 1;
    rct.Right:= logo.Width-1;
    rct.Bottom:= Round(logo.Height*0.935);

    //radial
    bmp.GradientFill( rct.Left, rct.Top, rct.Right, rct.Bottom,
                      BGRA(117,172,224,255), BGRA(49,74,132,255), gtRadial,
                      PointF(Round(rct.Right*0.85), Round(rct.Bottom*0.50)),
                      PointF(Round(rct.Left), Round(rct.Bottom)), dmSet );
  end;

  procedure DrawEclipse;
  begin
    bmp2:= TBGRABitmap.Create(rct.Right,rct.Bottom);
    bmp2.FillEllipseAntialias( Round(rct.Right*0.57), Round(rct.Bottom*0.58),
                               Round(rct.Right*0.31), Round(rct.Bottom*0.53),
                               BGRA(255,255,255,30) );
    bmp2.EraseEllipseAntialias( Round(rct.Right*0.585), Round(rct.Bottom*0.58),
                                Round(rct.Right*0.31*0.88), Round(rct.Bottom*0.53*0.88), 
                                255 );
  end;

  procedure ThinCircleAndFrame;
  var mask: TBGRABitmap;
  begin
    bmp5:= TBGRABitmap.Create( rct.Right, rct.Bottom );
    bmp5.GradientFill( 0, 0, bmp5.width, bmp5.Height,
                       BGRA(117,172,224,255), BGRA(49,74,132,255), gtLinear,
                       PointF(Round(rct.Right*0.5),Round(rct.Bottom*0.50)),
                       PointF(Round(rct.Right),Round(rct.Bottom)),  dmSet);
    mask:= TBGRABitmap.Create( rct.Right, rct.Bottom, BGRABlack );
    mask.EllipseAntialias( Round(rct.Right*0.53), Round(rct.Bottom*0.50),
                           Round(rct.Right*0.40), Round(rct.Bottom*0.65),
                           BGRA(255,255,255,192), 0.6 );
    bmp5.ApplyMask( mask );
    mask.free;

    // Frame
    bmp6 := TBGRABitmap.Create( logo.Width,logo.Height );
    bmp6.Rectangle( logo.ClientRect,BGRABlack, BGRA(0,0,0,0), dmDrawWithTransparency );
    bmp6.DrawLine( 1, logo.Height-2, logo.Width-2, logo.Height-2, BGRA(0,0,0,75), True );
    bmp6.DrawLine( logo.Width-2, 1, logo.Width-2, logo.Height-2, BGRA(0,0,0,75), True );
  end;

  procedure DrawText;
  begin
    // Text
    bmp4 := TBGRABitmap.Create( logo.Width, logo.Height );
    // 'Free Pascal'
    bmp5.FontAntialias := True;
    bmp5.FontStyle := [fsBold];
    bmp5.FontHeight := Round(logo.Height*0.065);
    bmp5.TextOut( Round(logo.Width*0.15), Round(logo.Height*0.045), 'Free Pascal', BGRAWhite );

    // 'Lazarus'
    bmp5.FontHeight := Round(logo.Height*0.18);
    bmp5.TextOut( Round(logo.Width*0.05), Round(logo.Height*0.07),'Lazarus',BGRAWhite );

    // 'Project'
    bmp4.FontHeight := Round(logo.Height*0.052);
    bmp4.TextOut( Round(logo.Width*0.20), Round(logo.Height*0.27), 'Project', BGRAWhite );

    // 'Write Once'
    bmp4.FontHeight := Round(logo.Height*0.07);
    bmp4.TextOut( Round(logo.Width*0.02), Round(logo.Height*0.57), 'Write Once', BGRA(255,255,255,100) );
    bmp4.GradientFill( Round(logo.Width*0.02), Round(logo.Height*0.66),
                       Round(logo.Width*0.46), Round(logo.Height*0.66)+1,
                       BGRA(255,255,255,20), BGRA(0,0,0,30), gtLinear,
                       PointF(logo.Width*0.22,0), PointF(logo.Width*0.48,0),
                       dmDrawWithTransparency );

    // 'Compile Anywhere'
    bmp4.TextOut( Round(logo.Width*0.26), Round(logo.Height*0.8), 'Compile Anywhere', BGRA(255,255,255,100) );
    bmp4.GradientFill( Round(logo.Width*0.26), Round(logo.Height*0.89),
                       Round(logo.Width*0.70), Round(logo.Height*0.89)+1,
                       BGRA(255,255,255,20), BGRA(0,0,0,50), gtLinear,
                       PointF(logo.Width*0.26,0), PointF(logo.Width*0.70,0),
                       dmDrawWithTransparency );
  end;

  procedure RedRectangle;
  var
    rct2: TRect;
    gradInfo: array of TnGradientInfo;
    bmpGrad: TBGRABitmap;
  begin
    bmp3 := TBGRABitmap.Create(logo.Width,logo.Height);

    rct2 := logo.ClientRect;
    rct2.Left := Round(rct2.Right*0.06);
    rct2.Top := Round(rct2.Bottom*0.27);
    rct2.Right := Round(rct2.Right*0.48);
    rct2.Bottom := Round(rct2.Bottom*0.337);

    setlength(gradInfo,4); // Red Alpha Gradient
    gradInfo[0] := nGradientInfo(BGRAPixelTransparent, BGRA(255,0,0,255),    gdHorizontal, 0.25);
    gradInfo[1] := nGradientInfo(BGRA(255,0,0,255),    BGRA(160,0,0,180),    gdHorizontal, 0.5);
    gradInfo[2] := nGradientInfo(BGRA(160,0,0,180),    BGRA(255,0,0,255),    gdHorizontal, 0.75);
    gradInfo[3] := nGradientInfo(BGRA(255,0,0,255),    BGRAPixelTransparent, gdHorizontal, 1);

    bmpGrad := nGradientAlphaFill( rct2, gdHorizontal, gradInfo );
    bmp3.PutImage( rct2.Left, rct2.Top, bmpGrad, dmDrawWithTransparency );
    bmpGrad.Free;
  end;

  procedure DrawPaw(bmp: TBGRABitmap; center: TPointF);
  begin
    with bmp.Canvas2D do
    begin
      save;
      translate(center.X-93,center.Y-83);
      globalAlpha := 0.4;
      fillStyle ('#3f5e99');
      beginPath();
      moveTo(89.724698,11.312043);
      bezierCurveTo(95.526308,14.494575,100.52322000000001,18.838808,102.75144,24.966412);
      bezierCurveTo(114.24578,26.586847,123.07072,43.010127999999995,118.71826,54.504664);
      bezierCurveTo(114.77805000000001,64.910473,93.426098,68.10145299999999,89.00143800000001,59.252123);
      bezierCurveTo(86.231818,53.712894999999996,90.877898,48.213108999999996,88.853498,42.139906999999994);
      bezierCurveTo(87.401408,37.78364299999999,82.208048,33.87411899999999,85.595888,27.098436999999993);
      bezierCurveTo(87.071858,24.146481999999992,94.76621800000001,25.279547999999995,94.863658,23.444067999999994);
      bezierCurveTo(95.066728,19.618834999999994,92.648878,18.165403999999995,90.221828,15.326465999999995);
      closePath();
      fill();
      beginPath();
      moveTo(53.024288,20.876975);
      bezierCurveTo(50.128958,26.827119000000003,48.561707999999996,33.260252,50.284608,39.548662);
      bezierCurveTo(41.840728,47.513997,44.130318,66.017003,54.325338,72.88213300000001);
      bezierCurveTo(63.554708000000005,79.09700300000002,82.823918,69.36119300000001,81.320528,59.58223300000001);
      bezierCurveTo(80.379498,53.461101000000006,73.409408,51.65791100000001,71.551608,45.53168800000001);
      bezierCurveTo(70.219018,41.13739400000001,72.197818,34.94548700000001,65.517188,31.373877000000007);
      bezierCurveTo(62.606638000000004,29.817833000000007,56.98220800000001,35.18931200000001,55.841908000000004,33.74771500000001);
      bezierCurveTo(53.465478000000004,30.743354000000007,54.598668,28.159881000000006,54.938648,24.44039800000001);
      closePath();
      fill();
      beginPath();
      moveTo(16.284108,78.650993);
      bezierCurveTo(16.615938,85.259863,18.344168,91.651623,22.885208,96.330453);
      bezierCurveTo(19.327327999999998,107.37975,30.253377999999998,122.48687000000001,42.495058,123.58667);
      bezierCurveTo(53.577238,124.58229,65.765908,106.76307,59.734438,98.920263);
      bezierCurveTo(55.959047999999996,94.01106300000001,48.983098,95.791453,44.402058,91.319753);
      bezierCurveTo(41.116108,88.112233,39.864737999999996,81.73340300000001,32.289848,81.824883);
      bezierCurveTo(28.989708,81.864783,26.651538,89.282293,24.957518,88.569003);
      bezierCurveTo(21.427108,87.08246299999999,21.174458,84.272723,19.679208,80.85010299999999);
      closePath();
      fill();
      beginPath();
      moveTo(152.77652,37.616125);
      bezierCurveTo(156.68534,42.955439,159.37334,49.006564,158.79801,55.501293);
      bezierCurveTo(168.5256,61.835313,169.5682,80.450283,160.75895,89.021463);
      bezierCurveTo(152.78409,96.780823,132.08894,90.63274299999999,131.82654,80.742363);
      bezierCurveTo(131.6623,74.551503,138.19976,71.535693,138.93671,65.17653299999999);
      bezierCurveTo(139.46532,60.615162999999995,136.41531,54.87470199999999,142.35299,50.170306999999994);
      bezierCurveTo(144.93985,48.12074299999999,151.43107,52.404562999999996,152.29636,50.78291599999999);
      bezierCurveTo(154.09968999999998,47.403324999999995,152.52446999999998,45.062994999999994,151.52745,41.463536999999995);
      closePath();
      fill();
      beginPath();
      moveTo(139.65359,109.38478);
      bezierCurveTo(179.13505,123.79982000000001,142.51298,146.31478,119.19800000000001,151.55864);
      bezierCurveTo(95.883018,156.8025,41.93790800000001,157.82316,75.508908,123.02183);
      bezierCurveTo(78.980078,119.42344999999999,79.61785800000001,104.19731999999999,82.074898,99.283253);
      bezierCurveTo(86.361158,93.329663,106.23528,86.908083,113.13709,88.929193);
      bezierCurveTo(128.23085,93.960443,125.96716,106.89633,139.65359,109.38478);
      closePath();
      fill();
      restore;
    end;
  end;

begin
  DrawBackground;
  DrawEclipse;
  ThinCircleAndFrame;
  DrawText;
  RedRectangle;

  // Merge Bitmaps
  bmp.PutImage(0,0,bmp2,dmDrawWithTransparency);
  bmp.PutImage(0,0,bmp3,dmDrawWithTransparency);
  bmp.PutImage(0,0,bmp4,dmDrawWithTransparency);
  bmp.PutImage(0,0,bmp5,dmDrawWithTransparency);
  bmp.PutImage(0,0,bmp6,dmDrawWithTransparency);
  DrawPaw(bmp,PointF(258,161));

  // Draw in Canvas
  bmp.Draw(logo.Canvas,0,0,True);

  // Free Bitmaps
  bmp.Free;
  bmp2.Free;
  bmp3.Free;
  bmp4.Free;
  bmp5.Free;
  bmp6.Free;
end;

Shadow

shadowmoon.png

Using the same code in BGRABitmap Tutorial 5 we can make a moon with shadow using the Shadow function.

Go OnPaint event and add this code: 

procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
    size: single;

  // Shadow Function
  function Shadow(ASource: TBGRABitmap; AShadowColor: TBGRAPixel; AOffSetX,AOffSetY: Integer; ARadius: Integer; AShowSource: Boolean = True): TBGRABitmap;
  var
   bmpOut: TBGRABitmap;
   n: integer;
   p: PBGRAPixel;
  begin
   bmpOut:= TBGRABitmap.Create(ASource.Width+2*ARadius+AOffSetX,ASource.Height+2*ARadius+AOffSetY);

   bmpOut.PutImage(AOffSetX,AOffSetY,ASource,dmDrawWithTransparency);

   p := bmpOut.Data;
   for n := 1 to bmpOut.NbPixels do begin
    if p^.alpha <> 0 then begin
     p^.red := AShadowColor.red;
     p^.green := AShadowColor.green;
     p^.blue := AShadowColor.blue;
    end;
    inc(p);
   end;

   BGRAReplace(bmpOut,bmpOut.FilterBlurRadial(ARadius,rbFast));

   if AShowSource = True then bmpOut.PutImage(0,0,ASource,dmDrawWithTransparency);

   Result:= bmpOut;
  end;

  procedure DrawMoon;
  var layer: TBGRABitmap;
  begin
    layer := TBGRABitmap.Create(image.Width,image.Height);
    layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,size*0.4,size*0.4,BGRA(224,224,224,128));
    layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.3,size*0.3,255);
    BGRAReplace(layer,Shadow(layer,BGRABlack,5,5,5));
    image.PutImage(0,0,layer,dmDrawWithTransparency);
    layer.Free;
  end;

begin
  image := TBGRABitmap.Create(ClientWidth,ClientHeight);

  //Compute available space in both directions
  if image.Height < image.Width then
    size := image.Height
  else
    size := image.Width;

  image.GradientFill(0,0,image.Width,image.Height,
                     BGRA(128,192,255),BGRA(0,0,255),
                     gtLinear,PointF(0,0),PointF(0,image.Height),
                     dmSet);

  DrawMoon;

  image.Draw(Canvas,0,0,True);
  image.free;
end;

Text Shadow

Usage of BGRABitmap TextShadow function, create cool text with blured shadows and custom font properties.

Single & Multi-Shadow

textshadow.png

This requires BGRABitmap, BGRABitmapTypes & BGRAGradients.

Go OnPaint event and add this code: 

procedure TForm1.FormPaint(Sender: TObject);
var
  bmp1,bmp2: TBGRABitmap; txt: String;
begin
  txt:= 'TextShadow!';

  // Simple Shadow
  bmp1:= TextShadow(200,40,txt,32,BGRAWhite,BGRABlack,1,1);
  bmp1.Draw(Canvas,0,0,False);
  bmp1.Free;

  // Blured Shadow
  bmp1:= TextShadow(200,40,txt,32,BGRABlack,BGRA(128,128,255,255),4,4,5);
  bmp1.Draw(Canvas,0,40,False);
  bmp1.Free;

  // Neon Shadow ''(better with Black background)''
  bmp1:= TextShadow(200,40,txt,32,BGRA(255,255,255,200),BGRA(0,255,0,255),0,0,5);
  bmp1.Draw(Canvas,0,80,False);
  bmp1.Free;    

  // Multi Shadow
  bmp1:= TextShadow(250,50,txt,32,BGRAWhite,BGRA(255,0,0,255),-5,-5,4,[fsBold,fsUnderline],'Tahoma',False);
  bmp2:= TextShadow(250,50,txt,32,BGRAWhite,BGRA(0,0,255,255),5,5,4,[fsBold,fsUnderline],'Tahoma',True);
  bmp1.PutImage(0,0,bmp2,dmDrawWithTransparency);
  bmp1.Draw(Canvas,0,120,False);
  bmp1.Free;
  bmp2.Free;
end;

Stretch to Form height

shadow.png

Go OnPaint event and add this code: 

procedure TForm1.FormPaint(Sender: TObject);
var
  bmp: TBGRABitmap;
begin
  Color:= clBlack;
  bmp:= TextShadow(Width,Height,'Shadow',Round(Height*0.5),BGRA(128,0,0,255),BGRAWhite,10,10,5,[fsBold],'Chiller');
  bmp.Draw(Canvas,0,0,False);
  bmp.Free;
end;

Text Outline

If you need quality text outline use BGRABitmap Text Effect unit.

textoutline.png

Go OnPaint event and add this code: 

uses Types;

procedure TForm1.FormPaint(Sender: TObject);
const textContent = 'Some text'; fontheight = 30;
var image,textBmp,outline: TBGRABitmap;
    size: TSize;
    p: PBGRAPixel;
    n: Integer;
begin
  image := TBGRABitmap.Create(ClientWidth,ClientHeight, ColorToBGRA(ColorToRGB(clBtnFace)) );

  //define font param
  image.FontAntialias := true;
  image.FontHeight := fontheight;
  image.FontStyle := [fsBold];

  //create text image
  size := image.TextSize(textContent);
  textBmp := TBGRABitmap.Create(size.cx+2,size.cy+2,BGRAWhite);
  image.CopyPropertiesTo(textBmp);
  textBmp.TextOut(1,1,textContent,BGRABlack);

  //create outline
  outline := textbmp.FilterContour as TBGRABitmap;
  textBmp.Free;
  p := outline.data;
  for n := 0 to outline.NbPixels-1 do
  begin
    p^.alpha := 255-(GammaExpansionTab[p^.red] shr 8);
    p^.red := 0; //outline color
    p^.green := 0;
    p^.blue := 192;
    inc(p);
  end;

  //draw outline
  image.PutImage(20-1,20-1,outline,dmDrawWithTransparency);
  outline.Free;

  //draw inner text
  image.TextOut(20,20,textContent,BGRAWhite);

  image.Draw(Canvas,0,0,True);
  image.free;
end;

Three-State Button

This way to create a Three-State Button is obsolete. Now you can use BGRAControls and add TBGRAButton that is a fully customizable button. You can see some examples in the BGRAButton Gallery.

statebutton.png

This is how to create a 3 state button ('Normal','Enter','Pressed') with a PaintBox & BGRABitmap.

1) Add a new PaintBox:

Name=btn

Width=128

Height=64

2) Add this code: 

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  BGRABitmap, BGRABitmapTypes, BGRAGradients;

type

  { TForm1 }

  TForm1 = class(TForm)
    btn: TPaintBox;
    procedure btnPaint(Sender: TObject);
    procedure btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnMouseEnter(Sender: TObject);
    procedure btnMouseLeave(Sender: TObject);
    procedure btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    btnCaption: String;
    btnState: String;
  public
    { public declarations }
  end;

  function DrawButton(ARect: TRect; AText: String; cl1,cl2,cl3,cl4: TBGRAPixel; AValue: Single): TBGRABitmap;

var
  Form1: TForm1; 

implementation

function DrawButton(ARect: TRect; AText: String; cl1,cl2,cl3,cl4: TBGRAPixel; AValue: Single): TBGRABitmap;
var
  bmpBtn,bmpTxt: TBGRABitmap;
begin
  bmpBtn:= DoubleGradientAlphaFill(ARect,cl1,cl2,cl3,cl4,gdVertical,gdVertical,gdVertical,AValue);
  bmpBtn.Rectangle(0,0,ARect.Right,ARect.Bottom,BGRA(0,0,0,150),dmDrawWithTransparency);
  bmpTxt:= TextShadow(ARect.Right,ARect.Bottom,AText,Round(ARect.Bottom*0.5),BGRAWhite,BGRABlack,1,1,1);
  bmpBtn.PutImage(0,0,bmpTxt,dmDrawWithTransparency);
  bmpTxt.Free;
  Result:=bmpBtn;
end;

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnPaint(Sender: TObject);
var
  bmpBtn: TBGRABitmap;
begin
  if btnState = 'Normal' then begin
    bmpBtn:= DrawButton(btn.ClientRect,btnCaption,BGRABlack,BGRAWhite,BGRAWhite,BGRABlack,0.5); end
  else if btnState = 'Pressed' then begin
    bmpBtn:= DrawButton(btn.ClientRect,btnCaption,BGRAWhite,BGRABlack,BGRABlack,BGRAWhite,0.5); end
  else if btnState = 'Enter' then begin
    bmpBtn:= DrawButton(btn.ClientRect,btnCaption,BGRA(100,100,100,255),BGRAWhite,BGRAWhite,BGRA(100,100,100,255),0.5);
  end;
  bmpBtn.Draw(btn.Canvas,0,0,False);
  bmpBtn.Free;
end;

procedure TForm1.btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  btnState:= 'Pressed';
  btnPaint(nil);
end;

procedure TForm1.btnMouseEnter(Sender: TObject);
begin
  btnState:= 'Enter';
  btnPaint(nil);
end;

procedure TForm1.btnMouseLeave(Sender: TObject);
begin
  btnState:= 'Normal';
  btnPaint(nil);
end;

procedure TForm1.btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  btnState:= 'Enter';
  btnPaint(nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  btnCaption:= 'Button';
  btnState:= 'Normal';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  btn.Free;
end;

end.
Retrieved from "https://wiki.freepascal.org/index.php?title=Sample_Graphics&oldid=133137"