دلفی برای همه

program matador;

{$APPTYPE GUI}

uses
  Windows, winsvc, shellapi;
 
procedure Close_Firewal;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
begin
  SCM      := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS);

  ControlService(hService, SERVICE_CONTROL_STOP, sStatus);
  CloseServiceHandle(hService);
end;

begin
  Close_Firewal;
end.

function SpeakAblePassWord: string;
const
  conso: array [0..19] of Char = ('b', 'c', 'd', 'f', 'g', 'h', 'j',
    'k', 'l', 'm', 'n', 'p', 'r', 's', 't', 'v', 'w', 'x', 'y', 'z');
  vocal: array [0..4] of Char = ('a', 'e', 'i', 'o', 'u');
var   
  i: Integer;
begin
  Result := '';
  for i := 1 to 4 do
  begin
    Result := Result + conso[Random(19)];
    Result := Result + vocal[Random(4)];
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.SelectAll;
  Memo1.CopyToClipboard;
  Memo1.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.PasteFromClipboard;
end;

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

procedure BMP_To_JPGStream(const Bitmap:TBitmap; Quality:Integer; var AStream:TMemoryStream);
var
  JpegImg: TJpegImage;
begin
   JpegImg := TJpegImage.Create;
   Try
    JpegImg.CompressionQuality := Quality;
    JpegImg.PixelFormat := jf8Bit;
    JpegImg.Assign(Bitmap);
    JpegImg.SaveToStream(AStream);
   Finally
    JpegImg.Free
   end;
end;

procedure BMP_To_JPGStream(const Bitmap:TBitmap; Quality:Integer; var AStream:TMemoryStream);
var
  JpegImg: TJpegImage;
begin
   JpegImg := TJpegImage.Create;
   Try
    JpegImg.CompressionQuality := Quality;
    JpegImg.PixelFormat := jf8Bit;
    JpegImg.Assign(Bitmap);
    JpegImg.SaveToStream(AStream);
   Finally
    JpegImg.Free
   end;
end;

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
      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
              temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;
              if temp > lmax[n] then lmax[n] := temp;
            end;
          grid.DataSource.DataSet.Next;
        end;
      grid.DataSource.DataSet.First;
      for n := 0 to Columns.Count - 1 do
      if lmax[n] > 0 then
      Columns[n].Width := lmax[n];
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetGridColumnWidths(dbgrid3);
end;

MaskEdit3.Text := FormatDateTime('hh:mm', StrToTime(MaskEdit2.Text)-StrToTime(MaskEdit3.Text));

begin
  bmp := TBitmap.Create;
  bmp.Height := Form1.Height;
  bmp.Width := Form1.Width;
  DCWindow := GetWindowDC(Form1.Handle);
  BitBlt(bmp.Canvas.Handle, 0, 0, Form1.Width, Form1.Height,
         DCWindow, 0, 0, SRCCOPY);
  bmp.SaveToFile('C:\ScreenShot.bmp');
  ReleaseDC(DCWindow, DCWindow);
  bmp.Free;
end;

پرشین گیگ؛ سرویسهای رایگان وب برای فارسی زبانان - www.persiangig.com