[Ronaldo Souza]

Hi,

We've been trying to kill this feature in our 20+ years old app, but too many users apparently love to have their logos splashed across their screens all day, so here we go…

The logo can be either centered or tiled on the main form's background. The really old routines used before AC don't work anymore, so I'd like to know if there's a safe way to create this effect within AC, since this is a critical, real time, medical application.

The old routines go something like this:

Code:

MainForm
. . .
FClientInstance: TFarProc;
FPrevClientProc: TFarProc;
. . .

Code:

MainForm.Create
. . .
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,LongInt(FClientInstance));
. . .

Code:

procedure TfrmMain.ClientWndProc(var Message: TMessage);
var
DC : hDC;
Row, Col : Integer;
begin
. . .
if (imgLogo.Picture.Height > 0) and (imgLogo.Picture.Width > 0) then
with Message do
case Msg of
WM_ERASEBKGND:
begin
DC := TWMEraseBkGnd(Message).DC;
if Config.bLogoTiled then
begin
for Row := 0 to ClientHeight div imgLogo.Picture.Height do
for Col := 0 to ClientWidth div imgLogo.Picture.Width do
BitBlt(DC,
Col * imgLogo.Picture.Width,
Row * imgLogo.Picture.Height,
imgLogo.Picture.Width,
imgLogo.Picture.Height,
imgLogo.Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;
else
begin
… handle centered logo
end;
Result := 1;
end;
. . .
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end; // case
end;

[attachment=7527:MDIBackground01.png]

[attachment=7528:MDIBackground02.png]

Thanks in advance!

Ronaldo

[Support]

Hello!

You can use OnPaint event, I think, look attached example.

[Ronaldo Souza]

'Support' wrote:

Hello!

You can use OnPaint event, I think, look attached example.

Thanks for the reply!

When I run the demo using AC version 10.23, I get a stack overflow on line 7327 of acSBUtils:

Code:

function TacMainWnd.CallPrevWndProc(const Handle: hwnd; const Msg: longint; const WParam: WPARAM; var LParam: LPARAM): LRESULT;
var
M: TMessage;
begin
if Assigned(OldWndProc) then begin
M.Msg := Msg;
M.WParam := WParam;
M.LParam := LParam;
M.Result := 0;
OldWndProc(M);
Result := M.Result;
LParam := M.LParam;
end
else
if Assigned(OldProc) then
try
Result := CallWindowProc(OldProc, Handle, Msg, WParam, LParam) <<<<<< STACK OVEREFLOW HERE
except
Result := 0;
end
else
Result := 0;
end;

but it doesn't happen using version 10.22 (Delphi 7.0 Professional – build 4.453).

I noticed this affects the background of all AC components, is there a way to avoid this side-effect?

Best regards,

Ronaldo

[Support]

Yes, I saw this error too, when prepared this demo.

The error is fixed and new package with a fix will be available at the nearest days.

[Ronaldo Souza]

'Support' wrote:

Yes, I saw this error too, when prepared this demo.

The error is fixed and new package with a fix will be available at the nearest days.

Thanks!

The OnPaint approach works fine except for one detail I couldn't fix so far: the background of the statusbar (or any other component I place on the main form) is also drawn with the logo.

Thanks in advance for any help you could provide!

Ronaldo

[Support]

I think, you can exclude this statusbar rectangle before painting, like this:

ExcludeClipRect(Canvas.Handle, sStatusBar1.Left, sStatusBar1.Top, sStatusBar1…)

[Ronaldo Souza]

'Support' wrote:

I think, you can exclude this statusbar rectangle before painting, like this:

ExcludeClipRect(Canvas.Handle, sStatusBar1.Left, sStatusBar1.Top, sStatusBar1…)

Works perfectly. Thanks!

Ronaldo

[Author]

Posts