Transparent Bitmap on a MDIParentForm

How can i paint or add centered a transparent bitmap on a mdiparentform in delphi 1?
And how can i put a text on the mdiparentform in a specific font?
pontiAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ZifNabCommented:
Can you be more specific?

MDIParentForm is always at the background --> why transparent bitmap?

Text in a specific font??? Where ? On form? Use a Label?

ZiF.
0
pontiAuthor Commented:
I tried to put a label or bitmap on the mdiparentform but nothing is displayed when starting the application. How can i show a text centered on a mdiparentform? I tried to use the windows api call "textout", but how can you assign a specific font?
0
ZifNabCommented:
If you use textout you've to change the font via the canvas....

Canvas.Font.Style ......

Regards, Zif.
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

ZifNabCommented:
Hi ponti,
Here is some code I found :

MDI Parent Background

From: Dave Horacek <dhoracek@swbell.net>

Here's some code that may prove useful. It is for either a normal form or an MDI form and tiles a bitmap or
produces gradients. The only tricky part is establishing the window message handler for the ClientHandle of the
window that actually manages the child forms. That's where the bitmaps and graphics actually appear in an MDI
form. Just load a bitmap into imgTile at design time and you're ready to go.



unit UMain;

interface

uses
  Windows, Messages, Classes, SysUtils, Graphics, Controls, Forms,
Dialogs,
  ExtCtrls, Menus;

type
  TfrmMain = class(TForm)
    mnuMain: TMainMenu;
    mnuFile: TMenuItem;
    mnuExit: TMenuItem;
    imgTile: TImage;
    mnuOptions: TMenuItem;
    mnuBitmap: TMenuItem;
    mnuGradient: TMenuItem;
    procedure mnuExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuBitmapClick(Sender: TObject);
    procedure mnuGradientClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    MDIDefProc:pointer;
    MDIInstance:TFarProc;
    procedure MDIWndProc(var prmMsg:TMessage);
    procedure CreateWnd;override;
    procedure ShowBitmap(prmDC:hDC);
    procedure ShowGradient(prmDC:hDC;prmRed,prmGreen,prmBlue:byte);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  glbImgWidth:integer;
  glbImgHeight:integer;

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 glbImgHeight:=imgTile.Picture.Height;
 glbImgWidth:=imgTile.Picture.Width;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
 FormPaint(Sender);
end;

procedure TfrmMain.MDIWndProc(var prmMsg:TMessage);
begin
 with prmMsg do
  begin
   if Msg=WM_ERASEBKGND then
    begin
     if mnuBitmap.Checked then
      ShowBitmap(wParam)
     else
      ShowGradient(wParam,255,0,0);
     Result:=1;
    end
   else
    Result:=CallWindowProc(MDIDefProc,ClientHandle,Msg,wParam,lParam);
  end;
end;

procedure TfrmMain.CreateWnd;
begin
 inherited CreateWnd;
 MDIInstance:=MakeObjectInstance(MDIWndProc); { create wrapper }
 MDIDefProc:=pointer(SetWindowLong(ClientHandle,GWL_WNDPROC,
     longint(MDIInstance)) );
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
 { restore default window proc }
 SetWindowLong(ClientHandle,GWL_WNDPROC,longint(MDIDefProc));
 { dispose of instance }
 FreeObjectInstance(MDIInstance);
end;

procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
 close;
end;

procedure TfrmMain.mnuBitmapClick(Sender: TObject);
 var
  wrkDC:hDC;
begin
 wrkDC:=GetDC(ClientHandle);
 ShowBitmap(wrkDC);
 ReleaseDC(ClientHandle,wrkDC);
 mnuBitmap.Checked:=true;
 mnuGradient.Checked:=false;
end;

procedure TfrmMain.mnuGradientClick(Sender: TObject);
 var
  wrkDC:hDC;
begin
 wrkDC:=GetDC(ClientHandle);
 ShowGradient(wrkDC,0,0,255);
 ReleaseDC(ClientHandle,wrkDC);
 mnuGradient.Checked:=true;
 mnuBitMap.Checked:=false;
end;

procedure TfrmMain.ShowBitmap(prmDC:hDC);
 var
  wrkSource:TRect;
  wrkTarget:TRect;
  wrkX:integer;
  wrkY:integer;
begin
 {tile bitmap }
 if FormStyle=fsNormal then
  begin
   wrkY:=0;
   while wrkY < ClientHeight do    { go from top to bottom.. }
    begin
     wrkX:=0;
     while wrkX < ClientWidth do   { ..and left to right. }
      begin
       Canvas.Draw(wrkX,wrkY,imgTile.Picture.Bitmap);
       Inc(wrkX,glbImgWidth);
      end;
     Inc(wrkY,glbImgHeight);
    end;
  end
 else if FormStyle=fsMDIForm then
  begin
   Windows.GetClientRect(ClientHandle,wrkTarget);
   wrkY:=0;
   while wrkY < wrkTarget.Bottom do
    begin
     wrkX:=0;
     while wrkX < wrkTarget.Right do
      begin
       BitBlt(longint(prmDC),wrkX,wrkY,imgTile.Width,imgTile.Height,
                imgTile.Canvas.Handle,0,0,SRCCOPY);
       Inc(wrkX,glbImgWidth);
      end;
     Inc(wrkY,glbImgHeight);
    end;
  end;
