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

[mahsa119]

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;

  const Rect: TRect; DataCol: Integer; Column: TColumn;

  State: TGridDrawState);

var

  test1: Real;

  RowNo: Integer;

begin

  with (Sender as TDBGrid) do

  begin

    if (gdSelected in State) then

    begin

      // Farbe für die Zelle mit dem Focus

      // color of the focused row

      Canvas.Brush.Color := clblue;

    end

    else

    begin

      // Zeile erfahren

      // get the actual row number

      rowno := Query1.RecNo;

      // gerade und ungerade Zeilen ermitteln

      // odd or even ?

      test1 := (RowNo / 2) - trunc(RowNo / 2);

      // Zeile gerade...

      // If it's an even one...

      if test1 = 0 then

      begin

        farbe := clWhite

      end

      // ...Zeile ungerade

      // ...else it's an odd one

      else

      begin

        farbe := clYellow;

      end;

      Canvas.Brush.Color := farbe;

      // Font-Farbe immer schwarz

      // font color always black

      Canvas.Font.Color := clBlack;

    end;

    Canvas.FillRect(Rect);

    // Denn Text in der Zelle ausgeben

    // manualy output the text

    Canvas.TextOut(Rect.Left + 2, Rect.Top + 1, Column.Field.AsString);

  end

end;

[mahsa119]

چگونه سایز Col را در یک DBGrid به صورت اتوماتیک قرار دهیم

procedure SetGridColumnWidths(Grid: Tdbgrid);

const

  DEFBORDER = 10;

var

  temp, n: Integer;

  lmax: array [0..30] of Integer;

begin

  with Grid do

  begin

    Canvas.Font := Font;

    for n := 0 to Columns.Count - 1 do

      //if columns[n].visible then

      lmax[n] := Canvas.TextWidth(Fields[n].FieldName) + DEFBORDER;

    grid.DataSource.DataSet.First;

    while not grid.DataSource.DataSet.EOF do 

    begin

      for n := 0 to Columns.Count - 1 do 

      begin

        //if columns[n].visible then begin

        temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;

        if temp > lmax[n] then lmax[n] := temp;

        //end; { if }

      end; {for}

      grid.DataSource.DataSet.Next;

    end; { while }

    grid.DataSource.DataSet.First;

    for n := 0 to Columns.Count - 1 do

      if lmax[n] > 0 then

        Columns[n].Width := lmax[n];

  end; { With }

end; {SetGridColumnWidths  }



procedure TForm1.Button1Click(Sender: TObject);

begin

  SetGridColumnWidths(dbgrid3);

end;

[mahsa119]

procedure SetGridColumnWidths(Grid: Tdbgrid);

const

  DEFBORDER = 10;

var

  temp, n: Integer;

  lmax: array [0..30] of Integer;

begin

  with Grid do

  begin

    Canvas.Font := Font;

    for n := 0 to Columns.Count - 1 do

      //if columns[n].visible then

      lmax[n] := Canvas.TextWidth(Fields[n].FieldName) + DEFBORDER;

    grid.DataSource.DataSet.First;

    while not grid.DataSource.DataSet.EOF do 

    begin

      for n := 0 to Columns.Count - 1 do 

      begin

        //if columns[n].visible then begin

        temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;

        if temp > lmax[n] then lmax[n] := temp;

        //end; { if }

      end; {for}

      grid.DataSource.DataSet.Next;

    end; { while }

    grid.DataSource.DataSet.First;

    for n := 0 to Columns.Count - 1 do

      if lmax[n] > 0 then

        Columns[n].Width := lmax[n];

  end; { With }

end; {SetGridColumnWidths  }



procedure TForm1.Button1Click(Sender: TObject);

begin

  SetGridColumnWidths(dbgrid3);

end;

[mahsa119]

procedure TForm1.Button1Click(Sender: TObject);

begin

  ADOCommand1.CommandText := 'Use DataBaseName';

  ADOCommand1.Execute;

  ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');

  ADOCommand1.Execute;

end;







