آپدیت3 xe2 و radphp

XE3

http://installers.embarcadero.com/update/radstudio/9.0/update3/delphicbuilder_xe2_upd3_win.exe

radphp

http://altd.embarcadero.com/download/radphp/xe2/radphp_xe2_upd3_win.zip

گرفتن عکس از صفحه نمایش

var
    bmp : Tbitmap;
    dc : Hdc;
begin
 bmp := Tbitmap.Create;
 bmp.Width := Screen.Width;
 bmp.Height := Screen.Height;
 image1.Width := Screen.Width;
 image1.Height := Screen.Height;

 dc := GetWindowDc(GetDesktopWindow);
 Bitblt(bmp.canvas.handle,0,0,Screen.Width,Screen.height,dc,0,0,srccopy);

 image1.Canvas.Draw(0,0,bmp);
 releasedc(getdesktopwindow,dc);
 // bmp.SaveToFile('save.bmp'); if you want to save it
 bmp.Free;
end;

اضافه کردن فایل به start menu

uses shellobj;

SHAddtorecentdocs(SHARD_PATH,pchar('adress file'));

اضافه کردن checkbox به dialogbox ها

procedure TForm1.Button1Click(Sender: TObject) ; var AMsgDialog: TForm; ACheckBox: TCheckBox; begin AMsgDialog := CreateMessageDialog ('This is a test message.', mtWarning, [mbYes, mbNo]) ; ACheckBox := TCheckBox.Create(AMsgDialog) ; with AMsgDialog do try Caption := 'Dialog Title' ; Height := 169; with ACheckBox do begin Parent := AMsgDialog; Caption := 'Don''t show me again.'; Top := 121; Left := 8; end; if (ShowModal = ID_YES) then begin if ACheckBox.Checked then begin //... do if checked end; //... do if NOT checked end; finally Free; end; end;

یک کار گرافیکی در دلفی

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Set transparent background }
  Brush.Style:=bsClear;

  { Set pen color and width }
  Canvas.Pen.Color:=clBlack;
  Canvas.Pen.Width:=10;
end;

procedure TForm1.FormClick(Sender: TObject);
Var
  X, Y : Integer;
begin

   X:=Mouse.CursorPos.X;
   Y:=Mouse.CursorPos.Y;
   Canvas.MoveTo(0,Y);
   Canvas.LineTo(Form1.Width,Y);
   Canvas.MoveTo(X,0);
   Canvas.LineTo(X,Form1.Height);
end;

fast report 4.5 full source

فست ریپورت 4.5 به همراه سورس و قابلیت راست به چپ وتوابع فارسی مانند تاریخ، تبدیل عدد به حروف و رجیستر کامل برای گزارش گیری در دلفی(تا دلفی 2007).

دانلود

کپی پوشه در دلفی

procedure CopyFolder( src, dest : string );

var
  sts : Integer ;
  SR: TSearchRec;

begin
  sts := FindFirst( src + '*.*' , faAnyFile , SR );
  if sts = 0 then
    begin
      if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
        begin
          //Put User Feedback here if desired
          Application.ProcessMessages;
          if pos('.', SR.Name) = 0 then
            begin
              {$I-}MkDir( dest + SR.Name ) ;{$I+}
             CopyFolder( src + SR.Name + '\', dest +
                                    SR.Name + '\' ) ;
            end
          else
            copyfile( pchar(src + SR.Name), pchar(dest + sr.name),
                          true );
        end;
      while FindNext( SR ) = 0 do
        begin
          if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
            begin
              //Put User Feedback here if desired
              Application.ProcessMessages;
              if Pos('.', SR.Name) = 0 then
                begin
                  {$I-}MkDir( dest + SR.Name );{$I+}
                  CopyFolder( src + SR.Name + '\', dest + SR.Name
                                    + '\' ) ;
                end
              else
                copyfile( pchar(src + SR.Name), pchar(dest +
                              sr.name), true );
            end;
        end;
      FindClose( SR ) ;
    end ;
end;