تبليغاتX
مرکز تخصصی دلفی

مرکز تخصصی دلفی

این وبلاگ توسط کم سن ترین برنامه نویس ایران مدیریت می «شد»

یک Message Dialog با امکان تغییر نوشته ی دکمه و تمام قسمتها

یک Message Dialog با امکان تغییر نوشته ی دکمه و تمام قسمتها:

function CustomMsg(const DlgCaption,Text:string; MsgType:TMsgDlgType; Buttons:TMsgDlgButtons):integer;
var
  MsgBox   : TForm;
  i        : byte;
  PicWidth : integer;
begin
  MsgBox := CreateMessageDialog(Text,MsgType,Buttons);
  try
    //Change TEXT Properties
    with (MsgBox.Controls[1] as Tlabel) do
    begin
      Font.Name := 'Tahoma';
      Font.Style := Font.Style + [fsBOLD];
      Font.Size := 8;
      WordWrap := False;
    end;
    //Change Messagebox Properties
    with MsgBox do
    begin
//      BiDiMode := bdRightToLeft;
      Font.Name := 'Tahoma';
      Font.Size := 8;
      Caption := DlgCaption;
      Width := (Controls[0] as TImage).Width +
               (Controls[1] as Tlabel).Width + 100;
    end;
  //Change Buttons' caption
    for i := 0 to MsgBox.ControlCount-1 do
      if (MsgBox.Controls[i] is TButton) then
        with (MsgBox.Controls[i] as TButton) do
        begin
          if      (UpperCase(Caption) = '&OK')         then Caption := 'ÊÇííÏ'
          else if (UpperCase(Caption) = '&YES')        then Caption := 'Èáí'
          else if (UpperCase(Caption) = '&NO')         then Caption := 'ÎíÑ'
          else if (UpperCase(Caption) = 'CANCEL')      then Caption := 'ÇäÕÑÇÝ'
          else if (UpperCase(Caption) = '&ABORT')      then Caption := 'áÛæ'
          else if (UpperCase(Caption) = '&RETRY')      then Caption := 'ÏæÈÇÑå'
          else if (UpperCase(Caption) = '&IGNORE')     then Caption := 'ÑÏ'
          else if (UpperCase(Caption) = '&ALL')        then Caption := 'åãå'
          else if (UpperCase(Caption) = 'N&O TO ALL')  then Caption := 'ÎíÑ Èå åãå'
          else if (UpperCase(Caption) = 'YES TO &ALL') then Caption := 'Èáí Èå åãå'
          else Caption := 'ÑÇåäãÇ';
        end; {with}
    Result := MsgBox.ShowModal;
  finally
    MsgBox.Free;
  end; {try}
end;

مثال:

procedure TForm1.Button1Click(Sender: TObject);
begin
 CustomMsg('caption','this is a test for delphi center',mtWarning,mbOKCancel)
end;

+ نوشته شده در  شنبه بیست و چهارم اردیبهشت 1384ساعت 23:25  توسط کوشا نخعی  | 

مخفی کردن Icon های دسکتاپ

با این کد می توانید آی کن ها را مخفی کنید:

// Hide the desktop icons:
ShowWindow(FindWindow(nil, 'Program Manager'), SW_HIDE);

با این کد می توانید آی کن ها را دوباره نمایان کنید:

// Show the desktop icons:
ShowWindow(FindWindow(nil, 'Program Manager'), SW_SHOW);

+ نوشته شده در  شنبه بیست و چهارم اردیبهشت 1384ساعت 18:55  توسط کوشا نخعی  | 

راهی ساده برای اجرای فایل ها

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

function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..79] of Char;
begin //© 2005 koosha system Software http://delphi-center.blogfa.com
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;//© 2005 koosha system Software http://delphi-center.blogfa.com

مثال:

 ExecuteFile('notepad.exe','','',1)

+ نوشته شده در  چهارشنبه بیست و یکم اردیبهشت 1384ساعت 11:7  توسط کوشا نخعی  | 

تشخیص اینکه آیا AutoHide در Task Bar فعال است یا خیر؟

خروجی یک مقدار منطقی است.با این کد به راحتی می توانید تشخیص دهید که آیا AutoHide در Task Bar فعال است یا خیر؟

uses ShellAPI;

function IsTaskbarAutoHideOn : boolean;
var
  ABData : TAppBarData;
begin
  ABData.cbSize := sizeof(ABData);
  Result :=
    (SHAppBarMessage(ABM_GETSTATE, ABData)
     and ABS_AUTOHIDE) > 0;
end;

+ نوشته شده در  دوشنبه دوازدهم اردیبهشت 1384ساعت 12:43  توسط کوشا نخعی  | 

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

با این تابع شما می توانید امکان ارسال ایمیل را برای کاربر فراهم سازید.این کد از ایمیل سندر ویندوز استفاده می کند.ویژگی این کد نسبت به دیگر کدهای موجود این است که شما می توانید متن نامه و مضوع آن را نیز به طور پیش فرض برای کاربر قرار دهید.در کد زیر Subject نامه کلمه ی Test و Body ایمیل This Is Body است.

MailTo := 'mailto:someone@somewhere.com?subject=Test&body=This Is Body';

if ShellExecute(GetDesktopWindow(), 'open', PChar(MailTo), nil, nil,SW_SHOWNORMAL) <= 32 then
 MessageDlg('An Error occurred with Mail!',mtError,[mbOK],0);

+ نوشته شده در  دوشنبه پنجم اردیبهشت 1384ساعت 15:27  توسط کوشا نخعی  |