{* For Any Infromation Mail Me *



Mail :  Mostafa@Touska.Co.ir0





...Add a user into a database in Sql Server 2000? 

[mzjahromi]

uses MMSystem;



 



type



TVolumeRec = record



     case Integer of



     0: (LongVolume: Longint) ;



     1: (LeftVolume, RightVolume : Word) ;



     end;



 



const DeviceIndex=5



     {0:Wave



        1:MIDI



        2:CDAudio



        3:Line-In



        4:Microphone



        5:Master



        6:PC-loudspeaker}



 



procedure SetVolume(aVolume:Byte) ;



var Vol: TVolumeRec;



begin



Vol.LeftVolume := aVolume shl 8;



Vol.RightVolume:= Vol.LeftVolume;



auxSetVolume(UINT(DeviceIndex), Vol.LongVolume) ;



end;



 



function GetVolume:Cardinal;



var Vol: TVolumeRec;



begin



AuxGetVolume(UINT(DeviceIndex),@Vol.LongVolume) ;



Result:=(Vol.LeftVolume + Vol.RightVolume) shr 9;



end;



 

لینک اصلی

[mzjahromi]

کامپوننت TImage برای نمایش تصاویر گرافیکی مورد استفاده قرار میگیرد(Ico,BMP,WMF,GIF,JPEG و مانند آن)خاصیت Picture مشخص کننده تصویری است که باید نمایش داده شود به منظور مقدار دادن به این خاصیت راههای زیادی وجود دارد: استفاده از خاصیت LoadFromFile که می توان به منظور خواندن یک فایل گرافیکی از هارد از آن استفاده کرد یا تابع Assign که می توان توسط آن تصاویر موجود در حافظه موقت(ClipBoard)
در بیشتر حالات شما تصویر خود را در زمان طراحی نرم افزار مقدار دهی میکنیدو این کار با مقدار دهی خاصیت Picture از Objectinspector امکان پذیر است
در صورتیکه میخواهید تصویر را در زمان اجرا حذف کنید مقدار خاصیت Picture را برابر با NIL قرار دهید.
و در صورتیکه بخواهید خالی بودن تصور را کنترل کنید از کد زیر استفاده کنید

if Image1.Picture.Graphic.Empty then

begin

...

end; 

لینک اصلی

[mzjahromi]

بدین منظور میتوانید از کنترل TScreen و رویداد onActiveControlChange استفاده کنید

const

   focusColor = clSkyBlue;



var

   lastFocused : TWinControl;

   originalColor : TColor;

توجه داشته باشید که کامپوننتی تحت عنوان TScreen برای قرار دادن روی فرم وجود ندارد و شما باید بصورت دستی رویدادها را تنظیم کنید

procedure TMainForm.FormCreate(Sender: TObject) ;

begin

   Screen.OnActiveControlChange := ScreenActiveControlChange;

end;



procedure TMainForm.FormDestroy(Sender: TObject) ;

begin

   Screen.OnActiveControlChange := nil;

end; 

و پیاده سازی رویداد ذکر شده به صورت زیر است

procedure TMainForm.ScreenActiveControlChange(Sender: TObject) ;

var

   doEnter, doExit : boolean;

   previousActiveControl : TWinControl;

begin

   if Screen.ActiveControl = nil then

   begin

     lastFocused := nil;

     Exit;

   end;



   doEnter := true;

   doExit := true;



   //CheckBox

   if Screen.ActiveControl is TButtonControl then doEnter := false;



   previousActiveControl := lastFocused;



   if previousActiveControl <> nil then

   begin

     //CheckBox

     if previousActiveControl is TButtonControl then doExit := false;

   end;



   lastFocused := Screen.ActiveControl;



   if doExit then ExitColor(previousActiveControl) ;

   if doEnter then EnterColor(lastFocused) ;

end; 



procedure TMainForm.EnterColor(Sender: TWinControl);

begin

  if Sender <> nil then

  begin

    if IsPublishedProp(Sender,'Color') then

    begin

      originalColor := GetOrdProp(Sender,'Color');

      SetOrdProp(Sender,'Color', focusColor);

    end;

  end;

end;



procedure TMainForm.ExitColor(Sender: TWinControl);

begin

  if Sender <> nil then

  begin

    if IsPublishedProp(Sender,'Color') then

    begin

      SetOrdProp(Sender,'Color',originalColor);

    end;

  end;

end;

[adelmobasheri]

جناب این TMB که استفاده کردی چیه؟

[mohebbi_en]

salam
bebakhshid
khat zir da barnameh CPUID chekar mikonad.

if s1 <> ' ' then


ba tashakor

[vesal]

سلام.
با این کد می تونید در کنترل DBGrid برای مقادیر منطقی به جای True یا False از CheckBox استفاده کنید

این کد یونیت :

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, DB, DBTables, Grids, DBGrids;



type

  TForm1 = class(TForm)

    DBGrid1: TDBGrid;

    Table1: TTable;

    DataSource1: TDataSource;

    procedure DBGrid1CellClick(Column: TColumn);

    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

      DataCol: Integer; Column: TColumn; State: TGridDrawState);

    procedure DBGrid1ColEnter(Sender: TObject);

    procedure DBGrid1ColExit(Sender: TObject);

  private



 FOriginalOptions : TDBGridOptions; { Private declarations }

  public

   procedure SaveBoolean;

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



