InvalidateRect(Application.Handle, NIL, True);
|
program Previns;
uses
WinTypes,
WinProcs,
SysUtils,
Forms,
Uprevins in 'UPREVINS.PAS' {Form1};
{$R *.RES}
type PHWND = ^HWND; function EnumFunc(Wnd:HWND; TargetWindow:PHWND): bool; export; var ClassName : array[0..30] of char; begin Result := true; if GetWindowWord(Wnd,GWW_HINSTANCE) = hPrevInst then begin GetClassName( Wnd, ClassName, 30 ); if StrIComp( ClassName, 'TApplication' ) = 0 then begin TargetWindow^ := Wnd; Result := false; end; end; end; procedure GotoPreviousInstance; var PrevInstWnd : HWND; begin PrevInstWnd := 0; EnumWindows( @EnumFunc, Longint( @PrevInstWnd ) ); if PrevInstWnd <> 0 then if IsIconic( PrevInstWnd ) then ShowWindow( PrevInstWnd, SW_RESTORE ) else BringWindowToTop( PrevInstWnd ); end; begin if hPrevInst <> 0 then GotoPreviousInstance else begin Application.CreateForm(TForm1, Form1); Application.Run; end; end. |
var MyIcon: TIcon; begin MyIcon := TIcon. Create; try MyIcon.Handle := ExtractIcon(hInstance, 'MYPROG.EXE', 0) {Здесь можно что-нибудь сделать с иконкой} finally MyIcon.Free; end; end; |
... Uses syncobjs; ... Var CheckEvent: TEvent; ... procedure TForm1.FormCreate( Sender: TObject ); begin CheckEvent:= TEvent.Create( nil, false, true, 'MYPROGRAM_CHECKEXIST' ); If CheckEvent.WaitFor( 10 ) <> wrSignaled then begin // Сюда попадаем если одна копия уже запущена. Можно, например, сообщить об этом пользователю. Self.Close; // Здесь можно завершить программу или сделать еще что-нибудь. end; end; |
FindWindow('theclassname', nil) |
FindWindow(nil, 'thecaption') |
unit Wintask1;
interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) ListBox1: TListBox; ListBox2: TListBox; procedure FormCreate(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); private function enumListOfTasks(hWindow: hWnd): Bool; export; function enumListOfChildTasks(hWindow: hWnd): Bool; export; end; THoldhWnd = class(TObject) private public hWindow: hWnd; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin enumWindows(@TForm1.EnumListOfTasks, Longint(Self)); if (ListBox1.Items.Count > 0) then ListBox1.ItemIndex := 0; end; function TForm1.enumListOfTasks(hWindow: hWnd): Bool; var HoldString: PChar; WindowStyle: Longint; IsAChild: Word; HoldhWnd: THoldhWnd; begin GetMem(HoldString, 256); HoldhWnd := THoldhWnd.Create; HoldhWnd.hWindow := hWindow; WindowStyle := GetWindowLong(hWindow, GWL_STYLE); WindowStyle := WindowStyle and Longint(WS_VISIBLE); IsAChild := GetWindowWord(hWindow, GWW_HWNDPARENT); {Добавляем строку с текстом задачи или именем класса и дескриптор в ListBox1.Items } if (GetWindowText(hWindow, HoldString, 255) > 0) and (WindowStyle > 0) and (IsAChild = Word(Nil)) then ListBox1.Items.AddObject(StrPas(HoldString), TObject(HoldhWnd)) else if (GetClassName(hWindow, HoldString, 255) > 0) and (WindowStyle > 0) and (IsAChild = Word(Nil)) then ListBox1.Items.AddObject(Concat('<',StrPas(HoldString),'>'), TObject(HoldhWnd)); FreeMem(HoldString, 256); HoldhWnd := Nil; Result := TRUE; end; function TForm1.enumListOfChildTasks(hWindow: hWnd): Bool; var HoldString: PChar; WindowStyle: Longint; IsAChild: Word; HoldhWnd: THoldhWnd; begin GetMem(HoldString, 256); HoldhWnd := THoldhWnd.Create; HoldhWnd.hWindow := hWindow; WindowStyle := GetWindowLong(hWindow, GWL_STYLE); WindowStyle := WindowStyle and Longint(WS_VISIBLE); IsAChild := GetWindowWord(hWindow, GWW_HWNDPARENT); {Добавляем строку с текстом задачи или именем класса и дескриптор в ListBox1.Items } if (GetWindowText(hWindow, HoldString, 255) > 0) and (WindowStyle > 0)and (IsAChild <> Word(Nil))then ListBox2.Items.AddObject(StrPas(HoldString), TObject(HoldhWnd)) else if (GetClassName(hWindow, HoldString, 255) > 0) and (WindowStyle > 0) and (IsAChild = Word(Nil)) then ListBox2.Items.AddObject(Concat('<',StrPas(HoldString),'>'), TObject(HoldhWnd)); FreeMem(HoldString, 256); HoldhWnd := Nil; Result := TRUE; end; procedure TForm1.ListBox1DblClick(Sender: TObject); begin enumChildWindows(THoldhWnd(ListBox1.Items.Objects[ListBox1.ItemIndex]).hWindow, @TForm1.enumListOfChildTasks, Longint(Self)); ListBox2.RePaint; end; end. |
type TForm1 = class(TForm) ListBox1: TListBox; ListBox2: TListBox; procedure FormCreate(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); private function enumListOfTasks(hWindow: hWnd): Bool; stdcall; function enumListOfChildTasks(hWindow: hWnd): Bool; stdcall; end; |
...
private
{ Private declarations }
InstHandle : Word;
WndHandle : hWnd;
NextGame : Word;
function EnumFunc(H : HWnd) : Word;
PROCEDURE WMQUERYOPEN(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;
...
interface USES ShellApi, IniFiles; {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); VAR H, SubH : hMenu; NewGameID : Word; FreeCellPath : String; begin WITH TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) DO try FreeCellPath := ReadString('FreeCell', 'Path', 'C:\WIN32APP\FREECELL\FREECELL.EXE') + #0; NextGame := ReadInteger('FreeCell', 'NextGame', 1); finally Free; end; InstHandle := ShellExecute(Handle, NIL, @FreeCellPath[1], NIL, NIL, SW_SHOW); WndHandle := 0; IF InstHandle >= 32 THEN EnumWindows(@TForm1.EnumFunc, LongInt(Self)); IF WndHandle <> 0 THEN BEGIN {Вычисляем ID пункта меню "Select Game"} H := GetMenu(WndHandle); SubH := GetSubMenu(H, 0); NewGameID := GetMenuItemID(SubH, 1); Winprocs.SetFocus(WndHandle); {вызываем "Select Game"} PostMessage(WndHandle, WM_COMMAND, NewGameID, 0); Timer1.Enabled := True; END ELSE Close; end; PROCEDURE TForm1.WMQUERYOPEN(VAR Msg : TWMQueryOpen); BEGIN Msg.Result := 0; END; function TForm1.EnumFunc(H : HWnd) : Word; BEGIN IF GetWindowWord(H, GWW_HINSTANCE) = InstHandle THEN BEGIN WndHandle := H; Result := 0; END ELSE Result := 1; END; procedure TForm1.Timer1Timer(Sender: TObject); VAR Buffer : ARRAY[0..10] OF Char; DlgHandle : Word; begin {Если пользователь закрыл FreeCell, выходим!} IF GetModuleUsage(InstHandle) = 0 THEN BEGIN Close; Exit; END; {При необходимости укажите номер игры} DlgHandle := FindWindow('#32770', 'Game Number'); IF DlgHandle <> 0 THEN BEGIN Str(NextGame, Buffer); SendDlgItemMessage(DlgHandle, $CB, WM_SETTEXT, 0, LongInt(@Buffer)); PostMessage(DlgHandle, WM_COMMAND, 1, MakeLong(GetDlgItem(DlgHandle, 1), BN_CLICKED)); END; {Если игра окончена, увеличиваем счетчик} DlgHandle := FindWindow('#32770', 'Game Over'); IF DlgHandle <> 0 THEN BEGIN Inc(NextGame); WITH TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) DO try WriteInteger('FreeCell', 'NextGame', NextGame); finally Free; end; PostMessage(DlgHandle, WM_COMMAND, 6, MakeLong(GetDlgItem(DlgHandle, 6), BN_CLICKED)); END; {Если игра спрашивает, хотите ли вы выйти, отвечем соответственно yes или OK} DlgHandle := FindWindow('#32770', 'FreeCell'); IF DlgHandle <> 0 THEN BEGIN IF (NOT (GetDlgItemText(DlgHandle, 6, Buffer, 10) IN [0,10])) AND (StrComp(Buffer, '&Yes') = 0) THEN PostMessage(DlgHandle, WM_COMMAND, 6, MakeLong(GetDlgItem(DlgHandle, 6), BN_CLICKED)) ELSE IF (NOT (GetDlgItemText(DlgHandle, 2, Buffer, 10) IN [0,10])) AND (StrComp(Buffer, 'Cancel') = 0) THEN PostMessage(DlgHandle, WM_COMMAND, 1, MakeLong(GetDlgItem(DlgHandle, 1), BN_CLICKED)) END; end; |
VAR S : ARRAY[0..40] OF Char; ... StrCopy(S, 'Desktop'); SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); |
program Once; uses {*} WinTypes, WinProcs, SysUtils, Forms, Onceu in 'ONCEU.PAS' {Form1}; {$R *.RES} {*}TYPE {*} PHWND = ^HWnd; {*} FUNCTION EnumWndProc(H : hWnd; P : PHWnd) : Integer; Export; {*} VAR ClassName : ARRAY[0..30] OF Char; {*} BEGIN {*} {Если это окно принадлежит предшествующему экземпляру...} {*} IF GetWindowWord(H, GWW_HINSTANCE) = hPrevInst THEN {*} BEGIN {*} {... проверяем КАКОЕ это окно.} {*} GetClassName(H, ClassName, 30); {*} {Если это главное окно приложения...} {*} IF StrIComp(ClassName, 'TApplication') = 0 THEN {*} BEGIN {*} {... ищем} {*}{*} P^ := H; {*} EnumWndProc := 0; {*} END; {*} END; {*} END; {*} PROCEDURE CheckPrevInst; {*} VAR PrevWnd : hWnd; {*} BEGIN {*} IF hPrevInst <> 0 THEN {*} {Предыдущий экземпляр запущен} {*} BEGIN {*} PrevWnd := 0; {*} EnumWindows(@EnumWndProc, LongInt(@PrevWnd)); {*} {Ищем дескриптор окна предыдущего} {*} {экземпляра и активизируем его} {*} IF PrevWnd <> 0 THEN {*} IF IsIconic(PrevWnd) THEN {*} ShowWindow(PrevWnd, SW_SHOWNORMAL) {*} ELSE BringWindowToTop(PrevWnd); {*} Halt; {*} END; {*} END; begin {*} CheckPrevInst; Application.Title := 'Once'; Application.CreateForm(TForm1, Form1); Application.Run; end. |
procedure TForm1.ButtonKillAllClick(Sender: TObject); var pTask : PTaskEntry; Task : Bool; ThisTask: THANDLE; begin GetMem (pTask, SizeOf (TTaskEntry)); pTask^.dwSize := SizeOf (TTaskEntry); Task := TaskFirst (pTask); while Task do begin if pTask^.hInst = hInstance then ThisTask := pTask^.hTask else TerminateApp (pTask^.hTask, NO_UAE_BOX); Task := TaskNext (pTask); end; TerminateApp (ThisTask, NO_UAE_BOX); end; |
program Project1; uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1}; {$R *.RES} var hwnd: THandle; begin hwnd := FindWindow('TForm1', 'Form1'); if hwnd = 0 then begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end else SetForegroundWindow(hwnd) end. |
program pds; uses Windows, Forms, Main in 'MAIN.PAS' {MainForm}, const MemFileSize=127; MemFileName='one_example'; var MemHnd:HWND; {$R *.RES} begin MemHnd:=CreateFileMapping(HWND($FFFFFFFF),nil, PAGE_READWRITE,0,MemFileSize, MemFileName); if GetLastError<>ERROR_ALREADY_EXISTS then begin Application.Initialize; with TForm1.Create(nil) do try Show; Update; Application.CreateForm(TMainForm, MainForm); finally Free; end; Application.Run; end else Application.MessageBox('Приложение уже запущено (возможно оно свёрнуто на панели задач): Нажмите кнопку ОК для продолжения работы','Производственно-диспетчерская служба',MB_OK); CloseHandle(MemHnd); end. |
CONST SC_UDF = $EFF0; {должен быть < $F000 и делиться на 16}
procedure TForm1.FormCreate(Sender: TObject); begin AppendMenu(GetSystemMenu(Handle, False), MF_STRING, SC_UDF, 'Всегда на&верху'); AppendMenu(GetSystemMenu(Application.Handle, False), MF_STRING, SC_UDF, 'Всегда на&верху'); Application.OnMessage := AppOnMessage; end; procedure TForm1.AppOnMessage(VAR Msg: TMsg; VAR Handled: Boolean); BEGIN IF Msg.Message <> WM_SYSCOMMAND THEN Exit; IF Msg.wParam AND $FFF0 <> SC_UDF THEN Exit; ... здесь вы можете включить код для обработки системного сообщения ... END; |