برنامه نویس

به وبلاگ خودتان خوش آمدید.

برنامه نویس

به وبلاگ خودتان خوش آمدید.

استفاده از ترد در دلفی

ابتدا باید ترد تعریف شود به صورت زیر


Type

   SefareshThread = Class(TThread)

//      procedure openquery();

تمامی توابع و پروسیژرها را در اینجا تعریف کنید

    protected

      procedure Execute; override;

end;


یک تایمر روی صفحه میتوان گذاشت برای فراخوانی ترد و کدهای زیر برای انجام عملیات مورد نظر 


procedure SefareshThread.Execute;

begin

  inherited;

  KalaOrderList_FRM.Timer1.Enabled:= false;

  KalaOrderList_FRM.sql3.DisableControls;

  KalaOrderList_FRM.sql2AfterScroll(nil);

  KalaOrderList_FRM.sql3.EnableControls;

end;


procedure SefareshThread.openquery;

begin

   Synchronize(openquery);

end;


procedure TKalaOrderList_FRM.Timer1Timer(Sender: TObject);

var

 T : SefareshThread;

begin

 T := SefareshThread.Create(True);

 T.FreeOnTerminate := True;

 T.Resume;

end;


و در مکان مورد نظر تایمر را فعال کنید


  Timer1.Enabled:=true;


نمایش تایم کارهای انجام شده در دلفی

کامپوننت acDateTimeCalc در تب app controls ++  قرار دارد روی فرم بگذارید و کد زیر را برای ان بنویسید

procedure TForm1.Button1Click(Sender: TObject);

begin

  acDateTimeCalc1.BeginTime:=Time;

  ADOQuery2.Close;

  ADOQuery2.Open;

  ADOQuery1.Close;

  ADOQuery1.Open;

  acDateTimeCalc1.EndTime:=Time;

  Caption:=Caption+'  '+IntToStr(acDateTimeCalc1.MSeconds);

end;

ازادسازی حافظه از فرم ها در دلفی

ازادسازی حافظه از فرمهای ایجاد شده 


var str_:tstringlist;

    i:integer;

begin

  str_:=tstringlist.Create;

  str_.Clear;

  for i:=0 to screen .FormCount-1 do

  begin

    if       (Screen.Forms[i].Name ='fmain')   then    Continue;

   Str_.add(screen .forms[i].Name) ;

  end;

  for  i:=0 to str_.Count-1 do

    (Application.FindComponent(str_.Strings[i])).free;

  str_.Free;

  ShowMessage' ok free  ');

ارسال دستور به سرور و دریافت پاسخ با tcpclient

برای کار با tcpclient دستورات زیر را وارد میکنیم 


procedure TForm1.btnSendClick(Sender: TObject);

var

  I: Integer;

begin

  TcpClient1.RemoteHost := edtRemoteHost.Text;

  TcpClient1.RemotePort := edtRemotePort.Text;

  if not TcpClient1.Connected then

   TcpClient1.Connect  ;

  i:= TcpClient1.Sendln(Trim(statement.Text));

  TcpClient1.Receiveln;

end;



procedure TForm1.TcpClient1Receive(Sender: TObject; Buf: PAnsiChar;

  var DataLen: Integer);

var s:string;