procedure TForm1.SaveBoolean;

begin

 Self.DBGrid1.SelectedField.Dataset.Edit;

 Self.DBGrid1.SelectedField.AsBoolean := not Self.DBGrid1.SelectedField.AsBoolean;

 Self.DBGrid1.SelectedField.Dataset.Post;

end;



procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

 if Self.DBGrid1.SelectedField.DataType = ftBoolean then

  SaveBoolean();

end;



procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

  DataCol: Integer; Column: TColumn; State: TGridDrawState);

Const

 CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,

     DFCS_BUTTONCHECK or DFCS_CHECKED);

var

 CheckBoxRectangle : TRect;

begin

 if Column.Field.DataType = ftBoolean then

 begin

 Self.DBGrid1.Canvas.FillRect(Rect);

 CheckBoxRectangle.Left := Rect.Left + 2;

 CheckBoxRectangle.Right := Rect.Right - 2;

 CheckBoxRectangle.Top := Rect.Top + 2;

 CheckBoxRectangle.Bottom := Rect.Bottom - 2;

 DrawFrameControl(Self.DBGrid1.Canvas.Handle,

      CheckBoxRectangle,

      DFC_BUTTON,

      CtrlState[Column.Field.AsBoolean]);

 end;

end;

procedure TForm1.DBGrid1ColEnter(Sender: TObject);

begin

 if Self.DBGrid1.SelectedField.DataType = ftBoolean then

 begin

  Self.FOriginalOptions := Self.DBGrid1.Options;

  Self.DBGrid1.Options := Self.DBGrid1.Options - [dgEditing];

 end;

end;



procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

 if Self.DBGrid1.SelectedField.DataType = ftBoolean then

  Self.DBGrid1.Options := Self.FOriginalOptions;

end;



end.



این هم مال فرم 



object Form1: TForm1

  Left = 192

  Top = 114

  Width = 953

  Height = 778

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object DBGrid1: TDBGrid

    Left = 0

    Top = 0

    Width = 945

    Height = 744

    Align = alClient

    DataSource = DataSource1

    TabOrder = 0

    TitleFont.Charset = DEFAULT_CHARSET

    TitleFont.Color = clWindowText

    TitleFont.Height = -11

    TitleFont.Name = 'MS Sans Serif'

    TitleFont.Style = []

    OnCellClick = DBGrid1CellClick

    OnColEnter = DBGrid1ColEnter

    OnColExit = DBGrid1ColExit

    OnDrawColumnCell = DBGrid1DrawColumnCell

  end

  object Table1: TTable

    Active = True

    DatabaseName = 'DBDEMOS'

    TableName = 'reservat.db'

    Left = 128

    Top = 88

  end

  object DataSource1: TDataSource

    DataSet = Table1

    Left = 176

    Top = 80

  end

end

[Touska]

procedure TForm1.Button1Click(Sender: TObject);

begin

  ADOCommand1.CommandText := 'Use DataBaseName';

  ADOCommand1.Execute;

  ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');

  ADOCommand1.Execute;

end;







