Drawing Transparent message to screen gives Out of system resources
delphi
Solution
How to debug this.
- Enable debug DCUs in your project options, disable optimizations.
- When you get out of resources error, hit "Break".
- Inspect call stack :
The problem happens in `CopyBitmap` when calling `GDICheck` -> double click `GDICheck` to go there.
Put a breakpoint. Run the program - count how many times it takes before the error shows up and break just before you expect the error.
Have a look around for anything that might be odd. A good place to start is the bitmap itself. Your first clue should be that each time you call this method your text is creeping away up into the corner of your invisible form.
Let's check the bitmap header and see what's going on :
Looks like your bitmap dimensions are negative. I wonder how that happened. In fact, if you watch each time this is called, your bitmap is shrinking each time. In fact, it is shrinking by 16px in width and 38px in height - the size of the window frame.
Each time you are calling `UpdateLayeredWindow` you are resizing your form (its outside dimension) to be the size of the client area - the size without the window frame. Your new window gets a new frame and the client area shrinks.
Eventually there is nothing left and you are trying to make a bitmap with negative dimensions. You should therefore take into account the frame size when building your bitmap. Use the form width and height rather than the client size :
bm.Width := Width;
bm.height := Height;
Also, when making API calls, please get into the habit of checking the return values for errors, as described in the documentation for the function in question. If you are not checking for errors you are asking for problems.
Problem
I have a code, that draws the message str directly to center of the screen without a visible window. Why using this code first works OK, but after dozens of calls, it gives Out of system resources. It seems to free BM ok, and I don't see that it allocates other resources at all. ``` procedure ttsplash.UpdateSplash(const Str: string); var R: TRect; P: TPoint; S: TPoint; bm: TBitmap; bf: TBlendFunction; EXSTYLE: DWORD; x, y: integer; pixel: PRGBQuad; TextRed, TextGreen, TextBlue: byte; begin if str='' then exit; EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE); SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or $80000); R := ClientRect; bm := TBitmap.Create; try bm.PixelFormat := pf32bit; // bm.SetSize(ClientWidth, ClientHeight); bm.Width := clientwidth; bm.height := clientheight; bm.Canvas.Brush.Color := clBlack; bm.Canvas.FillRect(ClientRect); bm.Canvas.Font.Assign(Self.Font); bm.Canvas.Font.Color := clWhite; DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R, DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS); TextRed := GetRValue(ColorToRGB(Font.Color)); TextGreen := GetGValue(ColorToRGB(Font.Color)); TextBlue := GetBValue(ColorToRGB(Font.Color)); for y := 0 to bm.Height - 1 do begin pixel := bm.ScanLine[y]; x := 0; while x < bm.Width do begin with pixel^ do begin rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3; rgbBlue := TextBlue * rgbReserved div 255; rgbGreen := TextGreen * rgbReserved div 255; rgbRed := TextRed * rgbReserved div 255; end; inc(pixel); inc(x); end; end; P := Point(0, 0); S := Point(bm.Width, bm.Height); bf.BlendOp := AC_SRC_OVER; bf.BlendFlags := 0; bf.SourceConstantAlpha := 255; bf.AlphaFormat := AC_SRC_ALPHA; UpdateLayeredWindow(Handle, 0, nil, @S, bm.Canvas.Handle, @P, 0, @bf, ULW_ALPHA) finally bm.Free; end; end; ```