Rica ederim
Çözümü merak eden diğer katılımcılar için kodları da paylaşma vakti sanırım.
Çözümü merak eden diğer katılımcılar için kodları da paylaşma vakti sanırım.
function LockScreen: boolean; type TLockWorkStation = function: Boolean; var hUser32 : HMODULE; LockWorkStation : TLockWorkStation; begin Result := false; hUser32 := GetModuleHandle('USER32.DLL'); if hUser32 <> 0 then begin @LockWorkStation := GetProcAddress(hUser32, 'LockWorkStation'); if @LockWorkStation <> nil then begin LockWorkStation; Result := True; end; end; end; Procedure DrawText( aMsg : String ); const pad = 50; var DesktopCanvas : TCanvas; x1, y1, x2, y2 : Integer; begin DesktopCanvas := TCanvas.Create; try With DesktopCanvas do begin Handle := GetWindowDC(0); // Now we have whole desktop ! Font.Name := 'Courier New'; Font.Style := [fsBold]; Font.Size := 40; x1 := ( Screen.DesktopWidth - TextWidth ( aMsg ) - (pad*2) ) div 2; y1 := ( Screen.DesktopHeight - TextHeight( aMsg ) - (pad*2) ) div 2; x2 := pad + x1 + TextWidth ( aMsg ) + pad; y2 := Pad + y1 + TextHeight( aMsg ) + pad; Brush.Style := bsSolid; Brush.Color := clRed; Rectangle(x1, y1, x2, y2); Font.Color := clYellow; Brush.Style := bsClear; TextOut(x1 + pad, y1 + pad, aMsg); end; // with finally FreeAndNil(DesktopCanvas); end; end; procedure TForm1.Button1Click(Sender: TObject); begin if LockScreen then begin Sleep(2000); DrawText( 'Save the world :) "This is an urgent message..."'); end; end;
Saygılarımla
Muharrem ARMAN
Muharrem ARMAN