begin

  SetLength (s, DataLen);

  move (Buf ^, s [1], DataLen);

  s:= StringReplace (s, #$0,#$13, [rfReplaceAll]);

  memRecv.Lines. Add( s);

  TcpClient1.Active:=False;

end;


همچنین از این دستور برای ارسال رشته به صورت استریم



Function StringToStream(const AString: string): TStream;

begin

  Result := TStringStream.Create(AString);

end;


--------------------------

procedure TForm1.btnSendClick(Sender: TObject);

begin

  TcpClient1.RemoteHost :='192.168.1.168';

  TcpClient1.RemotePort :='23768';

  if not TcpClient1.Connected then

   TcpClient1.Connect  ;

   TcpClient1.SendStream( StringToStream('readl'));

  TcpClient1.Receiveln;


end;

ارسال دستور به سرور و دریافت پاسخ با indytcpclient

برای ارسال و دریافت اطلاعات از طریق indytcpclient به صورت زیر عمل میکنیم . port , host  را تنظیم میکنیم  و من دستور مورد نظر را در ادیت وارد کردم و ارسال میکنم  و پاسخ را با دستور readchar دریافت کردم


var ch:char;

    str:string;

begin

      IdTCPClient1.host:='192.168.1.25';

      IdTCPClient1.port:=8080;

      IdTCPClient1.Connect(300);

      IdTCPClient1.WriteLn(edt1.Text);

      ch:=IdTCPClient1.ReadChar;

      while ch<>'$' do

      begin

         str:=str+ch;

         ch:=IdTCPClient1.ReadChar;

      end;

      mmo1.Lines.Add(str);

      IdTCPClient1.Disconnect();


و یا از کد زیر استفاده شود


var

    str:string;

begin

      IdTCPClient1.host:='192.168.1.168';

      IdTCPClient1.port:=23768;

      IdTCPClient1.Connect(300);

      IdTCPClient1.Write(edit1.Text);

      Sleep(1000);

      str:=IdTCPClient1.CurrentReadBuffer() ;

       Memo1.Lines.Add(str);

      IdTCPClient1.Disconnect();

end;


نمایش چندین رکورد جدول sql server در یک عبارت

به عنوان مثال

SubjectID       StudentName
----------      -------------
1               Mary
1               John
1               Sam
2               Alaina
2               Edward

که در این مثال نمایش میخواهیم به صورت زیر باشد :

SubjectID       StudentName
----------      -------------
1               Mary, John, Sam
2               Alaina, Edward

از کدهای زیر می توان استفاده کرد

DECLARE @Names VARCHAR(8000) 
SELECT @Names = COALESCE(@Names + ', ', '') + Name 
FROM People

یا

declare @phone varchar(max)='' 
   select @phone=@phone + mobileno +',' from  members
   select @phone

یا

DECLARE @Txt1 VARCHAR(MAX)
SET @Txt1=''
 
SELECT  @Txt1 = @Txt1 + Txt +','
FROM    ConcatenationDemo
SELECT  LEFT(@Txt1,LEN(@Txt1)-1) AS Txt







هندل کردن خطاهای رخ داده شده در برنامه دلفی

هندل کردن خطاهای رخ داده شده در برنامه دلفی در زمان try except


{
In addition to displaying the exception message, which 
happens by default, the following code shuts down the 
application when an exception is not caught and handled.  
AppException should be declared a method of TForm1.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := AppException;
end;

procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  Application.ShowException(E);
  Application.Terminate;
end; 

procedure TForm1.Button1Click(Sender: TObject);
begin
  raise EPasswordInvalid.Create('Incorrect password entered');
end;

به دست آوردن نام فرم ها در دلفی

برای به دست آوردن نام فرم ها در دلفی از کد زیر می توان استفاده کرد



procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
begin
for I:= 0 to Screen.CustomFormCount - 1 do
    Memo1.Lines.Add(Screen.Forms[I].Caption);
end;


و برای نمایش ابجکتهای هر فرم از کد زیر :


var
i:integer;
begin
with Application do
for i:=0 to componentcount-1 do
    if components[i] is TForm then showmessage(components[i].Name);
end;

تغییر فونت و سایز فونت در کل پروژه دلفی در زمان اجرا

ابتدا System.TypInfo را uses تعریف میکنیم به خاطر استفاده از GetObjectProp

حالا تابع زیر را تعریف میکنیم 

procedure SetFontProperties(Control: TControl; Name: TFontName; Size: Integer; Styles: TFontStyles);
// Set font properties
var
  Index: Integer;
  Font: TFont;
  AnObject: TObject;
  ChildControl: TControl;
begin
  // Set font properties
  AnObject := GetObjectProp(Control, 'Font', nil);
  if AnObject is TFont then
  begin
    // Set properties
    Font := TFont(AnObject);
    Font.Name  := Name;
    Font.Size  := Size;
    Font.Style := Styles;
  end;

  // Set child font properties
  if Control is TWinControl then
  begin
    // Set
    for Index := 0 to TWinControl(Control).ControlCount - 1 do
    begin
      // Child control
      ChildControl := TWinControl(Control).Controls[Index];

      // Set font properties
      SetFontProperties(ChildControl, Name, Size, Styles);
    end;
  end;
end;


و با کد زیر فراخوانی میکنیم


SetFontProperties(Self, 'Courier', 14, []);



ارسال پارامتر برای اجرای exe در دلفی

برای ارسال پارامتر دو روش زیر وجود دارد 


WinExec('C:\prog.exe param1 param2', SW_SHOW);

یا

uses ShellApi;
var parameter: String;
 
parameter:='param1 param2';
 
ShellExecute(0, 'open', 'C:\prog.exe', PChar(parameter), nil, SW_SHOW);

برای خواندن پارامترها  از دستور زیر میتوان استفاده کرد


var

   i: integer;
begin
   for i := 0 to ParamCount do
     ShowMessage(ParamStr(i));
end;

یا

// execute with "MyProgram.exe param1 /param2"
 
if FindCmdLineSwitch('param1') then
   ShowMessage('param1'); // will not be displayed
 
if FindCmdLineSwitch('param2') then
   ShowMessage('param2'); // will be displayed
 
if FindCmdLineSwitch('param3') then
   ShowMessage('param3'); // will not be displayed




نمایش فایل اکسل با کد دلفی

uses ComObj; ..

procdure startExcel; 
var   
  oE:Variant; 
begin
  try 
    oE := GetActiveOleObject('Excel.Application');
  except
    oE := CreateOleObject('Excel.Application'); 
  end; 
  oE.Workbooks.Open(filename, false, false);
  oE.Visible := True; 
end;

دستور Exec sp_Execute با پارامتر خروجی در sql server

Declare @TableName Varchar(100)

Set @TableName = 'TableName'
Declare @Count int
Declare @SqlString Nvarchar(1000)

Set @SqlString = 'Select @OutCount = Count(*) From ' +@TableName 
 
Exec sp_Executesql @SqlString, N'@OutCount Int Output', @OutCount = @Count Output

 

استفاده از define در دلفی

 کاربرد این  دستور در زمان کامپایل است که مشخص میکند کدام بخش از کد باید کامپایل شود تا خروجی بسازد 

  یک فایل با پسوند inc ایجاد کنید و در هر خط یک define  مورد نیاز بگذارید مثلا {DIFINE Symbol$} و به صورت زیر در دلفی استفاده کنید

interface

{$I Predefines.inc}

uses ...

// Check you defines

{$IFDEF Symbol}
...
{$ENDIF}
  

or 

 

{$IFDEF Symbol}
... 

{$Else} 

...
{$ENDIF}
  

or 

 

{$IFNDEF Symbol}
...
{$ENDIF}

دستور update با وجود sum

UPDATE table1
   SET field1 = (SELECT SUM(field2)
                   FROM table2 AS t2
                  WHERE t2.field3 = t1.field3)
  FROM table1 AS t1


or

UPDATE table1 SET field1 = (SELECT SUM(t2.field2) FROM TABLE2 t2 WHERE t2.field3 = field2)

انتخاب چندین رکورد از dbgrid در دلفی

procedure TForm1.Button3Click(Sender: TObject);

begin
  if dbgrid1.SelectedRows.CurrentRowSelected then  //check
  begin
    ShowMessage('This Record was selected');
    dbgrid1.SelectedRows.CurrentRowSelected := False; //Unselect
  end
  else
  begin
    ShowMessage('This Record was not selected');
    dbgrid1.SelectedRows.CurrentRowSelected := True;//select
  end;
end;



procedure TForm1.Button4Click(Sender: TObject);
var I : Integer;
begin
  for i := 0 to dbgrid1.SelectedRows.Count - 1 do
  begin
    dbgrid1.DataSource.Dataset.GotoBookmark(TBookmark(dbgrid1.SelectedRows[i]));
    //Do Something
    ShowMessage(dbgrid1.DataSource.Dataset.Fields[0].AsString);
  end;
end;

برای انتخاب چندین رکورد از کد زیر میشود استفاده کرد
با ید انتخاب ردیف و انتخاب چندین ردیف فعال باشد
DBGrid1.Options:=DBGrid1.Options + [dgMultiSelect,dgRowSelect]

if (Shift = []) then

  begin

    case Key of

    VK_UP: begin

             Key := 0;

             TDBGrid(Sender).DataSource.DataSet.Prior;

           end;

    VK_Down: begin

               Key := 0;

               TDBGrid(Sender).DataSource.DataSet.Next;

             end;

    VK_Space: begin

                Key := 0;

                TDBGrid(Sender).SelectedRows.CurrentRowSelected :=

       NOT(TDBGrid(Sender).SelectedRows.CurrentRowSelected);

              end;

    end;

  end;