Podstrony o programowaniu w Delphi

Strona o Delphi Pascal

Wprowadzanie hasła przy pomocy InputBox z ukrywaniem znaków
InputBox odp := InputBox('Potwierd- uprawnienia!',#31'HasÅ‚o : ','');
dodajemy #31
Okno dialogowe z klawiszami
MessageDlg if MessageDlg('Czy napewno usunąć tego użytkownika?',
               mtInformation, [mbYes, mbNo], 0, mbNo) = mrYes then

- treść
- ikona
- zestaw klawiszy
- 0
- domyÅ›lny ( podÅ›wietlony klawisz )
OK        mrOK      1
Anuluj    mrCancel  2
Tak       mrYes     6
Nie       mrNo      7
Przerwij  mrAbort   3
Powtórz   mrRetry   4
Ignoruj   mrIgnore  5

mtCustom        nazwa programu   brak
mtInformation   Information      dymek z literÅ¡ I
mtWarning       Warning          trójkÅ¡cik z wykrzyknikiem
mtError         Error            kółeczko z X
mtConfirmation  Confirmation     dymek ze znakiem zapytania
Hex wprowadzany przy pomocy MaskEdit
MaskEdit Object Inspector > EditMask
Wprowadzamy nastÄ™pujÄ…cÄ… filtr      !AA-AA-AA-AA-AA-AA-AA-AA;1;_
Dodajemy zdarzenie 
procedure TForm4.MaskEdit1KeyPress(Sender: TObject; var Key: Char);
begin
     key := UpCase(key);
     if not (Key in ['0'..'9','A'..'F']) then Key := #0;
end;
Shift: TShiftState
Shift = pusto Sprawdzenie czy którykolwiek z dodatkowych klawiszy zostaÅ‚ wciÅ›niÄ™ty

ssShift  Klawisz Shift jest wciÅ›niÄ™ty.  
ssAlt  Przytrzymany jest klawisz Alt.  
ssCtrl  Przytrzymany jest klawisz Ctrl.  
ssLeft  Lewy przycisk myszy jest wciÂœniÄ™ty.  
ssPrawa  Prawy przycisk myszy jest wciÂœniÄ™ty.  
ssMiddle   ÂŒrodkowy przycisk myszy jest wciÂœniÄ™ty.  
ssDouble   Mysz zostaÅ‚a dwukrotnie klikniÄ™ta.  
procedure Form1.gGridKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);
begin     
 if (key=13) and (Shift = [] ) then
         begin
              // wciÂœniÄ™ty sam enter bez Ctrl i Shift
        end;
end;

lub  if ( Key = VK_DELETE ) and ( ssCtrl in shift ) then
potwierdzić if ([ssShift, ssCtrl] in shift) then
Pobranie katalogu pulpitu
DESKTOP Funkcja zwraca katalog pulpitu.

uses WinApi.ShlObj;

function GetDesktopFolder: string;
var  buf: array[0..MAX_PATH] of char;
     pidList: PItemIDList;
begin
     Result := 'Brak danych.';
     SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidList);
     if (pidList <> nil) then
        if (SHGetPathFromIDList(pidList, buf)) then Result := buf;
end;


Tworzenie skrótu na pulpicie
Skrót Procedura tworzy na pulpicie skrót.
SciezkaIexe - Å›cieżka razem z nazwÄ… programu
KatalogPracy - katalog pracy
SciezkaSkrotu - Å›cieżka skrótu ( pulpitu )
Komentarz - komentarz
Parametry - z jakimi parametrami wywoÅ‚ujemy program ( opcja )



uses WinApi.ShlObj, System.Win.ComObj, ActiveX

procedure CreateLink(const SciezkaIexe, KatalogPracy , 
          SciezkaSkrotu , Komentarz , Parametry : 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(Parametry ));
      SetDescription(PChar(Komentarz));
      SetPath(PChar(SciezkaIexe));
      SetWorkingDirectory(PChar(KatalogPracy));
    end;
    PFile.Save(PWChar(WideString(SciezkaSkrotu)), FALSE);
end;



Zamykanie znanej aplikacji
HWND Zamykanie aplikacji po pobraniu jej uchwytu

