Einzelnen Beitrag anzeigen

FarAndBeyond
(Gast)

n/a Beiträge
 
#38

AW: Zwei Windows Explorer starten und nebeneinander bildschirmfüllend positionieren

  Alt 8. Jul 2016, 23:07
So geht's am besten:
"StartTwoWinEx" gekürzt und WorkArea selber eingebaut, so braucht man "Forms" nicht einbinden und die EXE ist kleiner (90,5 kb statt 362 kb). Jetzt kann man das Programm mit Delphi7 kompilieren und mit Lazarus und mit FreePascal (Einfach in Lazarus "Project".."Neues Project".. "Einfaches Programm" öffnen und {$APPTYPE GUI} eingeben und LongInt ersetzen mit PtrInt. Ohne LCL und LCLBase bekommt die EXE dann folgende Grösse: 32bit = 246 kb, 64bit = 335 kb;
In den Projekt-Einstellungen Win32App-Box deaktivieren.

Die D7-EXE ist natürlich schwer zu schlagen... es sei denn man nimmt API-Only oder KOL...

Delphi-Quellcode:
PROGRAM TwoWinEx;
 //{$APPTYPE GUI} //nur für FPC (Kein cmd-Fenster)
 USES
  Windows, Messages, Classes, SysUtils, ShellApi;

 VAR
  slFoundWnd: TStringlist;
  WndHandle : THandle;
  I : Integer;


Procedure ErrorLog(ErrorInfo: String);
  Var
   slLoad : TStringlist;
   slSave : TStringlist;
   strErrorLog: String;

  Procedure Free_slLoad;
   Begin
    Try
     FreeAndNil(slLoad);
    Except
    End;
   End;

  Procedure Free_slSave;
   Begin
    Try
     FreeAndNil(slSave);
    Except
    End;
   End;

  Function ErrorLogExists: Boolean;
   Begin
    Try
     Result:= False;
      If FileExists('ErrorLog.txt')
      Then
       Begin
        Try
         slLoad:= TStringlist.Create;
         slLoad.LoadFromFile('ErrorLog.txt');
          strErrorLog:= slLoad.Text;
          Result:= True;
        Finally
         Free_slLoad;
        End;
       End;
    Except
    End;
   End;

 Begin
  Try
   Try
    slSave:= TStringlist.Create;
     slSave.Add(DateTimeToStr(Now));
     slSave.Add(ErrorInfo);

      If ErrorLogExists
      Then
       Begin
        slSave.Add(' ');
        slSave.Add(Trim(strErrorLog));
       End;

     slSave.SaveToFile('ErrorLog.txt');
   Finally
    Free_slSave;
   End;
  Except
  End;
 End;


Function SearchCallback(Wnd: HWND; lParam: LongInt): BOOL; StdCall; //FPC: PtrInt
  Var
   ClassName: Array[0..255] Of Char;
 Begin
  Try
   If GetClassName(Wnd, ClassName, 255) > 0
   Then
    Begin
     If Pos('CabinetWClass', String(ClassName)) <> 0
     Then slFoundWnd.Add(IntToStr(Wnd));
    End;
   Result:= True;
  Except
   On E: Exception
   Do ErrorLog('SearchCallback'+#13#10+E.ClassName+#13#10+E.Message);
  End;
 End;


Procedure SearchWnd;
 Begin
  Try
   EnumWindows(@SearchCallback, 0);
  Except
   On E: Exception
   Do ErrorLog('SearchWnd'+#13#10+E.ClassName+#13#10+E.Message);
  End;
 End;


Procedure MinAllWnds;
 Begin
  Try
   Keybd_event(VK_LWIN, 0, 0, 0);
   Keybd_event(Byte('M'), 0, 0, 0);
   Keybd_event(Byte('M'), 0, KEYEVENTF_KEYUP, 0);
   Keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
  Except
   On E: Exception
   Do ErrorLog('MinAllWnds'+#13#10+E.ClassName+#13#10+E.Message);
  End;
 End;


Procedure StartTwoWinEx;
  Var
   Path1, Path2: String;
   WorkArea : TRect;
 Begin
  Try
   If DirectoryExists('I:\') And DirectoryExists('I:\(DOWNLOADS)')
   Then
    Begin
     Path1:= 'I:\';
     Path2:= 'I:\(DOWNLOADS)';
    End
   Else
    Begin
     Path1:= 'C:\';
     Path2:= 'D:\';
    End;

   ShellExecute(0, Nil, PChar(Path1), Nil, Nil, SW_SHOW);
   ShellExecute(0, Nil, PChar(Path2), Nil, Nil, SW_SHOW);

    Repeat
     slFoundWnd.Clear;
     SearchWnd;
    Until slFoundWnd.Count >= 2;

   SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea,0) ;

   MoveWindow(StrToInt(slFoundWnd[0]),
              WorkArea.Left,
              WorkArea.Top,
              ((WorkArea.Right-WorkArea.Left) Div 2),
              (WorkArea.Bottom-WorkArea.Top),
              True);

   MoveWindow(StrToInt(slFoundWnd[1]),
              ((WorkArea.Right-WorkArea.Left) Div 2),
              WorkArea.Top,
              ((WorkArea.Right-WorkArea.Left) Div 2),
              (WorkArea.Bottom-WorkArea.Top),
              True);
  Except
   On E: Exception
   Do ErrorLog('StartTwoWinEx'+#13#10+E.ClassName+#13#10+E.Message);
  End;
 End;


Procedure Free_slFoundWnd;
 Begin
  Try
   FreeAndNil(slFoundWnd);
  Except
   On E: Exception
   Do ErrorLog('Free_slFoundWnd'+#13#10+E.ClassName+#13#10+E.Message);
  End;
 End;


Begin
 Try
  slFoundWnd:= TStringlist.Create;
   Try
    SearchWnd;
     If slFoundWnd.Count >= 1
     Then
      Begin
       For I:= 0 To slFoundWnd.Count-1
       Do
        Begin
         WndHandle:= StrToInt(slFoundWnd[I]);
         SendMessage(WndHandle, WM_CLOSE, 0, 0);
        End;
      End;
    MinAllWnds;
    StartTwoWinEx;
   Finally
    Free_slFoundWnd;
   End;
 Except
  On E: Exception
  Do ErrorLog('MAIN PRG'+#13#10+E.ClassName+#13#10+E.Message);
 End;
End.
@ jaenicke:
"Sleep 1000" ist zwar nicht die Ewigkeit, aber besser wäre natürlich ohne... "MoveWindow" ist doch uralt oder? Das hatten doch schon die ersten Win9x-Versionen im Programm?? Ist doch gar nicht schlecht wenn man das überall verwenden kann.

Ich probier jetzt nochmal "SetForegroundWindow" und Restore & Co. .. mal sehen wie das optisch wirkt... (mal ohne MinAllWnds).
  Mit Zitat antworten Zitat