home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / pascal / zoom_10 / zoom!.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-14  |  8.5 KB  |  301 lines
  1. { Program:   Zoom
  2.   Version:   1.00
  3.   Purpose:   zooms part of the desktop
  4.   Date:      08.10.1992
  5.  
  6.   Developer: Peter Sawatzki (PS)
  7.              Buchenhof 3, D-5800 Hagen 1, Germany
  8.  CompuServe: 100031,3002
  9.        FIDO: 2:245/5800.17
  10.  
  11.   Date:     Author:
  12.   08.10.92  PS       written
  13.  
  14.   Copyright (c) 1993 Peter Sawatzki. All Rights Reserved.
  15. }
  16. Program Zoom;
  17.  
  18. {$R Zoom!.Res}
  19. Uses
  20.   oWindows,
  21.   WinTypes,
  22.   WinProcs,
  23.   Strings,
  24.   CustomWn,
  25.   DialogWn;
  26.  
  27. Type
  28.   pZoomWindow = ^tZoomWindow;
  29.   tZoomWindow = Object(tCustomWindow)
  30.     StayOnTop: Boolean;
  31.     UpdateTime,
  32.     DrawGrid: Integer;
  33.     FocPoint: tPoint;
  34.     DraggingW,
  35.     DraggingH,
  36.     MagFactor: Integer;
  37.     Constructor Init (aParent: pWindowsObject; aTitle: pChar);
  38.     Destructor Done; Virtual;
  39.     Procedure SetupWindow; Virtual;
  40.     Procedure GetWindowClass(var WndClass: TWndClass); virtual;
  41.     Procedure Paint (PaintDC: hDC; Var PaintInfo: tPaintStruct); Virtual;
  42.     Procedure wmSysCommand (Var Msg: tMessage); Virtual wm_First+wm_SysCommand;
  43.  
  44.     Procedure wmTimer       (Var Msg: tMessage); Virtual wm_First+wm_Timer;
  45.     Procedure wmLButtonDown (Var Msg: tMessage); Virtual wm_First+wm_LButtonDown;
  46.     Procedure wmMouseMove   (Var Msg: tMessage); Virtual wm_First+wm_MouseMove;
  47.     Procedure wmLButtonUp   (Var Msg: tMessage); Virtual wm_First+wm_LButtonUp;
  48.     Procedure wmRButtonUp   (Var Msg: tMessage); Virtual wm_First+wm_RButtonUp;
  49.     Procedure wmEraseBkGnd  (Var Msg: tMessage); Virtual wm_First+wm_EraseBkGnd;
  50.     Procedure GetFocusPoint (aPoint: LongInt);
  51.     Procedure DragRect;
  52.   End;
  53.  
  54.   pAboutWindow = ^tAboutWindow;
  55.   tAboutWindow = Object(tJanusDialogWindow)
  56.     Procedure wmLButtonUp (Var Msg: tMessage); Virtual wm_First+wm_LButtonUp;
  57.   End;
  58.  
  59. Const
  60.   ProgName   = 'Zoom!';
  61.   sc_About   = $100;
  62.  
  63. {----------- tZoomWindow}
  64.  
  65. Constructor tZoomWindow.Init (aParent: pWindowsObject; aTitle: pChar);
  66. Begin
  67.   Inherited Init(aParent, aTitle);
  68.   Attr.Style:= ws_ThickFrame+ws_Caption+ws_Popup+ws_SysMenu;
  69.   DraggingW:= 0;
  70.   DraggingH:= 0;
  71.  
  72.   StayOnTop:= Boolean(GetProfileInt(ProgName, 'StayOnTop', 1));
  73.   UpdateTime:= GetProfileInt(ProgName, 'Time', 1500);
  74.   Attr.w:= GetProfileInt(ProgName, 'Width', 150);
  75.   Attr.h:= GetProfileInt(ProgName, 'Height', 100);
  76.   Attr.x:= GetProfileInt(ProgName, 'xPos', GetSystemMetrics(sm_CxScreen)-Attr.w);
  77.   Attr.y:= GetProfileInt(ProgName, 'yPos', GetSystemMetrics(sm_CyScreen)-Attr.h);
  78.   FocPoint.x:= GetProfileInt(ProgName, 'xFocus', 0);
  79.   FocPoint.y:= GetProfileInt(ProgName, 'yFocus', 0);
  80.   MagFactor:=  GetProfileInt(ProgName, 'Magnification', 4);
  81.   DrawGrid:=   GetProfileInt(ProgName, 'DrawGrid', 4);
  82.  
  83.   If StayOnTop Then
  84.     Attr.ExStyle:= 8; {ws_ExTopMost}
  85. End;
  86.  
  87. Destructor tZoomWindow.Done;
  88.   Function WriteProfileInt (AppName, KeyName: pChar; anInt: Integer): Boolean;
  89.   Var
  90.     aTmp: Array[0..30] Of Char;
  91.   Begin
  92.     Str(anInt, aTmp);
  93.     WriteProfileInt:= WriteProfileString(AppName, KeyName, aTmp)
  94.   End;
  95. Begin
  96.   KillTimer(hWindow, 1);
  97.   WriteProfileInt(ProgName, 'StayOnTop', Integer(StayOnTop));
  98.   WriteProfileInt(ProgName, 'Time', UpdateTime);
  99.   WriteProfileInt(ProgName, 'Width',  Attr.w);
  100.   WriteProfileInt(ProgName, 'Height', Attr.h);
  101.   WriteProfileInt(ProgName, 'xPos',   Attr.x);
  102.   WriteProfileInt(ProgName, 'yPos',   Attr.y);
  103.   WriteProfileInt(ProgName, 'xFocus', FocPoint.x);
  104.   WriteProfileInt(ProgName, 'yFocus', FocPoint.y);
  105.   WriteProfileInt(ProgName, 'Magnification', MagFactor);
  106.   WriteProfileInt(ProgName, 'DrawGrid', DrawGrid);
  107.   Ancestor.Done
  108. End;
  109.  
  110. Procedure tZoomWindow.SetupWindow;
  111. Var
  112.   SysMenu: hMenu;
  113.   i: Integer;
  114. Begin
  115.   Ancestor.SetupWindow;
  116.   SysMenu:= GetSystemMenu(hWindow, False);
  117.   RemoveMenu(SysMenu, sc_Restore,  mf_ByCommand);
  118.   RemoveMenu(SysMenu, sc_Minimize, mf_ByCommand);
  119.   RemoveMenu(SysMenu, sc_Maximize, mf_ByCommand);
  120.   RemoveMenu(SysMenu, 2, mf_ByPosition);
  121.   RemoveMenu(SysMenu, sc_TaskList, mf_ByCommand);
  122.   AppendMenu(SysMenu, mf_String, sc_About,   '&About...');
  123.   If UpdateTime<>0 Then
  124.     SetTimer(hWindow, 1, UpdateTime, Nil)
  125. End;
  126.  
  127. Procedure tZoomWindow.GetWindowClass(Var WndClass: TWndClass);
  128. Begin
  129.   Ancestor.GetWindowClass(WndClass);
  130.   WndClass.lpszMenuName:= Nil
  131. End;
  132.  
  133. Procedure tZoomWindow.Paint (PaintDC: hDC; Var PaintInfo: tPaintStruct);
  134. Var
  135.   DisplayDC,
  136.   MemDC: hDC;
  137.   OldBmp, MemBmp: hBitmap;
  138.   SrcRect, DstRect: tRect;
  139.   i: Integer;
  140.   Grid: Boolean;
  141. Begin
  142.   DisplayDC:= GetDC(0);
  143.   If DisplayDC=0 Then
  144.     Exit;
  145.   Grid:= (DraggingW=0) And (DrawGrid<>0) And (MagFactor>DrawGrid);
  146.   DstRect:= PaintInfo.rcPaint;
  147.   With DstRect Do Begin
  148.     Dec(left, left Mod MagFactor);
  149.     Dec(top, top Mod MagFactor);
  150.     right:= ((right+MagFactor-1) Div MagFactor)* MagFactor;
  151.     bottom:= ((bottom+MagFactor-1) Div MagFactor)* MagFactor
  152.   End;
  153.   SrcRect.left:=   FocPoint.x+ DstRect.left   Div MagFactor;
  154.   SrcRect.right:=  FocPoint.x+ DstRect.right  Div MagFactor;
  155.   SrcRect.top:=    FocPoint.y+ DstRect.top    Div MagFactor;
  156.   SrcRect.bottom:= FocPoint.y+ DstRect.bottom Div MagFactor;
  157.  
  158.   If Grid Then With DstRect Do Begin
  159.     MemDC:= CreateCompatibleDC(DisplayDC);
  160.     MemBmp:= CreateCompatibleBitmap(DisplayDC, right-left, bottom-top);
  161.     OldBmp:= SelectObject(MemDC, MemBmp);
  162.     StretchBlt(MemDC, left, top, right-left, bottom-top,
  163.                DisplayDC, SrcRect.left, SrcRect.top,
  164.                SrcRect.right-SrcRect.left, SrcRect.bottom-SrcRect.top,
  165.                SrcCopy);
  166.     i:= left+MagFactor-1;
  167.     While i<right Do Begin
  168.       PatBlt(MemDC, i, top, 1, bottom-top, Blackness);
  169.       Inc(i, MagFactor)
  170.     End;
  171.     i:= top+MagFactor-1;
  172.     While i<bottom Do Begin
  173.       PatBlt(MemDC, left, i, right-left, 1, Blackness);
  174.       Inc(i, MagFactor)
  175.     End;
  176.     BitBlt(PaintDC, left, top, right-left, bottom-top, MemDC, left, top, SrcCopy);
  177.     SelectObject(MemDC, OldBmp);
  178.     DeleteObject(MemBmp);
  179.     DeleteDC(MemDC)
  180.   End Else
  181.     StretchBlt(PaintDC,   DstRect.left, DstRect.top, DstRect.right-DstRect.left, DstRect.bottom-DstRect.top,
  182.                DisplayDC, SrcRect.left, SrcRect.top, SrcRect.right-SrcRect.left, SrcRect.bottom-SrcRect.top,
  183.                SrcCopy);
  184.   ReleaseDC(0, DisplayDC)
  185. End;
  186.  
  187. Procedure tZoomWindow.wmSysCommand (Var Msg: tMessage);
  188. Begin
  189.   Case Msg.wParam Of
  190.     sc_About:   ExecDialogWindow(New(pAboutWindow,Init(@Self, 'About', True)));
  191.   Else
  192.     Inherited wmSysCommand(Msg)
  193.   End
  194. End;
  195.  
  196. Procedure tZoomWindow.wmTimer (Var Msg: tMessage);
  197. Begin
  198.   If DraggingW=0 Then
  199.     InvalidateRect(hWindow, Nil, False)
  200. End;
  201.  
  202. Procedure tZoomWindow.wmLButtonDown (Var Msg: tMessage);
  203. Var
  204.   aRect: tRect;
  205. Begin
  206.   SetCapture(hWindow);
  207.   GetClientRect(hWindow, aRect);
  208.   With aRect Do Begin
  209.     DraggingW:= (right-left) Div MagFactor;
  210.     DraggingH:= (bottom-top) Div MagFactor
  211.   End;
  212.   GetFocusPoint(Msg.lParam);
  213.   DragRect;
  214.   InvalidateRect(hWindow, Nil, False)
  215. End;
  216.  
  217. Procedure tZoomWindow.wmMouseMove (Var Msg: tMessage);
  218. Begin
  219.   If DraggingW<>0 Then Begin
  220.     DragRect;
  221.     GetFocusPoint(Msg.lParam);
  222.     DragRect;
  223.     InvalidateRect(hWindow, Nil, False)
  224.   End
  225. End;
  226.  
  227. Procedure tZoomWindow.wmLButtonUp (Var Msg: tMessage);
  228. Begin
  229.   If DraggingW<>0 Then Begin
  230.     ReleaseCapture;
  231.     DragRect;
  232.     GetFocusPoint(Msg.lParam);
  233.     InvalidateRect(hWindow, Nil, False)
  234.   End;
  235.   DraggingW:= 0;
  236. End;
  237.  
  238. Procedure tZoomWindow.wmRButtonUp (Var Msg: tMessage);
  239. Begin
  240.   Inc(MagFactor);
  241.   If MagFactor>30 Then
  242.     MagFactor:= 1;
  243.   InvalidateRect(hWindow, Nil, False)
  244. End;
  245.  
  246. Procedure tZoomWindow.wmEraseBkGnd (Var Msg: tMessage);
  247. Begin
  248. End;
  249.  
  250. Procedure tZoomWindow.GetFocusPoint (aPoint: LongInt);
  251. Begin
  252.   FocPoint:= tPoint(aPoint);
  253.   ClientToScreen(hWindow, FocPoint);
  254.   Dec(FocPoint.x, DraggingW Div 2);
  255.   Dec(FocPoint.y, DraggingH Div 2)
  256. End;
  257.  
  258. Procedure tZoomWindow.DragRect;
  259. Var
  260.   DisplayDC: hDC;
  261.   aRect: tRect;
  262. Begin
  263.   DisplayDC:= GetDC(0);
  264.   If DisplayDC=0 Then Exit;
  265.   With aRect, FocPoint Do Begin
  266.     left:= x;
  267.     top:= y;
  268.     right:= left+DraggingW;
  269.     bottom:= top+DraggingH;
  270.     InflateRect(aRect, 1, 1)
  271.   End;
  272.   DrawFocusRect(DisplayDC, aRect);
  273.   ReleaseDC(0, DisplayDC)
  274. End;
  275.  
  276. {----------- tAboutWindow}
  277.  
  278. Procedure tAboutWindow.wmLButtonUp (Var Msg: tMessage);
  279. Begin
  280.   CloseWindow
  281. End;
  282.  
  283. {-------------------- the Application part }
  284. Type
  285.   tZoomApp = Object(TApplication)
  286.     Procedure InitMainWindow; Virtual;
  287.   End;
  288.  
  289. Procedure tZoomApp.InitMainWindow;
  290. Begin
  291.   MainWindow:= New(pZoomWindow, Init(Nil, ProgName))
  292. End;
  293.  
  294. Var
  295.   App: tZoomApp;
  296. Begin With App Do Begin
  297.   Init(ProgName);
  298.   Run;
  299.   Done
  300. End End.
  301.