{
   This example can be compiled with either the
   "standard" windows look or the "Borland look".
   By default, it uses "standard" windows controls.
   To cause it to use Borland Windows Custom Controls,
   select Options.Compiler and enter BWCC in the
   Conditional defines field.

   Copyright (c) 1991 by Borland International
}


{$ifdef BWCC}
program RWPDemo;
{$else}
program RWPDemoB;
{$endif}

{$ifdef BWCC}
{$R RWPDEMOB.RES}
{$else}
{$R RWPDEMO.RES}
{$endif}
{$D 'Resource Workshop Demo Program. Copyright (c) Borland 1991'}

{$ifdef BWCC}
uses WObjectB, WinTypes, WinProcs, Strings, RWPDemoC, RWPDlgs, RWPWnd, WinDOS, bwcc;
{$else}
uses WObjects, WinTypes, WinProcs, Strings, RWPDemoC, RWPDlgs, RWPWnd, WinDOS;
{$endif}

const
  AppName = 'RWPDEMO';

const
  wm_DrawStatusLine: Word =   0;
  StatusLineHeight        =  20;

const
  TextStart               = 200; { Location for hints in status line }

const
  EditFirst               = cm_Undo;
  EnvironmentFirst        = cm_Preferences;
  FileFirst               = cm_New;
  Helpfirst               = cm_Index;
  OptionFirst             = cm_Directories;
  ViewFirst               = cm_All;
  WindowFirst             = cm_Tile;

{ Private Profile Identifiers}
const
  AppProfileName          = AppName + '.INI';
  AutoSaveDesktopKey      = 'AutoSave Desktop';
  AutoSaveEditorKey       = 'AutoSave Editor';
  AutoSaveEnvironmentKey  = 'AutoSave Environment';
  GraphicDirectoryKey     = 'Graphic Directory';
  ScribbleDirectoryKey    = 'Scribble Directory';
  TextDirectoryKey        = 'Text Directory';


type
  PRWPApplication = ^RWPApplication;
  RWPApplication = object(TApplication)
    AutoSaveEditor,
    AutoSaveDesktop,
    AutoSaveEnvironment: Boolean;
    GraphicDirectory: array[0..128] of Char;
    ScribbleDirectory: array[0..128] of Char;
    TextDirectory: array[0..128] of Char;
    constructor Init(AName: PChar);
    destructor Done; virtual;
    procedure InitMainWindow; virtual;
    procedure ReadProfileInfo;
    procedure WriteProfileInfo;
  end;

type
  PRWPWindow = ^TRWPWindow;
  TRWPWindow = object(TMDIWindow)
    BmpStatusBar: HBitmap;
    BmpStatusLine: HBitmap;
    CurrentID: Integer;
    CurrentPopup: HMenu;
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure AboutRWP(var Msg: TMessage); virtual cm_First + cm_About_RWP;
    procedure BlastStatusLine(PaintDC: HDC);
    procedure DefCommandProc(var Msg: TMessage); virtual;
    procedure DefWndProc(var Msg: TMessage); virtual;
    procedure Destroy; virtual;
    procedure FileNew(var Msg: TMessage); virtual cm_First + cm_New;
    procedure FileOpen(var Msg: TMessage); virtual cm_First + cm_Open;
    procedure FilePrint(var Msg: TMessage); virtual cm_First + cm_Print;
    procedure FileQuit(var Msg: TMessage); virtual cm_First + cm_Exit;
    function  GetClassName: PChar; virtual;
    procedure GetWindowClass(var WndClass: TWndClass); virtual;
    procedure OpenAFile(FileType: Integer; FileName: PChar);
    procedure OptionsDirectories(var Msg: TMessage); virtual cm_First+cm_Directories;
    procedure OptionsMouse(var Msg: TMessage); virtual cm_First+cm_Mouse;
    procedure OptionsOpen(var Msg: TMessage); virtual cm_First+cm_Options_Open;
    procedure OptionsPreferences(var Msg: TMessage); virtual cm_First+cm_Preferences;
    procedure OptionsSave(var Msg: TMessage); virtual cm_First+cm_Options_Save;
    procedure OptionsSaveAs(var Msg: TMessage); virtual cm_First+cm_Options_Saveas;
    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
    procedure RunDialog(ADialog: PRWPDialog; ACaption: PChar);
    procedure WindowArrangeIcons(var Msg: TMessage); virtual cm_First + cm_ArrangeIcons;
    procedure WindowCascade(var Msg: TMessage); virtual cm_First + cm_Cascade;
    procedure WindowCloseAll(var Msg: TMessage); virtual cm_First + cm_CloseAll;
    procedure WindowTile(var Msg: TMessage); virtual cm_First + cm_Tile;
    procedure WMDrawStatusLine(var Msg: TMessage);
    procedure WMMenuSelect(var Msg: TMessage); virtual wm_First + wm_MenuSelect;
    procedure WMEnterIdle(var Msg: TMessage); virtual wm_First + wm_EnterIdle;
    procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  end;