Używamy do tego polecenia SendMessage ( wyÅ›lij komunikat )
o treÅ›ci zakoÅ„cz dziaÅ‚anie programu ( WM_CLOSE ).
uses Winapi.Windows 

var mmHWND : HWND;

begin
    mmHWND := ExeProcessToHWnd('nazwa aplikacji.exe');
    ShowMessage('nazwa aplikacji.exe '+IntToStr(mmHWND));
    SendMessage(mmHWND_DM, WM_CLOSE, 0, 0);
end;
Dni miesiÄ…ca
DateTime OkreÅ›lenie z daty
pierwszego i ostatniego dnia miesiÄ…ca.
DateTimePicker1.DateTime := StartOfTheMonth(Now());
DateTimePicker2.DateTime := EndOfTheMonth(Now());
Formatowanie wyświetlania daty
DateTimePicker WyÅ›wietlanie daty w ustalonym formacie 
niezależnie od ustawieÅ„ w systemie.
FormatSettings.ShortDateFormat:='yyyy-mm-dd';
FormatSettings.DateSeparator:='-';
FormatSettings.ShortTimeFormat:='hh:nn:ss';
FormatSettings.TimeSeparator:=':';
DateTimePicker1.Format := 'yyyy-MM-dd';
DateTimePicker2.Format := 'yyyy-MM-dd';
DateTimePicker1.DateTime := StartOfTheMonth(Now());
DateTimePicker2.DateTime := EndOfTheMonth(Now());
Procedura ze zmienną ilością prarametrów
Procedure Tworzenie procedury z domyÅ›lnymi parametrami wejÅ›ciowymi,
które można pomijać przy wywoÅ‚aniu.
procedure NazwaProcedury ( FName : String;
                           SName : String = 'Nieznany';
                           Age : Byte = 0 );

wywoÅ‚anie :
procedure NazwaProcedury ( 'tekst' );
procedure NazwaProcedury ( 'tekst', 'tekst2' );
procedure NazwaProcedury ( 'tekst', 'tekst2' , 1 );

Kolor TPanel
Color Panel przyjmie ustawiony kolor w [ Object Inspector ]
Panel1.ControlState := Panel1.ControlState - [csParentBackground];
Szukannie w TStringGrid
TStringGrid Poniższy algorytm szuka fragmentu tekstu w siatce TStringGrid. Procedura,
siatkÄ™ przeszukuje w takiej kolejnoÅ›ci ja czytamy czyli od lewej 
strony do prawej wiersz za wierszem poczym wraca do pocztÄ…tku.
Jak sprawdzi wszystkie Cells i nie znajdzie szukanego 
testu to wypisuje komunikat o jego braku.
procedure TForm1.SzukajTextu( ggs : TStringGrid;  inStr : string );
var r, c : integer;

 procedure incCR; // przesuÅ„ siÄ™ w prawo tak jak czytamy
 begin
        inc(c);
        if c = ggs.ColCount then
           begin
              c := 1;
              inc(r);
              if r = ggs.RowCount then
                 begin
                    r := 1;
                 end;
           end;
 end;

begin
        if inStr='' then exit;

        if inStr[1]='#' then
           begin // usuwanie danych skanera
              delete ( inStr, pos('#',inStr) , 1 );
              delete ( inStr, pos('!',inStr) , 1 );
              delete ( inStr, pos('&',inStr) , 1 );
         end;

        inStr := LowerCase(inStr);

        StartRowSe := ggs.Row;
        StartColSe := ggs.Col;

        r := StartRowSe;
        c := StartColSe;

        repeat
            incCR;
        until ((r = StartRowSe) and 
               (c = StartColSe)) or 
               ( Pos(inStr,LowerCase(ggs.Cells[c,r]))<>0 );

        if Pos(inStr,LowerCase(ggs.Cells[c,r])) = 0 then
              begin
                ShowMessage(inStr + ': Brak takiej pozycji!');
                ggs.Row := StartRowSe;
                ggs.Col := StartColSe;
              end
            else
              begin
                ggs.Row := r;
                ggs.Col := c;
              end;

end;

Fatal error: Uncaught Error: Call to undefined function mysql_result() in /home/server433550/ftp/licznik.php:30 Stack trace: #0 /home/server433550/ftp/allLang.php(410): licznik_all() #1 {main} thrown in /home/server433550/ftp/licznik.php on line 30