{* For Any Infromation Mail Me *



Mail :  Mostafa@Touska.Co.ir





...Add a user into a database in Sql Server 2000? 

خیلی جالبه- تازه دیدمش - قصد هدر دادن وقت دیگران را ندارم - شرمنده این Email وجود نداره

[davoodmz]

لطفاً بیشتر توضیح بدهید که بدانیم . این user به چه شکل اضافه می شود آیا قبلاً دیتابیس باید در sql باشد. اگر برای کنترل یوزرها از یک جدول در sqlاستفاده می کنیم . اضافه کردن و حذف و دادن امکانات به یوزر مثل ثبت یک رکورد امکان دارد
با تشکر
داود

procedure TForm1.Button1Click(Sender: TObject);

begin

  ADOCommand1.CommandText := 'Use DataBaseName';

  ADOCommand1.Execute;

  ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');

  ADOCommand1.Execute;

end;







{* For Any Infromation Mail Me *



Mail :  Mostafa@Touska.Co.ir0





...Add a user into a database in Sql Server 2000? 

[Touska]

این USer قبلا ساخته شده حالا به این دیتابیس اضافه میشه :)

[amir_22]

تبدیل عدد به حرف

punit Curr2Str;



interface

function Add2Harf(i:int64):string;



implementation



function Add2Harf(i:int64):string;

const v=' æ ';

var

    ok:boolean;

  {___________________________________}

  function yekan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='íß';

        2:result:='Ïæ';

        3:result:='Óå';

        4:result:='چåÇÑ';

        5:result:='پäÌ';

        6:result:='ÔÔ';

        7:result:='åÝÊ';

        8:result:='åÔÊ';

        9:result:='äå';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function dahgan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='Ïå';

        2:result:='ÈíÓÊ';

        3:result:='Óí';

        4:result:='چåá';

        5:result:='پäÌÇå';

        6:result:='ÔÕÊ';

        7:result:='åÝÊÇÏ';

        8:result:='åÔÊÇÏ';

        9:result:='äæÏ';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function sadgan(y:byte):string;

  begin

    case y of

        0:result:='';

        1:result:='íßÕÏ';

        2:result:='ÏæíÓÊ';

        3:result:='ÓíÕÏ';

        4:result:='چåÇÑÕÏ';

        5:result:='پÇäÕÏ';

        6:result:='ÔÔÕÏ';

        7:result:='åÝÊÕÏ';

        8:result:='åÔÊÕÏ';

        9:result:='äåÕÏ';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function dah(y:byte):string;

  begin

    case y of

        0:result:='';

        10:result:='Ïå';

        11:result:='íÇÒÏå';

        12:result:='ÏæÇÒÏå';

        13:result:='ÓíÒÏå';

        14:result:='چåÇÑÏå';

        15:result:='پÇäÒÏå';

        16:result:='ÔÇäÒÏå';

        17:result:='åÝÏå';

        18:result:='åÌÏå';

        19:result:='äæÒÏå';

    enD;

    if result=''then ok:=false else ok:=true;

  end;

  {___________________________________}

  function seragham(si:smallint):string;

  begin

    result:='';

    result:=sadgan(si div 100);

    if ok then result:=result+v;



    if((si mod 100)div 10) <> 1 then begin

        result:=result+dahgan((si mod 100)div 10);

        if ok then result:=result+v;

        result:=result+yekan(si mod 10);

        if not ok then result:=copy(result,1,length(result)-3);

    End

    else begin

        result:=result+dah(si mod 100);

    end;

    if result='' then ok:=false else ok:=true;

  end;

  {___________________________________}

const

    tr=' ÊÑíáíæä';

    mr=' ãíáíÇÑÏ';

    ml=' ãíáíæä';

    hz=' åÒÇÑ';

begin

    ok:=false;



    result:=seragham(i div 1000000000000);

    if ok then result:=result+tr+v;

    result:=result+seragham((i mod 1000000000000)div 1000000000);

    if ok then result:=result+mr+v;

    result:=result+seragham((i mod 1000000000)div 1000000);

    if ok then result:=result+ml+v;

    result:=result+seragham((i mod 1000000)div 1000);

    if ok then result:=result+hz+v;

    result:=result+seragham(i mod 1000);

    if not ok then result:=copy(result,1,length(result)-3);



    if i=0 then result:='ÕÝÑ';

end;







end.

[jamjid]

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

procedure TForm1.FormCreate(Sender: TObject);

begin

 SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX  _TOOLWINDOW);

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 Action:=caNone;

 Form1.Hide;

