TEWAN KUNGSABAY: มกราคม 2012

วันอังคารที่ 31 มกราคม พ.ศ. 2555

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与编码的相互转换

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

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;

วันจันทร์ที่ 30 มกราคม พ.ศ. 2555

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;