سلام به دوست داران دلفی
این بحث و باز کردم که بتونیم از تجارب همدیگه استفاده کنیم
ممنون می شم اگه کسی تکه کد یا برنامه جالبی داره اینجا بزاره :cool: :laughing:
Printable View
سلام به دوست داران دلفی
این بحث و باز کردم که بتونیم از تجارب همدیگه استفاده کنیم
ممنون می شم اگه کسی تکه کد یا برنامه جالبی داره اینجا بزاره :cool: :laughing:
اینم اولیش
با اين تكه كد مي تويد با قرار دادن توي يك دكمه يا تايمر بعد از يك مدت خواص مانيتور را خاموش كرد.
کد:
Uses Shellapi;
SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0) ;
دوستان لطف كنيد كدها رو توي html وارد كنيد.
قبل از نوشتن كدها هم يك توضيح مختصر فارسي دربارش بنويسيد.
حسام جان.
لطفا پست بالا رو هم اصلاح كن.
ممنون
سلام
مرد مباح دیگه این هم توضیح می خواد.
راستی من باز کردن و بستن سی دی رام رو می نویسم.
کد باز کردن سی دی رام : mciSendString('Set cdaudio door open wait',nil, 0, Handle);
کد بستن سی دی رام : mciSendString('Set cdaudio door closed wait',nil, 0, Handle);
سلام
مرد مباح دیگه این هم توضیح می خواد.
راستی من باز کردن و بستن سی دی رام رو می نویسم.
کد باز کردن سی دی رام : mciSendString('Set cdaudio door open wait',nil, 0, Handle);
کد بستن سی دی رام : mciSendString('Set cdaudio door closed wait',nil, 0, Handle);
سولجر جان.
اولا 4 نفر ميفهمن كه اين كد چيه.
ثانيا وقتي پستها زياد بشه دوستان راحت يتونن دنبال يك چيز خاص بگردن.
سولجر جان.
شما هم لطف كن و كدهاتو توي html قرار به كه درست ديده بشن.
ممنون
سلام
باشه ميزارم
اما ديگه عجله داشتم.
در ضمن بجاي اينكه كه زير هر پست يه نظر بدي
يه نكته بگو.يعني هيچ نكته اي بلد نيست. كاربر فعال
سلام ...
منم يه دونه مي زارم :
ساختن فرم به شكلي غير از مربع :
به كد زير نگاه كنيد :
تو كد بالا و در خط اول يك بيضي مي سازيم و توي خط دوم بيضي رو با فرم خودمون Set مي كنيم ...کد:procedure TForm1.FormCreate(Sender: TObject);
var n:Integer;
begin
n:=CreateEllipticRgn(10,10,200,300);
SetWindowRgn(Form1.Handle , n , True);
end;
موفق باشيد ... ;)
رفقا من يك كتاب به شما معرفي ميكنم كه خيلي از اين فوت و فنها توش هست.
اگه ندارين و فكر كردين كه دنبالش رفتن براتون سخته, بگين كه من چندتا از برنامههاي خفنشو بزارم.
اسم اصلي كتاب Programs in Delphi است كه شمال 296 برنامه كاربردي و حرفه اي است و در روي جلد آن بزرگ نوشته دلفي 6.
البته يكي هم براي دلفي 7 اومده كه فقط اونو ديدم و ندارم.
اولي جلد زرد با رگه هاي سبز و دومي جلد خاكستري با رگه هاي سبز يشمي.
هر دو كتاب از نشر ناقوس است.
خوب اول سلام گرم به مرد مباح وسلجر جان و آقا محمود گل
خوبه اميدوارم كه گفتمان خوبي اينجا راه بندازيم
خوب اينم از توضيح عنوان معلومه كه براي چه كاريه
در حقيقت history اينترنت اكسپلور را در مياره و نشون ميده
کد:uses registry;
procedure ShowTypedUrls(Urls: TStrings);
var
Reg: TRegistry;
S: TStringList;
i: Integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', False) then
begin
S := TStringList.Create;
try
reg.GetValueNames(S);
for i := 0 to S.Count - 1 do
begin
Urls.Add(reg.ReadString(S.Strings[i]));
end;
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
//مثال
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowTypedUrls(ListBox1.Items);
end;
كساني كه ميخواهند رزولشن صفحه ويندوز را در برنامه خودشون عوض كنند مي توانند از اين كد استفاده كنند :cool: ;)
کد:function SetDisplay1024x768: Boolean;
var
DevMode: TDeviceMode;
begin
EnumDisplaySettings(nil, 0, DevMode);
DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
DevMode.dmPelsWidth := 1024;
DevMode.dmPelsHeight := 768;
Result := ChangeDisplaySettings(DevMode, CDS_UPDATEREGISTRY)
= DISP_CHANGE_SUCCESSFUL;
end;
//مثال
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDisplay1024x768;
end;
سلام ...
يكي ديگه :
با تابع زير به راحتي مي شه فهميد آيا يك نسخه از برنامه درحال اجرا است يا نه :
براي استفاده كافي كه با يه شرط مقدار True يا False اون رو بدست بياريد و كدهاي مورد نظرتون رو اجرا كنيد ...کد:Function IsRunningApp:Boolean;
var
Hwnd:Thandle;
begin
hwnd:=CreateMutex(nil,False,'OneCopyMutex');
Result:=false;
If not(WaitForSingleObject(Hwnd,0)<>Wait_TimeOut) then
Result:=true;
end;
موفق باشيد ...کد:if IsRunningApp = True then
begin
YOUR CODE HERE ...
end
else
begin
YOUR CODE HERE ...
end;
سلام ...
با رویه زیر می شه یک آیکون رو به یه عکس با فرمت BMP تبدیل کرد :
موفق باشید ...کد:Procedure IcoToBmp;
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico') ;
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon ) ;
Bitmap.SaveToFile('c:\picture.bmp') ;
Icon.Free;
Bitmap.Free;
end;
سلامنقل قول:
نوشته شده توسط مرد مباح
من این کتاب رو دارم.
اما مال دلفی 6 هست.
خیلی کتاب با حالیه
راستی اگر کسی دوست داره
بگه که بیشتر در مورد چی بنویسیم
اینطوری بهتر هم میشه
با این کد می تونید تشخیص بدید که برنامه ای بخوبی کار می کنه یا در حالت Not Responding است
بايد از تابع SendMessageTimeOut استفاده كنيد
کد:function isHung(theWindow:HWnd;timeout : longint): boolean;
var
dwResult : DWord;
begin
Result := SendMessageTimeOut(theWindow,WM_NULL,0,0
SMTO_ABORTIFHUNG Or SMTO_BLOCK, TimeOut,dwResult) <> 0;
end;
سلام ...نقل قول:
سلام
من این کتاب رو دارم.
اما مال دلفی 6 هست.
خیلی کتاب با حالیه
راستی اگر کسی دوست داره
بگه که بیشتر در مورد چی بنویسیم
اینطوری بهتر هم میشه
منم اين كتاب رو دارم و كتاب خوبيه ..
سعي مي كنم مثالهاي كاربرديش رو اينجا بنويسم ...
موفق باشيد ...
سلام
تاپيك خيلي خوبي هست و خواهد بود
در اين بين از اموزش دوستم كه طريقه تغيير شكل فرم رو گذاشته بود واقعا بكارم امد
ممنون ( منم حتما با دست پر خواهم امد)
سلام به همگي سلجر عزيز و آق محمود گل و hp بلبل
خوب ممنونم كه براي بهتر شدن تاپيك همكاري مي كنيد
خوب اينم سه تا تابع جديد براي ويندوز كه البته خود دلفي از توابع api بهره می گیره
خوب در پایان در صورت امکان اسم حقیقی خودتونو بگید ممنون میشمکد:Shutdown/restart windows
Uses Shellapi;
ExitWindowsEx(ewx_Shutdown,0); to shutdown
ExitWindowsEx(ewx_Reboot,0); to restart
ExitWindowsEx(ewx_Poweroff,0); to off your computer power
مخلص شما حسام :biggrin: خان :laughing: :cool:
اينم اجراي يک برنامه ديگه توي برنامه خودتون درحالي که تا برنامه اجرا شده بسته نشه برنامه شما کار نکنه
البته قاعدتا برنامه در دلفي 6 اجرا ميشه.
من روي دلفي 7 فرماني معادل با GetModuleUsage پيدا نکردم.
اگه کسي معادلشو ميدونه تو همين تاپيک بنويسه که براي دلفي 7 کارا هم قابل استفاده باشه
کد :
[HTML]var
PH : THandle;
begin
PH := Winexec('c:\Windows\Notpad.exe',SW_SHOWNORMAL);
while GetModuleUsage(PH) <> 0 Do
application.processmessage;
end;[/HTML]
سلام
با اين كد مي تونيد براي تغيير جاي فرم هر قسمت فرم رو بگيريد و بكشيد
در بخش private این خط را اضافه کنید.
بعد این پروسیجر رو قبل از end. بگذارید.کد:procedure WmNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST
کد:procedure TForm1.WmNCHitTest(var Msg : TWMNCHitTest);
begin
DefaultHandler(Msg);
if Msg.Result = HTCLIENT then
Msg.Result := HTCAPTION;
end;
سولجر جان
لطف كن و پست قبليتو اصلاح كن و كدها رو توي Html بزار.
ممنون./
سلام
مرد مباح من از جواب سريع استفاده مي كنم.
و جواب سريع هم كه خودت مي دوني اين امكان رو نداره.
اما سعي مي كنم بذارم.حالا هم درستش كردم
[HTML]
Its Only For Example
[/HTML]
سلام
محمود عزيز اين كدي كه شما براي تغيير شكل فرم گذاشتيد اونجور كه انتظار داشتم شكل فرم رو تغيير نداد
تنها قسمتي از فرم رو بصورت بيضي قابل نمايش ( ديدن ) كرد انگار كه يه بيضي روي فرم بزاري و به فرم از درون بيضي نگاه كني
من حسابي دنبال يه چيزي تو اين مايه ها مي گردم
ممنون
hp جان اون نوع كدي كه ميخواهي هست داشتمش ولي به فنا فلا رفت در صددم كه گيرش بيارم
اينم از كد جديد ما
نيك باشيدکد:procedure TForm1.Button1Click(Sender: TObject) ;
function FuncAvail(_dllname, _funcname: string;
var _p: pointer): boolean;
{return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end;
{
Call SHELL32.DLL for Win < Win98
otherwise call URL.dll
}
{button code:}
var
InetIsOffline : function(dwFlags: DWORD):
BOOL; stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline',
@InetIsOffline) then
if InetIsOffLine(0) = true
then ShowMessage('Not connected')
else ShowMessage('Connected!') ;
end;
نقل قول:
نوشته شده توسط soldier
خيلي ممنون سولجر جان كه اصلاح كردي.
منم توي همه صفحات از ارسال سريع استفاده ميكنم.
ولي اين صفحه رو استثنا بدون و برو تو حالت پيشرفته.
منم همين كارو ميكنم كه صفحه قشنگي خودشو داشته باشه.
سلام
براي مرد مباح كه شده ! باشه
راستي اچ پي اگر اون فرمي كه به صورت بيضي مي كنه
رو مي خواهي من دارمش.100% هم كار ميده.
تستش هم كردم.
کد:procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 0 to length(RichEdit1.Text) - 1 do
begin
if RichEdit1.Text[i] = #13 then
with Image1.Canvas do
MoveTo(0, PenPos.Y + TextHeight(RichEdit1.Lines.Strings[0]));
RichEdit1.SelStart := i;
RichEdit1.SelLength := 1;
with image1.Canvas do
begin
Font.Color := RichEdit1.SelAttributes.Color;
Font.Size := RichEdit1.SelAttributes.Size;
Font.Style := RichEdit1.SelAttributes.Style;
if (RichEdit1.Text[i] #13) and (char(RichEdit1.Text[i]) #10) then
TextOut(PenPos.X, PenPos.Y, RichEdit1.Text[i]);
end;
end;
end;
سلام
سولجر جيگر خوب بده بياد ديگه چونه زدن نداره كه
ممنون
سلام
اول اين رو توي private اضافه كنيد
بعد جايي كه مي خواستيد فرم رو گرد كنيد اين را اونجا قرار بديد.کد:procedure WmNCHitTest(var msg:TWMNCHitTest);message wm_NCHITTEST;
و حالا اين رو قبل از end. اضافه كنيد.کد:var h:THandle;
begin
H:=CreateEllipticRgn(40,40,Width,Height);
SetWindowRgn(Handle,h,True);
end;
اسم فرم من TFormEllipse بود پس وقتی که می خواستید استفاده کنیدکد:procedure TFormEllipse.WmNCHitTest(var Msg:TWMNCHitTest);
begin
DefaultHandler(Msg);
if Msg.result = htclient then
Msg.result := HTCAPTION;
end;
به جای TFormEllipse اسم فرم خودتان رو بگذارید.موفق باشید
سولجر عزيز اين دستور كه شما داديد با اون كد هايي كه قبلا دوستم محمود نوشته بود فرقي نداره كه
فقط دستوري كه بهش اضافه شده اجازه جابجايي فرم رو بوسيله كليك موس ميده
به هر حال دستتون درد نكنه
ممنون
سلام
مال اقا محمود رو با اين مقايسه نكردم.
اما اين تست شده.و كاملآ جواب ميده.
نقل قول:
نوشته شده توسط hesam_a110
دوست عزيز.
اين كدا رو كه مينويسي همش ميگه آنلايني.
حتي اگه آفلاين باشي.
چرا؟
سلام دوستان ...
از امروز سورس برنامه هاي كوچيك و جالب رو هم توي اين تاپيك مي زاريم ...
سورس یه برنامه که نام دکمه استارت ویندوز رو تغییر می ده : [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ] ( حجم : 168 كيلوبايت )
منتظر نظرات و سورسهاي بقيه دوستان هم هستم ...
موفق باشيد ...
سلام سولجر جان ...نقل قول:
سلام
مال اقا محمود رو با اين مقايسه نكردم.
اما اين تست شده.و كاملآ جواب ميده.
كدي كه من گذاشتم هم همون بود ...
ولي آقا يا خانم hp کدی می خوان که کل فرمشون رو بیضی کنه ( یعنی که تمام اجزای فرمشون توی اون بیضی قرار بگیرن )
به نظر تو این جوری می شه ؟ !! ( ولی در برنامه نویسی هیچ چیز غیر ممکن نیست )
فکر کنم که باید یه عکس جای فرمش بزاره و اون عکس بشه فرمش ( حالا بیضی باشه یا ... )
...
سلام به همگي چرا كسي حركتي نميزنه
مرد مباح من نميدونم چرا؟؟؟؟؟؟؟؟؟؟
حسام جان.
خودت تست كردي و يا از روي يك كتاب نوشتي؟
اگه از روي كتابه هميشه نميشه بهش اعتماد كرد ولي اگه خودت نوشتي ببين چرا و اصلاحش كن.
روي كامپيوتر خودت امتحانش كردي؟ جواب داده؟
:laughing: اول سلام
دوم اینکه مرد مباح اون کد موقع گشت گذار توی یه سایت پیدا کردم فکر کنم About بود
================================================
و اما امروز
کد:procedure TFRM_Main.DBG_MainGetCellParams(Sender: TObject; Field: TField;
AFont: TFont; var Background: TColor; Highlight: Boolean);
begin
if (Field.AsString = '0') and (Field.FullName = 'LoadingAttn') then
begin
Background := $00E69B00;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
if (Field.AsString = '0') and (Field.FullName = 'DeliveryAttn') then
begin
Background := $0082FFFF;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
if (Field.AsString = 'H') and (Field.FullName = 'EctaCode1') then
begin
Background := $008080FF;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
AFont.Color := clBlack;
AFont.Style := AFont.Style - [fsBold];
Background := clWhite;
end;
end;
end;
end;
سلام به همگی
میخواستم بدونم که چرا کسی نه چیزی میگه نه قطعه کدی میزاره فقط نگاه می کنیدو میرید؟
:sad: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :angry: :grrr: :grrr: :grrr: :grrr: :grrr: :grrr: :grrr: :weird: :weird: :weird: :weird: :weird: :weird: :weird: :weird: :weird: