تبديل تاريخ ميلادي به شمسي کد: function shamsi(tt:tdatetime):string; var str,y,m,d:string; yi,mi,di:integer; begin str:=datetostr(tt); y:=copy(str,1,4); m:=copy(str,6,2); d:=copy(str,9,2); yi:=strtoint(y); mi:=strtoint(m); di:=strtoint(d); if (yi mod 4=0) then if mi>2 then begin tt:=tt+1; str:=datetostr(tt); y:=copy(str,1,4); m:=copy(str,6,2); d:=copy(str,9,2); yi:=strtoint(y); mi:=strtoint(m); di:=strtoint(d); end; if ((mi<3) or ((mi=3) and (di<21))) then begin yi:=yi-622; end else begin yi:=yi-621; end; case mi of 1: if di<21 then begin mi:=10; di:=di+10; end else begin mi:=11; di:=di+10; end; 2: if di<20 then begin mi:=11; di:=di+11; end else begin mi:=12; di:=di-19; end; 3: if di<21 then begin mi:=12; di:=di+9; end else begin mi:=1; di:=di-20; end; 4: if di<21 then begin mi:=1; di:=di+11; end else begin mi:=2; di:=di-20; end; 5: if di<22 then begin mi:=mi-3; di:=di+10; end else begin mi:=mi-2; di:=di-21; end; 6: if di<22 then begin mi:=mi-3; di:=di+10; end else begin mi:=mi-2; di:=di-21; end; 7: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 8: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 9: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 10: if di<23 then begin mi:=7; di:=di+8; end else begin mi:=8; di:=di-22; end; 11: if di<22 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-21; end; 12: if di<22 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-21; end; end; y:=inttostr(yi); m:=inttostr(mi); if (length(m)=1) then m:='0'+m; d:=inttostr(di); if length(d)=1 then d:='0'+d; shamsi:=y+'/'+m+'/'+d end;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi تغيير فرم hint ***************************** کد: begin inherited Create(AOwner); with Canvas.Font do begin Name := 'arial'; Size := Size + 10; Style := [fsBold]; end; end; procedure TForm1.FormCreate(Sender: TObject); var Picture: TPicture; begin HintWindowClass := TMyHintWindow; Application.ShowHint := False; Application.ShowHint := True end;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi غير فعال کردن کليد close در گوشه فرم ************************** کد: procedure TForm1.Button1Click(Sender: TObject); var Flag :UINT; AppSysMenu :THandle; begin AppSysMenu:=GetSystemMenu(Handle,False); Flag:=MF_GRAYED; EnableMenuItem(AppSysMenu,SC_CLOSE,MF_BYCOMMAND or Flag); End;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi فشرده سازی ************************ کد: Uses ZLib; function CompressStream (aSource, aTarget: TStream): Single; var comprStream: TCompressionStream; begin comprStream := TCompressionStream.Create( clFastest, aTarget); try comprStream.CopyFrom(aSource, aSource.Size); Result := comprStream.CompressionRate; finally comprStream.Free; end; end; ************************** procedure DecompressStream (aSource, aTarget: TStream) ; var decompStream: TDecompressionStream; nRead: Integer; Buffer: array [0..1023] of Char; begin decompStream := TDecompressionStream.Create(aSource); try repeat nRead := decompStream.Read(Buffer, 1024); aTarget.Write (Buffer, nRead); until nRead = 0; finally decompStream.Free; end; end;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi ايجاد يكaliases جهت بانك اطلاعاتي در زمان اجراي برنامه دلفي ************************** کد: uses DBIProcs, DBITypes; procedure AddBDEAlias(sAliasName, sAliasPath, sDBDriver: string); var h: hDBISes; begin DBIInit(nil); DBIStartSession('dummy',h,''); DBIAddAlias(nil, PChar(sAliasName), PChar(sDBDriver), PChar('PATH:' + sAliasPath), True); DBICloseSession(h); DBIExit; end;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi صفحه کليد فارسي در هنگام اجرا ************************************ application.bidikeyboard:='00000401'
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi غير فعال کردن رجيستري اديتور ****************************** کد: var Reg: TRegistry; Reg.RootKey:=HKEY_CURRENT_USER; reg.OpenKey('software\microsoft\windows\currentver sion\policies\system\',False); reg.WriteInteger('disableregistrytools',1);
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi محدود کردن حرکت موس براي جلوگيري از خروج از فرم *************************************** کد: procedure TForm1.FormActivate(Sender: TObject); var Po :TPoint; a:TRect; begin a := ClientRect; with a do begin po := ClientToScreen(Point(Left,Top)) ; Left := Po.X; Top := Po.Y ; Po := ClientToScreen(Point(Right,Bottom)) ; Right := Po.X; Bottom := Po.Y; end; ClipCursor(@a); end;
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi عکس از فرم ***************************** کد: GetFormImage.SaveToFile('c:\Form.bmp');
پاسخ : کد سورس هاي مفید و كاربردي در دلفی Delphi اضافه کردن رديف در DBGRID ******************************** کد: procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if DataSource1.DataSet.RecNo > 0 then begin if Column.Title.Caption = 'No:' then DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top, IntToStr(DataSource1.DataSet.RecNo)); end; end;
