Simple Generics Type Example

Simple Generics Type Example

Here’s how to define a simple generic class:

type

TGenericContainer<T> = class

Value : T;

end;

With the following definition, here’s how to use an integer and string generic container:

var

genericInt : TGenericContainer<integer>;

genericStr : TGenericContainer<string>;

begin

genericInt := TGenericContainer<integer>.Create;

genericInt.Value := 2009; //only integers

genericInt.Free;

genericStr := TGenericContainer<string>.Create;

genericStr.Value := 'Delphi Generics'; //only strings

genericStr.Free;

end;

Calling CreateProcess() the easy way

If you look up the CreateProcess() function in Win32 help, you'll notice that there are more than three dozen parameters that you can optionally setup before calling it. The good news is that you have to setup only a small number of those parameters to make a simple CreateProcess() call as demonstrated in the following function:

function CreateProcessSimple(sExecutableFilePath: string ): string;
var
  pi: TProcessInformation;
  si: TStartupInfo;
begin
  FillMemory(@si, sizeof(si), 0);
  si.cb := sizeof(si);

  CreateProcess(
    nil,
    PChar( sExecutableFilePath ),     // path to the executable file:
    nil, nil, False,
    NORMAL_PRIORITY_CLASS, nil, nil,
    si, pi
  );

  // "after calling code" such as
  // the code to wait until the
  // process is done should go here  
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

Now, all you have to do is call CreateProcessSimple(), let's say to run Windows' Notepad:

CreateProcessSimple('notepad');

Strings in Case statements

function CaseOfString(s: string; a: array of string): Integer;
begin
  Result := 0;
  while (Result < Length(a)) and (a[Result] <> s) do
    Inc(Result);
  if a[Result] <> s then
    Result := -1;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  case CaseOfString(Edit1.Text, ['42', '23', 'nerd alert', 'hello world']) of
    0: Label1.Caption := 'What is six times nine?';
    1: Label1.Caption := 'Nichts ist, wie es scheint...';
    2: Label1.Caption := 'BATMAAAAAAAN!';
    3: Label1.Caption := 'Hello people.';
    else
      Label1.Caption := '?';
  end;
end;

check, if a directory is empty?

function DirectoryIsEmpty(Directory: string): Boolean;
var
  SR: TSearchRec;
  i: Integer;
begin
  Result := False;
  FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
  for i := 1 to 2 do
    if (SR.Name = '.') or (SR.Name = '..') then
      Result := FindNext(SR) <> 0;
  FindClose(SR);
end;


// Beispiel:
// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DirectoryIsEmpty('C:\test') then
    Label1.Caption := 'empty'
  else
    Label1.Caption := 'not empty';
end;

show a form without focusing

...show a form without focusing

//in TCustomForm class,in protected section add

    procedure ShowParam(var param : integer);dynamic;
    {
    this procedure call when form should be show,
    now you should override this method and write your option for
    ShowWindow API. see the example
    }
    function InShowFocus : boolean ;dynamic;
    //this function determine that after show the Form , focus on it or no.

//and it's code is

procedure TCustomForm.ShowParam(var param: Integer);
const
  ShowCommands: array[TWindowState] of Integer =
    (SW_SHOWNORMAL, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED);
begin
  param := ShowCommands[FWindowState];
end;

function TCustomForm.InShowFocus: Boolean;
begin
  Result := True;
end;
//-------------------------------------------------------
//now in your class you can use from themunit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm2 = class(TForm)
  private
    { Private declarations }
  protected
    procedure ShowParam(var param: Integer); override;
    function InShowFocus: Boolean; override;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TForm2 }

function TForm2.InShowFocus: Boolean;
begin
  Result := False;
end;

procedure TForm2.ShowParam(var param: Integer);
begin
  inherited;
  param := SW_SHOWNOACTIVATE;
end;

end.

Show the select directory dialog

uses Filectrl;


procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: String;
begin
  SelectDirectory('Select a directory', '', Dir);
  ShowMessage(Dir);
end;

//Dir is the selected directory

Set date/time of the file

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit1.Text:=OpenDialog1.FileName;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  HFile: Word;
  MyDate: TDateTime;
  MyDate2: Integer;
