Solved

How do i walpaper a MDI form with icons/bitmaps in Delphi

Posted on 1997-03-06
7
822 Views
Last Modified: 2013-12-03
I'm using Delphi and want to wallpaper the background of my main MDI form with an icon or bitmap.

How is it done?
0
Comment
Question by:MARTIN030397
[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
7 Comments
 
LVL 3

Expert Comment

by:sperling
ID: 1334162
Do you want it centered, tiled or stretched?


0
 

Author Comment

by:MARTIN030397
ID: 1334163
Edited text of question
0
 
LVL 3

Expert Comment

by:LucHoltkamp
ID: 1334164
Just the same as you would draw a bitmap on a client.
Make a DeviceContext in the Client-window setuproutine and place it on the screen (Using a Compatible DC to select the bitmap in an BitBlt it to the screen. )
0
Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

 

Author Comment

by:MARTIN030397
ID: 1334165
I'm sorry, perhaps i should have told you i am just a beginner at delphi, what does your jargon meen in terms of programming?

Device context in client window using compatable DC?

BitBlk is presumably bit block transfer which i have herd of but, i  still do not understand, could you be a bit more specific and slow please.

Martin
0
 
LVL 2

Expert Comment

by:alona041797
ID: 1334166
There is a freeware component which does that.
Save this as MDIBck.pas. In the OnPaint event you can draw your tiled background by calling Draw for the Canvas

---- CUT HERE ----
unit MDIBck;

interface

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

type
  TMDIPaint = procedure(Sender: TObject; ACanvas: TCanvas; var AClientRect: TRect) of object;

  TMDIBackground = class(TGraphicControl)
  private
    FMDICanvas: TCanvas;
    FBevelWidth: Integer;
    FMDIBackgroundPaint: TMDIPaint;
    FBackgroundColor: TColor;
    FOldClientProc: TFarProc;
    FNewClientProc: TFarProc;
    procedure ClientWndProc(var Mesg: TMessage);
    procedure SetBackgroundColor(const ANewColor: TColor);
    procedure SetBevelWidth(BW: Integer);
  protected
    procedure Paint; override;
    procedure DrawBackground(DC: HDC); dynamic;
    procedure FillClientRect(ACanvas: TCanvas; const ARect: TRect); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BevelWidth: Integer read FBevelWidth write SetBevelWidth default 2;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clInactiveCaption;
    property OnPaint: TMDIPaint read FMDIBackgroundPaint write FMDIBackgroundPaint;
  end;

procedure Register;

implementation

uses ExtCtrls;

constructor TMDIBackground.Create(AOwner: TComponent);
begin
   // Create then background only if it's on a Form wich is MDI parent
   if (AOwner is TForm) and (TForm(AOwner).FormStyle = fsMDIForm) then begin
      inherited Create(AOwner);
      Width := 150;
      Height := 40;
      Align := alClient;
      FBackgroundColor := clInactiveCaption;
      FBevelWidth := 2;
      FMDICanvas := TCanvas.Create;

      if not (csDesigning in ComponentState) then begin
         TForm(Owner).HandleNeeded;
         FNewClientProc := MakeObjectInstance(ClientWndProc);
         FOldClientProc := Pointer(GetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC));
         SetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC, Longint(FNewClientProc));
      end; end
   else begin
      raise Exception.Create('TMDIBackground can only be used on a form '#10 +
                             'with FormStyle = fsMDIForm');
   end;
end;

destructor TMDIBackground.Destroy;
begin
   FMDICanvas.Free;
   if Assigned(FNewClientProc) then begin
      FreeObjectInstance(FNewClientProc);
      SetWindowLong(TForm(Owner).ClientHandle, GWL_WNDPROC, Longint(FOldClientProc));
   end;
   inherited Destroy;
end;

