Drawing Form Background Problem

[BobbaFet]

Hi all! Thank you for reading my question!

I'm using a simple bit of code to draw a background on the form canvas. This is what I use (ok, a bit more complex than this due to supporting jpegs, resizing, etc as well but anyway):

...
private
myBackground: TBitmap;
...

function GetDesktopBG: string;
var R: TRegistry;
begin
R := TRegistry.Create;

R.RootKey := HKEY_CURRENT_USER;
R.OpenKey('\Control Panel\Desktop',False);
Result := R.ReadString('WallPaper');

R.Free;
end;

procedure TForm1.FormCreate(Sender:TObject);
begin
myBackground := TBitmap.Create;
myBackground.LoadFromFile(GetDesktopBG);
// resize to form dimensions
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0, 0, myBackground);
end;

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

Now what happens when I just scroll the form a little bit, the image isn't (IMHO) drawn properly, instead of it showing normally, it'll show like this:

And it should look like this (the pic that is):

Is there anything I can do about that? I've been scouring the interwebz but all this has done is:

Can you help me fix this, or is this just a fact of life?

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[Glenn9999]

What's the precise problem? The image glitches? Or the vertical scroll bar?

Measurement is not management.

 

[BobbaFet]

The image that glitches, can that be helped? Sorry for not being clear in my original post.

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[BobbaFet]

PS: The scrollbar is intentional, I could of course just hide it and use the onmousewheel event but I like clicking so I opted to leave it in. Undoubtably, using the mousewheel instead of the scrollbar wouldn't stop the image from glitching.

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[Glenn9999]

Okay the image glitch problem. This is assuming you want to define a bitmap and leave it on the background of the form no matter what the user does.

OnPaint is only for if a form is invalidated. That happens when you put another form on top of the form. In essence, you are responsible for redrawing the form when it is invalidated.

You want that, but you want OnResize defined as well. If you don't redraw on resize, it seems to just duplicate whatever it redrew the last time.

Of course all this changes if your form wasn't meant to resize at all (and you might need to redraw on use of the scroll bars as well). If I were doing this, I would do stretchdraw based on clientwidth and clientheight.

YMMV depending on what you want done.

Measurement is not management.

 

[BobbaFet]

The form size is fixed at:
Width : 740
Height : 555

I fixed this width by setting the Form.Borderstyle to bsToolWindow, so it doesn't resize at all.

I will try your suggestion of the onResize event anyway, "you never know how a cow catches a hare". (< weird Dutch expression).

Oh, what does YMMV mean?

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[BobbaFet]

Well, the onResize event thing didn't work, I've in the mean time tried several things with a TImage which were all worse than drawing on the form (lots n lots of flickering that even with doublebuffered wouldn't go away).

Any other suggestions?

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[Glenn9999]

Okay I got to looking more. OnResize won't fix your problem. It turns out anything you do (resize, scroll bar, form over top) will invalidate some portion of the form anyway. And as described above, OnPaint redraws only the invalidated portion of a form and not the whole thing.

So to sit an image on the background of a form in its canvas, you have to forcibly invalidate the whole thing, then redraw the form from scratch. It will flicker horribly if you move the form, but I don't know of any way around that.

procedure TForm1.FormPaint(Sender: TObject);
var
  MyRect: TRect;
  i: integer;
begin
  MyRect.Top := 0;
  MyRect.Left := 0;
  MyRect.Right := Form1.ClientWidth;
  MyRect.Bottom := Form1.ClientHeight;
  InvalidateRect(Form1.Handle, @MyRect, false);
  Form1.Canvas.StretchDraw(MyRect, MyBitMap);
  for i := 0 to Form1.ControlCount - 1 do
    Form1.Controls[i].Repaint;
end;

Hope this helps some. You might investigate positioning a TImage, but I'm not sure it would do much better.

(On a different note, this is a great example of why frameworks aren't necessarily best)

Measurement is not management.

 

[roo0047]

your mileage may vary

Roo
Delphi Rules!

 

[Glenn9999]

I apologize - this is definitely one of those times when I wish I could edit my posts, since I keep revising what is before me.

Non-flickering version (for most part), and hopefully last:

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBitMap := TBitMap.Create;
  MyBitMap.LoadFromFile('wallpaper.bmp');
  Form1.Brush.Bitmap := MyBitMap;
end;

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

procedure TForm1.FormPaint(Sender: TObject);
var
  MyRect: TRect;
  i: integer;
begin
  MyRect.Top := 0;
  MyRect.Left := 0;
  MyRect.Right := Form1.ClientWidth;
  MyRect.Bottom := Form1.ClientHeight;
  InvalidateRect(Form1.Handle, @MyRect, false);
  for i := 0 to Form1.ControlCount - 1 do
    begin
      Form1.Controls[i].Repaint;
    end;
  sleep(20);
end;

Measurement is not management.

 

[BobbaFet]

This is a toughy :S My milage is deffinately down the drain.

Even though the final result from your code is just what I want, it seriously hinders the preformance.

I'll have to find some other way to do it, thanks for all the help, Glenn!

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[BobbaFet]

I shouldve refreshed, my bad dude. I will check this code out as well.

BobbaFet

if not Programming = 'Severe Migraine' then
                       ShowMessage('Eureka!');

 

[Glenn9999]

I just noticed the other will show the bitmap but doesn't hold up if the form is resized (it tiles it). Hopefully something here will work.

Measurement is not management.