اموزش دلفی ,دانلود کامپوننت, برنامه نویسی ,سورس دلفی

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

با نوشتن این کد شما می توانید یک ProgressBar  در ListBox  داشته باشید.

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

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  pb: TProgressBar;
begin
  Listview1.Columns.Add.Width := 100;
  Listview1.Columns.Add.Width := 200;
  Listview1.ViewStyle         := vsReport;
  Listview1.Items.Add.Caption := 'Text';

  r := Listview1.Items[0].DisplayRect(drBounds);
  r.Left  := r.Left + Listview1.columns[0].Width;
  r.Right := r.Left + Listview1.columns[1].Width;

  pb := TProgressBar.Create(Self);
  pb.Parent := Listview1;
  pb.BoundsRect := r;
  pb.Position := 30;
  Listview1.Items[0].Data := pb;
end;

سپس یک دکمه دیگر روی فرم قرار داده و کد زیر را وارد نمایید:                                        



procedure TForm1.Button2Click(Sender: TObject);
var
  pb: TProgressBar;
begin
  pb := TProgressBar(Listview1.Items[0].Data);
  pb.StepIt;
end;

 

بابک احدی دوشنبه 9 خرداد‌ماه سال 1384 ساعت 10:54 ق.ظ
5 نظر

قراردادن DateTimePicker در یک  DBGrid:

ابتدا کد زیر را در قسمت رویداد OnDrawColumnCell وارد نمایید:

 

procedure TForm1.DBGrid1DrawColumnCell

  (Sender: TObject;

   const Rect: TRect;

   DataCol: Integer;

   Column: TColumn;

   State: TGridDrawState);

begin

  if (gdFocused in State) then

  begin

    if (Column.Field.FieldName = 'YourDateField') then

    with DateTimePicker do

    begin

      Left := Rect.Left + DBGrid1.Left + 1;

      Top := Rect.Top + DBGrid1.Top + 1;

      Width := Rect.Right - Rect.Left + 2;

      Width := Rect.Right - Rect.Left + 2;

      Height := Rect.Bottom - Rect.Top + 2;

 

      Visible := True;

    end;

  end
end;

سپس در ادامه این کد را در رویداد OnColExit  بنویسید:

 

procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

  if DBGrid1.SelectedField.FieldName = 'YourDateField' then

    DateTimePicker.Visible := False
end;

و در نهایت در رویداد  OnKeyPress بنویسید:

 

procedure TForm1.DBGrid1KeyPress

(Sender: TObject; var Key: Char);

begin

  if (key = Chr(9)) then Exit;

 

  if (DBGrid1.SelectedField.FieldName = 'YourDateField') then

  begin

    DateTimePicker.SetFocus;

    SendMessage(DateTimePicker.Handle, WM_Char, word(Key), 0);

  end
end;

بابک احدی پنج‌شنبه 5 خرداد‌ماه سال 1384 ساعت 03:13 ب.ظ
0 نظر

سورت کردن ستونهای یک DBGrid

سورت کردن و چیدن ستونهای یک  DbGrid  با کلیک کردن بر روی سر تیتر ستونها :

ابتدا در رویدادِ DBGridMouseMove   بنویسید :

 

 

procedure TForm1.DBGrid1MouseMove

  (Sender: TObject; Shift: TShiftState; X, Y: Integer);

var

  pt: TGridcoord;

begin

  pt:= DBGrid1.MouseCoord(x, y);

 

  if pt.y=0 then

    DBGrid1.Cursor:=crHandPoint

  else

    DBGrid1.Cursor:=crDefault;

End;

سپس در رویداد  DBGridTitleClick  بنویسید :

 

 

procedure TForm1.DBGrid1TitleClick(Column: TColumn);

{$J+}

 const PreviousColumnIndex : integer = -1;

{$J-}

begin

  if DBGrid1.DataSource.DataSet is TCustomADODataSet then

  with TCustomADODataSet(DBGrid1.DataSource.DataSet) do

  begin

    try

      DBGrid1.Columns[PreviousColumnIndex].title.Font.Style :=

      DBGrid1.Columns[PreviousColumnIndex].title.Font.Style - [fsBold];

    except

    end;

 

    Column.title.Font.Style :=

    Column.title.Font.Style + [fsBold];

    PreviousColumnIndex := Column.Index;

 

    if (Pos(Column.Field.FieldName, Sort) = 1)

    and (Pos(' DESC', Sort)= 0) then

      Sort := Column.Field.FieldName + ' DESC'

    else

      Sort := Column.Field.FieldName + ' ASC';

  end;