{------------------------- TRWPApplication implementation ---------------}

constructor RWPApplication.Init(AName: PChar);
begin
  TApplication.Init(AName);
  HAccTable := LoadAccelerators(HInstance, MakeIntResource(Acc_Main));
  wm_DrawStatusLine := RegisterWindowMessage('RWPDrawStatusLine');
  ReadProfileInfo;
end;

destructor RWPApplication.Done;
begin
  if WordBool(AutoSaveEnvironment) then WriteProfileInfo;
  TApplication.Done;
end;


procedure RWPApplication.WriteProfileInfo;

  procedure WritePrivateProfileBool(ApplicationName, KeyName: PChar;
    Value: Boolean; FileName: PChar);
  const
    Tmp: array[False..True] of PChar = ('0','1');
  begin
    WritePrivateProfileString(ApplicationName, KeyName, Tmp[Value], FileName);
  end;

begin
  WritePrivateProfileBool(AppName, AutoSaveEditorKey, AutoSaveEditor,
    AppProfileName);
  WritePrivateProfileBool(AppName, AutoSaveDesktopKey, AutoSaveDesktop,
    AppProfileName);
  WritePrivateProfileBool(AppName, AutoSaveEnvironmentKey,
    AutoSaveEnvironment, AppProfileName);
  WritePrivateProfileString(AppName, TextDirectoryKey, TextDirectory,
    AppProfileName);
  WritePrivateProfileString(AppName, GraphicDirectoryKey, GraphicDirectory,
    AppProfileName);
  WritePrivateProfileString(AppName, ScribbleDirectoryKey, ScribbleDirectory,
    AppProfileName);
end;

procedure RWPApplication.ReadProfileInfo;
begin
  AutoSaveEditor := Boolean(GetPrivateProfileInt(AppName, AutoSaveEditorKey,
    0, AppProfileName));
  AutoSaveDeskTop := Boolean(GetPrivateProfileInt(AppName, AutoSaveDesktopKey,
    0, AppProfileName));
  AutoSaveEnvironment := Boolean(GetPrivateProfileInt(AppName,
    AutoSaveEnvironmentKey, 0, AppProfileName));
  GetPrivateProfileString(AppName, TextDirectoryKey, '', TextDirectory,
    sizeof(TextDirectory), AppProfileName);
  GetPrivateProfileString(AppName, GraphicDirectoryKey, '', GraphicDirectory,
    sizeof(GraphicDirectory), AppProfileName);
  GetPrivateProfileString(AppName, ScribbleDirectoryKey, '', ScribbleDirectory,
    sizeof(ScribbleDirectory), AppProfileName);
end;

procedure RWPApplication.InitMainWindow;
begin
  MainWindow := New(PRWPWindow, Init(nil, 'Resource Workshop Demo Program'));
end;

{--------------------------- TRWPWindow implementation ------------------}

constructor TRWPWindow.Init(AParent:PWIndowsObject; ATitle:PChar);
begin
  TMDIWindow.Init('RWP Application', LoadMenu(HInstance,
    MakeIntResource(men_Main)));
  BmpStatusBar := LoadBitmap(HInstance, MakeIntResource(bmp_StatusBar));
  BmpStatusLine := 0;
end;

procedure TRWPWindow.AboutRWP(var Msg:TMessage);
begin
  Application^.ExecDialog(New(PRWPDialog, Init(@Self, MakeIntResource(dlg_About))));
end;

procedure TRWPWindow.BlastStatusLine(PaintDC: HDC);
var
  ClientRect: TRect;
  MemDC: HDC;
  OldBmp: THandle;