begin
  HFile:=FileOpen(Edit1.Text, fmOpenWrite);
  MyDate:=StrToDateTime(Edit2.Text);
  MyDate2:=DateTimeToFileDate(MyDate);
  FileSetDate(HFile, MyDate2);
  FileClose(HFile);
end;

Simulate the pressing of keyboard keys

{1. PostKeyEx32 function}

procedure PostKeyEx32(key: Word; const shift: TShiftState; specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx32
*
* Parameters:
*  key    : virtual keycode of the key to send. For printable
*           keys this is simply the ANSI code (Ord(character)).
*  shift  : state of the modifier keys. This is a set, so you
*           can set several of these keys (shift, control, alt,
*           mouse buttons) in tandem. The TShiftState type is
*           declared in the Classes Unit.
*  specialkey: normally this should be False. Set it to True to
*           specify a key on the numeric keypad, for example.
* Description:
*  Uses keybd_event to manufacture a series of key events matching
*  the passed parameters. The events go to the control with focus.
*  Note that for characters key is always the upper-case version of
*  the character. Sending without any modifier keys will result in
*  a lower-case character, sending it with [ssShift] will result
*  in an upper-case character!
************************************************************}
type
  TShiftKeyInfo = record
    shift: Byte;
    vkey: Byte;
  end;
  byteset = set of 0..7;
const
  shiftkeys: array [1..3] of TShiftKeyInfo =
    ((shift: Ord(ssCtrl); vkey: VK_CONTROL),
    (shift: Ord(ssShift); vkey: VK_SHIFT),
    (shift: Ord(ssAlt); vkey: VK_MENU));
var
  flag: DWORD;
  bShift: ByteSet absolute shift;
  i: Integer;
begin
  for i := 1 to 3 do
  begin
    if shiftkeys[i].shift in bShift then
      keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0), 0, 0);
  end; { For }
  if specialkey then
    flag := KEYEVENTF_EXTENDEDKEY
  else
    flag := 0;
  keybd_event(key, MapvirtualKey(key, 0), flag, 0);
  flag := flag or KEYEVENTF_KEYUP;
  keybd_event(key, MapvirtualKey(key, 0), flag, 0);
  for i := 3 downto 1 do
  begin
    if shiftkeys[i].shift in bShift then
      keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0),
        KEYEVENTF_KEYUP, 0);
  end; { For }