procedure TMDIBackground.ClientWndProc(var Mesg: TMessage);
begin
   with Mesg do begin
      case Msg of
         WM_ERASEBKGND: begin
            CallWindowProc(FOldClientProc, TForm(Owner).ClientHandle, Msg, wParam, lParam);
            DrawBackground(TWMEraseBkGnd(Mesg).DC);
            end;
         WM_VSCROLL, WM_HSCROLL: begin
            Result := CallWindowProc(FOldClientProc, TForm(Owner).ClientHandle, Msg, wParam, lParam);
            InvalidateRect(TForm(Owner).ClientHandle, nil, True);
            end;
         WM_WINDOWPOSCHANGING: begin
            with TWMWindowPosChanging(Mesg) do begin
               Inc(WindowPos^.x, FBevelWidth);
               Inc(WindowPos^.y, FBevelWidth);
               Dec(WindowPos^.cx, 2*FBevelWidth);
               Dec(WindowPos^.cy, 2*FBevelWidth);
            end;
            end;
      else
         Result := CallWindowProc(FOldClientProc, TForm(Owner).ClientHandle, Msg, wParam, lParam);
      end;
   end;
end;

procedure TMDIBackground.SetBackgroundColor(const ANewColor: TColor);
begin
   if (ANewColor <> FBackgroundColor) then begin
      FBackgroundColor := ANewColor;
      if not (csDesigning in ComponentState) then InvalidateRect(TForm(Owner).ClientHandle, nil, True);
      Repaint;
   end;
end;

procedure TMDIBackground.SetBevelWidth(BW: Integer);
var
   iDiff: Integer;
begin
   if (BW <> FBevelWidth) then begin
      iDiff := BW - FBevelWidth;
      FBevelWidth := BW;
      if not (csDesigning in ComponentState) then begin
         SetWindowPos(TForm(Owner).ClientHandle, 0, 0, 0, TForm(Owner).ClientWidth,
                      TForm(Owner).ClientHeight, SWP_NOZORDER + SWP_NOACTIVATE);
      end;
      Repaint;
   end;
end;


procedure TMDIBackground.Paint;
var
   Rect: TRect;
begin
   Rect := GetClientRect;
   if (csDesigning in ComponentState) then begin
      FillClientRect(Canvas, Rect);
   end;
   Frame3D(Canvas, Rect, clBlack, clBtnHighlight, FBevelWidth);
end;

procedure TMDIBackground.DrawBackground(DC: HDC);
var
   Rect: TRect;
begin
   FMDICanvas.Handle := DC;
   Windows.GetClientRect(TForm(Owner).ClientHandle, Rect);
   FillClientRect(FMDICanvas, Rect);
   if Assigned(FMDIBackgroundPaint) then FMDIBackgroundPaint(Self, FMDICanvas, Rect);
end;

procedure TMDIBackground.FillClientRect(ACanvas: TCanvas; const ARect: TRect);
begin
   with ACanvas do begin
      Brush.Style := bsSolid;
      Brush.Color := FBackgroundColor;
      FillRect(ARect);
   end;
end;

procedure Register;
begin
  RegisterComponents('Suppliment', [TMDIBackground]);
end;

end.


0
 

Author Comment

by:MARTIN030397
ID: 1334167
Perhaps i am not using the component correctly but, i have written in the components OnPaint event

 Canvas.Draw(X, Y, Bitmap);

both for MDIBackground1.Canvas.Draw(... which gives an error becouse MDIBackground does not seem to have a canvas property available to me.
and also
Form1.Canvas.Draw(...) does not seem to have any effect either, (or indeed placing a picture on the MDIBackground1)

by the way there was an end; missing out somwhere around the Case statment.

Martin.
0
 
LVL 4

Accepted Solution

by:
erajoj earned 50 total points
ID: 1334168
Something like this:

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.

SWP

/// John

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

For a while now I'v been searching for a circular progress control, much like the one you get when first starting your Silverlight application. I found a couple that were written in WPF and there were a few written in Silverlight, but all appeared o…
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …

707 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