Выборочный FAQ по некоторым интересным вопросам


  • Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
  • Как мне получить путь к запущенной программе из нее самой?
  • Как в Delphi определить, где установлена Windows?
  • Каким образом можно убрать приложение из Task Bar?
  • Каким образом можно убрать приложение из Task List? (Только для Win'9x)
  • Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
  • Как можно сделать форму прозрачной?
  • Как сделать произвольную (непрямоугольную) форму?
  • Как создать файлы с уникальными именами?
  • Как программно переключать раскладку клавиатуры?
  • Как сделать невидимой главную форму?
  • Как запустить создание письма по указанному адресу?
  • Как запустить браузер по http-адресу?
  • Как рисовать прямо на экране?
  • Как увеличить в RichEdit размер редактируемого файла?
  • В каком порядке происходят события при создании и показе окна?
  • Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?
  • Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую страницу и обратно?
  • Как использовать анимированные курсоры в программе?
  • Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос на сохранение?
  • Как выключить/включить PC Speaker?
  • Как скопировать файл?
  • Как инсталлировать на время работы программы свои шрифты?
  • Как узнать текущее разрешение экрана?
  • Как встроить некий ресурс, например, графику в исполняемый модуль?
  • Как программно создать ярлык?
  • Как быстро выводить графику? (А то Canvas очень медленно работает)
  • Как перетаскивать форму не только за Caption, но и за любое другое место?
  • Как лучше сделать, если необходимо запустить внешний процесс и подождать, пока он отработает?


    Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
    GetAsyncKeyState. И для клавиатуpы, и для мыши.
    Как мне получить путь к запущенной программе из нее самой?
    Application.EXEName
    Как в Delphi определить, где установлена Windows?
    GetWindowsDirectory
    Пример:
      var  Windir  : String;
           WindirP : PChar;
    
    		     .  .  .  .  .
           WinDirP := StrAlloc(MAX_PATH);
    Res := GetWindowsDirectory(WinDirP, MAX_PATH);
    if Res > 0 then WinDir := StrPas(WinDirP);
    . . . . .

    Каким образом можно убрать приложение из Task Bar?
    ShowWindow(Application.Handle,SW_HIDE);
    Каким образом можно убрать приложение из Task List? (Только для Win'9x)
      Пример:
    
      unit hideprg;
      interface
      procedure TryToHide;
      implementation
      procedure RegisterServiceProcess; external 'kernel32.dll' name
                                                 'RegisterServiceProcess';
      procedure TryToHide;assembler;
      asm
        push 1
        push 0
        call RegisterServiceProcess;
      end;
    

    Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
    Пример (работает только в Win'95):
      var  WnHnd   : Integer;
      . . . .
      WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE);
      WnHnd := WnHnd or WS_EX_TOOLWINDOW;
      SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd);
      . . . .
    

    Как можно сделать форму прозрачной?
    Для этого необходимо пеpеопpеделить обpаботчик события OnCreate:
      procedure TForm1.FormCreate(Sender: TObject);
      begin
         Brush.Style:=bsClear;
      end;
    

    Как сделать произвольную (непрямоугольную) форму?
    Win32 (Windows'95 or Windows NT 4.0 or above).
    Достаточно создать регион нужной формы и вызвать SetWindowRgn
       HRGN rgn := CreateEllipticRgn( 10,10,100,100 );
       SetWindowRgn( hMyWnd,rgn );  // Вот и будет круглое окно
    
    При этом регион этот теперь используется Windows и будет уничтожен при закрытии окна.
      Вот, например:
      ........................................................
      procedure TForm1.FormCreate(Sender: TObject);
      const W=36*pi/180;
      var   R,R1,R2: HRgn; X,Y,i:integer;
         function S(a:integer;R:integer):integer;
         begin
           Result:=round(R*sin(W*a));
         end;
         function C(a:integer;R:integer):integer;
         begin
           Result:=round(R*cos(W*a));
         end;
         function GetStarReg(X,Y,R:integer):HRGN;
         var  P : array [0..4] of TPoint;
         begin
            P[0] := Point(X, Y-R);
            P[1] := Point(X-S(4,R), Y-C(4,R));
            P[2] := Point(X-S(8,R), Y-C(8,R));
            P[3] := Point(X-S(2,R), Y-C(2,R));
            P[4] := Point(X-S(6,R), Y-C(6,R));
            Result := CreatePolygonRgn(P, 5, WINDING);
         end;
      begin
         X:=Width div 2;
         Y:=Height div 2;
         R:=GetStarReg(X,Y,100);
         i:=1;
         repeat
           R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
           CombineRgn(R,R,R1,RGN_OR);
           inc(i,2);
         until i>9;
         R1:=GetStarReg(X,Y,30);
         CombineRgn(R,R,R1,RGN_DIFF);
         R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
         R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
         CombineRgn(R1,R1,R2,RGN_DIFF);
         CombineRgn(R,R,R1,RGN_OR);
         SetWindowRgn(Handle, R, True);
      end;
      ........................................................
    

    Как создать файлы с уникальными именами?
    Здесь удобнее всего использовать имя, состоящее из даты и времени, напри- мер: 2310566160798 для 23:10:56 16-07-98. Если перевести это число в 32-чную систему счисления, получим искомые восемь символов имени файла. Это хорошо использовать, если программа создает много файлов, которые потом будут ис- пользоваться. Если же нужно создать несколько временных файлов, то лучше воспользоваться фyнкцией GetTempFileName.
    Как программно переключать раскладку клавиатуры?
    LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
    LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский
    Как сделать невидимой главную форму?
    Hаписать Application.ShowMainForm := False в файле пpоекта.
    Как запустить создание письма по указанному адресу?
    Как запустить браузер по http-адресу?
    Сначала необходимо написать в разделе uses ShellAPI.
    E-mail:
    ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);
    Страничка:
    ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);

    Как рисовать прямо на экране?
      ........................................................
      Procedure DrawOnScreen;
      Var DC:HDC;
          DesktopCanvas:TCanvas;
      begin
        DC:=GetDC(0);   // получили DC экрана
        try
           DesktopCanvas:=TCanvas.Create;
           DesktopCanvas.Handle:=DC;
           ..................
           // здесь рисуем на Canvas экрана
           ..................
        finally
          ReleaseDC(0,DC);
          DesktopCanvas.Free;
        end;
      end;
      ........................................................
    

    Как увеличить в RichEdit размер редактируемого файла?
    RichEdit1.Perform(EM_LIMITTEXT, нужный размер , 0);
    Перед каждым открытием файла это действие необходимо повторять.
    В каком порядке происходят события при создании и показе окна?
    OnCreate, OnShow, OnPaint, OnActivate, OnResize и снова OnPaint.

    Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?
    1. Вставить в тело цикла: Application.ProcessMessages
    2. Запустить этот цикл как отдельный процесс, используя класс TThread.

    Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую страницу и обратно?
    CharToOEM/OEMToChar и CharToOEMBuff/OEMToCharBuff.
    Как использовать анимированные курсоры в программе?
      Пример формы, использующей анимированный курсор:
      ........................................................
      procedure TForm1.Button1Click(Sender: TObject);
      var
        h : THandle;
      begin
        h := LoadImage(0,'C:\TheWall\Magic.ani',
          IMAGE_CURSOR, 0, 0,
          LR_DEFAULTSIZE or LR_LOADFROMFILE);
        if h = 0 then ShowMessage('Cursor not loaded')
        else
        begin
          Screen.Cursors[1] := h;
          Form1.Cursor := 1;
        end;
      end;
      ... ..... ...... ....... ....... ...... ..
    

    Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос на сохранение?
    Обрабатывать событие OnCloseQuery
    Как выключить/включить PC Speaker?
    Выключить:
      SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
    
    Включить:
      SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
    

    Как скопировать файл?
    Эта процедура позволяет скопиpовать как весь файл пpи From и Count = 0, так и пpоизвольный его кусок.
      ........................................................
      function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;
      var
        InFS,OutFS: TFileStream;
      begin
        InFS  := TFileStream.Create( InFile,  fmOpenRead );
        OutFS := TFileStream.Create( OutFile, fmCreate   );
        InFS.Seek( From, soFromBeginning );
        Result := OutFS.CopyFrom( InFS, Count );
        InFS.Free;
        OutFS.Free;
      end;
      ........................................................
    

    Как инсталлировать на время работы программы свои шрифты?
      Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
      ........................................................
      {$IFDEF WIN32}
      AddFontResource( PChar( my_font_PathName { AnsiString } ) );
      {$ELSE}
      var
        ss  : array [ 0..255 ] of Char;
    
      AddFontResource ( StrPCopy ( ss, my_font_PathName ));
      {$ENDIF}
      SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
      ........................................................
    
      Убрать его по окончании работы:
      ........................................................
      {$IFDEF WIN32}
      RemoveFontResource ( PChar(my_font_PathName) );
      {$ELSE}
      RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
      {$ENDIF}
      SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
      ........................................................
    
      Где my_font_PathName - полный путь к файлу со шрифтом.
    

    Как узнать текущее разрешение экрана?
    Screen.Width, Screen.Height
    Как в TMemo определить номер строки, в которой находится курсор и его местоположение в строке?
      ........................................................
      var X,Y: LongInt;
    
      Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
      X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
      inc(Y);
      X:=Memo1.SelStart-X+1;
      ........................................................
    

    Есть программа на Delphi, котоpая отображает какой-то html. В html используется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился в exe как некий кусок кода. А когда надо будет, записать его обратно в gif-файл без изменений, выковырнув из exe? Можно, используя RxLib. После его установки в меню View появится пунктик Project Resources. Hужно выбрать Project Resources->New->User Data и добавить нужный файл. В данном случае ресурс был назван "RCDATA_1".
    Если RxLib нет, то нужно создать файл описания ресурсов:
    === Begin gifs.rc ===
    mygif rcdata "имя_gif-файла.gif"
    mygif1 rcdata "RCDATA_1"
    === End dots.rc ===
    
    Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res В начало модуля добавь строчку {$R gifs.res}
    В своей программе необходимо написать:
    var
      rs     : TResourceStream;
      a      : Pointer;
    begin
      rs:=TResourceStream.Create(hinstance,'RCDATA_1',RT_RCDATA);
      try
        GetMem(a,rs.size);
        rs.Read(a^,rs.size);  {Теперь a - динамический указатель на код}
    
        { Здесь делается все, что необходимо с кодом, используя указатель a }
    
        FreeMem(a);
      finally
        rs.Free;
      end;
    end;
    
    А можно и так, если необходимо записать ресурс в файл:
    var
      rs     : TResourceStream;
      fs     : TFileStream;
    begin
       rs:=TResourceStream.Create(hInstance, 'mygif', RT_RCDATA);
       fs:=TFileStream.Create('имя_gif-файла.gif', fmCreate);
       try
         fs.CopyFrom(rs, rs.Size);
       finally
         fs.Free;
         rs.Free;
       end;
    end;
    

    Как программно создать ярлык?
      ........................................................
      uses ShlObj, ComObj, ActiveX;
    
      procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
      var
        IObject: IUnknown;
        SLink: IShellLink;
        PFile: IPersistFile;
      begin
        IObject := CreateComObject(CLSID_ShellLink);
        SLink := IObject as IShellLink;
        PFile := IObject as IPersistFile;
        with SLink do begin
          SetArguments(PChar(Param));
          SetDescription(PChar(Desc));
          SetPath(PChar(PathObj));
        end;
        PFile.Save(PWChar(WideString(PathLink)), FALSE);
      end;
      ........................................................
    

    Как быстро выводить графику? (А то Canvas очень медленно работает).
      Вот пример заполнения формами точками случайного цвета.
      ........................................................
      type
        TRGB=record
          b,g,r:byte;
        end;
        ARGB=array [0..1] of TRGB;
        PARGB=^ARGB;
    
      var
        b:TBitMap;
    
      procedure TForm1.FormCreate(sender:TObject);
      begin
        b:=TBitMap.Create;
        b.pixelformat:=pf24bit;
        b.width:=Clientwidth;
        b.height:=Clientheight;
      end;
    
      procedure TForm1.Tim1OnTimer(sender:TObject);
      Var
        p:PARGB;
        x,y:integer;
      begin
        for y:=0 to b.height-1 do
        begin
          p:=b.scanline[y];
          for x:=0 to b.width-1 do
          begin
            p[x].r:=random(256);
            p[x].g:=random(256);
            p[x].b:=random(256);
          end;
        end;
        canvas.draw(0,0,b);
      end;
    
      procedure TForm1.FormDestroy(sender:TObject);
      begin
        b.free;
      end;
      ........................................................
    

    Как перетаскивать форму не только за Caption, но и за любое другое место?
         ........................................................
           TForm1 = class(TForm)
           ...
           private
           ...
             procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
           ...
           end;
    
       ...
       procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
       begin
         inherited;                    { вызов унаследованного обpаботчика      }
         if  M.Result = htClient then  { Мышь сидит на окне?                    }
           M.Result := htCaption;      { Если да - то пусть Windows думает, что }
                                       { мышь на caption bar                    }
       end;
      ........................................................
    

    Как лучше сделать, если необходимо запустить внешний процесс и подождать, пока он отработает?
    procedure TForm1.Button1Click(Sender: TObject);
    var si:STARTUPINFO;
        pi:PROCESS_INFORMATION;
        cmdline:string;
    begin
        ZeroMemory(@si,sizeof(si));
        si.cb:=SizeOf(si);
        cmdline:='c:\command.com';
        if not CreateProcess( nil, // No module name (use command line).
            PChar(cmdline),  // Command line.
            nil,             // Process handle not inheritable.
            nil,             // Thread handle not inheritable.
            False,           // Set handle inheritance to FALSE.
            0,               // No creation flags.
            nil,             // Use parent's environment block.
            nil,             // Use parent's starting directory.
            si,              // Pointer to STARTUPINFO structure.
            pi )             // Pointer to PROCESS_INFORMATION structure.
           then
            begin
             ShowMessage( 'CreateProcess failed.' );
             Exit;
            end;
        WaitForSingleObject( pi.hProcess, INFINITE );
        CloseHandle( pi.hProcess );
        CloseHandle( pi.hThread );
        ShowMessage('Done !');
    end;