Advanced Delphi Systems- Windows

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Advanced Delphi Systems- Windows

Mesaj gönderen Asri »

Aşağıdaki unit'i unit1'de uses olarak ekleyip bu unit içindeki procedure ve function'ları kullanbilirsiniz.

Bu unit program windows işleminde kullanılır.

Kod: Tümünü seç

unit ads_Windows;

{Copyright(c)2000 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 maley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to maley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}

interface
Uses Windows, Classes, SysUtils, Forms;

procedure ApInstanceOnlyOne;
Function  ApInstanceGetOtherApHandle: THandle;
Function  ApInstanceIsOnly: Boolean;
Function  ApWindowActiveSet(Handle: THandle): Boolean;
Function  WindowListGetByHandle: String;
Function  WindowListGetByName: String;


implementation

Var
  lst         : TStringList;
  MutexHandle : THandle;

Function ApInstanceIsOnly: Boolean;
Begin
  Try
    MutexHandle := CreateMutex(nil, False, PChar(ParamStr(0)));
    If GetLastError = ERROR_ALREADY_EXISTS Then
    Begin
      Result := False;
    End
    Else
    Begin
      Result := (MutexHandle > 0);
    End;
  Except
    Result := False;
  End;
End;

Function ApInstanceGetOtherApHandle: THandle;
Var
  sgApTitle       : String;
  inApHandleCur   : Integer;
  inApHandleOther : Integer;
  sgApHandleCur   : String;
  lst             : TStringList;
  inCounter       : Integer;
  sgVar           : String;
  sgValue         : String;
  inPos           : Integer;
  sgTemp          : String;
Begin
  Result := 0;
  Try
    lst := TStringList.Create();
    Try
      lst.Clear;
      sgApTitle     := Application.Title;
      inApHandleCur := Application.Handle;
      sgApHandleCur := IntToStr(inApHandleCur);
      lst.SetText(PChar(WindowListGetByName));
      For inCounter := 0 To lst.Count-1 Do
      Begin
        sgTemp      := lst[inCounter];
        inPos       := Pos('=',sgTemp);
        If inPos > 0 Then
        Begin
          sgVar     := Copy(sgTemp,1,inPos-1);
          sgValue   := Copy(sgTemp,inPos+1,Length(sgTemp)-(inPos+1)+1);
          If (sgVar = sgApTitle) And (sgValue <> sgApHandleCur) Then
          Begin
            inApHandleOther := StrToInt(sgValue);
            Result := inApHandleOther;
            Break;
          End
        End;
      End;
    Finally
      lst.Free;
    End;
  Except
  End;
End;

Function ApWindowActiveSet(Handle: THandle): Boolean;
begin
  Result := True;
  Try
    SetForegroundWindow(Handle);
  Except
    Result := False;
  End;
end;

Function WindowListGetByHandle: String;
  Var
    inCounter : Integer;
  Function WindowListGetByHandleDetail(hWnd: HWND; lParam: LPARAM): BOOL;stdcall;
  Var
    sgTitle   : Array[0..255] of char;
    sgBase    : String;
    sgH       : String;
    inLen     : Integer;
    sgText    : String;
  Begin
    sgBase := '    ';
    If Not (GetWindowText(hWnd, sgTitle, 255)=0) Then
    Begin
      sgH       := IntToStr(hWnd);
      inLen     := Length(sgH);
      sgH       := Copy(sgBase,1,4-inLen)+sgH;
      sgText    :=(Format('%s',[sgTitle]));
      lst.Add(sgH+'='+sgText);
    End;
    Result:=TRUE;
  End;
Begin
  lst.Clear;
  lst.Duplicates := dupAccept;
  lst.Sorted := True;
  Try
    EnumWindows(@WindowListGetByHandleDetail,0);
  Except
  End;
  lst.Sorted := False;
  For inCounter := 0 To lst.Count - 1 Do
  Begin
    lst[inCounter] := TrimLeft(lst[inCounter]);
  End;
  Result := lst.Text;
end;

Function WindowListGetByName: String;
  Var
    inCounter : Integer;
  Function WindowListGetByHandleDetail(hWnd: HWND; lParam: LPARAM): BOOL;stdcall;
  Var
    sgTitle   : Array[0..255] of char;
    sgH       : String;
    sgText    : String;
  Begin
    If Not (GetWindowText(hWnd, sgTitle, 255)=0) Then
    Begin
      sgH       := IntToStr(hWnd);
      sgText    :=(Format('%s',[sgTitle]));
      lst.Add(sgText+'='+sgH);
    End;
    Result:=TRUE;
  End;
Begin
  lst.Clear;
  lst.Duplicates := dupAccept;
  lst.Sorted := True;
  Try
    EnumWindows(@WindowListGetByHandleDetail,0);
  Except
  End;
  lst.Sorted := False;
  For inCounter := 0 To lst.Count - 1 Do
  Begin
    lst[inCounter] := TrimLeft(lst[inCounter]);
  End;
  Result := lst.Text;
end;

procedure ApInstanceOnlyOne;
Var
  OtherHandle : THandle;
Begin
  If ApInstanceIsOnly Then Exit;
  OtherHandle := ApInstanceGetOtherApHandle;
  If OtherHandle = 0 Then Exit;
  ApWindowActiveSet(OtherHandle);
  Try
    ShowWindow(OtherHandle,SW_RESTORE);
  Except
  End;
  Halt;
End;

Initialization
  lst := TStringList.Create();
Finalization
  lst.Free;
end.
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Cevapla