صفحه 11 از 11 اولاول ... 91011
نمایش نتایج 401 تا 435 از 435

نام تاپیک: نکات برنامه نویسی در دلفی

  1. #401
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد Database در يك بانك اطلاعاتي sql sever 2000 در حالت local

    procedure CreateDatabase(WindowsSecurity: Boolean; Username, Password: String);
    var
    ConnectionString: String;
    CommandText: String;
    begin
    if WindowsSecurity then
    ConnectionString := 'Provider=SQLOLEDB.1;' +
    'Integrated Security=SSPI;' +
    'Persist Security Info=False;' +
    'Initial Catalog=master'
    else
    ConnectionString := 'Provider=SQLOLEDB.1;' +
    'Password=' + Password + ';' +
    'Persist Security Info=True;' +
    'User ID=' + Username + ';' +
    'Initial Catalog=master';

    try

    try
    ADOConnection.ConnectionString := ConnectionString;
    ADOConnection.LoginPrompt := False;
    ADOConnection.Connected := True;


    CommandText := 'CREATE DATABASE test ON ' +
    '( NAME = test_dat, ' +
    'FILENAME = ''c:\program files\microsoft sql server\mssql\data\test.mdf'', ' +
    'SIZE = 4, ' +
    'MAXSIZE = 10, ' +
    'FILEGROWTH = 1 )';

    ADOCommand.CommandText := CommandText;
    ADOCommand.Connection := ADOConnection;
    ADOCommand.Execute;
    MessageDlg('Database succesfully created.', mtInformation, [mbOK], 0);

    except
    on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
    end;

    finally
    ADOConnection.Connected := False;
    ADOCommand.Connection := nil;
    end;

    end;

  2. #402
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد خروجي از TDBGrid به قالب Excel

    unit DBGridExportToExcel;

    interface

    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;


    type TScrollEvents = class
    BeforeScroll_Event: TDataSetNotifyEvent;
    AfterScroll_Event: TDataSetNotifyEvent;
    AutoCalcFields_Property: Boolean;
    end;

    procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
    procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
    procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);


    implementation

    //Support procedures: I made that in order to increase speed in
    //the process of scanning large amounts
    //of records in a dataset

    //we make a call to the "DisableControls" procedure and then disable the "BeforeScroll" and
    //"AfterScroll" events and the "AutoCalcFields" property.
    procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
    begin
    with DataSet do
    begin
    DisableControls;
    ScrollEvents := TScrollEvents.Create();
    with ScrollEvents do
    begin
    BeforeScroll_Event := BeforeScroll;
    AfterScroll_Event := AfterScroll;
    AutoCalcFields_Property := AutoCalcFields;
    BeforeScroll := nil;
    AfterScroll := nil;
    AutoCalcFields := False;
    end;
    end;
    end;

    //we make a call to the "EnableControls" procedure and then restore
    // the "BeforeScroll" and "AfterScroll" events and the "AutoCalcFields" property.
    procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
    begin
    with DataSet do
    begin
    EnableControls;
    with ScrollEvents do
    begin
    BeforeScroll := BeforeScroll_Event;
    AfterScroll := AfterScroll_Event;
    AutoCalcFields := AutoCalcFields_Property;
    end;
    end;
    end;

    //This is the procedure which make the work:

    procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
    var
    cat: _Catalog;
    tbl: _Table;
    col: _Column;
    i: integer;
    ADOConnection: TADOConnection;
    ADOQuery: TADOQuery;
    ScrollEvents: TScrollEvents;
    SavePlace: TBookmark;
    begin
    //
    //WorkBook creation (database)
    cat := CoCatalog.Create;
    cat._Set_ActiveConnection('Provider=Microsoft.Jet. OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');
    //WorkSheet creation (table)
    tbl := CoTable.Create;
    tbl.Set_Name(SheetName);
    //Columns creation (fields)
    DBGrid.DataSource.DataSet.First;
    with DBGrid.Columns do
    begin
    for i := 0 to Count - 1 do
    if Items[i].Visible then
    begin
    col := nil;
    col := CoColumn.Create;
    with col do
    begin
    Set_Name(Items[i].Title.Caption);
    Set_Type_(adVarWChar);
    end;
    //add column to table
    tbl.Columns.Append(col, adVarWChar, 20);
    end;
    end;
    //add table to database
    cat.Tables.Append(tbl);

    col := nil;
    tbl := nil;
    cat := nil;

    //exporting
    ADOConnection := TADOConnection.Create(nil);
    ADOConnection.LoginPrompt := False;
    ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
    ADOQuery := TADOQuery.Create(nil);
    ADOQuery.Connection := ADOConnection;
    ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
    ADOQuery.Open;


    DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
    SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
    try
    with DBGrid.DataSource.DataSet do
    begin
    First;
    while not Eof do
    begin
    ADOQuery.Append;
    with DBGrid.Columns do
    begin
    ADOQuery.Edit;
    for i := 0 to Count - 1 do
    if Items[i].Visible then
    begin
    ADOQuery.FieldByName(Items[i].Title.Caption).AsString := FieldByName(Items[i].FieldName).AsString;
    end;
    ADOQuery.Post;
    end;
    Next;
    end;
    end;

    finally
    DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
    DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
    EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);

    ADOQuery.Close;
    ADOConnection.Close;

    ADOQuery.Free;
    ADOConnection.Free;

    end;

    end;

    end.

  3. #403
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد سايه براي Hint ها

    type
    TXPHintWindow = class(THintWindow)
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMNCPaint(var msg: TMessage); message WM_NCPAINT;
    end;

    function IsWinXP: Boolean;
    begin
    Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
    (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
    end;

    procedure TXPHintWindow.CreateParams(var Params: TCreateParams);
    const
    CS_DROPSHADOW = $00020000;
    begin
    inherited;
    if IsWinXP then
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
    end;

    procedure TXPHintWindow.WMNCPaint(var msg: TMessage);
    var
    R: TRect;
    DC: HDC;
    begin
    DC := GetWindowDC(Handle);
    try
    R := Rect(0, 0, Width, Height);
    DrawEdge(DC, R, EDGE_ETCHED, BF_RECT or BF_MONO);
    finally
    ReleaseDC(Handle, DC);
    end;
    end;

    initialization
    HintWindowClass := TXPHintWindow;
    Application.ShowHint := False;
    Application.ShowHint := True;
    end.

  4. #404
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد سايه براي پنجره هاي برنامه

    type
    TForm1 = class(TForm)
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.CreateParams(var Params: TCreateParams);
    const
    CS_DROPSHADOW = $00020000;
    begin
    inherited;
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
    end;

  5. #405
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد سريع يك جدول پارادوكس به كمك كد

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    with Query1 do
    begin
    DatabaseName := 'DBDemos';
    with SQL do
    begin
    Clear;
    {
    CREATE TABLE creates a table with the given name in the
    current database

    CREATE TABLE erzeugt eine Tabelle mit einem angegebenen
    Namen in der aktuellen Datenbank
    }
    Add('CREATE TABLE "PDoxTbl.db" (ID AUTOINC,');
    Add('Name CHAR(255),');
    Add('PRIMARY KEY(ID))');
    {
    Call ExecSQL to execute the SQL statement currently
    assigned to the SQL property.

    Mit ExecSQL wird die Anweisung ausgeführt,
    welche aktuell in der Eigenschaft SQL enthalten ist.
    }
    ExecSQL;
    Clear;
    Add('CREATE INDEX ByName ON "PDoxTbl.db" (Name)');
    ExecSQL;
    end;
    end;
    end;

  6. #406
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد صدا هنگام وارد شدن ماوس روي كنترل

    uses ... , MMSystem;

    TYourObject = class(TAnyControl)
    ...
    private
    procedure CMMouseEnter(var AMsg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var AMsg: TMessage); message CM_MOUSELEAVE;
    ...
    end;

    implementation

    procedure TYourObject.CMMouseEnter(var AMsg: TMessage);
    begin
    sndPlaySound('c:\win98\media\ding.wav',snd_Async or snd_NoDefault);
    end;

    procedure TYourObject.CMMouseLeave(var AMsg: TMessage);
    begin
    sndPlaySound(nil,snd_Async or snd_NoDefault);
    end;

  7. #407
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد ميانبر از يك فايل در ويندوز

    procedure CreateShortcut(SourceFileName, Title: string; Location:
    ShortcutType; SubDirectory : string);
    var
    MyObject : IUnknown;
    MySLink : IShellLink;
    MyPFile : IPersistFile;
    Directory,
    LinkName : string;
    WFileName : WideString;
    MyReg,
    QuickLaunchReg : TRegIniFile;
    begin
    MyObject := CreateComObject(CLSID_ShellLink);
    MySLink := MyObject as IShellLink;
    MyPFile := MyObject as IPersistFile;

    MySLink.SetPath(PChar(SourceFileName));

    MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\Cur rentVersion\Explorer');
    try
    LinkName := ChangeFileExt(SourceFileName, '.lnk');
    LinkName := ExtractFileName(LinkName);
    case Location of
    _DESKTOP : Directory := MyReg.ReadString('Shell Folders', 'Desktop', '');
    _STARTMENU : Directory := MyReg.ReadString('Shell Folders', 'Start Menu', '');
    _SENDTO : Directory := MyReg.ReadString('Shell Folders', 'SendTo', '');
    _QUICKLAUNCH:
    begin
    QuickLaunchReg := TRegIniFile.Create('Software\MicroSoft\Windows\Cur rentVersion\GrpConv');

    try
    Directory := QuickLaunchReg.ReadString('MapGroups', 'Quick Launch', '');
    finally
    QuickLaunchReg.Free;
    end; {try..finally}
    end; {case _QUICKLAUNCH}
    end; {case}
    if Directory <> '' then
    begin
    if SubDirectory <> '' then
    WFileName := Directory + '\'+ SubDirectory +'\' + LinkName
    else
    WFileName := Directory + '\' + LinkName;
    MyPFile.Save(PWChar(WFileName), False);
    end; {Directory <> ''}
    finally
    MyReg.Free;
    end; {try..finally}
    end; {CreateShortcut}

  8. #408
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد يك TWebBrowser در RunTime

    procedure TForm1.Button1Click(Sender: TObject);
    var
    wb: TWebBrowser;
    begin
    wb := TWebBrowser.Create(Form1);
    TWinControl(wb).Name := 'MyWebBrowser';
    TWinControl(wb).Parent := Form1;
    wb.Align := alClient;
    // TWinControl(wb).Parent := TabSheet1; ( To put it on a TabSheet )
    wb.Navigate('http://www.google.com');
    end;

  9. #409
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد يك اتصال DBExpress در زمان اجرا

    procedure TVCLScanner.PostUser(const Email, FirstName, LastName: WideString);
    var
    Connection: TSQLConnection;
    DataSet: TSQLDataSet;
    begin
    Connection := TSQLConnection.Create(nil);
    with Connection do
    begin
    ConnectionName := 'VCLScanner';
    DriverName := 'INTERBASE';
    LibraryName := 'dbexpint.dll';
    VendorLib := 'GDS32.DLL';
    GetDriverFunc := 'getSQLDriverINTERBASE';
    Params.Add('User_Name=SYSDBA');
    Params.Add('Password=masterkey');
    Params.Add('Database=milo2:D:\frank\webservices\um lbank.gdb');
    LoginPrompt := False;
    Open;
    end;
    DataSet := TSQLDataSet.Create(nil);
    with DataSet do
    begin
    SQLConnection := Connection;
    CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")',
    [Email, FirstN, LastN]);
    try
    ExecSQL;
    except
    end;
    end;
    Connection.Close;
    DataSet.Free;
    Connection.Free;
    end;

  10. #410
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    ايجاد يک ديتا بيس Access را در زمان اجرا

    uses
    ComObj;

    procedure TForm1.Button1Click(Sender: TObject);
    var
    AccessApp: Variant;
    begin
    AccessApp := CreateOleObject('Access.Application');
    AccessApp.NewCurrentDatabase('c:\111.mdb');
    AccessApp := Unassigned;
    end;

  11. #411
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    اين تابع براي حذف کليه يک فولدر با کليه فايل ها داخل آن

    procedure TForm1.Button1Click(Sender: TObject);
    var
    DirInfo: TSearchRec;
    r : Integer;
    begin
    r := FindFirst('C:\Download\Test\*.*', FaAnyfile, DirInfo);
    while r = 0 do begin
    if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
    (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
    if DeleteFile(pChar('C:\Download\test\' + DirInfo.Name))
    = false then
    {Si no puede borrar el fichero}
    ShowMessage('Unable to delete : C:\Download\test\' +
    DirInfo.Name);
    r := FindNext(DirInfo);
    end;
    SysUtils.FindClose(DirInfo);
    if RemoveDirectory('C:\Download\Test') = false then
    {Si no puedes borrar el directorio}
    ShowMessage('Unable to delete dirctory : C:\Download\test');
    end;

  12. #412
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    اين تابع براي عوض کردن مشخصات همه کامپوننت ها در يک فرم است

    procedure TForm1.SetReadOnly(Value:boolean) ;
    var
    PropInfo : PPropInfo;
    Component : TComponent;
    i : integer;
    begin
    for i := 0 to ComponentCount - 1 do begin
    Component := Components[ i ];
    if Component is TControl then begin
    PropInfo := GetPropInfo( Component.ClassInfo, 'ReadOnly' );
    if Assigned( PropInfo ) and
    ( PropInfo^.PropType^.Kind = tkEnumeration ) then
    SetOrdProp( Component, PropInfo, integer( Value ) );
    end;
    end;
    end;


  13. #413
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    با اين کد مي توانيد عنوان دکمه برنامه خودتون رو در Taskbar متحرک کنيد

    procedure TForm1.Timer1Timer(Sender: TObject);
    const
    {$J+}
    animatedTitle : string = 'www.mojtabaie.persianblog.ir';
    {$J-}
    var
    cnt: Integer;

    begin
    Application.Title := animatedTitle;
    for cnt := 1 to (Length(animatedTitle) - 1) do
    begin
    animatedTitle[cnt] := Application.Title[cnt + 1];
    animatedTitle[Length(animatedTitle)] := Application.Title[1];
    end;
    end;

  14. #414
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    با کد زير مي توانيد يک ProgressBar در يک MessageBox معمولي

    procedure TForm1.Button1Click(Sender: TObject) ;
    var
    AMsgDialog : TForm;
    AProgressBar : TProgressBar;
    ATimer : TTimer;
    begin
    AMsgDialog := CreateMessageDialog('Quickly! Answer Yes or No!', mtWarning, [mbYes, mbNo]) ;
    AProgressBar := TProgressBar.Create(AMsgDialog) ;
    ATimer := TTimer.Create(AMsgDialog) ;
    with AMsgDialog do
    try
    Tag := 10; //seconds!

    Caption := 'You have 10 seconds';
    Height := 150;

    with AProgressBar do begin
    Name := 'Progress';
    Parent := AMsgDialog;
    Max := AMsgDialog.Tag; //seconds
    Step := 1;
    Top := 100;
    Left := 8;
    Width := AMsgDialog.ClientWidth - 16;
    end;

    with ATimer do
    begin
    Interval := 1000;
    OnTimer:=DialogTimer;
    end;

    case ShowModal of
    ID_YES: ShowMessage('Answered "Yes".') ;
    ID_NO: ShowMessage('Answered "No".') ;
    ID_CANCEL: ShowMessage('Time up!')
    end;//case
    finally
    ATimer.OnTimer := nil;
    Free;
    end;
    end;


    //make sure you add this function's header in the private part of the TForm1 type declaration.
    procedure TForm1.DialogTimer(Sender: TObject) ;
    var
    aPB : TProgressBar;
    begin
    if NOT (Sender is TTimer) then Exit;

    if ((Sender as TTimer).Owner) is TForm then
    with ((Sender as TTimer).Owner) as TForm do
    begin
    aPB := TProgressBar(FindComponent('Progress')) ;

    if aPB.Position >= aPB.Max then
    ModalResult := mrCancel
    else
    aPB.StepIt;
    end;
    end;

  15. #415
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    باز كردن پنجره پروپرتي پرينتر

    uses WinSpool, Printers;
    ...
    procedure TForm1.Button1Click(Sender: TObject);
    var
    MyPrinter, MyDriver, MyPort: array[0..100] of Char;
    PrinterHandle, DevMode: THandle;
    begin
    Printer.GetPrinter(MyPrinter, MyDriver, MyPort, DevMode);
    OpenPrinter(MyPrinter, PrinterHandle, nil);
    PrinterProperties(Form1.Handle, PrinterHandle);
    end;

  16. #416
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    باز كردن دكمه Start ويندوز

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    SendMessage(Handle, WM_SYSCOMMAND, SC_TASKLIST, 1);
    end;

  17. #417
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    باز و بسته كردن سيدي درايو

    uses
    MMSystem;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    {باز كردن سيدي رام: در صورت موفقيت 0 برميگرداند}
    { open CD-ROM drive; returns 0 if successfull }
    mciSendString('set cdaudio door open wait', nil, 0, handle);

    { close the CD-ROM drive; returns 0 if successfull }
    {بستن سيدي رام: در صورت موفقيت 0 برميگرداند}
    mciSendString('set cdaudio door closed wait', nil, 0, handle);
    end;

  18. #418
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    باز کردن پوشه پرينترها توسط اين تابع انجام مي شود

    procedure TForm1.Button1Click(Sender: TObject);
    var
    PIDL:PItemIDList;
    Info:TShellExecuteInfo;
    pInfo:PShellExecuteInfo;
    WaitCode:DWord;
    begin
    {Obtenemos PIDL de la carpeta virtual}
    {get PIDL of the virtual folder}
    SHGetSpecialFolderLocation(Handle,
    CSIDL_PRINTERS,
    PIDL);
    {Puntero a Info}
    {Pointer to Info}
    pInfo:=@Info;
    {Rellenamos Info}
    {Fill info}
    with Info do
    begin
    cbSize:=SizeOf(Info);
    fMask:=SEE_MASK_NOCLOSEPROCESS+
    SEE_MASK_IDLIST;
    wnd:=Handle;
    lpVerb:=nil;
    lpFile:=nil;
    {Parametros al ejecutable}
    {Executable parameters}
    lpParameters:=nil;
    lpDirectory:=nil;
    nShow:=SW_ShowNormal;
    hInstApp:=0;
    lpIDList:=PIDL;
    end;
    {Ejecutamos}
    {Execute}
    ShellExecuteEx(pInfo);

    {Esperamos que termine}
    {Wait to finish}
    repeat
    WaitCode := WaitForSingleObject(Info.hProcess,500);
    Application.ProcessMessages;
    until (WaitCode <> WAIT_TIMEOUT);

    end;

  19. #419
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بازگرداندن بزرگترين ID بوسيله SQL

    CREATE PROCEDURE MaxId
    @Max int output,
    @para char(30)
    AS
    select @Max = (select max(Code) from tblBank Where Country = @para)
    return @Max
    GO


  20. #420
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن آيپي اينترنت External IP

    //add URLMon In Uses
    function Ipfilter(sTexto: String): String;
    var
    iCont: Short;
    sTemp: String;
    begin
    sTemp := '';
    for iCont := 1 to Length(sTexto) do
    if (sTexto[iCont] in ['0'..'9','.']) then
    sTemp:=sTemp+sTexto[iCont];
    //AppendStr(sTemp, sTexto[iCont]);
    Result := sTemp;
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    var
    parser:TStrings;
    begin
    if URLDownloadToFile(nil, 'http://checkip.dyndns.org/', 'c:\windows\temp\externalip.txt', 0, nil) <> 0 then
    MessageBox(Handle, 'An error ocurred while downloading the file.', PChar(Application.Title), MB_ICONERROR or MB_OK);
    parser := TStringList.Create;
    parser.LoadFromFile('c:\windows\temp\externalip.tx t');
    //showmessage(parser.Text);
    edt1.text:=ipfilter(copy(parser.text,pos('IP Address: ',parser.text)+12,16));
    parser.Free;
    end;


  21. #421
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن اطلاعاتي در مورد حافظه

    procedure TForm1.Button1Click(Sender: TObject);
    var
    MyStatus: TMemoryStatus;
    begin
    MyStatus.dwLength:=SizeOf(MyStatus);
    GlobalmemoryStatus(MyStatus);
    with Memo1.Lines do
    begin
    Add(FloatToStr(MyStatus.dwMemoryLoad)+'% memory in use');
    Add(FloatToStr(MyStatus.dwTotalPhys/1024)+' Kb of physical memory');
    Add(
    FloatToStr(MyStatus.dwAvailPhys/1024)+
    ' Kb of available physical memory');
    Add(
    FloatToStr(MyStatus.dwTotalPageFile/1024)+
    ' Kb that can be stored in the paging file');
    Add(
    FloatToStr(MyStatus.dwAvailPageFile/1024)+
    ' Kb available in the paging file');
    end;
    end;

  22. #422
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن اطلاعاتي درباره سيستم

    procedure TForm1.Button1Click(Sender: TObject);
    var
    MySystem: TSystemInfo;
    begin
    GetSystemInfo(MySystem);
    with Memo1.Lines do
    begin
    if (MySystem.wProcessorArchitecture=0) then
    Add('Intel architecture');
    Add(FloatToStr(MySystem.dwPageSize)+' Kb page size');
    Add(
    Format('Lowest memory address accessible to applications and DLL - %p',
    [MySystem.lpMinimumApplicationAddress]));
    Add(
    Format('Highest memory address accessible to applications and DLL - %p',
    [MySystem.lpMaximumApplicationAddress]));
    Add(IntToStr(MySystem.dwNumberOfProcessors)+' - number of processors');
    Add(
    FloatToStr(MySystem.dwAllocationGranularity/1024)+
    ' Kb - granularity with which virtual memory is allocated');
    case MySystem.wProcessorLevel of
    3: Add('Intel 80386 processor level');
    4: Add('Intel 80486 processor level');
    5: Add('Intel Pentium processor level');
    end;
    end;
    end;

  23. #423
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن پروسسهاي فعال شبكه

    unit PerfInfo;

    interface

    uses
    Windows, SysUtils, Classes;

    type
    TPerfCounter = record
    Counter: Integer;
    Value: TLargeInteger;
    end;

    TPerfCounters = Array of TPerfCounter;

    TPerfInstance = class
    private
    FName: string;
    FCounters: TPerfCounters;
    public
    property Name: string read FName;
    property Counters: TPerfCounters read FCounters;
    end;

    TPerfObject = class
    private
    FList: TList;
    FObjectID: DWORD;
    FMachine: string;
    function GetCount: Integer;
    function GetInstance(Index: Integer): TPerfInstance;
    procedure ReadInstances;
    public
    property ObjectID: DWORD read FObjectID;
    property Item[Index: Integer]: TPerfInstance
    read GetInstance; default;
    property Count: Integer read GetCount;
    constructor Create(const AMachine: string; AObjectID: DWORD);
    destructor Destroy; override;
    end;

    procedure GetProcesses(const Machine: string; List: TStrings);

    implementation

    type
    PPerfDataBlock = ^TPerfDataBlock;
    TPerfDataBlock = record
    Signature: array[0..3] of WCHAR;
    LittleEndian: DWORD;
    Version: DWORD;
    Revision: DWORD;
    TotalByteLength: DWORD;
    HeaderLength: DWORD;
    NumObjectTypes: DWORD;
    DefaultObject: Longint;
    SystemTime: TSystemTime;
    PerfTime: TLargeInteger;
    PerfFreq: TLargeInteger;
    PerfTime100nSec: TLargeInteger;
    SystemNameLength: DWORD;
    SystemNameOffset: DWORD;
    end;

    PPerfObjectType = ^TPerfObjectType;
    TPerfObjectType = record
    TotalByteLength: DWORD;
    DefinitionLength: DWORD;
    HeaderLength: DWORD;
    ObjectNameTitleIndex: DWORD;
    ObjectNameTitle: LPWSTR;
    ObjectHelpTitleIndex: DWORD;
    ObjectHelpTitle: LPWSTR;
    DetailLevel: DWORD;
    NumCounters: DWORD;
    DefaultCounter: Longint;
    NumInstances: Longint;
    CodePage: DWORD;
    PerfTime: TLargeInteger;
    PerfFreq: TLargeInteger;
    end;

    PPerfCounterDefinition = ^TPerfCounterDefinition;
    TPerfCounterDefinition = record
    ByteLength: DWORD;
    CounterNameTitleIndex: DWORD;
    CounterNameTitle: LPWSTR;
    CounterHelpTitleIndex: DWORD;
    CounterHelpTitle: LPWSTR;
    DefaultScale: Longint;
    DetailLevel: DWORD;
    CounterType: DWORD;
    CounterSize: DWORD;
    CounterOffset: DWORD;
    end;

    PPerfInstanceDefinition = ^TPerfInstanceDefinition;
    TPerfInstanceDefinition = record
    ByteLength: DWORD;
    ParentObjectTitleIndex: DWORD;
    ParentObjectInstance: DWORD;
    UniqueID: Longint;
    NameOffset: DWORD;
    NameLength: DWORD;
    end;

    PPerfCounterBlock = ^TPerfCounterBlock;
    TPerfCounterBlock = record
    ByteLength: DWORD;
    end;


    {Navigation helpers}

    function FirstObject(PerfData: PPerfDataBlock): PPerfObjectType;
    begin
    Result := PPerfObjectType(DWORD(PerfData) + PerfData.HeaderLength);
    end;


    function NextObject(PerfObj: PPerfObjectType): PPerfObjectType;
    begin
    Result := PPerfObjectType(DWORD(PerfObj) + PerfObj.TotalByteLength);
    end;


    function FirstInstance(PerfObj: PPerfObjectType): PPerfInstanceDefinition;
    begin
    Result := PPerfInstanceDefinition(DWORD(PerfObj) + PerfObj.DefinitionLength);
    end;


    function NextInstance(PerfInst: PPerfInstanceDefinition): PPerfInstanceDefinition;
    var
    PerfCntrBlk: PPerfCounterBlock;
    begin
    PerfCntrBlk := PPerfCounterBlock(DWORD(PerfInst) + PerfInst.ByteLength);
    Result := PPerfInstanceDefinition(DWORD(PerfCntrBlk) + PerfCntrBlk.ByteLength);
    end;


    function FirstCounter(PerfObj: PPerfObjectType): PPerfCounterDefinition;
    begin
    Result := PPerfCounterDefinition(DWORD(PerfObj) + PerfObj.HeaderLength);
    end;


    function NextCounter(PerfCntr: PPerfCounterDefinition): PPerfCounterDefinition;
    begin
    Result := PPerfCounterDefinition(DWORD(PerfCntr) + PerfCntr.ByteLength);
    end;


    {Registry helpers}

    function GetPerformanceKey(const Machine: string): HKey;
    var
    s: string;
    begin
    Result := 0;
    if Length(Machine) = 0 then
    Result := HKEY_PERFORMANCE_DATA
    else
    begin
    s := Machine;
    if Pos('\\', s) &lt;> 1 then
    s := '\\' + s;
    if RegConnectRegistry(PChar(s), HKEY_PERFORMANCE_DATA, Result) &lt;> ERROR_SUCCESS then
    Result := 0;
    end;
    end;


    {TPerfObject}

    constructor TPerfObject.Create(const AMachine: string; AObjectID: DWORD);
    begin
    inherited Create;
    FList := TList.Create;
    FMachine := AMachine;
    FObjectID := AObjectID;
    ReadInstances;
    end;


    destructor TPerfObject.Destroy;
    var
    i: Integer;
    begin
    for i := 0 to FList.Count - 1 do
    TPerfInstance(FList[i]).Free;
    FList.Free;
    inherited Destroy;
    end;


    function TPerfObject.GetCount: Integer;
    begin
    Result := FList.Count;
    end;


    function TPerfObject.GetInstance(Index: Integer): TPerfInstance;
    begin
    Result := FList[Index];
    end;


    procedure TPerfObject.ReadInstances;
    var
    PerfData: PPerfDataBlock;
    PerfObj: PPerfObjectType;
    PerfInst: PPerfInstanceDefinition;
    PerfCntr, CurCntr: PPerfCounterDefinition;
    PtrToCntr: PPerfCounterBlock;
    BufferSize: Integer;
    i, j, k: Integer;
    pData: PLargeInteger;
    Key: HKey;
    CurInstance: TPerfInstance;
    begin
    for i := 0 to FList.Count - 1 do
    TPerfInstance(FList[i]).Free;
    FList.Clear;
    Key := GetPerformanceKey(FMachine);
    if Key = 0 then Exit;
    PerfData := nil;
    try
    {Allocate initial buffer for object information}
    BufferSize := 65536;
    GetMem(PerfData, BufferSize);
    {retrieve data}
    while RegQueryValueEx(Key,
    PChar(IntToStr(FObjectID)), {Object name}
    nil, nil, Pointer(PerfData), @BufferSize) = ERROR_MORE_DATA do
    begin
    {buffer is too small}
    Inc(BufferSize, 1024);
    ReallocMem(PerfData, BufferSize);
    end;
    RegCloseKey(HKEY_PERFORMANCE_DATA);
    {Get the first object type}
    PerfObj := FirstObject(PerfData);
    {Process all objects}
    for i := 0 to PerfData.NumObjectTypes - 1 do
    begin
    {Check for requested object}
    if PerfObj.ObjectNameTitleIndex = FObjectID then
    begin
    {Get the first counter}
    PerfCntr := FirstCounter(PerfObj);
    if PerfObj.NumInstances > 0 then
    begin
    {Get the first instance}
    PerfInst := FirstInstance(PerfObj);
    {Retrieve all instances}
    for k := 0 to PerfObj.NumInstances - 1 do
    begin
    {Create entry for instance}
    CurInstance := TPerfInstance.Create;
    CurInstance.FName := WideCharToString(PWideChar(DWORD(PerfInst) +
    PerfInst.NameOffset));
    FList.Add(CurInstance);
    CurCntr := PerfCntr;
    {Retrieve all counters}
    SetLength(CurInstance.FCounters, PerfObj.NumCounters);
    for j := 0 to PerfObj.NumCounters - 1 do
    begin
    PtrToCntr := PPerfCounterBlock(DWORD(PerfInst) + PerfInst.ByteLength);
    pData := Pointer(DWORD(PtrToCntr) + CurCntr.CounterOffset);
    {Add counter to array}
    CurInstance.FCounters[j].Counter := CurCntr.CounterNameTitleIndex;
    CurInstance.FCounters[j].Value := pData^;
    {Get the next counter}
    CurCntr := NextCounter(CurCntr);
    end;
    {Get the next instance.}
    PerfInst := NextInstance(PerfInst);
    end;
    end;
    end;
    {Get the next object type}
    PerfObj := NextObject(PerfObj);
    end;
    finally
    {Release buffer}
    FreeMem(PerfData);
    {Close remote registry handle}
    if Key &lt;> HKEY_PERFORMANCE_DATA then
    RegCloseKey(Key);
    end;
    end;


    procedure GetProcesses(const Machine: string; List: TStrings);
    var
    Processes: TPerfObject;
    i, j: Integer;
    ProcessID: DWORD;
    begin
    Processes := nil;
    List.Clear;
    try
    Processes := TPerfObject.Create(Machine, 230); {230 = Process}
    for i := 0 to Processes.Count - 1 do
    {Find process ID}
    for j := 0 to Length(Processes[i].Counters) - 1 do
    if (Processes[i].Counters[j].Counter = 784) then
    begin
    ProcessID := Processes[i].Counters[j].Value;
    if ProcessID &lt;> 0 then
    List.AddObject(Processes[i].Name, Pointer(ProcessID));
    Break;
    end;
    finally
    Processes.Free;
    end;
    end;

    end.

  24. #424
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن پرينترهاي نصب شده

    uses Printers;
    ...
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    Memo1.Lines.Assign(Printer.Printers);
    end;

  25. #425
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن جداول يك بانك با استفاده از ADO

    unit dbTables;

    interface

    uses ADODb;

    type
    TTableType = (ttTable, ttView, ttSynonym, ttSystemTable, ttAccessTable);

    type
    TTableTypes = set of TTableType;

    type
    TTableItem = record
    ItemName: string;
    ItemType: string;
    end;

    type
    TTableItems = array of TTableItem;
    function addFilter(string1, string2: string): string;
    function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;

    implementation

    function addFilter(string1, string2: string): string;
    begin
    if string1 <> '' then
    Result := string1 + ' or ' + string2
    else
    Result := string2;
    end;

    function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;
    var
    ADODataSet: TADODataSet;
    i: integer;
    begin
    ADODataSet := TADODataSet.Create(nil);
    ADODataSet.Connection := ADOConnection;
    ADOConnection.OpenSchema(siTables, EmptyParam, EmptyParam, ADODataSet);

    if (ttTable in types) then
    ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''TABLE'')');

    if (ttView in types) then
    ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''VIEW'')');

    if (ttSynonym in types) then
    ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''SYNONYM'')');

    if (ttSystemTable in types) then
    ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''SYSTEM TABLE'')');

    if (ttAccessTable in types) then
    ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''ACCESS TABLE'')');

    ADODataSet.Filtered := True;

    SetLength(Result, ADODataSet.RecordCount);

    i := 0;
    with ADODataSet do
    begin
    First;
    while not EOF do
    begin
    with Result[i] do
    begin
    ItemName := FieldByName('TABLE_NAME').AsString;
    ItemType := FieldByName('TABLE_TYPE').AsString;
    end;
    Inc(i);
    Next;
    end;
    end;
    ADODataSet.Free;
    end;

    end.

    {
    Example: create a new project and add a TADOConnection (ADOConnection1),
    a TButton (Button1) and a TMemo (Memo1); assign a ConnectionString to the
    TADOConnection component and set "ADOConnection1.Active := True"
    }

    procedure TForm1.Button1Click(Sender: TObject);
    var
    output: ttableitems;
    i: integer;
    begin
    output := ADODbTables(ADOConnection1, [ttTable, ttView, ttSynonym]);
    // output := ADODbTables(ADOConnection1, [ttSystemTable, ttAccessTable]);
    for i := Low(output) to High(output) do
    begin
    Memo1.Lines.Add(output[i].ItemName + '---' + output[i].ItemType);
    end;
    output := nil;
    end;

  26. #426
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن خط جاري در Memo

    procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    var LineNum: LongInt;
    begin
    if (Key=VK_UP)or(Key=VK_DOWN) then
    begin
    LineNum:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
    Label1.Caption:='Line - '+IntToStr(LineNum+1);
    end;
    end;

  27. #427
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن پسورد فايلهاي اکسس 97

    Procedure GetMDB97PassWord;

    Const
    XorArr : Array[0..12] of Byte =
    ($86,$FB,$EC,$37,$5D,$44,$9C,$FA,$C6,$5E,$28,$E6,$ 13);

    Var
    I : Integer;
    S1 : String;
    FI : File of Byte;
    By : Byte;
    Access97 : Boolean;
    FileError : Boolean;

    Begin
    // Init
    FileError := False;
    Access97 := True;

    // Open *.mbd file
    AssignFile(FI,Filename);
    Reset(FI);

    // Read file
    I := 0;
    Repeat
    If not Eof(FI) then
    Begin
    Read(FI,By);
    Inc(I);
    End;
    Until (I = $42) or Eof(FI);
    If Eof(FI) then
    FileError := True;

    // Read password string
    S1 := '';
    For I := 0 to 12 do
    If not Eof(FI) then
    Begin
    Read(f,By);
    S1 := S1 + Chr(By);
    End;

    If Eof(FI) then
    FileError := True;

    //Close file
    CloseFile(FI);

    // Is nul string?
    If S1 = #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 then
    Access97 := False;

    // Decode string
    For I := 0 to 12 do
    S1[I + 1] := Chr(Ord(S[I + 1]) xor XORArr[i]);

    // Find end of string
    I := Pos(#0,S1);
    If I = 1 then
    S1 := '';
    If I > 1 then
    S1 := Copy(S1,1,I);

    If Access97 then
    Begin
    If Length(S1) > 0 then
    ShowMessage := ('The password is: "' + S1 + '".')
    else
    ShowMessage ('The file is NOT password protected.');
    End
    else
    ShowMessage('The file is not an Access 97 file.');

    If FileError then
    ShowMessage('File error');

    End;

  28. #428
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

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

    بدست آوردن دايركتوري ويندوز

    procedure TForm1.Button1Click(Sender: TObject);
    var
    PWindowsDir: array [0..255] of Char;
    begin
    GetWindowsDirectory(PWindowsDir,255);
    Label1.Caption:=StrPas(PWindowsDir);
    end;

  29. #429

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

    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  30. #430

    تعریف ثابتی از نوع آرایه ای از رکورد

    برای دیدن روش کار به لینک زیر مراجعه کنید:
    https://barnamenevis.org/showthread.php?420040

  31. #431

    حلقه For کاهشی یا افزایشی

    گاهی اوقات نیاز میشود که حلقه ای برعکس شرایط عادی ، یعنی کاهشی بنویسم.
    برای مشخص نمودن افزایشی یا کاهشی بودن for از دو کلمه ی کلیدی to برای افزایشی کردن حلقه و downto برای کاهشی کردن حلقه استفاده می گردد.

    توضیح: حلقه ی افزایشی به حلقه ای گفته می شود که در آن مقدار اندیس حلقه در هر بار تکرار حلقه افزایش می یابد ولی حلقه ی کاهشی در هر تکرار حلقه مقدار اندیس حلقه را کاهش می دهد.
    افزایشی
    for variable := start to finish do

    // code

    مثال :
    for i := 0 to  10 do
    Memo1.Lines.Append(IntToStr(i));

    کاهشی :
    for variable := start downto  finish do

    // code

    مثال :
    for i := 10 downto  0 do
    Memo1.Lines.Append(IntToStr(i));


  32. #432
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

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

    سلام علیکم
    * چندتا اشکال عجیب هست که چند بار باهاش دست و پنجه نرم کردم.گفتم بد نیست به مبتدیها بگم حواسشون باشه.اگر میشد بزرگان هم در مورد بعضیهاش نظر یا توضیح بدهند خوب بود.

    من در تعریف نوع خسیس بازی در میارم. در یک برنامه از نوع داده Word استفاده کرده بودم . از این کد برای Draw استفاده می کردم اما گاهی چیزی رسم نمیشد. بعد دیدم عدد منفی به 65535 و .. تبدیل میشد!
    یه اشکال عجیب دیگه هم این بود که یک آرایه تعریف کرده بودم که تعداد سطرهای نمایشی یک فایل متن رو 2000 داده بودم.
    تعداد سطرها بیشتر میشد، برنامه میرفت مقدار رو توی یک متغیر دیگه میریخت.گاهی در خوندن کارکتر بعد از پایان رشته هم مشکل پیش میاد مثل وقتی که در یک حلقه میگیم تا آخر رشته بررسی کن که کارکتر بعدی چیه و اگر فلان کارکتر بعد از کارکتر خاصی بود..(از نحوه ذخیره آرایه و استفاده برنامه از حافظه چیز زیادی نمی دونم)
    وقتی یک رشته مقداردهی می کنیم که وسطش کارکتر 0# هست، (حد اقل در دلفی نسخه خودم) بقیه رشته خونده نمیشه.

    * چند تا نکته گرافیکی هم بگم:

    وقتی میخوایم یک خط ترسیم کنیم، سریعترین راه استفاده از PolyLine هست.(راه دیگه استفاده از MoveTo ,LineTo هست)
    LineTo آخرین نقطه خط رو رسم نمی کنه
    چنین کدی مربع 2*2 رسم می کنه:
    R:=Rect(11,11,13,13);
    canvas.Rectangle(R);

    Stretch میتونه برای ذره بین استفاده بشه. و تنظیمش طول و عرض بیت مپ رو تغییر نمیده اما در MouseMove روی TImage مختصات X,Y طبق محل زیر ماوس هست نه نقطه در بیت مپ.
    انتساب یک بت مپ به دیگری با =: معادل assign نیست. اولی فقط باعث بشه دو بیت مپ یک حافظه داشته باشند. بنابر این اگر داشته باشیم:
    B:=B2;

    با تغییر نقاط رنگی بیت مپ B2، پیکسلهای B هم تغییر می کنند.
    اگر در یک پروسیجر بخوایم پیکسلها رو به صورت عمودی ببرسی کنیم؛ مثلا حلقه بررسی عمودی پیکسلها درون حلقه بررسی افقی پیکسلها باشه،(به طور مثال برای بررسی رنگ پیکسل مجاور که راه بهتری هم داره) بهتره به جای اینکه برای هر پیکسل از scanline استفاده کنیم، یک ارایه از مقدار برگردونده شده توسط scanline داشته باشیم. چون scanline نیاز به محاسبه داره و فقط مثل اشارهگر به محل ذخیره اولین بایت از اولین پیکسل از یک خط پیکسل هست.نتیجه اختلاف سرعت در بیت مپ بزرگ معلوم میشه.
    آخرین ویرایش به وسیله mbshareat : جمعه 27 آبان 1401 در 12:56 عصر

  33. #433

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

    نوع word فقط اعداد مثبت رو ساپورت می کنه، اعداد منفی بیت علامت دارند که اولین بیت از سمت چپ یک متغیره و کامپایلر ازش می فهمه منفی هست یا مثبت، این بیت برای اعداد مثبت صفر و برای اعداد منفی یک هست، اگر سعی کنید در متغیر ورد یک عدد منفی بریزید یعنی در اولین بیتش از سمت چپ دارید یک می ریزید و چون متغیر از نوع ورد هست طبعا باید کامپایلر اون رو مثبت تفسیر کنه و می شه اونی که گفتی.
    در خصوص آرایه ها و غیره گاهی پیش میاد که از حد تعریف شده بصورت غیر مجاز بزنید بالاتر، وقتایی که شدنیه خود کامپایلر جلوتون رو می گیره ولی گاهی به هر دلیلی نمی تونه، تعریف متغیر ها هم بسته به سایزی که دارن معمولا پشت سر هم روی حافظه اتفاق می افته برای همین از یکی بزنید بیرون می ریزه تو بعدی! این داستان خوشبختانه در دلفی خیلی خیلی کمتره، اگر برنامه نویسی سی کرده باشید خیلی این موضوع براتون غریبه نیست.
    در خصوص 0 در رشته، خود صفر که کدش 48 هست، اگر عدد 0 رو داخل رشته بریزید نال در نظر گرفته می شه، رشته ها در دلفی معمولا بایت اولشون طولشون هست، یعنی وقتی می گید رشته ده تایی، کامپایلر 11 بایت رزرو می کنه، وقتی هم هیچی نمی گید 255 تا رزرو می کنه نه 256 تا، چرا؟ چون یه دونه می ذاره برا طول. اصلا دلیل این که ماکزیمم طول نمی تونه بالاتر از 255 بره (در این نوع رشته) اینه که از این عدد بیشتر نمی تونید تو یک بایت که برای طول در نظر گرفته شده بریزید.
    انواع دیگه رشته هم هستند که از همین نال برای تشخیص پایان رشته استفاده می کنند، مهم ترینشون هم PChar هست.
    احتمال زیادی داره که کامپایلر در توابعتون نال رو تفسیر به پایان رشته کرده باشه.

    موفق باشید.


    ---------

    اضافات:

    در مورد انتساب اشیا، اگر متغیری از نوع یک شی رو مساوی یک متغیر شی دیگه قرار بدید، در حقیقت دارید می گید که این اشاره گر به یک شی به همونجایی اشاره کنه که اون یکی داره اشاره می کنه، برای این که این دو تا از هم جدا باشند، باید حتما اونها رو جداگانه Create یا Assign کنید.
    این ها کاملا منطقی و جزو اساس برنامه نویسی شی گراست، در حقیقت یک پله هم قبل از شی گراییه، به طور خلاصه، هر متغیری از نوع شی باشه یک پوینتر محسوب می شه و معمولا 4 بایته! مهم جاییه که داره بهش اشاره می کنه.

    در خصوص پیمایش بیت مپ بصورت عمودی هم یکی از راههاش اینه که دو تا بیت مپ داشته باشید که یکیش عادی باشه برای افقی و یکیش فلیپ 90 درجه شده باشه برای عمودی. هردو رو هم با اسکن لاین بررسی کنید که سریع ترین حالتیه که در شی بیت مپ بصورت ساده در دسترسه. می شه بصورت فوری به پیکسلی که می خواهید دسترسی مستقیم داشته باشید ولی نیاز به کد نویسی قوی ای داره، بصورت عادی هم که بهش دسترسی دارید از حالت اسکن لاین خیلی خیلی کندتره.
    اگر کدنویسی سطح پایینتون خوب باشه می تونید با حساب کتاب نوع بیت مپ و این که هررنگ چه عمقی داره و چند بایته و طول تصویر چقدره و هدر و ایناش چندتاست، صاف هرطوری که دوست دارید از حافظه برش دارید. طولی، عرضی، ضربدری، بصورت اسکیمویی یا هرروش سامورایی دیگه ای که دوست داشته باشید!
    آخرین ویرایش به وسیله یوسف زالی : چهارشنبه 25 آبان 1401 در 07:16 صبح
    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  34. #434
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

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

    سلام بر دوستان
    دو تا نکته در مورد چک باکس یادم اومد. چون خودم درگیرش شده بودم گفتم شاید بد نیست اینجا بذارم:
    1.وقتی در رویداد MouseDown کد میذاریم، هنوز وضعیت Checked عوض نشده
    2.کد Click چک باکس با تنظیم Checked اجرا میشه. به همین دلیل اگر در Create این خصوصیت(Checked ) رو تنظیم می کنیم، ممکنه دچار Access Violation یا مشکل فوکوس به پنجره نامرئی بشیم.من برای حل این مشکل از بررسی متغیر FirstRun که در ابتدای اجرای برنامه True می کنم، در رویداد Click استفاده می کنم.(بررسی Visible هم معمولا جواب میده!)

    در مورد لیست باکس:
    اگر لیست بلندی داریم مثل برنامه متنی خودم که نمایش و آماده سازی متن با انتساب به Items.Text خیلی طول میکشه میتونیم برای هر سطر یک فاصله اضافه کنیم (با چیزی مثل DupeString(' '+#10,N)) و هر آیتم از لیست باکس رو در آرایه بریزیم. و بعد برای ترسیم هر سطر لیست باکس در OnDrawItem با بررسی عنصر مرتبط در آرایه، اقدام کنیم( تفصیلش رو خودتون بررسی کنید)
    آخرین ویرایش به وسیله mbshareat : جمعه 19 اسفند 1401 در 22:20 عصر

  35. #435
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

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

    سلام خدمت دوستان
    تعدادی اشکال هست که ممکنه برنامه رو بررسی کنیم ولی متوجهشون نشیم. بعضیهاشون اصالتاً اشکال برنامه نویسی نیستند و میتونند هنگام صحبت هم پیش بیاند.چند تاشون رو لیست می کنم.بد نیست اگر سر در نیوردیم مشکل برنامه چیه، دنبال چنین اشکالاتی بگردیم:
    (ممکنه قبلا هم چنین پستی با اختصار گذاشته باشم و یادم رفته باشه!!)

    * جابجايي سطرهای کد: گاهی فقط باید یک سطر کد رو قبل یا بعد از موقعیت فعلیش بذاریم

    * کمبود پرانتز در عبارت عددی یا ترکیب And و Or:عبارت 1+2-3 با (1+2)-3 برابر نیست

    * فراموش کردن مقداردهي اوليه اعداد:فرض کنید میخوایم N رو در حلقه با یک شرطی یکی اضافه کنیم. قبل از شروع حلقه باید N رو صفر کنیم وگرنه معلوم نیست چی پیش بیاد.

    * الصاق کد بدون تغيير موارد ضروری: گاهی کد دو پروسیجر شبیه هم هستند یا از اینترنت گرفتیم و چیزی شبیهش نیاز داریم ؛ کپی و الصاق می کنیم اما یادمون میره که کمی هم متفاوت هستند.

    * متغير مشابه: بارها شده X , X2 یا حتی I,J در حلقه رو با هم قاطی کردم.مخصوصا هنگام کپی و الصاق پیش میاد.

    * نام مبهم براي متغير يا پروسيجر. بعد از مدتی از نوشتن برنامه، اسم گویا برای متغیر و پروسیجر مهم میشه،چون یادمون میره کارش چی بود و شاید فکر کنیم در قسمتی از کد بهش نیاز نداریم یا کارکردش چیز دیگه ای هست.

    * فراموشی خروج از حلقه: بارها شده فراموش کردم Break استفاده کنم.
    نکته:گاهی لازم هست یک شرط رو با بعد از چند خط کد محاسباتی بررسی کنیم. در این صورت میتونیم اگر شرایط برقرار نبود داخل بلاک جرای حلقه، از Continue استفاده کنیم که از اون بار اجرای کد صرف نظر بشه.

    * استفاده نادرست از نوع داده کوچک يا بي علامت : این اشکال برنامه نویسی گاهی میتونه باعث به دست آمدن عدد نادرست و عمل نادرست بشه.

    * تعریف آرایه با تعداد اندیسهای کم یا ارسال آرایه شروع شده از غیر صفر به پروسیجر: در پروسیجر اولین مورد، مورد اندیس صفر محسوب میشه و مثلا اگر در پروسیجر بگیم مورد دارای اندیس یک رو تغییر بده، برنامه، مورد دوم از آرایه شروع شده با یک رو در نظر میگیره!

    * Else بعد از دو شرط:این کد رو ملاحظه کنید:

    If X=1 then
    If Y=2 then
    A:=0
    Else
    N:=3;

    Else استثنا از شرط دوم هست. برای اینکه استثنا از شرط اول بشه بهتر هست از Begin..end برای شرط اول استفاده کنیم. گاهی هم میشه دو شرط رو با And ادغام کرد.

    * استفاده از قسمتی از رشته بعد از حذف آن. بعضی وقتها میشه قسمتی از رشته رو گرفتم و درمتغیر ریختم و حذف کردم اما باز هم انتظار دارم اون قسمت از متن هنوز سر جاش باشه!!

    * استفاده از حلقه افزایشی به جای کاهشی، هنگام دستکاری متن: مثلا میخوایم در صورت برقرار بودن شرطی، یک متن کوتاه در محل جاری از متن اصلی درج کنیم، بهتره در حلقه از انتها به سمت ابتدای رشته اصلی بررسی کنیم. (روش دیگه استفاده از While به جای For هست)
    گاهی هم که چند فایل رو میخونیم و هر فایل رو به پروسیجر میدیم که کاری انجام بده، اگراز یک متغیر غیر وابسته به فایل خاص استفاده کنیم، رعایت نکردن ترتیب معکوس برای خوندن فایلها مشکل ساز میشه. من برای بررسی عناوین تکراری یک کتاب، حواسم نبود، فایلها رو از اول به آخر خوندم . درحالیکه هرفایل رو از آخر به اول بررسی می کردم و از یک متغیر عمومی هم استفاده می کردم که نشون میداد عنوان بعدی (که ممکن بود درفایل بعد باشه) چی بوده، به این مشکل برخوردم.

    چند نقص که خطای برنامه نویسی نیستند اما مهم هستند:

    * رعايت نکردن تو رفتگي: بدون رعایتIndent گاهی درک کد مشکل میشه و موجب اشتباه در کد نویسی میشه.(گاهی Begin رو در سطر، بعد از then ، میذارند و گیج میشم!)

    * کمبود کامنت: در برنامه های بزرگ که یک پروسیجر میتونه تعداد زیادی پروسیجر یا انتساب داشته باشه، مهم هست که کامنت کافی برای بعد داشته باشیم. ممکنه فردای نوشتن کد هم یادمون بره بعد از آزمون و خطا چه کار کردیم.
    من خودم برای کامنتهای مهمتر از (**) استفاده می کنم و در بالا یا کنار کد از // و وسط کد از {} استفاده می کنم
    آخرین ویرایش به وسیله mbshareat : دوشنبه 18 اردیبهشت 1402 در 10:55 صبح دلیل: خداجون! از اشتباه املایی و تغییر دقیقه نودی جمله خسته شدم :(

صفحه 11 از 11 اولاول ... 91011

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

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