home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / metawin / exdlg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-05  |  18.5 KB  |  626 lines
  1. {$define RETAIL_VERSION}
  2. {!define Win32}
  3. {***************************************************************************
  4.   Source File Name     :  ExDlgs
  5.   Autor                :  Mario M. Westphal
  6.   Erstellt am          :  14.07.1992
  7.  
  8.   Compiler             :  Borland Pascal for Windows 1.x
  9.   Betriebssystem       :  DOS 5.0, Windows 3.x
  10.   Compiler-Schalter    :  -
  11.  
  12.   Bemerkungen          :  -
  13.  
  14.   Beschreibung         :  Unit fⁿr erweiterte Dialogelemente und allgemeine
  15.                           Routinen.
  16.                                    Diese Unit deklariert benutzerdefinierte
  17.                           Nachrichten ab wm_User+300;
  18.  
  19.   Revisionen           :  1.00 14.10.1992 created (MW)
  20.                                07.04.1993 revisited (MW)
  21.  
  22. ****************************************************************************}
  23. {$M 8192,8192}
  24. {$A+,B-,D+,F-,G+,I+,L+,N-,R+,S+,V+,W-,X+,Q+}
  25.  
  26. {$IFDEF RETAIL_VERSION}
  27.   {$D-,L-,S-,R-,Q-,I-}
  28. {$ENDIF}
  29.  
  30. Unit ExDlg;
  31.  
  32. interface
  33.  
  34. uses
  35.   WinTypes,
  36.   WinProcs,
  37.   WinDos,
  38.   Objects,
  39.   Strings,
  40.   OWindows,
  41.   ODialogs,
  42.   SysTools;
  43.  
  44. const
  45.     WMOFFSET                    = 300;                            { Start der Meldungen dieser Unit }
  46.     wm_PBarCanceled     = wm_User+WMOFFSET;
  47.  
  48. type
  49.     PPBarDialog    = ^TPBarDialog ;
  50.     TPBarDialog = object(TWindow)
  51.  
  52.       MaxValue : Real;                  { Maximalwert }
  53.       ActValue : Integer;               { Aktueller Wert }
  54.       BarBrush : HBrush;                { Balkenfarbe }
  55.       pnShadow : HPen;                  { Schatten }
  56.       HasButton: Boolean;               { Schalter ? }
  57.       PBtn     : PButton;               { Schalter }
  58.       CharPt   : TPoint;                { Zeichenbreite- und H÷he des Systemfonts }
  59.       rcBar    : TRect;                 { Rechteck des Balkens }
  60.       hbmBar   : HBitmap;               { Ausgabe-Bitmap }
  61.  
  62.         constructor Init (AParent : PWindowsObject;
  63.                       ATitle  : PChar;
  64.                       AMax    : Real;
  65.                             Button  : Boolean);
  66.     destructor Done; virtual;
  67.     function CanClose : Boolean; virtual;
  68.  
  69.         procedure SetupWindow; virtual;
  70.     procedure SetColors; virtual;
  71.  
  72.         function  GetClassName: PChar; virtual;
  73.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  74.         procedure DrawBar (DC: HDC);
  75.         procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  76.         procedure SetPos(CurValue: Real);
  77.     procedure WMKeyDown (var Msg: TMessage);
  78.       virtual wm_First or wm_KeyDown;
  79.     procedure Cancel (var Msg: TMessage);
  80.       virtual id_First or ID_ABORT;
  81.     end;
  82.  
  83. type
  84.     PMsgWindow = ^TMsgWindow;
  85.     TMsgWindow = object(TWindow)
  86.       Message : PChar;        { Angezeigter Text }
  87.       CharPt  : TPoint;       { Zeichenbreite- und H÷he des Systemfonts }
  88.       rcText  : TRect;        { Das den Text umgebende Rechteck }
  89.         constructor Init (AParent: PWindowsObject; ATitle: PChar);
  90.     destructor Done; virtual;
  91.     function  CanClose : Boolean; virtual;
  92.         function  GetClassName: PChar; virtual;
  93.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  94.         procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  95.     procedure SetText (MsgStr: PChar);
  96.     end;
  97.  
  98.  
  99. const
  100.   { Modi fⁿr den CtrDialog }
  101.   CTRDLG_SYSTEM = 1;              { Ausrichtung bezⁿglich des Bildschirms }
  102.   CTRDLG_PARENT = 2;              { Ausrichtung bezⁿglich des Parent-Windows }
  103.  
  104. { Zentrierte Dialoge }
  105. type
  106.     PCtrDialog    = ^TCtrDialog;
  107.     TCtrDialog    = object(TDialog)
  108.       CtrMode : Byte;
  109.     constructor Init(AParent: PWindowsObject; AName: PChar; AMode: Byte);
  110.         procedure SetupWindow; virtual;
  111.         function  GetClassName: PChar; virtual;
  112.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  113.     end;
  114.  
  115.  
  116. {* Allgemeines *}
  117.  
  118. function ChangeMenu (Wnd: HWnd; Position, Flags: Word;
  119.                                          NewStr: PChar) : Bool;
  120.  
  121. function ChangeSysMenu (Wnd: HWnd; Position, Flags: Word;
  122.                                                 NewStr: PChar) : Bool;
  123.  
  124.  
  125. implementation
  126.  
  127. {----------------------------------------------------------
  128.     ─ndert das Menu mit dem Handle "Menu" mit der Command-ID
  129.     Position auf Flags. Wird fⁿr NewStr ein Leerstring
  130.     ⁿbergeben, wird der alte Menⁿname beibehalten, ansonsten
  131.     wird er auf NewStr geΣndert.
  132. }
  133. function ChangeMenu (Wnd: HWnd; Position, Flags: Word;
  134.                                          NewStr: PChar) : Bool;
  135. var
  136.     s : array[0..50] of Char;
  137.     Menu : HMenu;
  138. begin
  139.     Menu := GetMenu(Wnd);
  140.     GetMenuString(Menu, Position, s, 50, MF_BYCOMMAND);
  141.     if NewStr[0] = #0 then
  142.         ChangeMenu := ModifyMenu(Menu, Position, Flags, Position, s)
  143.     else
  144.         ChangeMenu := ModifyMenu(Menu, Position, Flags, Position, NewStr);
  145. end;
  146.  
  147. {----------------------------------------------------------
  148.     Wie ChangeMenu, arbeitet aber mit dem System-Menⁿ des
  149.     angegebenen Fensters.
  150. }
  151. function ChangeSysMenu (Wnd: HWnd; Position, Flags: Word;
  152.                                                 NewStr: PChar) : Bool;
  153. var
  154.     s : array[0..50] of Char;
  155.     Menu : HMenu;
  156. begin
  157.     Menu := GetSystemMenu(Wnd,false);
  158.     GetMenuString(Menu, Position, s, 50, MF_BYCOMMAND);
  159.     if NewStr[0] = #0 then
  160.         ChangeSysMenu := ModifyMenu(Menu, Position, Flags, Position, s)
  161.     else
  162.         ChangeSysMenu := ModifyMenu(Menu, Position, Flags, Position, NewStr);
  163. end;
  164.  
  165.  
  166. {**********************************************************}
  167. { TPBarDialog                                              }
  168. {                                                          }
  169. { Erzeugt einen Dialog mit einem optionalen Schalter. In   }
  170. { diesem Dialog wird ein Prozentbalken angezeigt der vom   }
  171. { Parent neu gesetzt werden kann. Der Dialog ist bezⁿglich }
  172. { des Parent zentriert.                                    }
  173. { Drⁿckt der Anwender den Schalter, wird eine entsprechende}
  174. { Nachricht an den Parent gesendet.                        }
  175. {**********************************************************}
  176. constructor TPBarDialog.Init (AParent  : PWindowsObject;
  177.                               ATitle   : PChar;
  178.                               AMax     : Real;
  179.                                                             Button   : Boolean);
  180. var
  181.   R       : TRect;
  182.     tm   : TTextMetric;
  183.     DC   : HDC;
  184.   x,y  : Integer;
  185.   w,h  : Integer;
  186.   s    : array[0..50] of Char;
  187.  
  188. begin
  189.   Inherited Init(AParent,ATitle);
  190.   Attr.Style := ws_Visible or ws_Popup or ws_Caption or ws_Border;
  191.  
  192.     DC := CreateIC('DISPLAY',nil,nil,nil);
  193.     GetTextMetrics(DC,tm);
  194.     DeleteDC(DC);
  195.     CharPt.y := tm.tmHeight;
  196.     CharPt.x := tm.tmAveCharWidth;
  197.  
  198.   GetWindowRect(Parent^.HWindow,R);
  199.   Attr.W := GetSystemMetrics(SM_CXSCREEN) div 10 * 4;
  200.   Attr.H := 3*CharPt.x+2*CharPt.y+GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CYBORDER);
  201.   Attr.X := R.Left+(R.Right-R.Left) div 2 - Attr.W div 2;
  202.  
  203.   { Pens und Brushes anlegen }
  204.   SetColors;
  205.  
  206.   MaxValue := AMax;
  207.   ActValue := 0;
  208.   HasButton := Button;
  209.  
  210.   { Rechteck for den Balken berechnen }
  211.   rcBar.Left   := 2*CharPt.x;
  212.   rcBar.Right  := Attr.W-2*CharPt.x;
  213.   rcBar.Top    := 2*CharPt.x;
  214.   rcBar.Bottom := rcBar.Top+CharPt.y+CharPt.x;
  215.  
  216.   if HasButton then
  217.   begin
  218.     StrCopy(s,'Abbrechen');
  219.     w := (StrLen(s)+4)*CharPt.x;
  220.     h := CharPt.y+ CharPt.y div 4*3;
  221.     x := Attr.W div 2 - w div 2;
  222.     y := rcBar.Bottom+2*CharPt.x;
  223.     New(pBtn,Init(@Self,ID_ABORT,s,x,y,w,h,true));
  224.     inc(Attr.H,rcBar.Bottom);
  225.   end
  226.   else
  227.   begin
  228.     h := 0;
  229.     PBtn := NIL;
  230.   end;
  231.  
  232.   Attr.Y := R.Top+(R.Bottom-R.Top) div 2 - Attr.H div 2;
  233. end;
  234.  
  235. {----------------------------------------------------------
  236.   Erzeugt eine kompatible Bitmap von der Gr÷▀e des
  237.   Balkens. In diese Bitmap werden alle Ausgaben des
  238.   des Balkens von DrawBar gemacht.
  239. }
  240. procedure TPBarDialog.SetupWindow;
  241. var
  242.   DC     : HDC;
  243.   rcTemp : TRect;
  244. begin
  245.   Inherited SetupWindow;
  246.   DC := GetDC(HWindow);
  247.   rcTemp := rcBar;
  248.   OffsetRect(rcTemp,-rcBar.Left,-rcBar.Top);
  249.   hbmBar := CreateCompatibleBitmap(DC,rcTemp.Right,rcTemp.Bottom);
  250.   ReleaseDC(HWindow,DC);
  251. end;
  252.  
  253. {----------------------------------------------------------
  254. }
  255. destructor TPBarDialog.Done;
  256. begin
  257.   DeleteObject(hbmBar);
  258.   DeleteObject(BarBrush);
  259.   DeleteObject(pnShadow);
  260.   Inherited Done;
  261. end;
  262.  
  263. {----------------------------------------------------------
  264.   Wenn der Anwender das Fenster ⁿber das Systemmenⁿ
  265.   schlie▀t, wird geprⁿft, ob das Fenster ⁿber einen
  266.   Button verfⁿgt. Wenn ja, wird die "Button gedrⁿckt"
  267.   Botschaft gesendet. Ansonsten wird immer false
  268.   geliefert.
  269. }
  270. function TPBarDialog.CanClose : Boolean;
  271. begin
  272.   CanClose := false;
  273. end;
  274.  
  275. {----------------------------------------------------------
  276. }
  277. procedure TPBarDialog.SetColors;
  278. var
  279.   IC : HDC;
  280. begin
  281.   IC := CreateIC('DISPLAY',nil,nil,nil);
  282.   pnShadow := CreatePen(PS_SOLID,1,GetNearestColor(IC,RGB(85,85,85)));
  283.   BarBrush := CreateSolidBrush(GetNearestColor(IC,RGB(0,0,255)));
  284.   DeleteDC(IC);
  285. end;
  286.  
  287. {----------------------------------------------------------
  288.     Neue Fenster-Klasse definieren.
  289. }
  290. function TPBarDialog.GetClassName: PChar;
  291. begin
  292.     GetClassName := 'MWINDICATOR';
  293. end;
  294.  
  295. {----------------------------------------------------------
  296. }
  297. procedure TPBarDialog.GetWindowClass(var AWndClass: TWndClass);
  298. var IC : HDC;
  299. begin
  300.   Inherited GetWindowClass(AWndClass);
  301.   IC := CreateIC('DISPLAY',nil,nil,nil);
  302.   AWndClass.hBrBackground := CreateSolidBrush(GetNearestColor(IC,RGB(193,193,193)));
  303.   AWndClass.Style := AWndClass.Style or cs_SaveBits;
  304.   DeleteDC(IC);
  305. end;
  306.  
  307. {----------------------------------------------------------
  308.     Zeichnet den Prozentbalken neu und gibt die Prozentzahl
  309.     in der Mitte des Balkens aus.
  310. }
  311. procedure TPBarDialog.DrawBar (DC: HDC);
  312. var
  313.   OldBrush : HBrush;
  314.   R        : TRect;
  315.   Size     : Integer;
  316.   MadeDC   : Boolean;
  317.   OldPen   : HPen;
  318.   rcTemp   : TRect;
  319.   MemDC    : HDC;
  320.   hbmOld   : HBitmap;
  321.   PercStr  : array[0..4] of Char;
  322.  
  323. begin
  324.   if DC = 0 then
  325.   begin
  326.     DC := GetDC(HWindow);
  327.     MadeDC := true;
  328.   end
  329.   else
  330.     MadeDC := false;
  331.  
  332.   { Rechteck des Balkens an den Nullpunkt verschieben (Bitmap-Ursprung) }
  333.   rcTemp := rcBar;
  334.   OffsetRect(rcTemp,-rcBar.Left,-rcBar.Top);
  335.  
  336.   { Die Bitmap in einen Memory Device Context selektieren. In diesen wird gezeichnet. }
  337.   MemDC := CreateCompatibleDC(DC);
  338.   hbmOld := SelectObject(MemDC,hbmBar);
  339.  
  340.   { Rahmen zeichnen }
  341.   OldPen := SelectObject(MemDC,GetStockObject(WHITE_PEN));
  342.   OldBrush := SelectObject(MemDC,GetClassWord(HWindow,GCW_HBRBACKGROUND));
  343.   with rcTemp do begin
  344.     Rectangle(MemDC,Left,Top,Right,Bottom);
  345.     SelectObject(MemDC,pnShadow);
  346.     MoveTo(MemDC,Succ(Left),Pred(Bottom));
  347.     LineTo(MemDC,Pred(Right),Pred(Bottom));
  348.     LineTo(MemDC,Pred(Right),Top);
  349.   end;
  350.  
  351.   SetBkMode(MemDC,TRANSPARENT);
  352.  
  353.   { Balken einzeichnen }
  354.   SelectObject(MemDC,GetStockObject(NULL_PEN));
  355.   SelectObject(MemDC,BarBrush);
  356.   R := rcTemp;
  357.   OffsetRect(R,1,1);
  358.   dec(R.Bottom,1);
  359.   Size := Round((rcTemp.Right-R.Left-1) / 100 * ActValue);
  360.  
  361.   R.Right := r.Left+Size;
  362.   with R do Rectangle(MemDC,Left,Top,Right,Bottom);
  363.  
  364.   { Neuen Text schreiben }
  365.   SetTextColor(MemDC,RGB(255,255,255));
  366.   wvsprintf(PercStr,'%u%%',ActValue);
  367.  
  368.   DrawText(MemDC,PercStr,-1,rcTemp,DT_CENTER or DT_NOCLIP or DT_VCENTER or DT_SINGLELINE);
  369.  
  370.   BitBlt(DC,rcBar.Left,rcBar.Top,rcBar.Right,rcBar.Bottom,MemDC,0,0,SRCCOPY);
  371.  
  372.   SelectObject(MemDC,hbmOld);
  373.   SelectObject(MemDC,OldPen);
  374.   SelectObject(MemDC,OldBrush);
  375.   DeleteDC(MemDC);
  376.   if MadeDC then ReleaseDC(HWindow,DC);
  377. end;
  378.  
  379. {----------------------------------------------------------
  380.     Bearbeitet WM_PAINT-Nachrichten. Ruft DrawBar auf, um den
  381.     Balken neu zu zeichnen.
  382. }
  383. procedure TPBarDialog.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  384. begin
  385.   Inherited Paint(PaintDC,PaintInfo);
  386.   if not IsIconic(HWindow) then DrawBar(PaintDC);
  387. end;
  388.  
  389. {----------------------------------------------------------
  390.     Setzt einen neuen Prozentwert.
  391. }
  392. procedure TPBarDialog.SetPos(CurValue: Real);
  393. var
  394.   ActSave : Integer;
  395. begin
  396.   ActSave := ActValue;
  397.   ActValue := Round(CurValue / (MaxValue / 100));
  398.   if ActValue <= ActSave then exit;
  399.     if (ActValue >= 0) and (ActValue <= 100) then
  400.   begin
  401.     DrawBar(0);
  402.     end;
  403. end;
  404.  
  405. {----------------------------------------------------------
  406. }
  407. procedure TPBarDialog.WMKeyDown (var Msg: TMessage);
  408. begin
  409.   if HasButton then
  410.   begin
  411.     if Msg.wParam = VK_ESCAPE then SendMessage(HWindow,wm_Command,ID_ABORT,pBtn^.HWindow);
  412.   end;
  413.   DefWndProc(Msg);
  414. end;
  415.  
  416. {----------------------------------------------------------
  417.     Wird aufgerufen, wenn der Halt-Button gedrⁿckt wird.
  418.     *******
  419.     ACHTUNG: Entfernt NICHT den Dialog. Dies mu▀ von der
  420.     *******     Funktion erledigt werden, die den Dialog erzeugt
  421.                      hat. Sendet die Nachricht wm_PBarCanceled an das
  422.                      erzeugende Fenster.
  423. }
  424. procedure TPBarDialog.Cancel (var Msg: TMessage);
  425. begin
  426.     PostMessage(Parent^.HWindow, wm_PBarCanceled, 0, 0);
  427. end;
  428.  
  429.  
  430. {**********************************************************}
  431. { TMessageWindow                                           }
  432. {                                                          }
  433. { Erzeugt ein Fenster mit einem grauen Hintergrund auf das }
  434. { eine beliebige Textausgabe gemacht werden kann. Der Text }
  435. { wird automatisch zentriert und das Fenster in seiner     }
  436. { Gr÷▀e an den Text angepassst. Das Fenster ist bezⁿglich  }
  437. { des Parents zentriert.                                   }
  438. {**********************************************************}
  439.  
  440. {----------------------------------------------------------
  441. }
  442. constructor TMsgWindow.Init (AParent: PWindowsObject; ATitle: PChar);
  443. var
  444.   R  : TRect;
  445.   DC : HDC;
  446.     tm : TTextMetric;
  447. begin
  448.   Inherited Init (AParent, ATitle);
  449.   Attr.Style := ws_Popup or ws_Border or ws_Visible or ws_Caption;
  450.   Message := Nil;
  451.  
  452.     DC := CreateIC('DISPLAY',nil,nil,nil);
  453.     GetTextMetrics(DC,tm);
  454.     DeleteDC(DC);
  455.  
  456.     CharPt.y := tm.tmHeight + tm.tmExternalLeading;
  457.     CharPt.x := tm.tmAveCharWidth;
  458.   rcText.Left := 0;
  459.   rcText.Top := 0;
  460.   rcText.Right := GetSystemMetrics(SM_CXSCREEN) div 10 * 4;
  461.   rcText.Bottom := 0;
  462.  
  463.   InflateRect(rcText,2*CharPt.y,2*CharPt.y);
  464.   OffsetRect(rcText,Abs(rcText.Left),Abs(rcText.Top));
  465. end;
  466.  
  467. {----------------------------------------------------------
  468. }
  469. destructor TMsgWindow.Done;
  470. begin
  471.   if Message <> Nil then StrDispose(Message);
  472.   Inherited Done;
  473. end;
  474.  
  475. {----------------------------------------------------------
  476.   Sorgt dafⁿr, da▀ der Anwender das Fenster nicht ⁿber
  477.   <Alt>-<F4> schlie▀en kann. Das Fenster kann nur vom
  478.   ⁿbergeordneten Fenster geschlossen werden.
  479. }
  480. function TMsgWindow.CanClose : Boolean;
  481. begin
  482.   CanClose := false;
  483. end;
  484.  
  485. {----------------------------------------------------------
  486. }
  487. function  TMsgWindow.GetClassName: PChar;
  488. begin
  489.     GetClassName := 'MWMSGWINDOW';
  490. end;
  491.  
  492. {----------------------------------------------------------
  493. }
  494. procedure TMsgWindow.GetWindowClass(var AWndClass: TWndClass);
  495. var IC : HDC;
  496. begin
  497.   Inherited GetWindowClass(AWndClass);
  498.   IC := CreateIC('DISPLAY',nil,nil,nil);
  499.   AWndClass.hBrBackground := CreateSolidBrush(GetNearestColor(IC,RGB(193,193,193)));
  500.   DeleteDC(IC);
  501.   AWndClass.Style := AWndClass.Style or cs_SaveBits;
  502. end;
  503.  
  504. {----------------------------------------------------------
  505. }
  506. procedure TMsgWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  507. var R : TRect;
  508. begin
  509.   Inherited Paint(PaintDC,PaintInfo);
  510.   GetClientRect(HWindow,R);
  511.   InflateRect(R,-2*CharPt.x,-CharPt.y);
  512.   SetBkColor(PaintDC,GetNearestColor(PaintDC,RGB(193,193,193)));
  513.   DrawText(PaintDC,Message,-1,R,DT_CENTER or DT_NOCLIP or DT_WORDBREAK);
  514. end;
  515.  
  516. {----------------------------------------------------------
  517. }
  518. procedure TMsgWindow.SetText(MsgStr: PChar);
  519. var
  520.   R       : TRect;
  521.   DC      : HDC;
  522.   x,y,w,h : Integer;
  523. begin
  524.   if Message <> Nil then StrDispose(Message);
  525.   Message := StrNew(MsgStr);
  526.  
  527.   rcText.Left := 0;
  528.   rcText.Top := 0;
  529.   rcText.Right := GetSystemMetrics(SM_CXSCREEN) div 10 * 4;
  530.   rcText.Bottom := 0;
  531.  
  532.   DC := GetDC(HWindow);
  533.   DrawText(DC,Message,-1,rcText,DT_CALCRECT or DT_CENTER or DT_NOCLIP or DT_WORDBREAK);
  534.   rcText.Right := Max(rcText.Right,GetSystemMetrics(SM_CXSCREEN) div 10*4);
  535.     ReleaseDC(HWindow,DC);
  536.  
  537.   InflateRect(rcText,2*CharPt.x,1*CharPt.y);
  538.   OffsetRect(rcText,Abs(rcText.Left),Abs(rcText.Top));
  539.  
  540.   { for saventy! }
  541.   if Parent <> NIL then
  542.     GetWindowRect(Parent^.HWindow,R)
  543.   else
  544.     GetWindowRect(GetDesktopWindow,R);
  545.  
  546.   W := rcText.Right+2*GetSystemMetrics(SM_CXBORDER);
  547.   H := rcText.Bottom+GetSystemMetrics(SM_CYCAPTION) + 2*GetSystemMetrics(SM_CYBORDER);
  548.   X := R.Left+(R.Right-R.Left) div 2 - W div 2;
  549.   Y := R.Top+(R.Bottom-R.Top) div 2 - H div 2;
  550.  
  551.   SetWindowPos(HWindow,0,x,y,w,h,swp_NoZOrder);
  552.   InvalidateRect(HWindow,nil,true);
  553.   UpdateWindow(HWindow);
  554. end;
  555.  
  556. {***********************************************************}
  557. { TCtrDialog - Zentrierter Dialog                           }
  558. {                                                           }
  559. { Wie TDialog, allerdings wird der Dialog automatisch auf      }
  560. { dem Bildschirm zentiert.                                  }
  561. {                                                           }
  562. {***********************************************************}
  563.  
  564. {----------------------------------------------------------
  565.   Initialisiert einen zentrierten Dialog.
  566.   Parameter wie bei TDialog.
  567.   Mode definiert, ob der Dialog bezⁿglich des Bildschirms
  568.   ausgerichtet werden soll, oder bezⁿglich des Parents.
  569. }
  570. constructor TCtrDialog.Init(AParent: PWindowsObject; AName: PChar; AMode: Byte);
  571. begin
  572.   Inherited Init(AParent,AName);
  573.   CtrMode := AMode;
  574. end;
  575.  
  576. {----------------------------------------------------------
  577. }
  578. procedure TCtrDialog.SetupWindow;
  579. var
  580.     r,r2 : TRect;
  581.   x,y  : Integer;
  582. begin
  583.     Inherited SetupWindow;
  584.     GetWindowRect(HWindow,r);
  585.     OffsetRect(r,-r.Left,-r.Top);
  586.   if CtrMode = CTRDLG_SYSTEM then
  587.   begin
  588.       SetWindowPos(HWindow,0,(GetSystemMetrics(sm_CXScreen) - R.Right) div 2,
  589.                                (GetSystemMetrics(sm_CYScreen) - R.Bottom) div 2,0,0,swp_NoSize or swp_NoZOrder);
  590.   end
  591.   else
  592.   begin
  593.     { for saventy }
  594.       if Parent <> NIL then
  595.       GetWindowRect(Parent^.HWindow,r2)
  596.     else
  597.       GetWindowRect(GetDesktopWindow,r2);
  598.     x := (R2.Right-R2.Left)-R.Right;
  599.     if x > 0 then
  600.       x := R2.Left + x div 2
  601.     else
  602.      x := (GetSystemMetrics(sm_CXScreen) - R.Right) div 2;
  603.     y := (R2.Bottom-R2.Top)-R.Bottom;
  604.     if y > 0 then
  605.       y := R2.Top+y div 2
  606.     else
  607.      y := (GetSystemMetrics(sm_CYScreen) - R.Bottom) div 2;
  608.       SetWindowPos(HWindow,0,x,y,0,0,swp_NoSize or swp_NoZOrder);
  609.   end;
  610. end; { SetupWindow }
  611.  
  612. {----------------------------------------------------------
  613. }
  614. function TCtrDialog.GetClassName: PChar;
  615. begin
  616.     GetClassName := 'MWCTRDIALOG';
  617. end;
  618.  
  619. {----------------------------------------------------------
  620. }
  621. procedure TCtrDialog.GetWindowClass(var AWndClass: TWndClass);
  622. begin
  623.   Inherited GetWindowClass(AWndClass);
  624. end;
  625.  
  626. END.