end;

 

 

بابک احدی پنج‌شنبه 5 خرداد‌ماه سال 1384 ساعت 12:23 ق.ظ
2 نظر

Registering DLL and ActiveX controls from code

One of the features that make Delphi so popular is that when it comes to project deployment, you as a developer (in most cases) only need to send the executable file (exe) of your application.

However, in some situations, for example when you import an ActiveX control into your project, you'll need to make sure that this ActiveX control is registered on your users machines. If the control is not registered there, an EOleSysError exception will be displayed to your user eyes.

RegSvr32.exe
The regsvr32.exe command-line tool registers dll and ActiveX controls on a system. You can manually use the Regsvr32.exe (Windows.Start - Run) to register and unregister OLE controls such as dynamic link library (DLL) or ActiveX Controls (OCX) files that are self-registerable.
When you use Regsvr32.exe, it attempts to load the component and call its DLLSelfRegister function. If this attempt is successful, Regsvr32.exe displays a dialog indicating success.

RegSvr32.exe has the following command-line options:

Regsvr32 [/u] [/s] [/n] [/i[:cmdline]] dllname

 /s - Silent; display no message boxes

 /u - Unregister server

 /i - Call DllInstall passing it an optional [cmdline];

      when used with /u calls dll uninstall

 /n - do not call DllRegisterServer; this option must

      be used with /i

From Delphi code

To call the regsvr32 tool from within Delphi code, you'll need a function that can execute a file and wait for the execution to finish.

This is how the 'RegisterOCX' procedure could look:

procedure RegisterOCX;

type

  TRegFunc = function : HResult; stdcall;

var

  ARegFunc : TRegFunc;

  aHandle  : THandle;

  ocxPath  : string;

begin

 try

  ocxPath := ExtractFilePath(Application.ExeName) + 'Flash.ocx';

  aHandle := LoadLibrary(PChar(ocxPath));

  if aHandle <> 0 then

  begin

    ARegFunc := GetProcAddress(aHandle,'DllRegisterServer');

    if Assigned(ARegFunc) then

    begin

      ExecAndWait('regsvr32','/s ' + ocxPath);

    end;

    FreeLibrary(aHandle);

  end;

 except

  ShowMessage(Format('Unable to register %s', [ocxPath]));

 end;

end;

Note: the ocxPath variable points to the 'Flash.ocx' Macromedia ActiveX control.

To be able to register itself, an ActiveX control needs to implement the DllRegisterServer function. In simple words, this function creates registry entries for all the classes inside the control. We do not need to worry about the DllRegisterServer function we just want to make sure it is there. For the sake of simplicity, we've presumed that the ActiveX control (the *.ocx file) is located in the same folder as where your application is.

The red line in the above code, does the job of calling the regsvr32 tool by passing the "/s" switch along with the full path to the ActiveX control. The function is ExecAndWait.

uses shellapi;

...

function ExecAndWait(const ExecuteFile, ParamString : string): boolean;

var

  SEInfo: TShellExecuteInfo;

  ExitCode: DWORD;

begin

  FillChar(SEInfo, SizeOf(SEInfo), 0);

  SEInfo.cbSize := SizeOf(TShellExecuteInfo);

  with SEInfo do begin

    fMask := SEE_MASK_NOCLOSEPROCESS;

    Wnd := Application.Handle;

    lpFile := PChar(ExecuteFile);

    lpParameters := PChar(ParamString);

    nShow := SW_HIDE;

  end;

  if ShellExecuteEx(@SEInfo) then

  begin

    repeat

      Application.ProcessMessages;

      GetExitCodeProcess(SEInfo.hProcess, ExitCode);

    until (ExitCode <> STILL_ACTIVE) or Application.Terminated;

    Result:=True;

  end

  else Result:=False;

end;

The above, ExecAndWait, function uses ShellExecuteEx API call to execute a file on a system. If you need more examples of executing any file from Delphi, check the Start from Delphi article.