phi3A`s Digital Notes

Kode ini berfungsi untuk menambahkan background pada MDI Form.
Thx to Delphindo@yahoogroups.com
Dalam kode aslinya, background berupa file BMP.
Kode ini dikembangkan untuk background yang berupa *.JPG.
Juga utk menampilkan login form pada running awal aplikasi MDI.

=============================================

Unit Unit1

interface

uses JPEG,ExtCtrls; // Adding Unit For TJPEGImage & TImage

type
   TForm1 = class (TForm)
    MainMenu1: TMainMenu;
    Logout1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
      FirstLoad:boolean;
      FDefProc: Pointer;
      procedure ClientProc( var M: TMessage );
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

uses UnitLogin;

{$R *.DFM}

procedure TForm1.ClientProc(var M: TMessage);
var jpg: TJPEGImage;
    img: TImage;
Begin
  if (M.Msg = WM_ERASEBKGND) then
  begin
  jpg:=TJPEGImage.Create;
  img:=TImage.Create(nil);
   try
    jpg.LoadFromFile(’..\pic\mPit.jpg’); // load gambar jpg
    img.Height:=jpg.Height;
    img.Width:=jpg.Width;
    img.Picture.Bitmap.Assign(jpg);
    StretchBlt(
        m.WParam,0,0,Width,Height,
        img.canvas.handle,0,0,
        img.Width,
        img.Height,
        SRCCOPY);
    finally
     jpg.free;
     img.free;
    end;
   end
   else
   m.Result := CallwindowProc(FdefProc,ClientHandle,M.Msg,M.wParam,m.lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
var proc: TFarProc;
begin
  proc := MakeObjectInstance(ClientProc);
  FDefProc := pointer(SetWindowLong(ClientHandle,GWL_WNDPROC,Longint(proc)));
  FirstLoad:=true;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
If FirstLoad then
   begin
   FormLogin.ShowModal;
   FirstLoad:=false;
   end;
end;

procedure TForm1.Logout1Click(Sender: TObject);
var i:integer;
begin
for I := MDIChildCount-1 downto 0 do MDIChildren[I].Close;
FormLogin.ShowModal;
end;

end.

This entry was posted on Saturday, June 3rd, 2006 at 12:58 am and is filed under Programming. You can follow any responses to this entry through the RSS 2.0 feed. You can skip to the end and leave a response. Pinging is currently not allowed.