Solved

Transparent Bitmap on a MDIParentForm

Posted on 1998-05-06
10
397 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
  • 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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 
LVL 8

Accepted Solution

by:
ZifNab earned 100 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

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
add combobox item based on numbers 9 144
Help on VBSCript Font and color 1 89
what font behind pdf 32 140
Breakpoint doesn't stop in my variable 3 28
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

831 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