![]() |
Programm nicht über den Bildschirmrand herausschieben?
Hallo,
wie kann ich es verhindern das der User das Programm außerhalb des Bildschirmrandes scheiben kann? Ich möchte das das volle Programm bei jeder Auflösung voll sichtbar ist! Kann mir jemand dafür den Code geben? |
Moin smax,
das müsstest Du abfangen können, indem Du WM_MOVING überwachst (Beispiele hier im Forum). Zitat:
Wenn ich als Anwender ein Fenster über den sichtbaren Bereich hinaus verschieben will (warum auch immer), würde ich es einem Programm, dass das nicht zulässt, aber ganz entschieden übel nehmen. |
Hallo,
ok Danke für deine Antwort! Ich hab mal im Board nach WM_MOVING gesucht und auch 3 weitere Beiträge gefunden aber in keinem habe ich eine genau Lösung! Könntest du mir vielleicht ein Beispiel senden? |
Moin smax,
so geht's
Delphi-Quellcode:
Wichtig:
TfrmMAIN = class(TForm)
//... procedure WMMoving(var msg : TMessage); message WM_MOVING; //... end; //... implementation //... procedure TfrmMAIN.WMMoving(var msg : TMessage); var rtDragRect : TRect; begin rtDragRect := TRect(Pointer(msg.lParam)^); if (rtDragRect.Top < 0) then begin rtDragRect.Top := 0; rtDragRect.Bottom := rtDragRect.Top+self.Height; end; if (rtDragRect.Left < 0) then begin rtDragRect.Left := 0; rtDragRect.Right := rtDragRect.Left+self.Width; end; if (rtDragRect.Bottom > (Screen.Height-1)) then begin rtDragRect.Bottom := Screen.Height; rtDragRect.Top := rtDragRect.Bottom-self.Height; end; if (rtDragRect.Right > (Screen.Width-1)) then begin rtDragRect.Right := Screen.Width; rtDragRect.Left := rtDragRect.Right-self.Width; end; TRect(Pointer(msg.lParam)^) := rtDragRect; end; Du musst aber auch noch absichern, dass die Formulargrösse innerhalb der Screenkoordinaten passt. Ich weiss nicht was passiert, wenn das Formular z.b. höher ist, als der Screen.Height. |
Hallo,
ok Danke! Da sind leider noch ein paar Fehler drin: [Fehler] Unit1.pas(26): ',' oder ':' erwartet, aber '=' gefunden [Fehler] Unit1.pas(35): Bezeichner redefiniert: 'TfrmMAIN' [Fehler] Unit1.pas(35): ';' erwartet, aber ')' gefunden [Fehler] Unit1.pas(44): Undefinierter Bezeichner: 'self' [Fehler] Unit1.pas(48): Operator oder Semikolon fehlt [Fehler] Unit1.pas(52): Operator oder Semikolon fehlt [Fehler] Unit1.pas(56): Operator oder Semikolon fehlt [Fehler] Unit1.pas(28): Ungenügende Forward- oder External-Deklaration: '.2.WMMoving' [Fataler Fehler] Project2.dpr(5): Verwendete Unit 'Unit1.pas' kann nicht compiliert werden Wie meinst du das mit den Screenkoordinaten? |
Poste mal Deinen Code, inkl. Deklaration. Ich denke mal, daß Du bei der Übernahme des Codes einen Fehler gemacht hast.
...:cat:... P.S. Welche Zeile ist Zeile 26? |
Etwas lang aber hier isser!
Thx für den Support...
Delphi-Quellcode:
TfrmMAIN = class(TForm) ist Zeile 26!
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw; type TForm1 = class(TForm) WebBrowser1: TWebBrowser; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; TfrmMAIN = class(TForm) //... procedure WMMoving(var msg : TMessage); message WM_MOVING; //... end; implementation {$R *.dfm} procedure TfrmMAIN.WMMoving(var msg : TMessage); var rtDragRect : TRect; begin rtDragRect := TRect(Pointer(msg.lParam)^); if (rtDragRect.Top < 0) then begin rtDragRect.Top := 0; rtDragRect.Bottom := rtDragRect.Top+self.Height; end; if (rtDragRect.Left < 0) then begin rtDragRect.Left := 0; rtDragRect.Right := rtDragRect.Left+self.Width; end; if (rtDragRect.Bottom > (Screen.Height-1)) then begin rtDragRect.Bottom := Screen.Height; rtDragRect.Top := rtDragRect.Bottom-self.Height; end; if (rtDragRect.Right > (Screen.Width-1)) then begin rtDragRect.Right := Screen.Width; rtDragRect.Left := rtDragRect.Right-self.Width; end; TRect(Pointer(msg.lParam)^) := rtDragRect; end; procedure TForm1.Button1Click(Sender: TObject); begin WebBrowser1.Navigate('http://delphipraxis.net'); end; end. |
Moin smax,
Zitat:
Und man kann die Grösse ja auch per Programm ändern. Du musst also abfangen, dass das Formular durch Änderung der Grösse über zu zur Verfügung stehenden Platz hinausgeht. Zu den Fehlern:
Delphi-Quellcode:
das hab' ich so geschrieben, damit Du weisst, wo die Deklaration hinmusst. Du brauchst natürlich nur die procedure Zeile, und musst dann bei der Implementierung der Methode den Klassennamen Deines Formulares angeben.
TfrmMAIN = class(TForm)
//... procedure WMMoving(var msg : TMessage); message WM_MOVING; //... end; |
Keine Ursache, hier die Änderungen:
Code:
...:cat:...
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw; type TForm1 = class(TForm) WebBrowser1: TWebBrowser; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); private { Private-Deklarationen } [b][color=#ff0000] procedure WMMoving(var msg : TMessage); message WM_MOVING; [/color][/b] public { Public-Deklarationen } end; var Form1: TForm1; [color=#0019ff] //LÖSCHEN!!!!!!!!!!!! TfrmMAIN = class(TForm) //... procedure WMMoving(var msg : TMessage); message WM_MOVING; //... end; //LÖSCHEN!!!!!!!!!!!![/color] implementation {$R *.dfm} procedure [color=#ff0000][b]TForm1[/b][/color].WMMoving(var msg : TMessage); var rtDragRect : TRect; begin rtDragRect := TRect(Pointer(msg.lParam)^); if (rtDragRect.Top < 0) then begin rtDragRect.Top := 0; rtDragRect.Bottom := rtDragRect.Top+self.Height; end; if (rtDragRect.Left < 0) then begin rtDragRect.Left := 0; rtDragRect.Right := rtDragRect.Left+self.Width; end; if (rtDragRect.Bottom > (Screen.Height-1)) then begin rtDragRect.Bottom := Screen.Height; rtDragRect.Top := rtDragRect.Bottom-self.Height; end; if (rtDragRect.Right > (Screen.Width-1)) then begin rtDragRect.Right := Screen.Width; rtDragRect.Left := rtDragRect.Right-self.Width; end; TRect(Pointer(msg.lParam)^) := rtDragRect; end; procedure TForm1.Button1Click(Sender: TObject); begin WebBrowser1.Navigate('http://delphipraxis.net'); end; end. |
Ok Danke!
Es läuft alles super :D |
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:07 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz