-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد خروجي از 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.
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد سايه براي 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.
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد سايه براي پنجره هاي برنامه
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد سريع يك جدول پارادوكس به كمك كد
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد صدا هنگام وارد شدن ماوس روي كنترل
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد ميانبر از يك فايل در ويندوز
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}
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد يك 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد يك اتصال 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
ايجاد يک ديتا بيس Access را در زمان اجرا
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
AccessApp: Variant;
begin
AccessApp := CreateOleObject('Access.Application');
AccessApp.NewCurrentDatabase('c:\111.mdb');
AccessApp := Unassigned;
end;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
اين تابع براي حذف کليه يک فولدر با کليه فايل ها داخل آن
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
اين تابع براي عوض کردن مشخصات همه کامپوننت ها در يک فرم است
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
با اين کد مي توانيد عنوان دکمه برنامه خودتون رو در 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
با کد زير مي توانيد يک 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
باز كردن پنجره پروپرتي پرينتر
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
باز كردن دكمه Start ويندوز
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Handle, WM_SYSCOMMAND, SC_TASKLIST, 1);
end;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
باز و بسته كردن سيدي درايو
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
باز کردن پوشه پرينترها توسط اين تابع انجام مي شود
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بازگرداندن بزرگترين 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
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن آيپي اينترنت 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن اطلاعاتي در مورد حافظه
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن اطلاعاتي درباره سيستم
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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن پروسسهاي فعال شبكه
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) <> 1 then
s := '\\' + s;
if RegConnectRegistry(PChar(s), HKEY_PERFORMANCE_DATA, Result) <> 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 <> 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 <> 0 then
List.AddObject(Processes[i].Name, Pointer(ProcessID));
Break;
end;
finally
Processes.Free;
end;
end;
end.
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن پرينترهاي نصب شده
uses Printers;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Assign(Printer.Printers);
end;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن جداول يك بانك با استفاده از 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن خط جاري در 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن پسورد فايلهاي اکسس 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;
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
بدست آوردن دايركتوري ويندوز
procedure TForm1.Button1Click(Sender: TObject);
var
PWindowsDir: array [0..255] of Char;
begin
GetWindowsDirectory(PWindowsDir,255);
Label1.Caption:=StrPas(PWindowsDir);
end;
-
نقل قول: نکات برنامه نویسی در دلفی
-
تعریف ثابتی از نوع آرایه ای از رکورد
-
حلقه 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));
-
نقل قول: نکات برنامه نویسی در دلفی
سلام علیکم:قلب:
* چندتا اشکال عجیب هست که چند بار باهاش دست و پنجه نرم کردم.گفتم بد نیست به مبتدیها بگم حواسشون باشه.اگر میشد بزرگان هم در مورد بعضیهاش نظر یا توضیح بدهند خوب بود.
من در تعریف نوع خسیس بازی در میارم. در یک برنامه از نوع داده 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 نیاز به محاسبه داره و فقط مثل اشارهگر به محل ذخیره اولین بایت از اولین پیکسل از یک خط پیکسل هست.نتیجه اختلاف سرعت در بیت مپ بزرگ معلوم میشه.
-
نقل قول: نکات برنامه نویسی در دلفی
نوع word فقط اعداد مثبت رو ساپورت می کنه، اعداد منفی بیت علامت دارند که اولین بیت از سمت چپ یک متغیره و کامپایلر ازش می فهمه منفی هست یا مثبت، این بیت برای اعداد مثبت صفر و برای اعداد منفی یک هست، اگر سعی کنید در متغیر ورد یک عدد منفی بریزید یعنی در اولین بیتش از سمت چپ دارید یک می ریزید و چون متغیر از نوع ورد هست طبعا باید کامپایلر اون رو مثبت تفسیر کنه و می شه اونی که گفتی.
در خصوص آرایه ها و غیره گاهی پیش میاد که از حد تعریف شده بصورت غیر مجاز بزنید بالاتر، وقتایی که شدنیه خود کامپایلر جلوتون رو می گیره ولی گاهی به هر دلیلی نمی تونه، تعریف متغیر ها هم بسته به سایزی که دارن معمولا پشت سر هم روی حافظه اتفاق می افته برای همین از یکی بزنید بیرون می ریزه تو بعدی! این داستان خوشبختانه در دلفی خیلی خیلی کمتره، اگر برنامه نویسی سی کرده باشید خیلی این موضوع براتون غریبه نیست.
در خصوص 0 در رشته، خود صفر که کدش 48 هست، اگر عدد 0 رو داخل رشته بریزید نال در نظر گرفته می شه، رشته ها در دلفی معمولا بایت اولشون طولشون هست، یعنی وقتی می گید رشته ده تایی، کامپایلر 11 بایت رزرو می کنه، وقتی هم هیچی نمی گید 255 تا رزرو می کنه نه 256 تا، چرا؟ چون یه دونه می ذاره برا طول. اصلا دلیل این که ماکزیمم طول نمی تونه بالاتر از 255 بره (در این نوع رشته) اینه که از این عدد بیشتر نمی تونید تو یک بایت که برای طول در نظر گرفته شده بریزید.
انواع دیگه رشته هم هستند که از همین نال برای تشخیص پایان رشته استفاده می کنند، مهم ترینشون هم PChar هست.
احتمال زیادی داره که کامپایلر در توابعتون نال رو تفسیر به پایان رشته کرده باشه.
موفق باشید.
---------
اضافات:
در مورد انتساب اشیا، اگر متغیری از نوع یک شی رو مساوی یک متغیر شی دیگه قرار بدید، در حقیقت دارید می گید که این اشاره گر به یک شی به همونجایی اشاره کنه که اون یکی داره اشاره می کنه، برای این که این دو تا از هم جدا باشند، باید حتما اونها رو جداگانه Create یا Assign کنید.
این ها کاملا منطقی و جزو اساس برنامه نویسی شی گراست، در حقیقت یک پله هم قبل از شی گراییه، به طور خلاصه، هر متغیری از نوع شی باشه یک پوینتر محسوب می شه و معمولا 4 بایته! مهم جاییه که داره بهش اشاره می کنه.
در خصوص پیمایش بیت مپ بصورت عمودی هم یکی از راههاش اینه که دو تا بیت مپ داشته باشید که یکیش عادی باشه برای افقی و یکیش فلیپ 90 درجه شده باشه برای عمودی. هردو رو هم با اسکن لاین بررسی کنید که سریع ترین حالتیه که در شی بیت مپ بصورت ساده در دسترسه. می شه بصورت فوری به پیکسلی که می خواهید دسترسی مستقیم داشته باشید ولی نیاز به کد نویسی قوی ای داره، بصورت عادی هم که بهش دسترسی دارید از حالت اسکن لاین خیلی خیلی کندتره.
اگر کدنویسی سطح پایینتون خوب باشه می تونید با حساب کتاب نوع بیت مپ و این که هررنگ چه عمقی داره و چند بایته و طول تصویر چقدره و هدر و ایناش چندتاست، صاف هرطوری که دوست دارید از حافظه برش دارید. طولی، عرضی، ضربدری، بصورت اسکیمویی یا هرروش سامورایی دیگه ای که دوست داشته باشید!
-
نقل قول: نکات برنامه نویسی در دلفی
سلام بر دوستان
دو تا نکته در مورد چک باکس یادم اومد. چون خودم درگیرش شده بودم گفتم شاید بد نیست اینجا بذارم:
1.وقتی در رویداد MouseDown کد میذاریم، هنوز وضعیت Checked عوض نشده
2.کد Click چک باکس با تنظیم Checked اجرا میشه. به همین دلیل اگر در Create این خصوصیت(Checked ) رو تنظیم می کنیم، ممکنه دچار Access Violation یا مشکل فوکوس به پنجره نامرئی بشیم.من برای حل این مشکل از بررسی متغیر FirstRun که در ابتدای اجرای برنامه True می کنم، در رویداد Click استفاده می کنم.(بررسی Visible هم معمولا جواب میده!)
در مورد لیست باکس:
اگر لیست بلندی داریم مثل برنامه متنی خودم که نمایش و آماده سازی متن با انتساب به Items.Text خیلی طول میکشه میتونیم برای هر سطر یک فاصله اضافه کنیم (با چیزی مثل DupeString(' '+#10,N)) و هر آیتم از لیست باکس رو در آرایه بریزیم. و بعد برای ترسیم هر سطر لیست باکس در OnDrawItem با بررسی عنصر مرتبط در آرایه، اقدام کنیم( تفصیلش رو خودتون بررسی کنید)
-
نقل قول: نکات برنامه نویسی در دلفی
سلام خدمت دوستان
تعدادی اشکال هست که ممکنه برنامه رو بررسی کنیم ولی متوجهشون نشیم. بعضیهاشون اصالتاً اشکال برنامه نویسی نیستند و میتونند هنگام صحبت هم پیش بیاند.چند تاشون رو لیست می کنم.بد نیست اگر سر در نیوردیم مشکل برنامه چیه، دنبال چنین اشکالاتی بگردیم:
(ممکنه قبلا هم چنین پستی با اختصار گذاشته باشم و یادم رفته باشه!!)
* جابجايي سطرهای کد: گاهی فقط باید یک سطر کد رو قبل یا بعد از موقعیت فعلیش بذاریم
* کمبود پرانتز در عبارت عددی یا ترکیب 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 ، میذارند و گیج میشم!)
* کمبود کامنت: در برنامه های بزرگ که یک پروسیجر میتونه تعداد زیادی پروسیجر یا انتساب داشته باشه، مهم هست که کامنت کافی برای بعد داشته باشیم. ممکنه فردای نوشتن کد هم یادمون بره بعد از آزمون و خطا چه کار کردیم.
من خودم برای کامنتهای مهمتر از (**) استفاده می کنم و در بالا یا کنار کد از // و وسط کد از {} استفاده می کنم