end;[QUOTE][/QUOTE

--------------------بدست آوردن زمان شروع به کار ویندوز

procedure TForm1.Button1Click(Sender: TObject);

var nday:Double;

    tick:Longint;

    btime:TDateTime;

    s:string;

begin

 tick:=GetTickCount;

 nday:=tick/86400000;

 btime:=Now-nday;

 s:='"Windows started on" dddd,mmmm d,yyyy,'+'"at" hh:nn:ss AM/PM';

 showmessage( FormatDateTime(s,btime)+#10#13+

 'It been up for '+IntToStr(TRUNC(nday))+' Days,'+

 FormatDateTime(' h "Houre," n "minutes," s "seconds"',nday));

end;

[partorad]

آیا کسی هست کمک کنه
میخواهم مشخصات سخت افزار کامپیوتری که به آن کانکت کرده ام (server )را بدست بیاورم مانند سریال سخت افزاری هارد ( نهVolumelable ) ، سریال CPU ، سریال فلش مموری

[Touska]

آیا کسی هست کمک کنه
میخواهم مشخصات سخت افزار کامپیوتری که به آن کانکت کرده ام (server )را بدست بیاورم مانند سریال سخت افزاری هارد ( نهVolumelable ) ، سریال CPU ، سریال فلش مموری

سئوال خود را به بخش مباحث برنامه نویسی منتفل نمایید.

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

یک نمونه از این برنامه رو من تهیه کردم که از Indy و Mitec System Information در پروژه سود بردم.

موفق باشید :)

[dkhatibi]

تشخیص اتصال به شبکه

procedure TForm1.Button1Click(Sender: TObject);

begin

if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then

  MessageDlg('Machine is attached to network',MtInformation,[mbok],0)

else

MessageDlg('Machine is not attached to network',mtInformation,[mbok],0);

end;

[dkhatibi]

چه مدت است که ویندوز شما در حال اجراست؟

[vesal]

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}

[mehdi_mohamadi]

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

 function EnumWinProc(Wnd : HWND) : Boolean; Export; StdCall;

 var

   WinText : Array[0..255] of Char;

 begin

   GetWindowText(Wnd, WinText, 255);

   Result := True;

   if (StrPas(WinText) <> '') and

      IsWindowVisible(Wnd) and

      (Wnd<>Application.Handle) and

      (Wnd<>Form1.Handle)

      then

        CloseWindow(Wnd);

 end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  EnumWindows(@EnumWinProc, LongInt(Self));

end;

end.

[mehdi_mohamadi]

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Label1: TLabel;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure FechaDelSistema(Fecha: TDateTime);

   var

     FecSys: TSystemTime;

     nA, nM, nD: Word;

   begin

     DecodeDate(Fecha, nA,nM,nD);

     GetLocalTime(FecSys);

     FecSys.wYear  := nA;

     FecSys.wMonth := nM;

     FecSys.wDay   := nD;

     SetLocalTime(FecSys);

   end;



procedure TForm1.Button1Click(Sender: TObject);

begin

 

FechaDelSistema( StrToDate('2006/10/09') );

end;

end.

[Mah6447]

محاسبه و نمایش مجموع مقادیر فیلدهای DbGrid
برداشت از سایت
http://search.experts-exchange.com/

[babak_delphi]

تغییر Resolution مونیتور
باید یک پروسیجر به شکل زیر بنویسیم:

procedure SetResolution(ResX, ResY: DWord); 

var 

lDeviceMode : TDeviceMode; 

begin 

EnumDisplaySettings(nil, 0, lDeviceMode); 

lDeviceMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT; 

lDeviceMode.dmPelsWidth :=ResX; 

lDeviceMode.dmPelsHeight:=ResY; 

ChangeDisplaySettings(lDeviceMode, 0); 

end; 

