Download Now
Forums
    General

    Simple examples of surface graphics

    Started by sysrpl on 20 March 2015

    sysrpl20 March 2015, 22:15

    The following is a topic related to the Free Pascal Cross Codebot library. You can read more about about Cross Codebot here. If you are interested in gaining git access to the library, which implements the code or classes in this posting, it is now hosted in this github repository.

    This article describes how to get started with the Cross Codebot advanced drawing surface. To get started, you can use a surface in conjunction with a normal Lazarus TCanvas object as demonstrated in the example below.

    Example:

    uses
      Codebot.Graphics,
      Codebot.Graphics.Types;
    
    procedure TForm1.FormPaint(Sender: TObject);
    var
      Surface: ISurface;
      Brush: IGradientBrush;
    begin
      Surface := NewSurface(Canvas);
      Surface.Ellipse(ClientRect);
      Brush := NewBrush(ClientRect);
      Brush.AddStop(clRed, 0);
      Brush.AddStop(clGreen, 0.5);
      Brush.AddStop(clBlue, 0.75);
      Brush.AddStop(clTransparent, 1);
      Surface.Fill(Brush);
    end;

    Result:

    Note how surface objects are interfaces. There is no need to destroy either surface or brush objects. The only restriction is that an ISurface tied to a control (as opposed to IBitmap.Surface) should only exist during Paint or Render handlers.

    Here is another example with using the Cross Codebot TContentGrid control. Note how it passes an ISurface in all its draw event handlers.

    Example:

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      ContentGrid1.ColCount := 20;
      ContentGrid1.RowCount := 10;
      ContentGrid1.DefColWidth := 25;
    end;
    
    procedure TForm1.ContentGrid1DrawBackground(Sender: TObject; Surface: ISurface;
      Rect: TRectI);
    var
      B: IBrush;
    begin
      { Brushes contains several convenient brush patterns }
      B := Brushes.Transparent;
      { Align the transparent checker board brush with the scroll bars }
      B.Matrix.Translate(-ContentGrid1.ScrollLeft, -ContentGrid1.ScrollTop);
      { Use the FillRect method to both add a path and fill it in one command }
      Surface.FillRect(B, Rect);
    end;
    
    procedure TForm1.ContentGrid1DrawCell(Sender: TObject; Surface: ISurface; Col,
      Row: Integer; Rect: TRectI; State: TDrawState);
    var
      { TColorB is the super color type de jour, B is short for Byte }
      Color: TColorB;
    begin
      { Generate color from a hue }
      Color := Hue(Col / (ContentGrid1.ColCount + 1));
      { Alpha is a byte, so lets modify it using the row count }
      Color.Alpha := Round((1 - Row / ContentGrid1.RowCount) * $FF);
      { NewBrush with a color creates an ISolidBrush }
      Surface.FillRect(NewBrush(Color), Rect);
      { If the grid cell is selected }
      if dsSelected in State then
        { Give it a black outline }
        Surface.StrokeRect(NewPen(clBlack), Rect);
    end;

    Result:

    And finally here is example of drawing curves and using line styles. Note how the TRenderBox (similiar to TPaintBox, but using an ISurface instead of a TCanvas) is quickly updated if the user drags a control point.

    { Our control and drag points }
    
    var
      P1, P2, C1, C2: TPointI;
      Drag: PPointI;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      { Initialize control and drag points in form create }
      P1 := TPointI.Create(50, RenderBox1.Height div 2);
      C1 := TPointI.Create(150, RenderBox1.Height div 2 - 100);
      C2 := TPointI.Create(RenderBox1.Width - 150, RenderBox1.Height div 2 + 100);
      P2 := TPointI.Create(RenderBox1.Width - 50, RenderBox1.Height div 2);
    end;
    
    procedure TForm1.RenderBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    var
      R: TRectI;
    begin
      { Start dragging points on mouse down }
      R := TRectI.Create(15, 15);
      { Center the rectangular grab area over each point }
      R.Center(P1);
      { And test if it contains the mouse down location }
      if R.Contains(X, Y) then
        { If the test passes, set the drag reference }
        Drag := @P1;
      { Repeat for all points }
      R.Center(P2);
      if R.Contains(X, Y) then
        Drag := @P2;
      R.Center(C1);
      if R.Contains(X, Y) then
        Drag := @C1;
      R.Center(C2);
      if R.Contains(X, Y) then
        Drag := @C2;
    end;
    
    procedure TForm1.RenderBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    begin
      { If dragging, update the point and refresh the render area }
      if Drag <> nil then
      begin
        Drag.X := X;
        Drag.Y := Y;
        RenderBox1.Invalidate;
      end;
    end;
    
    procedure TForm1.RenderBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    begin
      { Release the drag }
      Drag := nil;
    end;
    
    procedure TForm1.RenderBox1Render(Sender: TObject; Surface: ISurface);
    var
      R: TRectI;
      P: IPen;
    begin
      { We're rendering in a TRenderBox control }
      R := RenderBox1.ClientRect;
      { Start with a transparent checker board background }
      Surface.FillRect(Brushes.Transparent, R);
      { Create paths for our points using a 15x15 rect }
      R := TRectI.Create(15, 15);
      { TRectI can center itself on a point }
      R.Center(P1);
      { We are drawing rectangle paths for the end points }
      Surface.Rectangle(R);
      R.Center(P2);
      Surface.Rectangle(R);
      R.Center(C1);
      { And circle paths for the control points }
      Surface.Ellipse(R);
      R.Center(C2);
      Surface.Ellipse(R);
      { Connect the lines between end point and control points }
      Surface.MoveTo(P1.X, P1.Y);
      Surface.LineTo(C1.X, C1.Y);
      Surface.MoveTo(P2.X, P2.Y);
      Surface.LineTo(C2.X, C2.Y);
      { Now stroke all paths in a red pen, after this call all paths removed }
      Surface.Stroke(NewPen(clRed, 2));
      { Now start the curve path }
      Surface.MoveTo(P1.X, P1.Y);
      { Using the CurveTo command }
      Surface.CurveTo(P2.X, P2.Y, C1, C2);
      { Let's use a fat black dashed pen }
      P := NewPen(clBlack, 8);
      P.LinePattern := pnDash;
      P.LineCap := cpRound;
      { And stroke the curve }
      Surface.Stroke(P);
    end;

    Result:

    sysrpl23 March 2015, 23:27

    Typically, when a type begins with "I" it means the type is an interface. Like IUnknown, or IDispatch. When following Cross Codebot code you'll notice I try to follow as many establsihed patterns as possible, both to improve readability, but also as a convenience for experienced developers.

    The ISurface and IBrush types are defined in Codebot.Graphics.Types. If you look in that unit you'll see a listing of these interfaces: http://www.getlazarus.org/videos/crossgraphics

    They are the core interface to 2D graphics in Cross Codebot. The functions to generate instances of these interfaces are in Codebot.Graphics. In that unit you'll find functions like:

    { Create a new matrix }
    function NewMatrix: IMatrix;
    { Create a new pen using a brush as the color }
    function NewPen(Brush: IBrush; Width: Float = 1): IPen; overload;
    { Create a new solid color pen }
    function NewPen(Color: TColorB; Width: Float = 1): IPen; overload;
    { Create a new solid color brush }
    function NewBrush(Color: TColorB): ISolidBrush; overload;
    { Create a new bitmap pattern brush }
    function NewBrush(Bitmap: IBitmap): IBitmapBrush; overload;
    { Create a new linear gradient brush using four coordinates for endpoints }
    function NewBrush(X1, Y1, X2, Y2: Float): ILinearGradientBrush; overload;
    { Create a new linear gradient brush using two points for endpoints }
    function NewBrush(const A, B: TPointF): ILinearGradientBrush; overload;
    { Create a new radial gradient brush bounded by a rect }
    function NewBrush(const Rect: TRectF): IRadialGradientBrush; overload;
    { Create a new font by copying a regular font object }
    function NewFont(Font: TFont): IFont;
    { Create a new surface using a regular canvas object }
    function NewSurface(Canvas: TCanvas): ISurface; overload;
    { Create a new surface using a window }
    function NewSurface(Control: TWinControl): ISurface; overload;
    { Create a new bitmap of width and height size }
    function NewBitmap(Width: Integer = 0; Height: Integer = 0): IBitmap;
    { Create a new splash screen }
    function NewSplash: ISplash;

    Which create instances of the interfaces.

    sysrpl24 March 2015, 03:51

    No I didn't use interfaces for that reason. The main reason to use interfaces is to create an abstraction of an implementation. That is, to shield the user from the underlying details by which some system works.

    In the case of this 2D graphics systems which prominently features an ISurface interface, they are implemented differently by operating system. On Windows ISurface is backed by Direct2D or GdiPlus depending on what's available and the SurfaceOptions you've set. On Linux it uses Cairo. On Mac it uses Quartz2D. But a programmer doesn't need to be aware of this, they can just be knowledgeable of the interfaces and care not about how the underlying system works.

    This is different than abstract classes, in that it is much more flexible for both implementors, but also interface consumers. An added benefit of which is the built in managemed type system which reference counts interfaces. This means that users can work with interfaces and not be required to manage their lifetimes. In other words, it's okay to write:

    Canvas.FillRect(NewBrush(clRed), Rect);

    Because even though you're creating a red brush and not explicitly destroying it, Free Pascal will destroy it for you when it detects the red brush is no longer being referenced. There is a bit more to interfaces than that, and I've recently seen people make mistakes with them because they don't understand them. But as long as you extend TInterfacedObject when you define an interface, or if your chosen class respects the _AddRef/_Release reference counting, then the managed type system will work as intended.

    So in summary, interfaces are good for creating abstractions, and interfaces simplify object lifetime management. I hope this helps.

    sysrpl25 March 2015, 16:59

    zedalaye wrote: I'm really interrested in the source code but I just joined this board and I can't send private messages for now.

    Yes, I had a configuration problem with private messages and newly registered users. It's now been fioxed. A message is waiting for you in your inbox with your git account details.