begin
  GetClientRect(HWindow, ClientRect);
  MemDC := CreateCompatibleDC(PaintDC);
  OldBmp := SelectObject(MemDC, BmpStatusLine);
  with ClientRect do
  begin
    BitBlt(PaintDC, 0, Bottom - StatusLineHeight, ClientRect.Right,
      StatusLineHeight, MemDC, 0, 0, SrcCopy);
    SelectObject(MemDC, BmpStatusBar);
    BitBlt(PaintDC, 40, Bottom - StatusLineHeight, 10, StatusLineHeight,
      MemDC, 0, 0, SrcCopy);
    BitBlt(PaintDC, 100, Bottom - StatusLineHeight, 10, StatusLineHeight,
      MemDC, 0, 0, SrcCopy);
    BitBlt(PaintDC, TextStart, Bottom - StatusLineHeight, 10, StatusLineHeight,
      MemDC, 0, 0, SrcCopy);
  end;
  SelectObject(MemDC, OldBmp);
  DeleteDC(MemDC);
end;

procedure TRWPWindow.DefCommandProc(var Msg: TMessage);
var
  DC: HDC;
begin
  TMDIWindow.DefCommandProc(Msg);
  if CurrentPopup <> 0 then
  begin
    CurrentPopup := 0;
    CurrentID := 0;
    DC := GetDC(HWindow);
    BlastStatusLine(DC);
    ReleaseDC(HWindow, DC);
  end;
end;

procedure TRWPWindow.DefWndProc(var Msg: TMessage);
begin
  TMDIWindow.DefWndProc(Msg);
  if Msg.Message = wm_DrawStatusLine then WMDrawStatusLine(Msg);
end;

procedure TRWPWindow.Destroy;
begin
  DeleteObject(BmpStatusLine);
  DeleteObject(BmpStatusBar);
  TMDIWindow.Destroy;
end;

procedure TRWPWindow.FileNew(var Msg:TMessage);
var
  FileName: array[0..128] of Char;
  FileType: Integer;
begin
  if Application^.ExecDialog(New(PFileNew,
    Init(@Self, FileType))) = id_OK then OpenAFile(FileType, 'Noname')
end;

procedure TRWPWindow.FileOpen(var Msg:TMessage);
var
  FileName: array[0..128] of Char;
  FileType: Integer;
begin
  if Application^.ExecDialog(New(PFileOpen,
    Init(@Self, FileType, FileName, FileName))) = id_OK then
    OpenAFile(FileType,FileName)
end;

procedure TRWPWindow.FilePrint(var Msg:TMessage);
begin
  if Application^.ExecDialog(New(PRWPDialog,
    Init(@Self,MakeIntResource(dlg_Print)))) = id_OK then
{$ifdef BWCC}
    BWCCMessageBox(HWindow,'Feature not implemented','Print',mb_OK or mb_IconHand);
{$else}
    MessageBox(HWindow,'Feature not implemented','Print',mb_OK or mb_IconHand);
{$endif}
end;

procedure TRWPWindow.FileQuit(var Msg: TMessage);
begin
  CloseWindow;
end;

function TRWPWindow.GetClassName: PChar;
begin
  GetClassName := 'RWPWindow';
end;

procedure TRWPWindow.GetWindowClass(var WndClass: TWndClass);
begin
  TMDIWindow.GetWindowClass(WndClass);
  WndClass.HIcon := LoadIcon(HInstance, MakeIntResource(ico_RWPDemo));
  WndClass.HBrBackground := color_AppWorkspace + 1;
end;

procedure TRWPWindow.OpenAFile(FileType: Integer; FileName: PChar);
begin
  with PRWPApplication(Application)^ do
    case FileType of
      ScribbleWindow:
        MakeWindow(new(PScribbleWindow, Init(@Self, FileName)));
      FileWindow:
        MakeWindow(new(PEditWindow, Init(@Self, FileName)));
      GraphWindow:
        MakeWindow(new(PGraphWindow, Init(@Self, FileName)));
    end;
end;

procedure TRWPWindow.OptionsDirectories(var Msg:TMessage);
begin
  RunDialog(new(PDlgDirectories,
    Init(@Self, MakeIntResource(dlg_Options_Directories))), 'Directories');
end;

procedure TRWPWindow.OptionsMouse(var Msg:TMessage);
begin
  RunDialog(new(PRWPDialog,
    Init(@Self, MakeIntResource(dlg_MouseDialog))), 'Mouse');
end;