نکته بسیار مهم:
اگر اعداد غیر استاندارد برای Resolutoin مونیتور وارد کنید احتمال آسیب رسیدن به مونیتور وجود دارد، از رزولوشن های استاندارد مثل 320*240 ، 640*480 ، 1024*768 و ... استفاده کنید

[delphi5]

shutdown and restart and logof windows

 
function WindowsExit(RebootParam: Longword): Boolean;

var

TTokenHd: THandle;

TTokenPvg: TTokenPrivileges;

cbtpPrevious: DWORD;

rTTokenPvg: TTokenPrivileges;

pcbtpPreviousRequired: DWORD;

tpResult: Boolean;

const

SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

tpResult := OpenProcessToken(GetCurrentProcess(),

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

TTokenHd) ;

if tpResult then

begin

tpResult := LookupPrivilegeValue(nil,

SE_SHUTDOWN_NAME,

TTokenPvg.Privileges[0].Luid) ;

TTokenPvg.PrivilegeCount := 1;

TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

cbtpPrevious := SizeOf(rTTokenPvg) ;

pcbtpPreviousRequired := 0;

if tpResult then

Windows.AdjustTokenPrivileges(TTokenHd,

False,

TTokenPvg,

cbtpPrevious,

rTTokenPvg,

pcbtpPreviousRequired) ;

end;

end;

Result := ExitWindowsEx(RebootParam, 0) ;

end;

نحوه استفاده

//reboot windows 

ExitWindowsEx(EWX_REBOOT, 0) ;

 

//shut down windows 

ExitWindowsEx(EWX_SHUTDOWN, 0) ;

 

// log off and prompt for login

ExitWindowsEx(EWX_LOGOFF, 0) ;

[Keramatifar]

سلام
1-با اخطار دوستم کمی ترسیدم!!! 1024 را مثلا کجا و 768 را کجا وارد کنیم.
2- می شود اول چک کند که 1024*768 است اگر نباشد به این حالت مانیتور را ببرد.

برای اینکه رزولوشن فعلی مونیتور را بدست بیاری کافیه دو متغیر x,y از نوع int تعریف کنی و به این صورت عمل کنی:

x:= screen.width;

y:=screen.height

حالا رزولوشن صفحه رو توی دو متغیر داری (افقی داخل x و عمودی داخل y) موقعی که میخوای رزولوشن رو چک کنی که اگه مثلا 800 در 600 نبود عوضش کنه این کد رو بزن:

if (x<>800) and (y<>600) 

then ....

در ضمن بعد از پایان کارت می تونی با استفاده از همین دو متغیر رزولوشن مونیتور را به حالت اصلی بر گردونی

[hr110]

تصویر توسعه‌دهندگان دلفی 7

کافی است به محض اجرا Delphi 7 دو کلید CTRL و SHIFT را پایین نگه دارید:



به نظر شما این تصویر با چه تکنیکی capture شده است؟

[Hamid_PaK]

به نظر شما این تصویر با چه تکنیکی capture شده است؟

کلید PrtScrn -> واژه Enterprise ...

یا حق ...

[شیلا .ک]

از همه دوستانی که در این بخش زحمت می کشن و تاپیک می ذارن بخصوص جناب WishMaster که این تاپیک رو باز کردن نهایت تشکر و قدردانی رو دارم
من امروز که دنبال حل یکی از مشکلاتم تو دلفی مگشتم اینجا رو پیدا کردم و علاوه بر احل مشکلم کلی چیز جدید هم یاد گرفتم

[Future_Coder]

این قسمت فقط یک مشکل کوچیک داره اونم ذکر کردنه منبعه!از این تکنیکهایی که انجا هستند تعدادی از اونها در سایتهای دیگر نوشته و پخش شدند و اگه اون منبع رو ذکر کنیم در آخر هر صفحه از اون مقاله ها Related Articles هستند که کاربر رو به سمت موضوعات مشابه هدایت میکنه!

---------------------------------------
Persians Are Rulerz!Persians Are Creator Of Algorithmic Method For Solving A Problem
And Now It's Honor To be A Coder

[پرواز]

کافی است به محض اجرا Delphi 7 دو کلید CTRL و SHIFT را پایین نگه دارید:

