کپشن دکمه در چند خط
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Button1.Handle,GWL_STYLE,GetWindowLong(Button1.Handle,GWL_STYLE) OR BS_MULTILINE);
end;
| تبليغات | X |
مباحث برنامه نویسی
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Button1.Handle,GWL_STYLE,GetWindowLong(Button1.Handle,GWL_STYLE) OR BS_MULTILINE);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AngleTextOut(Form1.Canvas,12,10,65,'Advanced Delphi Technicals !!');
end;
procedure AngleTextOut(ACanvas: TCanvas;Angle,X,Y: Integer;Str: string);
var
LogRec : TLogFont;
OldFontHandle,NewFontHandle :HFONT;
begin
GetObject(ACanvas.Font.Handle,SizeOf(LogRec),Addr(LogRec));
LogRec.lfEscapement := Angle * 10;
NewFontHandle := CreateFontIndirect(LogRec);
OldFontHandle := SelectObject(ACanvas.Handle,NewFontHandle);
ACanvas.TextOut(X,Y,str);
NewFontHandle := SelectObject(ACanvas.Handle,OldFontHandle);
DeleteObject(NewFontHandle);
برای فارسی نويسی در دلفی فقط شما بايد سيستم عاملی که استفاده می کنيد فارسی ساز آن هم نصب کنيد تا بتوانيد فارسی تایپ کنيد و سپس در برنامه دلفی هم می توانيد تمام کپشن های فرها و دکمه ها و ... را فارسی بنويسيد.
فقطشما بايد از فونت هايی مه استفاده می کنيد اطلاع داشته باشيد تا بتوانيد بدون مشکل ازاين برنامه در سيستم های ديگر که سيتم عامل آنها فرق می کند استفاده کنيد.
1- هنگام اجراي برنامه دلفي پس از دابل كليك كردن بروي آيكن دلفي سريع كليد تركيبي ctrl + shift را بگيرد ببينيد چه اتفاقي مي افتد .اگر هيچ اتفاقي پيش نيامد دوباره 2- گزينه ABOUT را از منوي HELP انتخاب كنيد سپس كليد آلت را گرفته و كلمه TEAM را
سعي كنديد.
تايپ كنيد تا نام اعضاي تيم لفي به نمايش درآيد.
با استفاده از کدهای زیر می توانید اطلاعات دقیق و مفیدی در مورد پردازندۀ کامپیوترتان بدست آورید .
زیربرنامۀ
procedure info(s1, s2: string);
را در Public تعریف کنید ؛ متغیر های زیر را به صورت عمومی تعریف کنبد ؛
var
frm_main: Tfrm_main;
gn_speed_y: Integer;
gn_text_y: Integer;
const
gn_speed_x: Integer = 8;
gn_text_x: Integer = 15;
gl_start: Boolean = True;
یک Image روی فرم قرار دهید و اسم اون رو img_info قرار بدید ؛
دربلاک برنامه هم دو زیربرنامه وجود دارد که اولی مربوط به OnShow فرم اصلی و دومی همان زیربرنامه ای است که در ابتدا تعریف کردیم :
procedure Tfrm_main.FormShow(Sender: TObject);
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
b1: Word;
s, s1, s2, s3, s_all: string;
begin
//Set the startup colour of the image
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));
gn_text_y := 5; //position of the 1st text
asm //asm call to the CPUID inst.
mov eax,0 //sub. func call
db $0F,$A2 //db $0F,$A2 = CPUID instruction
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
for i := 0 to 3 do //extract vendor id
begin
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1:= s1 + chr(b);
b := lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('CPU', '');
info(' - ' + 'Vendor ID: ', s + s2 + s1);
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
//06B1
//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
b := lo(_eax) and 15;
info(' - ' + 'Stepping ID: ', IntToStr(b));
b := lo(_eax) shr 4;
info(' - ' + 'Model Number: ', IntToHex(b, 1));
b := hi(_eax) and 15;
info(' - ' + 'Family Code: ', IntToStr(b));
b := hi(_eax) shr 4;
info(' - ' + 'Processor Type: ', IntToStr(b));
//31. 28. 27. 24. 23. 20. 19. 16.
// 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
b := lo((_eax shr 16)) and 15;
info(' - ' + 'Extended Model: ', IntToStr(b));
b := lo((_eax shr 20));
info(' - ' + 'Extended Family: ', IntToStr(b));
b := lo(_ebx);
info(' - ' + 'Brand ID: ', IntToStr(b));
b := hi(_ebx);
info(' - ' + 'Chunks: ', IntToStr(b));
b := lo(_ebx shr 16);
info(' - ' + 'Count: ', IntToStr(b));
b := hi(_ebx shr 16);
info(' - ' + 'APIC ID: ', IntToStr(b));
//Bit 18 =? 1 //is serial number enabled?
if (_edx and $40000) = $40000 then
info(' - ' + 'Serial Number ', 'Enabled')
else
info(' - ' + 'Serial Number ', 'Disabled');
Hide/show start button
Uses Shellapi;
ShowWindow(FindWindowEx(FindWindow('Shell_traywnd',nil),0,'Button',nil),1); to show
ShowWindow(FindWindowEx(FindWindow('Shell_traywnd',nil),0,'Button',nil),0); to hide
EnableWindow(FindWindowEx(FindWindow('Shell_traywnd',nil),0,'Button',nil),True); to enable start button
EnableWindow(FindWindowEx(FindWindow('Shell_traywnd',nil),0,'Button',nil),False); to disable start button
Hide/show task bar
Uses Shellapi;
ShowWindow(FindWindow('shell_traywnd',nil),1); to show
ShowWindow(FindWindow('shell_traywnd',nil),0); to hide
EnableWindow(FindWindow('shell_traywnd',nil),True); enable task bar
EnableWindow(FindWindow('shell_traywnd',nil),False); disable task bar
procedure TForm10.Button2Click(Sender: TObject);
var
s:string;
sos:tlocateoptions;
begin
s:=inputbox(' Please Enter Product Name ' , 'Product Name','');
if s='' then exit;
if table1.IsEmpty then
begin
Messagebox (0,pchar (' Database is Empty '),'Error',0);
exit;
end;
sos:=[lopartialkey]+[loCaseInsensitive];
if not table1.Locate ('Product Name' , s ,sos )
then showmessage (' Nothing ')
end;
نمی دونم این کد قبلا گذاشته بودم یا نه ولی خیلی باحال.... همونطور که از اسمش معلومه فرمتون می لرزونه....
procedure TForm1.Button1Click(Sender: TObject);
var
N : Integer;
TL,TT : Integer;
begin
TL := Left;
TT := Top;
for N:=1 to 200 do begin //shemordane tedade tekrar
Left:= (TL+Random(30));
Top := (TT+Random(30));
end;
Left := TL;
Top := TT;
end;
Uses mmsystem;
حالا از برای باز کردن در CRROM از این تابع :
mciSendString('Set cdaudio door open wait', nil, 0, handle); to open
و برا ی بستن در CDROM از این تابع استفاده کنید:
mciSendString('Set cdaudio door closed wait', nil, 0, handle); to close
برای رفتن مانیتور به استندبای ابتدا باید Shellapi را یوز کنید:
Uses Shellapi;
حالا توسط این تابع می توانید مانیتور را به حالت استندبای ببرید.
SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0) ;