ملیساا 5015 اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ uses MMSystem; type TVolumeRec = record case Integer of 0: (LongVolume: Longint) ; 1: (LeftVolume, RightVolume : Word) ; end; const DeviceIndex=5 {0:Wave 1:MIDI 2:CDAudio 3:Line-In 4:Microphone 5:Master 6:PC-loudspeaker} procedure SetVolume(aVolume:Byte) ; var Vol: TVolumeRec; begin Vol.LeftVolume := aVolume shl 8; Vol.RightVolume:= Vol.LeftVolume; auxSetVolume(UINT(DeviceIndex), Vol.LongVolume) ; end; function GetVolume:Cardinal; var Vol: TVolumeRec; begin AuxGetVolume(UINT(DeviceIndex),@Vol.LongVolume) ; Result:=(Vol.LeftVolume + Vol.RightVolume) shr 9; end; 1 لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ کامپوننت TImage برای نمایش تصاویر گرافیکی مورد استفاده قرار میگیرد(Ico,BMP,WMF,GIF,JPEG و مانند آن)خاصیت Picture مشخص کننده تصویری است که باید نمایش داده شود به منظور مقدار دادن به این خاصیت راههای زیادی وجود دارد: استفاده از خاصیت LoadFromFile که می توان به منظور خواندن یک فایل گرافیکی از هارد از آن استفاده کرد یا تابع Assign که می توان توسط آن تصاویر موجود در حافظه موقت(ClipBoard) در بیشتر حالات شما تصویر خود را در زمان طراحی نرم افزار مقدار دهی میکنیدو این کار با مقدار دهی خاصیت Picture از Objectinspector امکان پذیر است در صورتیکه میخواهید تصویر را در زمان اجرا حذف کنید مقدار خاصیت Picture را برابر با NIL قرار دهید. و در صورتیکه بخواهید خالی بودن تصور را کنترل کنید از کد زیر استفاده کنید کد: if Image1.Picture.Graphic.Empty thenbegin...end; لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ کد: function SetNumLock(Active: Boolean): Boolean;begin کد: // Check to see if the desired state is set if (Active ((GetKeyState(VK_NUMLOCK) and 1) = 1)) then begin // Turn on / off keybd_event(VK_NUMLOCK, 45, KEYEVENTF_EXTENDEDKEY, 0); keybd_event(VK_NUMLOCK, 45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP , 0); end;end; لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ زمانیکه ویندوز در حال ShutDown شدن است پیغام WM_QueryEndSession را به کلیه نرم افزار های در حال اجرا ارسال میکند.جهت شناسائی (و جلوگیری از ShutDown شدن) ما بای یک کنترل کننده پیام برای این پیام تعریف کنیم تعریفات زیر را در قسمت Private فرم اصلی قرار دهید کد: procedure WMQueryEndSession (var Msg : TWMQueryEndSession) ; message WM_QueryEndSession; همچنین برای جلوگیری از خاموش شدن تابع زیر را در قسمت Implementation قرار دهید کد: procedure TForm1.WMQueryEndSession (var Msg : TWMQueryEndSession) ; begin if MessageDlg('Close Windows ?', mtConfirmation, [mbYes,mbNo], 0) = mrNo then Msg.Result := 0 else Msg.Result := 1 ; end; به منظور شناسائی Shutdown ما باید پیام WM_EndSession را کنترل کنیم.یک روال کنترل ÷یام را در بخش Private فرم اصلی تعریف کنید کد: Procedure WMEndSession (var Msg : TWMEndSession) ; message WM_ENDSESSION; و روال زیر را به بخش Implementation اضافه کنید کد: procedure TForm1.WMEndSession (var Msg : TWMEndSession) ; begin if Msg.EndSession = TRUE then ShowMessage('Windows is shutting down ' + #10#13 + 'at ' + FormatDateTime('c', Now)) ; inherited; end; لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ کد: procedure ShowDesktop(const YesNo : boolean) ;var h : THandle;begin h := FindWindow('ProgMan', nil) ; h := GetWindow(h, GW_CHILD) ; if YesNo = True then ShowWindow(h, SW_SHOW) else ShowWindow(h, SW_HIDE) ;end; لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ بدین منظور میتوانید از کنترل TScreen و رویداد onActiveControlChange استفاده کنید کد: const focusColor = clSkyBlue;var lastFocused : TWinControl; originalColor : TColor; توجه داشته باشید که کامپوننتی تحت عنوان TScreen برای قرار دادن روی فرم وجود ندارد و شما باید بصورت دستی رویدادها را تنظیم کنید کد: procedure TMainForm.FormCreate(Sender: TObject) ;begin Screen.OnActiveControlChange := ScreenActiveControlChange;end;procedure TMainForm.FormDestroy(Sender: TObject) ;begin Screen.OnActiveControlChange := nil;end; و پیاده سازی رویداد ذکر شده به صورت زیر است کد: procedure TMainForm.ScreenActiveControlChange(Sender: TObject) ;var doEnter, doExit : boolean; previousActiveControl : TWinControl;begin if Screen.ActiveControl = nil then begin lastFocused := nil; Exit; end; doEnter := true; doExit := true; //CheckBox if Screen.ActiveControl is TButtonControl then doEnter := false; previousActiveControl := lastFocused; if previousActiveControl nil then begin //CheckBox if previousActiveControl is TButtonControl then doExit := false; end; lastFocused := Screen.ActiveControl; if doExit then ExitColor(previousActiveControl) ; if doEnter then EnterColor(lastFocused) ;end; procedure TMainForm.EnterColor(Sender: TWinControl);begin if Sender nil then begin if IsPublishedProp(Sender,'Color') then begin originalColor := GetOrdProp(Sender,'Color'); SetOrdProp(Sender,'Color', focusColor); end; end;end;procedure TMainForm.ExitColor(Sender: TWinControl);begin if Sender nil then begin if IsPublishedProp(Sender,'Color') then begin SetOrdProp(Sender,'Color',originalColor); end; end;end; لینک به دیدگاه
ملیساا 5015 مالک اشتراک گذاری ارسال شده در 27 شهریور، ۱۳۸۹ ميتونيد اونا رو مثل يك فايل باز كنيد و توشون بنويسيد يا ازشون بخونيد اين كد باز كردن پورت کد: procedure TMainForm.OpenPort(i:Integer);{} Procedure InitSerial; Var DCB: TDCB; Config : String; CommTimeouts : TCommTimeouts; begin if not SetupComm(hCom, RxBufferSize, TxBufferSize) then showMessage('CanNot Setup Com Port'); if not GetCommState(hCom, DCB) then showmessage('can not read com state') Else Begin Config :=Pchar('baud=19200 parity=n data=8 stop=1'+#0); if not BuildCommDCB(@Config[1], DCB) then ShowMessage('Can Not build com dcb') else if not SetCommState(hCom, DCB) then ShowMessage('Can Not set com state'); End; with CommTimeouts do begin ReadIntervalTimeout := 0; ReadTotalTimeoutMultiplier := 0; ReadTotalTimeoutConstant := 1000; WriteTotalTimeoutMultiplier := 0; WriteTotalTimeoutConstant := 1000; end; if not SetCommTimeouts(hCom, CommTimeouts) then showMessage('Can not set com timeout'); End;begin CPN:=i; //initialize serial Port to Boud=9600 Parity=none startbit=1 hCom := CreateFile(PChar(ComPort), Generic_Read,// Or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCom = INVALID_HANDLE_VALUE then showMessage('Error Opening File') else Begin InitSerial; End;end; اينهم كد خواندن کد: function TMainForm.read1byteFromPort:byte;Var d: array[1..1] of byte; s: String; BytesRead, i: cardinal;Begin if not ReadFile (hCom, d, sizeof(d), BytesRead, Nil) then read1byteFromPort:=0 Else read1byteFromPort:=d[1];end; البته كد خواندن رو بر اساس نياز خودتون بايد تغييرش بدي كد نوشتن هم خودتون مثل اين كد بنويسید لینک به دیدگاه
ارسال های توصیه شده