end; { PostKeyEx32 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  PostKeyEx32(VK_LWIN, [], False);
  PostKeyEx32(Ord('D'), [], False);
  PostKeyEx32(Ord('C'), [ssctrl, ssAlt], False);
end;
{************************************************************}
{2. With keybd_event API}

procedure TForm1.Button1Click(Sender: TObject);
begin
  {or you can also try this simple example to send any
   amount of keystrokes at the same time. }
  {Pressing the A Key and showing it in the Edit1.Text}
  Edit1.SetFocus;
  keybd_event(VK_SHIFT, 0, 0, 0);
  keybd_event(Ord('A'), 0, 0, 0);
  keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
  {Presses the Left Window Key and starts the Run}
  keybd_event(VK_LWIN, 0, 0, 0);
  keybd_event(Ord('R'), 0, 0, 0);
  keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;
{***********************************************************}
{3. With keybd_event API}

procedure PostKeyExHWND(hWindow: HWnd; key: Word; const shift: TShiftState;
  specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx
*
* Parameters:
*  hWindow: target window to be send the keystroke
*  key    : virtual keycode of the key to send. For printable
*           keys this is simply the ANSI code (Ord(character)).
*  shift  : state of the modifier keys. This is a set, so you
*           can set several of these keys (shift, control, alt,
*           mouse buttons) in tandem. The TShiftState type is
*           declared in the Classes Unit.
*  specialkey: normally this should be False. Set it to True to
*           specify a key on the numeric keypad, for example.
*           If this parameter is true, bit 24 of the lparam for
*           the posted WM_KEY* messages will be set.
* Description:
*  This
procedure sets up Windows key state array to correctly
*  reflect the requested pattern of modifier keys and then posts
*  a WM_KEYDOWN/WM_KEYUP message pair to the target window. Then
*  Application.ProcessMessages is called to process the messages
*  before the keyboard state is restored.
* Error Conditions:
*  May fail due to lack of memory for the two key state buffers.
*  Will raise an exception in this case.
* NOTE:
*  Setting the keyboard state will not work across applications
*  running in different memory spaces on Win32 unless AttachThreadInput
*  is used to connect to the target thread first.
*Created: 02/21/96 16:39:00 by P. Below
************************************************************}
type
  TBuffers = array [0..1] of TKeyboardState;
var
  pKeyBuffers: ^TBuffers;
  lParam: LongInt;
begin
  (* check if the target window exists *)
  if IsWindow(hWindow) then
  begin
    (* set local variables to default values *)
    pKeyBuffers := nil;
    lParam := MakeLong(0, MapVirtualKey(key, 0));
    (* modify lparam if special key requested *)
    if specialkey then
      lParam := lParam or $1000000;
    (* allocate space for the key state buffers *)
    New(pKeyBuffers);
    try
      (* Fill buffer 1 with current state so we can later restore it.
         Null out buffer 0 to get a "no key pressed" state. *)
      GetKeyboardState(pKeyBuffers^[1]);
      FillChar(pKeyBuffers^[0], SizeOf(TKeyboardState), 0);
      (* set the requested modifier keys to "down" state in the buffer*)
      if ssShift in shift then
        pKeyBuffers^[0][VK_SHIFT] := $80;
      if ssAlt in shift then
      begin
        (* Alt needs special treatment since a bit in lparam needs also be set *)
        pKeyBuffers^[0][VK_MENU] := $80;
        lParam := lParam or $20000000;
      end;
      if ssCtrl in shift then
        pKeyBuffers^[0][VK_CONTROL] := $80;
      if ssLeft in shift then
        pKeyBuffers^[0][VK_LBUTTON] := $80;
      if ssRight in shift then
        pKeyBuffers^[0][VK_RBUTTON] := $80;
      if ssMiddle in shift then
        pKeyBuffers^[0][VK_MBUTTON] := $80;
      (* make out new key state array the active key state map *)
      SetKeyboardState(pKeyBuffers^[0]);
      (* post the key messages *)
      if ssAlt in Shift then
      begin
        PostMessage(hWindow, WM_SYSKEYDOWN, key, lParam);
        PostMessage(hWindow, WM_SYSKEYUP, key, lParam or $C0000000);
      end
      else
      begin
        PostMessage(hWindow, WM_KEYDOWN, key, lParam);
        PostMessage(hWindow, WM_KEYUP, key, lParam or $C0000000);
      end;
      (* process the messages *)
      Application.ProcessMessages;
      (* restore the old key state map *)
      SetKeyboardState(pKeyBuffers^[1]);
    finally
      (* free the memory for the key state buffers *)
      if pKeyBuffers <> nil then
        Dispose(pKeyBuffers);
    end; { If }
  end;
end; { PostKeyEx }

procedure TForm1.Button1Click(Sender: TObject);
var
  targetWnd: HWND;
begin
  targetWnd := FindWindow('notepad', nil)
    if targetWnd <> 0 then
    begin
      PostKeyExHWND(targetWnd, Ord('I'), [ssAlt], False);
  end;
end;
{***********************************************************}
{3. With SendInput API}

procedure TForm1.Button1Click(Sender: TObject);
const
   Str: string = 'writing writing writing';
var
  Inp: TInput;
  I: Integer;
begin
  Edit1.SetFocus;
  for I := 1 to Length(Str) do
  begin
    Inp.Itype := INPUT_KEYBOARD;
    Inp.ki.wVk := Ord(UpCase(Str[i]));
    Inp.ki.dwFlags := 0;
    SendInput(1, Inp, SizeOf(Inp));
    Inp.Itype := INPUT_KEYBOARD;
    Inp.ki.wVk := Ord(UpCase(Str[i]));
    Inp.ki.dwFlags := KEYEVENTF_KEYUP;
    SendInput(1, Inp, SizeOf(Inp));
    Application.ProcessMessages;
    Sleep(80);
  end;
end;

procedure SendAltTab;
var
  KeyInputs: array of TInput;
  KeyInputCount: Integer;
 
procedure KeybdInput(VKey: Byte; Flags: DWORD);
  begin
    Inc(KeyInputCount);
    SetLength(KeyInputs, KeyInputCount);
    KeyInputs[KeyInputCount - 1].Itype := INPUT_KEYBOARD;
    with  KeyInputs[KeyInputCount - 1].ki do
    begin
      wVk := VKey;
      wScan := MapVirtualKey(wVk, 0);
      dwFlags := KEYEVENTF_EXTENDEDKEY;
      dwFlags := Flags or dwFlags;
      time := 0;
      dwExtraInfo := 0;
    end;
  end;
begin
  KeybdInput(VK_MENU, 0);                // Alt
  KeybdInput(VK_TAB, 0);                 // Tab
  KeybdInput(VK_TAB, KEYEVENTF_KEYUP);   // Tab
  KeybdInput(VK_MENU, KEYEVENTF_KEYUP); // Alt
  SendInput(KeyInputCount, KeyInputs[0], SizeOf(KeyInputs[0]));
end;

Hi！Delphi ！

http://www.hidelphi.com/

Android MySQL Connectivity via JSON

Android MySQL Connectivity via JSON

http://appinventor.blogspot.com/search/label/android

Rave Report PDF and Intraweb

http://www.felix-colibri.com/papers/db/rave_pdf_intraweb/rave_pdf_intraweb.html

How to track a user's idle time

function SecondsIdle: DWord;
var
   liInfo: TLastInputInfo;
begin
   liInfo.cbSize := SizeOf(TLastInputInfo) ;
   GetLastInputInfo(liInfo) ;
   Result := (GetTickCount - liInfo.dwTime) DIV 1000;
end;

procedure TForm1.Timer1Timer(Sender: TObject) ;
begin
   Caption := Format('System IDLE last %d seconds', [SecondsIdle]) ;
end;

DevExpress GetSkinNames

procedure GetSkinNames(aList: TStrings);
var
  i : Integer;
begin
  for i := 0 to Pred(cxLookAndFeelPaintersManager.Count ) do
    AList.Add( cxLookAndFeelPaintersManager.Items[ i ].LookAndFeelName );
end;
/////////////////
uses
...., cxLookAndFeelPainters, dxSkinInfo, dxGDIPlusClasses;

procedure GetSkinNamesAndIcon(aList: TStrings; aImageList16 : TcxImageList);
var
  i         : Integer;
  fDetails  : TdxSkinDetails;
  fIcon     : TdxPNGImage;
  fPainter  : TcxCustomLookAndFeelPainter;
  fSkinInfo : TdxSkinInfo;
  fImg      : TBitmap;
  fTempList : TStrings;
begin
  fImg := TBitmap.Create;
  fTempList := TStringList.Create;
  try
    for i := 0 to Pred( cxLookAndFeelPaintersManager.Count ) do
    begin
      fTempList.Add( cxLookAndFeelPaintersManager.Items[ i ].LookAndFeelName );
    end;
    for i := 0 to Pred( fTempList.Count ) do
    begin
      cxLookAndFeelPaintersManager.GetPainter(fTempList[i], fPainter);
      fPainter.GetPainterData(fSkinInfo) ;
      if fPainter.GetPainterDetails(fDetails) then
      begin
        aList.Add(fTempList[i]);
        fIcon := fDetails.Icons[sis16];
        fImg.Assign(fIcon);
        aImageList16.Add(fImg, Nil);
      end;
    end;
  finally
    fImg.Free;
    fTempList.Free;
  end;
end;

Delphi and USB

http://sourceforge.net/projects/delphiusb/?source=directory

convert a WideString to a String

{:Converts Unicode string to Ansi string using specified code page.
  @param   ws       Unicode string.
  @param   codePage Code page to be used in conversion.
  @returns Converted ansi string.
}

function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
var
  l: integer;
begin
  if ws = ' then
    Result := '
  else
  begin
    l := WideCharToMultiByte(codePage,
      WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
      @ws[1], - 1, nil, 0, nil, nil);
    SetLength(Result, l - 1);
    if l > 1 then
      WideCharToMultiByte(codePage,
        WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
        @ws[1], - 1, @Result[1], l - 1, nil, nil);
  end;
end; { WideStringToString }


{:Converts Ansi string to Unicode string using specified code page.
  @param   s        Ansi string.
  @param   codePage Code page to be used in conversion.
  @returns Converted wide string.
}
function StringToWideString(const s: AnsiString; codePage: Word): WideString;
var
  l: integer;
begin
  if s = ' then
    Result := '
  else
  begin
    l := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PChar(@s[1]), - 1, nil, 0);
    SetLength(Result, l - 1);
    if l > 1 then
      MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PChar(@s[1]),
        - 1, PWideChar(@Result[1]), l - 1);
  end;
