Recent

Author Topic: [Solved]Paint misbehavin'  (Read 2604 times)

bobonwhidbey

  • Hero Member
  • *****
  • Posts: 592
    • Double Dummy Solver - free download
[Solved]Paint misbehavin'
« on: November 25, 2015, 09:21:33 pm »
In my TCustomControl descendent the Paint method is acting strange.  The before and after BMP files are correct, proving that the ShowDDTricks routine is doing what I expect. However, what's seen on the screen is different from the after BMP file.

For some strange reason, in the area of the BMP that is overwritten in ShowDDTricks I see on the screen what that area looked like in the prior painting of this control. Why does Canvas.Draw(0, 0, FCardBMP) show a slightly different BMP on the screen?

Code: Pascal  [Select][+][-]
  1.       Deck.CardList.GetBitmap(Ord(FSuit) * 15 + FRank, FCardBMP);
  2.       FCardBMP.SavetoFile('C:\Users\Bob\Desktop\testcardBef.bmp');
  3.       ShowDDTricks; //routine to write the FCardBMP canvas
  4.       FCardBMP.SavetoFile('C:\Users\Bob\Desktop\testcardAft.bmp');
  5.       Canvas.Draw(0, 0, FCardBMP);
  6.  
« Last Edit: November 26, 2015, 10:25:50 pm by bobonwhidbey »
Lazarus 3.0RC2, FPC 3.2.2 x86_64-win64-win32/win64

balazsszekely

  • Guest
Re: Paint misbehavin'
« Reply #1 on: November 26, 2015, 06:20:00 am »
Hi bobonwhidbey,

First of all you should switch to BGRABitmap(http://sourceforge.net/projects/lazpaint/files/src/), it's light-year ahead in terms of speed and effectiveness. Secondly I doubt somebody can help without more details.  Is FCardBMP transparent? To what canvas are you drawing? Can you make a small demo project which reproduce the error?

regards,
GetMem

bobonwhidbey

  • Hero Member
  • *****
  • Posts: 592
    • Double Dummy Solver - free download
Re: Paint misbehavin'
« Reply #2 on: November 26, 2015, 08:52:29 pm »
Here's a simple example that shows my problem. The screen shows a teal box. The file shows a yellow box with "-2". Seems to me that they should both show -2.

Code: Pascal  [Select][+][-]
  1. unit Imageunit;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, LCLIntf, LCLType;
  6. type
  7.   TCard = class(TCustomControl)
  8.   private
  9.     FCardBMP: TBitmap;
  10.   protected
  11.     procedure Paint; override;
  12.   public
  13.     StandardCardList: timagelist;
  14.     constructor Create(AOwner: TComponent); override;
  15.     destructor Destroy; override;
  16.     procedure SetupStandardCards;
  17.   end;
  18.  
  19.   TForm1 = class(TForm)
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormDestroy(Sender: TObject);
  22.   public     { public declarations }
  23.     Card1: TCard;
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30. {$R *.lfm}
  31. constructor TCard.Create(AOwner: TComponent);
  32. begin
  33.   inherited Create(AOwner);
  34.   parent := TWinControl(Aowner);
  35.   FCardBMP := tbitmap.Create;
  36.   StandardCardList := timagelist.createSize(71, 95);
  37.   SetupStandardCards;
  38.   left := 0;
  39.   top := 0;
  40.   Height := 95;
  41.   Width := 71;
  42.   Show;
  43. end;
  44.  
  45. destructor TCard.Destroy;
  46. begin
  47.   FCardBMP.Free;
  48.   StandardCardList.Free;
  49.   inherited Destroy;
  50. end;
  51.  
  52. procedure TCard.SetupStandardCards;
  53. var
  54.   i: integer;
  55.   ACard: TBitmap;
  56. begin
  57.   ACard := tbitmap.Create;
  58.   ACard.Height := 95;
  59.   ACard.Width := 72;
  60.   for i := 0 to 74 do
  61.     StandardCardList.Add(ACard, nil);
  62.   acard.Free;
  63. end;
  64.  
  65. procedure TCard.Paint;
  66. var
  67.   TS: TTextStyle;
  68.   R: TRect;
  69. begin
  70.   StandardCardList.GetBitmap(1, FCardBMP);
  71.   FCardBMP.Canvas.Brush.color := clYellow;
  72.   FCardBMP.Canvas.FillRect(Bounds(1, 30, 14, 16));
  73.   FCardBMP.Canvas.Font.Style := [fsBold];
  74.   TS := FCardBMP.Canvas.TextStyle;
  75.   TS.Alignment := taCenter;
  76.   R := Rect(1, 30, 15, 46);
  77.   FCardBMP.Canvas.Font.Color := clblack;
  78.   FCardBMP.Canvas.TextRect(R, 1, 29, '-2', TS);
  79.   FCardbmp.SavetoFile('C:\Users\Bob\Documents\Attach\testcardbef.bmp');
  80.   Self.Canvas.Draw(0, 0, FCardBMP);
  81. end;
  82.  
  83. procedure TForm1.FormCreate(Sender: TObject);
  84. begin
  85.   Card1 := TCard.Create(Form1);
  86.   self.color := clTeal;
  87.   Card1.left := 50;
  88.   Card1.top := 50;
  89. end;
  90.  
  91. procedure TForm1.FormDestroy(Sender: TObject);
  92. begin
  93.   Card1.Free;
  94. end;
  95. end.
Lazarus 3.0RC2, FPC 3.2.2 x86_64-win64-win32/win64

balazsszekely

  • Guest
Re: Paint misbehavin'
« Reply #3 on: November 26, 2015, 10:22:21 pm »
The ImageList is misbehavin'  :D. Anyway just set the pixelformat both for FCardBMP and ACard like this:
Code: Pascal  [Select][+][-]
  1. ACard.PixelFormat:=pf32bit;
  2. FCardBMP.PixelFormat := pf32bit;
and you are good to go.

PS: Please consider switching to BGRABitmaps.

bobonwhidbey

  • Hero Member
  • *****
  • Posts: 592
    • Double Dummy Solver - free download
Re: Paint misbehavin'
« Reply #4 on: November 26, 2015, 10:25:20 pm »
Thank you very much - I've been tearing my hair out over this for a few weeks. :)
Lazarus 3.0RC2, FPC 3.2.2 x86_64-win64-win32/win64

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: [Solved]Paint misbehavin'
« Reply #5 on: November 26, 2015, 10:28:14 pm »
I would also report a bug too, if you set the pixelformat to pf24bit it resurfaces the problem making it a bug in my book.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

 

TinyPortal © 2005-2018