end;

procedure TfrmMain.ShowGradient(prmDC:hDC;prmRed,prmGreen,prmBlue:byte);
 var
  wrkBrushNew:hBrush;
  wrkBrushOld:hBrush;
  wrkColor:TColor;
  wrkCount:integer;
  wrkDelta:integer;
  wrkRect:TRect;
  wrkSize:integer;
  wrkY:integer;
begin
 { gradient routine }
 wrkDelta:=255 div (1+ClientHeight); { number of shades desired }
 if wrkDelta=0 then wrkDelta:=1;     { yes, usually 1 }
 wrkSize:=ClientHeight div 240;      { size of blended bars }
 if wrkSize=0 then wrkSize:=1;
 for wrkY:=0 to 1+(ClientHeight div wrkSize) do
  begin
   wrkColor:=RGB(prmRed,prmGreen,prmBlue);
   wrkRect:=Rect(0,wrkY*wrkSize,ClientWidth,(wrkY+1)*wrkSize);
   if FormStyle=fsNormal then
    begin
     Canvas.Brush.Color:=wrkColor;
     Canvas.FillRect(wrkRect);
    end
   else if FormStyle=fsMDIForm then
    begin
     wrkBrushNew:=CreateSolidBrush(wrkColor);
     wrkBrushOld:=SelectObject(prmDC,wrkBrushNew);
     FillRect(prmDC,wrkRect,wrkBrushNew);
     SelectObject(prmDC,wrkBrushOld);
     DeleteObject(wrkBrushNew);
    end;
   if prmRed >wrkDelta then Dec(prmRed,wrkDelta);
   if prmGreen > wrkDelta then Dec(prmGreen,wrkDelta);
   if prmBlue  > wrkDelta then Dec(prmBlue,wrkDelta);
  end;
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
 if FormStyle=fsNormal then
  if mnuBitMap.Checked then
   mnuBitMapClick(Sender)
  else
   mnuGradientClick(Sender);
end;

end.

Regards, ZiF.

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
pontiAuthor Commented:
The code is nearly useful. My problem is to set a specific font via the api function selectobject. With tfont.handle it work nearly fine, except that the font color i have set doesnot work. the text is always painted black on white background, whatever i set.
Also a new brush or pen does not help.
0
ZifNabCommented:
Can you send a piece of your code?
0
pontiAuthor Commented:
Here is a piece of my code. The problem is the color property of tfont, which does not affect the output of the text. It is always painted black on white background.
What is wrong?
 
class MyClass
  ...
private
    fClientInstance, fPrevClient: TFarProc;
    procedure ClientWindow(var aMessage: TMessage);
end;

procedure TMyClass.ClientWindow(var aMessage: TMessage);
var row, col: word; dc: hDC;
    mybrush: TBrush;
    mypen: TPen;
    myFont: TFont;
begin
  with aMessage do
    case Msg of
      WM_ERASEBKGND:
        begin
          dc:= TWMEraseBkGnd(aMessage).dc;
          mybrush:= TBrush.Create;
          mybrush.Color:= clBtnFace;
          mybrush.style:= bsSolid;
          mypen:= TPen.Create;
          mypen.Color:= clBtnFace;
          myfont:= TFont.Create;
          myfont.color:= clGray;
          myfont.size:= 32;
          myfont.name:= 'Arial';
          WinProcs.SelectObject(dc, mybrush.Handle);
          WinProcs.SelectObject(dc, mypen.Handle);
          WinProcs.Rectangle( dc, 0, 0, ClientWidth, ClientHeight );
          WinProcs.SelectObject(dc, myfont.Handle);
          WinProcs.TextOut(dc, 200, 200, 'My Output', 10);
          mybrush.free;
          mypen.free;
          myfont.free;
          result:=1;
        end;
    else result:= CallWindowProc(fPrevClient, Clienthandle, Msg, wParam, lParam);
  end;
end;


At beginning:
   fClientInstance:= MakeObjectInstance(ClientWindow);
   fPrevClient:= Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
   SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(fClientInstance));

At the end:
   SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(fPrevClient));
   FreeObjectInstance(fClientInstance);  

0
ZifNabCommented:
Try to use this with your canvas... Yo do use the same canvas I hope?

                          var
                            OldBkMode : integer;
                          begin
                            with Form1.Canvas do begin
                              Brush.Color := clRed;
                              FillRect(Rect(0, 0, 100, 100));
                              Brush.Color := clBlue;
                              TextOut(10, 20, 'Not Transparent!');
                              OldBkMode := SetBkMode(Handle, TRANSPARENT);
                              TextOut(10, 50, 'Transparent!');
                              SetBkMode(Handle, OldBkMode);
                            end;
                          end;

regards, ZiF.
0
pontiAuthor Commented:
I have found out how i can do it. I assign the dc to the canvas.handle and it works.
But i will also try your version.

Thanks for helping
0
bitgoeul100898Commented:
Thanks For helping...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.