سلام.

سوالی که اینجا مطرح میشه اینه که این عکس کجا نگهداری مشه؟
چون تو مسیر نصب دلفی که نیست. دو راه وجود داره:
اول اینکه در زمان اجرا ساخته بشه. یعنی از محتویات یک یا چند فایل کد شده بخونه.
دوم اینکه این عکس به سورس برنامه اد شده باشه که از Borland بعیده که بیاد با بالا بردن حجم برنامه سرعتش رو کم کنه.
اگه کسی می دونه قضیه چیه به ما هم یاد بده.

موفق باشید

[hr110]

ریسورس لزوماً در فایل اجرایی نیست، میتوان این تصویر را در هر فایل دیگری قرار داد.
به دنبال فایل با پسوند JPG, GIF,BMP نباشید.

[hossein taghi zadeh]

با سلام

دوم اینکه این عکس به سورس برنامه اد شده باشه که از Borland بعیده که بیاد با بالا بردن حجم برنامه سرعتش رو کم کنه.

این عکس با نام SPLASHHIGH1 در بخش RCData ریسورس فایل اجرایی دلفی هست.
می‌تونید با برنامه‌هایی مثل EXEScope این عکس رو ببینید.

[msseng]

سلام
ممنون از نکات بسیار جالبی که مطرح میکنید.
یه سوال داشتم... نمدونم جاش اینجا هست یا نه ولی در هر صورت شما ببخشید:
منظور از lt& که بعضی جاها استفاده شده چیه؟
آیا یه عملگر هست؟ چون همیشه بعد از یک متغیر میاد...

[ali_abbasi22145]

محاسبه و نمایش مجموع مقادیر فیلدهای DbGrid
برداشت از سایت
http://search.experts-exchange.com/

سلام برنامه تان خطا می دهد!

[msseng]

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

[Vahid_moghaddam]

با این روش:

type

  TShopItem = record

    Name : string;

    Price : currency;

  end;
 

const

  Days : array[0..6] of string =

  (

    'Sun', 'Mon', 'Tue', 'Wed',

    'Thu', 'Fri', 'Sat'

  ) ;
 

  CursorMode : array[boolean] of TCursor =

  (

    crHourGlass, crSQLWait

  ) ;
 

  Items : array[1..3] of TShopItem =

  (

    (Name : 'Clock'; Price : 20.99),

    (Name : 'Pencil'; Price : 15.75),

    (Name : 'Board'; Price : 42.96)

  ) ; 

[Vahid_moghaddam]

مرجع:
http://delphi.about.com

[Vahid_moghaddam]

procedure Shuffle(

  var aArray;

  aItemCount: Integer;

  aItemSize: Integer) ;

var

  Inx: Integer;

  RandInx: Integer;

  SwapItem: PByteArray;

  A: TByteArray absolute aArray;

begin

  if (aItemCount > 1) then

  begin

    GetMem(SwapItem, aItemSize) ;

    try

      for Inx := 0 to (aItemCount - 2) do

      begin

        RandInx := Random(aItemCount - Inx) ;

        Move(A[Inx * aItemSize], SwapItem^, aItemSize) ;

        Move(A[RandInx * aItemSize],

             A[Inx * aItemSize], aItemSize) ;

        Move(SwapItem^, A[RandInx * aItemSize],

             aItemSize) ;

      end;

    finally

      FreeMem(SwapItem, aItemSize) ;

    end;

  end;

end;
 

procedure TForm1.Button1Click(Sender: TObject) ;

var

  a: array[1..54] of Integer;

  i: Shortint;

begin

  Randomize;

  for i := Low(a) to High(a) do a := i;

  Shuffle(a, High(a), SizeOf(Integer)) ;

  ListBox1.Clear;

  for i := 1 to High(a) - 1 do

    ListBox1.Items.Add(IntToStr(a)) ;

end;

[M0h$enRunTime]

آقای Wish مطالب خوبیه
فقط اگه بشه راجع به اون بحث کرد خیلی خوب می شد
منظورم درک عمقی کد های نوشته شده
اگه بشه بحث کرد اونوقت همه می تونن از API استفاده کنن و کد بنویسن