Hi. Habe ein kleines Tool in dem ich ein Panel dynamisch erzeuge. In diesem Panel erzeuge ich ein Image.
Zur Laufzeit hole ich mir mit "self.GetFormImage" dann das aktuelle Bild der Form.
Funktion:
Ich will, wenn ich ein Fenster aufmache den Hintergrund verschleiern.
Das Funktioniert soweit ganz gut, aber nach dem ca. 47 maligen aufrufen des Fensters kommt die Fehlermeldung:
Exception-Klasse EOutOfResources mit Meldung 'Für diesen Befehl ist nicht genügend Speicher verfügbar.
Ich hab keine Ahnung wie ich den Fehler lokalisieren soll, bzw. ich weiß garnicht warum hier ein Fehler auftritt.
Delphi-Quellcode:
procedure TFrmMain.Button1Click(Sender: TObject);
var
ModalesFenster: TForm2;
begin
Verschleiern(TRUE);
ModalesFenster := TForm2.Create(Self);
ModalesFenster.ShowModal;
Verschleiern(FALSE);
end;
procedure TFrmMain.Verschleiern(Status: Boolean);
begin
if Status = TRUE then
begin
PanelVerschleiern := TPanel.Create(nil);
PanelVerschleiern.Parent := FrmMain;
PanelVerschleiern.Align := alclient;
PanelVerschleiern.Visible := FALSE;
PanelVerschleiern.BevelOuter := bvNone;
ImageVerschleiern := TImage.Create(PanelVerschleiern);
ImageVerschleiern.Parent := PanelVerschleiern;
ImageVerschleiern.Align := alclient;
ImageVerschleiern.Picture.Bitmap := self.GetFormImage;
AlphaBlendRect(ImageVerschleiern.Canvas,PanelVerschleiern.ClientRect,clblack,80);
PanelVerschleiern.Show;
end
else
begin
PanelVerschleiern.Hide;
ImageVerschleiern.Free;
PanelVerschleiern.Free;
end;
end;
procedure TFrmMain.AlphaBlendRect (const aCanvas: TCanvas;
const aRect: TRect;
const aColor: TColor;
const aIntensity: Byte);
var
w, h : Integer;
Bitmap : TBitmap;
BlendParams : TBlendFunction;
begin
w := Succ(aRect.Right - aRect.Left);
h := Succ(aRect.Bottom - aRect.Top);
Bitmap := TBitmap.Create;
try
Bitmap.Width := w;
Bitmap.Height := h;
Bitmap.Canvas.Brush.Color := ColorToRGB(aColor);
Bitmap.Canvas.FillRect (Rect(0, 0, w, h));
BlendParams.BlendOp := AC_SRC_OVER;
BlendParams.BlendFlags := 0;
BlendParams.SourceConstantAlpha := aIntensity;
BlendParams.AlphaFormat := 0;
Windows.AlphaBlend(aCanvas.Handle, aRect.Left, aRect.Top, w, h,
Bitmap.Canvas.Handle, 0, 0, w, h,
BlendParams);
finally
Bitmap.Free;
end;
end;
Im Anhang ist das Projekt