(***********************************************)
(*                                             *)
(* MDI Dib Viewer                              *)
(* Copyright (c) 2000 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(*                                             *)
(* Targets:                                    *)
(*   WIN32 GUI application                     *)
(*                                             *)
(***********************************************)

program MDIDib;

{$ifndef __WIN32__}
{$define INVALID_TARGET}
{$endif}
{$ifndef __GUI__}
{$define INVALID_TARGET}
{$endif}
{$ifdef INVALID_TARGET}
  This program must be compiled as Win32 GUI application only
{$endif}

uses Windows, Messages, CommCtrl, CommDlg, Strings, ShellAPI, AfxCDib;

{$r mdidib.res}

const
  ABOUT_BOX           = 100;
  IDM_OPEN            = 200;
  IDM_EXIT            = 270;
  IDM_WINDOWTILEH     = 410;
  IDM_WINDOWTILEV     = 411;
  IDM_WINDOWCASCADE   = 420;
  IDM_WINDOWICONS     = 430;
  IDM_WINDOWCLOSE     = 440;
  IDM_WINDOWCLOSEALL  = 450;
  IDM_ABOUT           = 500;
  IDM_MAINMENU        = 600;
  IDM_HOMEPAGE        = 700;
  IDI_CHILDICON       = 800;
  IDS_SYSMENU         = 2030;
  IDM_STATUSBAR       = 3000;
  IDM_WINDOWCHILD     = 3010;
  IDACCEL             = 10000;

var
  hwndMain: HWND;
  hwndMDIClient: HWND;
  cUntitled: Longint;

var
  Rect: TREct;
  wRect, cRect: TRect;
  UpdateFlag: Boolean := TRUE;

function MainWndProc conv arg_stdcall (Window: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): Longint; Forward;
function MdiChildWndProc conv arg_stdcall (Window: HWND; Mess: UINT; WP: WPARAM; LP: LPARAM): Longint; Forward;

var
  hWndStatusbar: HWND;

procedure UpdateStatusBar(lpszStatusString: LPSTR; partNumber, displayFlags: WORD);
begin
  SendMessage(hWndStatusbar,
              SB_SETTEXT,
              partNumber or displayFlags,
              LPARAM(lpszStatusString));
end;


function MsgMenuSelect(hwnd: HWND; uMessage: UINT; wparam: WPARAM; lparam: LPARAM): Longint;
var
  szBuffer: array [0..255] of Char;
  nStringID: UINT := 0;
  fuFlags:   UINT := HIWORD(wparam) and $FFFF;
  uCmd:      UINT := LOWORD(wparam);
  hMenu:    HMENU := HMENU(lparam);
begin
  szBuffer[0] := #0;
  if (fuFlags = $FFFF) and (hMenu = 0) then
    nStringID := 0

  else if (fuFlags and MFT_SEPARATOR) <> 0 then
    nStringID := 0

  else if (fuFlags and MF_POPUP) <> 0 then
  begin
    if (fuFlags and MF_SYSMENU) <> 0 then
      nStringID := IDS_SYSMENU
    else
      nStringID := 0;
  end else
      nStringID := uCmd;

  if nStringID <> 0 then
      LoadString(hInstance, nStringID, szBuffer, SizeOf(szBuffer));

  UpdateStatusBar(szBuffer, 0, 0);
  Result := 0;
end;

procedure InitializeStatusBar(hwndParent: HWND; nrOfParts: Longint);
const
  cSpaceInBetween = 8;
var
  ptArray: array [0..39] of Longint;
  rect: TRect;
  hDC: HDC;
begin
  hDC := GetDC(hwndParent);
  GetClientRect(hwndParent, rect);

  ptArray[nrOfParts - 1] := rect.right;

  ReleaseDC(hwndParent, hDC);
  SendMessage(hWndStatusbar,
              SB_SETPARTS,
              nrOfParts,
              LPARAM(@ptArray));

  UpdateStatusBar('Ready', 0, 0);
end;

function CreateSBar(hwndParent: HWND; initialText: PChar; nrOfParts: Longint): Boolean;
begin
  hWndStatusbar := CreateStatusWindow(WS_CHILD or WS_VISIBLE or WS_BORDER or SBARS_SIZEGRIP,
                                      initialText,
                                      hwndParent,
                                      IDM_STATUSBAR);
  if hWndStatusbar <> 0 then
  begin
    InitializeStatusBar(hwndParent, nrOfParts);
    Result := TRUE;
  end else
    Result := FALSE;
end;

function InitApplication: Boolean;
var
  wc: TWndClass;
begin
  FillChar(wc, SizeOf(wc), 0);
  wc.style         := CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS ;
  wc.lpfnWndProc   := @MainWndProc;
  wc.hInstance     := hInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.lpszClassName := 'MDIDibWndClass';
  wc.lpszMenuName  := MAKEINTRESOURCE(IDM_MAINMENU);
  wc.hCursor       := LoadCursor(0, IDC_ARROW);
  wc.hIcon         := LoadIcon(hInstance, MAKEINTRESOURCE(101));
  if RegisterClass(wc) = 0 then
  begin
    Result := FALSE;
    exit;
  end;
  wc.style         := 0;
  wc.lpfnWndProc   := @MdiChildWndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 20;
  wc.hInstance     := hInstance;                  // Owner of this class
  wc.hIcon         := LoadIcon(hInstance, MAKEINTRESOURCE(102));
  wc.hCursor       := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := COLOR_WINDOW + 1;           // Default color
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := 'MdiChildWndClass';
  if RegisterClass(wc) = 0 then
  begin
    Result := FALSE;
    exit;
  end;
  Result := TRUE;
end;

function CreatetestWndClassWnd: HWND;
begin
  Result := CreateWindow('MDIDibWndClass', 'MDIDib',
          WS_MINIMIZEBOX or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_MAXIMIZEBOX or WS_CAPTION or WS_BORDER or WS_SYSMENU or WS_THICKFRAME,
          CW_USEDEFAULT, 0, CW_USEDEFAULT, 0,
          0,
          0,
          hInstance,
          NIL);
end;

function MDICmdFileNew(Title: String): HWND;
var
  hwndChild: HWND;
  rgch: array [0..149] of Char;
  mcs: TMDICreateStruct;
  myDib: CDib;
  DibFile: array[0..MAX_PATH] of Char;
begin
  if Title = '' then
  begin
    StrPCopy(rgch, 'Untitled' + IntToStr(cUntitled));
    cUntitled +:= 1;
  end else
    StrPCopy(rgch, Title);

  myDib.Create(Title);

  mcs.szClass := 'MdiChildWndClass';
  mcs.szTitle := rgch;
  mcs.hOwner  := hInstance;
  mcs.x       := CW_USEDEFAULT;
  mcs.y       := CW_USEDEFAULT;
  mcs.cx      := myDib.GetDibWidth + (Rect.Right - Rect.Left) - (cRect.Right - cRect.Left);
  mcs.cy      := myDib.GetDibHeight + (Rect.Bottom - Rect.Top) - (cRect.Bottom - cRect.Top);
  mcs.style   := 0;
  mcs.lParam  := 0;

  hwndChild := SendMessage(hwndMDIClient, WM_MDICREATE, 0, LPARAM(@mcs));

  if hwndChild <> 0 then
    ShowWindow(hwndChild, SW_SHOW);
  Result := hwndChild;
  myDib.Free;
end;

function OpenFile: String;
const
  FILTER = 'BitMap files (*.bmp)'+ #0 + '*.bmp' + #0 +
           'Dib files (*.dib)'+ #0 + '*.dib' + #0 +
           'All files (*.*)' + #0 + '*.*' + #0 + #0#0;
var
  OFN: TOpenFileName;
  FileName: array [0..MAX_PATH] of char;
begin
  FillChar(OFN, SizeOf(OFN), 0);
  OFN.lStructSize := SizeOf(OFN);
  StrPCopy(FileName, '*.bmp');
  OFN.lpstrFilter := Filter;
  OFN.lpstrFile := FileName;
  OFN.HInstance := hInstance;
  OFN.nMaxFile  := MAX_PATH;
  if GetOpenFileName(OFN) then
    Result := StrPas(FileName)
  else
    Result := '';
end;

procedure UpdateDib(Window: DWORD);
var
  DC, Brush: hDC;
  DX, DY: DWORD;
  myDib: CDib;
  DibFile: array[0..MAX_PATH] of Char;
begin
  SendMessage(Window, WM_GETTEXT, MAX_PATH, DWORD(@DibFile));
  myDib.Create(DibFile);
  DC := GetDC(Window);
  GetClientRect(Window, cRect);
  if myDib.Exists then
  begin
    DX := cRect.Right - cRect.Left;
    DY := cRect.Bottom - cRect.Top;
    StretchDIBits(DC, 0, 0, DX, DY, 0, 0, myDib.GetDibWidth, myDib.GetDibHeight,
                  myDib.GetDibBitsPtr, myDib.GetDibInfoPtr^, DIB_RGB_COLORS, SRCCOPY);
  end else
  begin
    Brush := CreateSolidBrush(0);
    SelectObject(DC, Brush);
    FillRect(DC, cRect, 0);
    DeleteObject(Brush);
  end;
  GetWindowRect(Window, Rect);
  ReleaseDC(DC, Window);
  myDib.Free;
end;

function AboutDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
const
  MEM_AVAIL_CAPTION = 1000;
  MEM_INUSE_CAPTION = 1001;
var
  Txt: String;
  MS: TMemoryStatus;
begin
  Result := 0;
  case Mess of
    WM_INITDIALOG:
      begin
        GlobalMemoryStatus(MS);
        Txt := IntToStr(MS.dwTotalPhys div 1024) + ' KB' + #0;
        SendDlgItemMessage(Dialog, MEM_AVAIL_CAPTION, WM_SETTEXT, 0, DWORD(@Txt[1]));
        Txt := IntToStr(MS.dwMemoryLoad) + ' %' + #0;
        SendDlgItemMessage(Dialog, MEM_INUSE_CAPTION, WM_SETTEXT, 0, DWORD(@Txt[1]));
      end;

    WM_CLOSE:
      EndDialog(Dialog, 0);

    WM_COMMAND:
      begin
        if LoWord(WParam) = IDOK then
          SendMessage(Dialog, WM_CLOSE, 0, 0);
      end;
  end;
end;

procedure MainWndProc_OnCommand(wnd: HWND; id: Longint; hwndCtl: HWND; codeNotify: UINT);
var
  ChildWnd: HWND;
  Name: String;
begin
  case(id) of
    IDM_OPEN:
      begin
        Name := OpenFile;
        if Name <> '' then
        begin
          ChildWnd := MDICmdFileNew(Name);
          UpdateDib(ChildWnd);
        end;
      end;

      IDM_WINDOWTILEH:
        SendMessage(hwndMDIClient, WM_MDITILE, MDITILE_HORIZONTAL, 0);

      IDM_WINDOWTILEV:
        SendMessage(hwndMDIClient, WM_MDITILE, MDITILE_VERTICAL, 0);

      IDM_WINDOWCASCADE:
        SendMessage(hwndMDIClient, WM_MDICASCADE, 0, 0);

      IDM_WINDOWICONS:
        SendMessage(hwndMDIClient, WM_MDIICONARRANGE, 0, 0);

      IDM_WINDOWCLOSE:
      begin
        ChildWnd := SendMessage(hwndMDIClient, WM_MDIGETACTIVE, 0, 0);
        if ChildWnd <> 0 then
          SendMessage(ChildWnd, WM_CLOSE, 0, 0)
      end;

      IDM_WINDOWCLOSEALL:
      begin
        repeat
          ChildWnd := SendMessage(hwndMDIClient, WM_MDIGETACTIVE, 0, 0);
          if ChildWnd <> 0 then
            SendMessage(ChildWnd, WM_CLOSE, 0, 0)
          else
            Break;
        until FALSE;
      end;

      IDM_EXIT:
        PostMessage(wnd, WM_CLOSE, 0, 0);

      IDM_ABOUT:
        DialogBoxParam(hInstance, MAKEINTRESOURCE(ABOUT_BOX), wnd, @AboutDlgProc, 0);

      IDM_HOMEPAGE:
        ShellExecute(wnd, 'open', 'http://www.tmt.com', nil, nil, SW_SHOWDEFAULT);
  end;
end;

function CreateMdiClient(hwndparent: HWND): HWND;
var
  ccs: TClientCreateStruct;
  hwndMDIClient: HWND;
  icount: Longint := GetMenuItemCount(GetMenu(hwndparent));
begin
  FillChar(ccs, SizeOf(ccs), 0);
  ccs.hWindowMenu  := GetSubMenu(GetMenu(hwndparent), icount - 2);
  ccs.idFirstChild := IDM_WINDOWCHILD;
  hwndMDIClient := CreateWindow('mdiclient',
                                '',
                                WS_CHILD or WS_CLIPCHILDREN or WS_VSCROLL or
                                WS_HSCROLL,
                                0, 0, 0, 0,
                                hwndparent,
                                $0CAC,
                                hInstance,
                                @ccs);

  ShowWindow(hwndMDIClient, SW_SHOW);
  Result := hwndMDIClient;
end;

function MdiChildWndProc conv arg_stdcall (Window: HWND; Mess: UINT; WP: WPARAM; LP: LPARAM): Longint;
begin
  if Mess = WM_ERASEBKGND then
  begin
    if UpdateFlag then UpdateDib(Window);
    UpdateFlag := TRUE;
    Result := 1;
  end else
    Result :=DefMDIChildProc(Window, Mess, Wp, Lp);
end;

function MainWndProc conv arg_stdcall (Window: HWND; msg: UINT; wparam: WPARAM; lparam: LPARAM): Longint;
begin
  case msg of
   WM_CREATE:
     hwndMDIClient := CreateMdiClient(Window);

   WM_SIZE:
     begin
       SendMessage(hWndStatusbar, msg, wParam, lParam);
       InitializeStatusBar(hWndStatusbar, 1);
       if wParam <> SIZE_MINIMIZED then
       declare
       var
         rc, rcClient: TRect;
         pc: TPoint;
       begin
         GetClientRect(Window, rcClient);
         GetWindowRect(hWndStatusbar, rc);
         pc.x := rc.left;
         pc.y := rc.top;
         ScreenToClient(Window, pc);
         rc.left := pc.x;
         rc.top  := pc.y;
         rcClient.bottom := rc.top;
         MoveWindow(hwndMDIClient, rcClient.left, rcClient.top, rcClient. right - rcClient.left, rcClient.bottom - rcClient.top, TRUE);
       end;
       Result := 0;
       exit;
     end;

   WM_MENUSELECT:
     begin
       Result := MsgMenuSelect(Window,msg,wParam,lParam);
       exit;
     end;

   WM_COMMAND:
     MainWndProc_OnCommand(Window, LOWORD(wParam), lParam, HIWORD(wParam));

   WM_DESTROY:
     PostQuitMessage(0);
  end;

 Result := DefFrameProc(Window, hwndMDIClient, msg, wParam, lParam);
end;

var
  msg: TMsg;
  hAccelTable: THandle;
begin
  if not InitApplication then exit;
  hAccelTable := LoadAccelerators(hInstance, MAKEINTRESOURCE(IDACCEL));
  hwndMain := CreatetestWndClassWnd;
  if hwndMain = 0 then exit;
  CreateSBar(hwndMain, 'Ready', 1);
  ShowWindow(hwndMain, SW_SHOW);
  while GetMessage(Msg,0,0,0) do
  begin
    if not TranslateMDISysAccel(hwndMDIClient, msg) then
      if TranslateAccelerator(msg.hwnd, hAccelTable, msg) = 0 then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
  end;
end.