procedure TRWPWindow.OptionsOpen(var Msg:TMessage);
begin
{
  RunDialog(new(PRWPDialog,
    Init(@Self, MakeIntResource(dlg_Options_Open))), 'Options Open');
}
end;

procedure TRWPWindow.OptionsPreferences(var Msg:TMessage);
begin
  RunDialog(new(PRWPDialog,
    Init(@Self, MakeIntResource(dlg_Preferences))), 'Preferences');
end;

procedure TRWPWindow.OptionsSave(Var Msg: TMessage);
begin
  PRWPApplication(Application)^.WriteProfileInfo;
end;

procedure TRWPWindow.OptionsSaveAs(var Msg:TMessage);
begin
{
  RunDialog(new(PRWPDialog,
    Init(@Self,MakeIntResource(dlg_Options_SaveAs))), 'Options SaveAs');
}
end;

procedure TRWPWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
begin
  TMDIWindow.Paint(PaintDC, PaintInfo);
  BlastStatusLine(PaintDC);
end;

procedure TRWPWindow.RunDialog(ADialog: PRWPDialog; ACaption: PChar);
begin
  if Application^.ExecDialog(ADialog) = id_Ok then
    MessageBox(HWindow, 'Feature not implemented', ACaption, mb_OK);
end;

procedure TRWPWindow.WindowArrangeIcons(var Msg: TMessage);
begin
  ArrangeIcons;
end;

procedure TRWPWindow.WindowCascade(var Msg: TMessage);
begin
  CascadeChildren;
end;

procedure TRWPWindow.WindowCloseAll(var Msg: TMessage);
begin
  CloseChildren;
end;

procedure TRWPWindow.WindowTile(var Msg: TMessage);
begin
  TileChildren;
end;

procedure TRWPWindow.WMDrawStatusLine(var Msg: TMessage);
var
  DC: HDC;
  Rect: TRect;
  Str: array[0..128] of Char;
  StrID: Integer;
  Lf: TLogFont;
  hSmall, hOld: HFont;
  TextHeight: Integer;
begin
  if CurrentID <> 0 then
  begin
    case CurrentID of
      cm_New: StrID := sth_FileNew;
      cm_Open: StrID := sth_FileOpen;
      cm_Save: StrID := sth_FileSave;
      cm_SaveAs: StrID := sth_FileSaveAs;
      cm_Print: StrID := sth_FilePrint;
      cm_Exit: StrID := sth_FileExit;
      cm_Undo: StrID := sth_EditUndo;
      cm_Cut: StrID := sth_EditCut;
      cm_Copy: StrID := sth_EditCopy;
      cm_Paste: StrID := sth_EditPaste;
      cm_Delete: StrID := sth_EditDelete;
      cm_Clear: StrID := sth_EditClear;
      cm_Options_Open: StrID := sth_OptionsOpen;
      cm_all: StrID := sth_ViewAll;
      cm_By: StrID := sth_ViewBy;
      cm_Some: StrID := sth_ViewSome;
      cm_Directories: StrID := sth_OptionsDirectory;
      cm_Options_Save: StrID := sth_OptionsSave;
      cm_Options_SaveAs: StrID := sth_OptionsSaveAs;
      cm_Preferences: StrID := sth_EnvironmentPreferences;
      cm_Mouse: StrID := sth_EnvironmentMouse;
      cm_Tile: StrID := sth_WindowTile;
      cm_Cascade: StrID := sth_WindowCascade;
      cm_ArrangeIcons: StrID := sth_WindowArrange;
      cm_CloseAll: StrID := sth_WindowCloseAll;
      cm_Index: StrID := sth_HelpIndex;
      cm_Topic_Search: StrID := sth_HelpTopic;
      cm_Glossary: StrID := sth_HelpGlossary;
      cm_Using_Help: StrID := sth_HelpUsing;
      cm_About_RWP: StrID := sth_HelpAbout;
      else
        Exit;
    end
  end
  else
  if CurrentPopup <> 0 then
  begin
    case GetMenuItemID(CurrentPopup, 0) of
      FileFirst: StrID := sth_File;
      EditFirst: StrID := sth_Edit;
      ViewFirst: StrID := sth_View;
      WindowFirst: StrID := sth_Window;
      OptionFirst: StrID := sth_Option;
      EnvironmentFirst: StrID := sth_OptionsEnvironment;
      HelpFirst: StrID := sth_Help;
      else
        Exit;
    end;
  end;

  DC := GetDC(HWindow);
  BlastStatusLine(DC);
  if (CurrentPopup <> 0) or (CurrentID <> 0) then
  begin
    { get a slightly smaller font }

    hOld := GetStockObject( ANSI_VAR_FONT);
    if ( hOld <> 0) then
    begin
      GetObject( hOld, sizeof( TLogFont), @lf );
      if ( lf.lfHeight > 3) then
	lf.lfHeight := lf.lfHeight - 3;
      lf.lfWidth := 0;
      hSmall := CreateFontIndirect(lf);
    end
    else
      hSmall := 0;
    if ( hSmall <> 0) then
      hOld := SelectObject( DC, hSmall)
    else
      hOld := 0;
    LoadString(HInstance, StrID, Str, Sizeof(Str));
    GetClientRect(HWindow, Rect);
    SetBKColor(DC, RGB(192, 192, 192));
    TextHeight :=  HiWord( GetTextExtent( DC, Str, 1) );
    TextOut(DC, TextStart+10,
      Rect.bottom - StatusLineHeight + ( ( StatusLineHeight - TextHeight ) div 2),
      Str, strlen(Str));
  end;
  ReleaseDC(HWindow, DC);