end; { StringToWideString }

Delphi字符和字符串-Char(AnsiChar)、WideChar与编码的相互转换

Delphi字符和字符串-Char(AnsiChar)、WideChar与编码的相互转换

RadXE 2012-01-30 03:45 Delphi, 程序设计 抢沙发 1阅读次数：9

//Char 类型与其编码值的转换:
var
  b: Byte;
  c: Char;
begin
  b := Ord('A');   {返回: 65}
  b := Ord(#65);   {返回: 65}
  b := Ord($41);   {返回: 65}
  b := Ord(#$41);  {返回: 65}

  b := Byte('A');  {返回: 65}
  b := Byte(#65);  {返回: 65}
  b := Byte($41);  {返回: 65}
  b := Byte(#$41); {返回: 65}

  c := Chr(65);    {返回: A }
  c := Chr($41);   {返回: A }

  c := Char(65);   {返回: A }
  c := Char($41);  {返回: A }
end;

---

//WideChar 类型与其编码值的转换; 汉字的 UniCode 编码范围是: $4E00..$9FA5
var
  w : Word;
  c : WideChar;
  ws: WideString;
  s : string;
begin
  {准备工作}
  ws := '万一';
  c := ws[1];
  //ShowMessage(c); {万}

  {从汉字到 UniCode 编码}
  w := Ord(c);                  {返回十进制数        : 19975}
  w := Word(c);                 {返回十进制数        : 19975}
  s := Format('%.4x',[Ord(c)]); {返回十六进制的字符串: 4E07 }
  s := IntToHex(Ord(c), 4);     {返回十六进制的字符串: 4E07 }

  {从 UniCode 编码到汉字}
  c := #19975;           {万}
  c := #$4E07;           {万}
  c := #$4e07;           {万}
  c := WideChar(19975);  {万}
  c := WideChar($4E07);  {万}
end;

Delphi字符和字符串Char、AnsiChar、WideChar、PChar、PAnsiChar、PWideChar

Delphi字符和字符串Char、AnsiChar、WideChar、PChar、PAnsiChar、PWideChar

RadXE 2012-01-30 03:38 Delphi, 程序设计 抢沙发 1阅读次数：9

//单字符 Char、AnsiChar (在目前版本(2007)中, 它们是一回事, 只有 1 字节大小)
var
  c: Char; {Char 类型的取值范围是: #0..#255, 用十六进制表示是: #$0..#$FF}
begin
  {用十进制方式赋值:}
  c := #65;
  ShowMessage(c); {A}

  {用十六进制方式赋值:}
  c := #$41;
  ShowMessage(c); {A}

  {用 Chr 函数代替 # 符号}
  c := Chr(65);
  ShowMessage(c); {A}
  c := Chr($41);
  ShowMessage(c); {A}

  {Char 长度当然会是 1}
  ShowMessage(IntToStr(Length(c))); {1}

  {Char、AnsiChar 允许这样方便地赋值(也就是和 1 字节长度的字符串是兼容的):}
  c := 'B';
  ShowMessage(c); {B}
end;

---

//UniCode 字符 WideChar; 和 AnsiChar 不同, WideChar 是占 2 字节大小.
var
  c: WideChar; {WideChar 的取值范围是: #0..#65535, 用十六进制表示是: #$0..#$FFFF}
begin
  {WideChar 兼容了 AnsiChar 的 #0..#255; 但占用了 2 字节大小}
  c := #65;
  ShowMessage(c); {A}
  ShowMessage(IntToStr(Length(c))); {1; 这是字符长度}
  ShowMessage(IntToStr(SizeOf(c))); {2; 但占用 2 个字节}

  {用十六进制赋值}
  c := #$4E07;
  ShowMessage(c); {万}
  ShowMessage(IntToStr(Length(c))); {1; 这是字符长度}
  ShowMessage(IntToStr(SizeOf(c))); {2; 但占用 2 个字节}

  {用十进制赋值}
  c := #19975;
  ShowMessage(c); {万}

  {如果不超出 #255 的范围是可以直接赋值的}
  c := 'B';
  ShowMessage(c); {万}

  {这样不行}
  //c := '万'; {这是 Delphi 的支持问题, 估计 Delphi 2008 应该可以解决}

  {可以这样变通一下:}
  c := WideString('万')[1];
  ShowMessage(c); {万}

  {用 WideChar 的方式显示我的名字}
  ShowMessage(#19975#19968);    {万一}
  ShowMessage(#19975 + #19968); {万一}
  ShowMessage(#$4e07#$4e00);    {万一}
end;

---

//字符指针 PChar、PAnsiChar; 在当前版本(2007)中它们没有区别.
var
  p: PChar;
  str: string;
begin
  {可以给 PChar 直接赋予字符串常量}
  p := '万一';
  ShowMessage(p);                   {万一}
  ShowMessage(IntToStr(Length(p))); {4}

  {给变量值需要转换}
  str := '万一的 Delphi 博客';
  p := PChar(str); {转换}
  ShowMessage(p);                   {万一的 Delphi 博客}
  ShowMessage(IntToStr(Length(p))); {18}
end;

---

//宽字符指针 PWideChar
var
  p: PWideChar;
  str: WideString; {注意这里不是 String}
begin
  {可以给 PWideChar 直接赋予字符串常量}
  p := '万一';
  ShowMessage(p);                   {万一}
  ShowMessage(IntToStr(Length(p))); {2}

  {给变量值需要转换}
  str := '万一的 Delphi 博客';
  p := PWideChar(str); {转换}
  ShowMessage(p);                   {万一的 Delphi 博客}
  ShowMessage(IntToStr(Length(p))); {13}
end;

attactfiletoapplication

toring dGina.dll in a Delphi exe file
I've already written several articles about using resource files, in order to store (and use) sound files, video clips, animations and more generally any kind of binary files in a Delphi executable.

This time our oponent is dGina.dll. The process of storing dGina.dll inside your exe is simple as the following 5 steps.
Before you start make sure your Delphi project, for the sake of simplicity, has only one form (Form1) hosting the TdWinLock component.

0. Note: the following steps are described in detail in the article "Inside the EXE"

1. Create a new resource file (call it dGinaDLL.rc). This text document needs to have at least one line:
dGina RCDATA dGina.dll
2. Compile this resource using the brcc32 command line compiler. This will create dGinaDLL.res file.
3. Go to Project | View Source to display your Delphi PROJECT source file. It should look like:

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

4. Now replace the project source file with the next code:

program Project1;

uses
  Forms, Windows, Classes, SysUtils,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

{$R dGinaDLL.RES}  <-- DON'T FORGET

var
 rStream: TResourceStream;
 fStream: TFileStream;
 fname: string;
 sAppPath : string;
begin
  Application.Initialize;

  //start extract dGina.dll if not fond
    sAppPath:=IncludeTrailingPathDelimiter
              (ExtractFileDir(Application.ExeName));
   if not FileExists(sAppPath +'dGina.dll') then
   begin
     fname:=sAppPath+'dGina.dll';
     rStream := TResourceStream.Create
                (hInstance, 'dGina', RT_RCDATA);
     try
      fStream := TFileStream.Create(fname, fmCreate);
      try
       fStream.CopyFrom(rStream, 0);
      finally
       fStream.Free;
      end;
     finally
      rStream.Free;
     end;
   end;
  //stop extract dGina.dll if not fond

  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Quick description of the code:
In general, this is what the code does: Before the Project creates Form1 (hosting dWinLock), we need to make sure that dGina.dll can be found in the Project startup folder. We use the FileExists function to see if dGina.dll exists in the Application exe file's folder. If not found, the code looks "inside" the exe to extract the dGina.dll in the same folder. Once complete the dGina.dll will be saved and the "Big Brother Delphi Application" can proceed...

That's All!

delphi วิธีตรวจสอบค่าที่พิมพ์ว่าเป็นตัวเลข

function IsStrANumber(const S: string): Boolean;
var
P: PChar;
begin
P := PChar(S);
Result := False;
while P^ <> #0 do
begin
if not (P^ in ['0'..'9']) then Exit;
Inc(P);
end;
Result := True;
end;

Adding components to a DBGrid

unit Unit1;


{
Article:

Adding components to a DBGrid

http://delphi.about.com/library/weekly/aa081903a.htm

How to place just about any Delphi control
(visual component) into a cell of a DGBrid.
Find out how to put a CheckBox, a ComboBox
(drop down list box) and even an Image inside
a DBGrid.


..............................................
Zarko Gajic, BSCS
About Guide to Delphi Programming
http://delphi.about.com
how to advertise: http://delphi.about.com/library/bladvertise.htm
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
..............................................
}


interface

uses
  Buttons, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, StdCtrls, DBCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ADOTable1AuthorEmail: TWideStringField;
    ADOTable1Title: TWideStringField;
    ADOTable1Description: TWideStringField;
    ADOTable1Subject: TWideStringField;
    ADOTable1Winner: TBooleanField;
    ADOTable1Image: TBlobField;
    ADOTable1Round: TIntegerField;
    DBCheckBox1: TDBCheckBox;
    DataSource2: TDataSource;
    ADOQuery1: TADOQuery;
    DBLookupComboBox1: TDBLookupComboBox;
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure DBCheckBox1Click(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1CellClick(Column: TColumn);

  private
    procedure SetupGridPickList(const FieldName : string; const sql : string);
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
const IsChecked : array[Boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);
var
  DrawState: Integer;
  DrawRect: TRect;
begin
  if (gdFocused in State) then
  begin
    if (Column.Field.FieldName = DBCheckBox1.DataField) then
    begin

     DBCheckBox1.Left := Rect.Left + DBGrid1.Left + 2;
     DBCheckBox1.Top := Rect.Top + DBGrid1.top + 2;
     DBCheckBox1.Width := Rect.Right - Rect.Left;
     DBCheckBox1.Height := Rect.Bottom - Rect.Top;

     DBCheckBox1.Visible := True;
    end;
    if (Column.Field.FieldName = DBLookupComboBox1.DataField) then
    with DBLookupComboBox1 do begin
      Left := Rect.Left + DBGrid1.Left + 2;
      Top := Rect.Top + DBGrid1.Top + 2;
      Width := Rect.Right - Rect.Left;
      Width := Rect.Right - Rect.Left;
      Height := Rect.Bottom - Rect.Top;

      Visible := True;
    end
  end
  else {in this else area draw any "stay behind" bitmaps}
  begin
    if (Column.Field.FieldName = DBCheckBox1.DataField) then
    begin
      DrawRect:=Rect;
      InflateRect(DrawRect,-1,-1);

      DrawState := ISChecked[Column.Field.AsBoolean];

      DBGrid1.Canvas.FillRect(Rect);
      DrawFrameControl(DBGrid1.Canvas.Handle, DrawRect, DFC_BUTTON, DrawState);
    end;
  end; //if focused
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DBGrid1.Align:=alClient;

  //setup check box
  DBCheckBox1.DataSource := DataSource1;
  DBCheckBox1.DataField  := 'Winner';
  DBCheckBox1.Visible    := False;
  DBCheckBox1.Color      := DBGrid1.Color;
  DBCheckBox1.Caption    := '';

  //setup DBLookupComboBox
  DataSource2.DataSet := AdoQuery1;
  with AdoQuery1 do
  begin
    Connection := AdoConnection1;
    SQL.Text := 'SELECT Name, Email FROM Authors';
    Open;
    FieldByName('Email').DisplayWidth:=15;
    FieldByName('Name').DisplayWidth:=15;
 end;

 with DBLookupComboBox1 do
 begin
   DataSource := DataSource1; // -> Table1 -> DBGrid1
   ListSource := DataSource2;
   DataField  := 'AuthorEmail'; // from Table1 - displayed in the DBGrid
   KeyField   := 'Email';
   ListField  := 'Name; Email';

   Color      := clCream;

   Visible       := False;
   DropDownWidth := 200;
 end;

  //setup PickList for the 'Subject' field
  SetupGridPickList('Subject', 'SELECT Name FROM Subjects');
end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
  if DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField then DBCheckBox1.Visible := False;

  if DBGrid1.SelectedField.FieldName = DBLookupComboBox1.DataField then DBLookupComboBox1.Visible := False
end;

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if (key = Chr(9)) then Exit;

  if (DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField)
  then
  begin
    DBCheckBox1.SetFocus;
    SendMessage(DBCheckBox1.Handle, WM_Char, word(Key), 0);
  end;

  if (DBGrid1.SelectedField.FieldName = DBLookupComboBox1.DataField) then
  begin
    DBLookupComboBox1.SetFocus;
    SendMessage(DBLookupComboBox1.Handle, WM_Char, word(Key), 0);
  end
end;

procedure TForm1.DBCheckBox1Click(Sender: TObject);
begin
  if DBCheckBox1.Checked then
     DBCheckBox1.Caption := DBCheckBox1.ValueChecked
  else
     DBCheckBox1.Caption := DBCheckBox1.ValueUnChecked;
end;



procedure TForm1.SetupGridPickList(const FieldName, sql: string);
var slPickList:TStringList;
    Query : TADOQuery;
    i:integer;
begin
  slPickList:=TStringList.Create;
  Query := TADOQuery.Create(self);
  try
    Query.Connection := ADOConnection1;
    Query.SQL.Text := sql;
    Query.Open;
    while not Query.EOF do
    begin
      slPickList.Add(Query.Fields[0].AsString);
      Query.Next;
    end; //while

    //place the list it the correct column
    for i:=0 to DBGrid1.Columns.Count-1 do begin
      if DBGrid1.Columns[i].FieldName = FieldName then
      begin
        DBGrid1.Columns[i].PickList:=slPickList;
        Break;
      end;
    end;
  finally
    slPickList.Free;
    Query.Free;
  end; //try
end; (*SetupGridPickList*)

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  //Making the drop-down pick list appear faster by
  //mimicking a hit to the F2 key followed by Alt + DownArrow
  if Column.PickList.Count > 0 then
  begin
    keybd_event(VK_F2,0,0,0);
    keybd_event(VK_F2,0,KEYEVENTF_KEYUP,0);
    keybd_event(VK_MENU,0,0,0);
    keybd_event(VK_DOWN,0,0,0);
    keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0);
    keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0);
  end;
end;

end.

If a demo DLL is stored as a resource using the RC file

DemoDLL RCDATA DemoDLL.dll

to load it from the resource, the next code can be used:

    var
      ms : TMemoryStream;
      rs : TResourceStream;
    begin
      if 0 <> FindResource(hInstance, 'DemoDLL', RT_RCDATA) then
      begin
        rs := TResourceStream.Create(hInstance, 'DemoDLL', RT_RCDATA);
        ms := TMemoryStream.Create;
        try
          ms.LoadFromStream(rs);

          ms.Position := 0;
          m_DllDataSize := ms.Size;
          mp_DllData := GetMemory(m_DllDataSize);

          ms.Read(mp_DllData^, m_DllDataSize);
        finally
          ms.Free;
          rs.Free;
        end;
      end;
    end;

Next, when you have the DLL loaded from a resource into memory, you can call its procedures:

    var
      btMM: PBTMemoryModule;
    begin
      btMM := BTMemoryLoadLibary(mp_DllData, m_DllDataSize);
      try
        if btMM = nil then Abort;
        @m_TestCallstd := BTMemoryGetProcAddress(btMM, 'TestCallstd');
        if @m_TestCallstd = nil then Abort;
        m_TestCallstd('This is a Dll Memory call!');
      except
        Showmessage('An error occoured while loading the dll: ' + BTMemoryGetLastError);
      end;
      if Assigned(btMM) then BTMemoryFreeLibrary(btMM);
    end;