Problem with painting with TImage. I have drawn on the TImage but it is not being painted

127 views Asked by At

I have created a sample component below. There are 3 TPanels containing 1 TImage each. I want the images to paint themselves as instructed in the code. This does not happen.

If you build this component and drop it on a form, you will see no painting, and when executed the program shows no painting.

I am using Delphi 10.4 on a Windows 11 machine.

I do not know what I am doing wrong. I tried using the Paint method, but this causes a looping error. I just copied the same details from the created components' painting commands into Paint. Not a good result.

unit Schedule;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Controls,
  Vcl.ExtCtrls, Vcl.Graphics, Vcl.StdCtrls, Vcl.Forms;

type
  TEBSSchedule = class(TCustomControl)
  private
    Panel1, Panel2, Panel3: TPanel;
    Image1, Image2, Image3: TImage;
    ScrollBar1, ScrollBar2: TScrollBar;

    procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Image3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure CreatePanels;
    procedure CreateScrollBars;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

Procedure Register;

implementation


constructor TEBSSchedule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 400;
  Height := 300;

  CreatePanels;
  CreateScrollBars;
end;

destructor TEBSSchedule.Destroy;
begin
  if Assigned(Image1) then Image1.Free;
  if Assigned(Image2) then Image2.Free;
  if Assigned(Image3) then Image3.Free;
  if Assigned(Panel1) then Panel1.Free;
  if Assigned(Panel2) then Panel2.Free;
  if Assigned(Panel3) then Panel3.Free;
  if Assigned(ScrollBar1) then ScrollBar1.Free;
  if Assigned(ScrollBar2) then ScrollBar2.Free;

  inherited Destroy;
end;

procedure TEBSSchedule.CreatePanels;
var
  T: TRect;
begin
  T.Left := 0;
  T.Top := 0;
  Panel1 := TPanel.Create(Self);
  Panel1.Parent := Self;
  Panel1.SetBounds(100,0,Self.Width-100,25);
  Panel1.Anchors := [akLeft,akTop,akRight];
  Image1 := TImage.Create(Panel1);
  Image1.Parent := Panel1;
  Image1.Align := alClient;
  Image1.Picture.Bitmap.Canvas.Brush.Color := clBlue;
  T.Right := Panel1.Width;
  T.Bottom := Panel1.Height;
  Image1.Picture.Bitmap.Canvas.FillRect(T);

  Panel2 := TPanel.Create(Self);
  Panel2.Parent := Self;
  Panel2.SetBounds(0,Panel1.Height,100,Self.Height-25);
  Panel2.Anchors := [akLeft,akTop,akBottom];
  Image2 := TImage.Create(Panel2);
  Image2.Parent := Panel2;
  Image2.Align := alClient;
  Image2.Picture.Bitmap.Canvas.Brush.Color := clBlue;
  T.Right := Panel2.Width;
  T.Bottom := Panel2.Height;
  Image2.Picture.Bitmap.Canvas.FillRect(T);

   Panel3 := TPanel.Create(Self);
  Panel3.Parent := Self;
  Panel3.SetBounds(Panel2.Width,Panel1.Height,
  Self.Width-Panel2.Width,Self.Height-Panel1.Height);
  Panel3.Anchors := [akLeft,akTop,akRight,akBottom];
  Image3 := TImage.Create(Panel3);
  Image3.Parent := Panel3;
  Image3.Align := alClient;
  Image3.Picture.Bitmap.Canvas.Brush.Color := clYellow;
  T.Right := Panel3.Width;
  T.Bottom := Panel3.Height;
  Image3.Picture.Bitmap.Canvas.FillRect(T);
  Image3.OnMouseDown := Image3MouseDown;
  Image3.OnMouseMove := Image3MouseMove;
  Image3.OnMouseUp := Image3MouseUp;
end;

procedure TEBSSchedule.CreateScrollBars;
begin
  ScrollBar1 := TScrollBar.Create(Self);
  ScrollBar1.Parent := Self;
  ScrollBar1.Kind := sbHorizontal;
  ScrollBar1.Align := alBottom;

  ScrollBar2 := TScrollBar.Create(Self);
  ScrollBar2.Parent := Self;
  ScrollBar2.Kind := sbVertical;
  ScrollBar2.Align := alRight;
end;

procedure TEBSSchedule.Paint;
begin
  inherited Paint;
end;

procedure TEBSSchedule.Image3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TEBSSchedule.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
end;

procedure TEBSSchedule.Image3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
end;

procedure Register;
begin
  RegisterComponents('EBSH', [TEBSSchedule]);
end;


end.
1

There are 1 answers

0
Remy Lebeau On

You are not seeing anything painted because there is nothing available to be painted.

When you access the TImage.Picture.Bitmap property for the first time, there is no graphic loaded in the TImage yet, so the Bitmap property getter creates a blank TBitmap object with dimensions of 0x0. This is (somewhat) documented behavior (although the wording is a little misleading1):

https://docwiki.embarcadero.com/Libraries/en/Vcl.Graphics.TPicture.Bitmap

Use Bitmap to reference the picture object when it contains a bitmap. If Bitmap is referenced when the picture contains a Metafile or Icon graphic, the graphic won't be converted (Types of Graphic Objects). Instead, the original contents of the picture are discarded and Bitmap returns a new, blank bitmap.

1: What the documentation really means is something more like this:

Use Bitmap to reference the picture object when it contains a bitmap. If Bitmap is referenced when the picture does not contain a bitmap graphic, any existing graphic won't be converted (Types of Graphic Objects). Instead, the original contents of the picture are discarded and Bitmap returns a new, blank bitmap with no size yet.

You are thus drawing on the Bitmap.Canvas outside of the bounds of the TBitmap's available drawing area.

To fix this, you need to resize the TBitmap object before you can then draw anything on it, eg:

Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height); // <-- ADD THIS!
Image1.Picture.Bitmap.Canvas.Brush.Color := clBlue;