end;

procedure TRWPWindow.WMMenuSelect(var Msg: TMessage);
var
  CurrentMenu: HWnd;
  Str: array[0..20] of Char;
begin
  if Msg.LParamLo = $FFFF then
  begin
    CurrentPopup := 0;
    CurrentID := 0;
  end
  else
  if (Msg.LParamLo and mf_Popup) <> 0 then
  begin
   CurrentPopup := Msg.WParam;
    CurrentID := 0;
  end
  else
    CurrentID := Msg.WParam;
  PostMessage(HWindow,wm_DrawStatusLine, 0, 0);
end;

procedure TRWPWindow.WMEnterIdle(var Msg: TMessage);
begin
 if ( Msg.WParam = Msgf_DialogBox) and ( ( GetKeyState( Vk_F1) and $8000) <> 0) then
 begin
{$ifdef BWCC}
   SendMessage( Msg.LParamLo, wm_Command, IdHelp, 0);
{$else}
   SendMessage( Msg.LParamLo, wm_Command, Id_Help, 0);
{$endif}
 end

end;

procedure TRWPWindow.WMSize(var Msg: TMessage);
var
  Bmp: HBitmap;
  DC: HDC;
  DestDC: HDC;
  OldSrc: HBitmap;
  OldDest: HBitmap;
  Rect: TRect;
  SrcDC: HDC;
begin
  TMDIWindow.WMSize(Msg);
  GetClientRect(HWindow, Rect);
  MoveWindow(ClientWnd^.HWindow, 0, 0, Rect.Right,
    Rect.Bottom - StatusLineHeight,True);
  InvalidateRect(HWindow, nil, True);
  DC := GetDC(HWindow);
  SrcDC := CreateCompatibleDC(DC);
  DestDC := CreateCompatibleDC(DC);
  ReleaseDC(HWindow, DC);

  Bmp := LoadBitmap(HInstance, MakeIntResource(bmp_StatusLine));
  OldSrc := SelectObject(SrcDC, Bmp);
  if BmpStatusLine <> 0 then
    DeleteObject(BmpStatusLine);
  BmpStatusLine := CreateCompatibleBitmap(DC, Rect.Right, StatusLineHeight);
  OldDest := SelectObject(DestDC, BmpStatusLine);
  BitBlt(DestDC, 0, 0, 5, StatusLineHeight, SrcDC, 0, 0, srcCopy);
  StretchBlt(DestDC, 5, 0, Rect.Right - 5, StatusLineHeight,
             SrcDC, 6, 0, 20, StatusLineHeight, srcCopy);
  BitBlt(DestDC, Rect.Right - 5, 0, 5, StatusLineHeight, SrcDC, 59, 0, srcCopy);
  SelectObject(SrcDC, OldSrc);
  SelectObject(DestDC, OldDest);
  DeleteDC(SrcDC);
  DeleteDC(DestDC);
  DeleteObject(Bmp);
end;

var
  RWPApp:RWPApplication;

begin
  RWPApp.Init(AppName);
  RWPApp.Run;
  RWPApp.Done;
end.
