Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Transparent Bitmap on a MDIParentForm

Posted on 1998-05-06
10
Medium Priority
?
404 Views
Last Modified: 2013-12-02
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?
0
Comment
Question by:ponti
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
10 Comments
 
LVL 8

Expert Comment

by:ZifNab
ID: 1342064
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
 

Author Comment

by:ponti
ID: 1342065
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
 
LVL 8

Expert Comment

by:ZifNab
ID: 1342066
If you use textout you've to change the font via the canvas....

Canvas.Font.Style ......

Regards, Zif.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 8

Accepted Solution

by:
ZifNab earned 300 total points
ID: 1342067
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
 

Author Comment

by:ponti
ID: 1342068
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
 
LVL 8

Expert Comment

by:ZifNab
ID: 1342069
Can you send a piece of your code?
0
 

Author Comment

by:ponti
ID: 1342070
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
 
LVL 8

Expert Comment

by:ZifNab
ID: 1342071
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
 

Author Comment

by:ponti
ID: 1342072
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
 

Expert Comment

by:bitgoeul100898
ID: 1342073
Thanks For helping...
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question