(***********************************************)
(*                                             *)
(* Show Dib Demo                               *)
(* Copyright (c) 1999 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(*                                             *)
(* Targets:                                    *)
(*   WIN32 GUI application                     *)
(*                                             *)
(***********************************************)

program ShowDib;

{$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, CommCtrl, CommDlg, MMSystem, Messages, Strings, AfxCDib, AfxRes;

{$r showdib.res}

var
  myDib: CDib;
  Rect: TREct;
  wRect, cRect: TRect;
  DibFile: String;
  UpdateFlag: Boolean := TRUE;

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;

function OpenFile: Boolean;
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, DibFile);
  OFN.lpstrFilter := Filter;
  OFN.lpstrFile := FileName;
  OFN.HInstance := hInstance;
  OFN.nMaxFile  := MAX_PATH;
  Result := GetOpenFileName(OFN);
  DibFile := StrPas(FileName);
end;

procedure ScaleWindow(Window: HWND);
var
 AddX, AddY: Longint;
begin
  UpdateFlag := FALSE;
  AddX := (Rect.Right - Rect.Left) - (cRect.Right - cRect.Left);
  AddY := (Rect.Bottom - Rect.Top) - (cRect.Bottom - cRect.Top);
  SetWindowPos(Window, HWND_TOP, Rect.Left, Rect.Top,
     myDib.GetDibWidth + AddX, myDib.GetDibHeight + AddY, SWP_SHOWWINDOW);
end;

procedure UpdateDib(Window: HWND);
var
  DC, Brush: hDC;
  DX, DY: DWORD;
begin
  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);
end;

function MyWndProc conv arg_stdcall (Window: HWND; Mess: UINT; Wp: WParam; Lp: LParam): LRESULT;
begin
  case Mess of
    WM_ERASEBKGND:
      begin
        if UpdateFlag then UpdateDib(Window);
        UpdateFlag := TRUE;
        Result := 1;
      end;

    WM_COMMAND:
      begin
        case WP of
          ID_APP_ABOUT:
            DialogBoxParam(hInstance, MAKEINTRESOURCE(101), Window, @AboutDlgProc, 0);

          ID_FILE_OPEN:
            begin
              if OpenFile then
              begin
                myDib.Free;
                myDib.Create(DibFile);
                ScaleWindow(Window);
                UpdateDib(Window);
              end;
            end;

          ID_APP_EXIT:
            SendMessage(Window, WM_CLOSE, 0, 0);
        end;
        Result := 0;
      end;

    WM_DESTROY:
      begin
        PostQuitMessage(0);
        Result := 0;
      end;
  else
    Result := DefWindowProc(Window, Mess, Wp, Lp);
  end;
end;

var
  wc :  TWndClass;
  wnd:  HWnd;
  Msg:  TMsg;
  Menu: HMenu;
begin
  DibFile := '*.bmp';
  Menu := LoadMenu(hInstance, MAKEINTRESOURCE(101));
  FillChar(wc, SizeOf(wc), 0);
  with wc do begin
    style:=CS_HREDRAW + CS_VREDRAW;
    lpfnWndProc := @MyWndProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := System.hInstance;
    hIcon := LoadIcon(System.hInstance, MAKEINTRESOURCE(101));
    hCursor := LoadCursor(THandle(NIL), IDC_ARROW);
    hbrBackGround := COLOR_WINDOW+1;
    lpszMenuName := nil;
    lpszClassName := 'ShowDib';
  end;
  if RegisterClass(wc) = 0 then
  begin
    Exit;
  end;

  wnd := CreateWindow(wc.lpszClassName, 'Show Dib Demo', WS_OVERLAPPEDWINDOW,
     CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, 0, Menu, HInstance, nil);

  ShowWindow(wnd, SW_SHOW);
  if ParamCount > 0 then
  begin
    myDib.Create(ParamStr(1));
    ScaleWindow(wnd);
    UpdateDib(wnd);
  end;

  while GetMessage(Msg,0,0,0) do

  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

  myDib.Free;
end.