Tips dan Trik Delphi - Windows

uses ShlObj;

procedure RefreshDesktop1;
begin
    SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     RefreshDesktop1;
end;


<>/pre                                        

Uses Registry;

procedure TForm1.FormCreate(Sender: TObject);
var
  Reg: TRegIniFile;
begin
    Reg := TRegIniFile.Create('Control Panel');
    Reg.WriteString('desktop', 'Wallpaper', 'c:\windows\fotomu.bmp');
    Reg.WriteString('desktop', 'TileWallpaper', '1');
    Reg.Free;
    SystemParametersInfo(SPI_SETDESKWALLPAPER,0, nil, SPIF_SENDWININICHANGE);
end;

                                        

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     if Button = mbLeft then
        ShowMessage('Klik Kiri')
     else if Button = mbRight then
        ShowMessage('Klik Kanan')
     else
        ShowMessage('Klik Tengah');
end;

procedure TForm1.BTHideClick(Sender: TObject);
VAR
     rc :LongInt;
BEGIN
    rc := FindWindow('shell_traywnd', NIL);
    ShowWindow(rc, 0);
end;

procedure TForm1.BTShowClick(Sender: TObject);
VAR
     rc : LongInt;
BEGIN
    rc := FindWindow('shell_traywnd', NIL);
    ShowWindow(rc, 1);begin
end;

uses ddeman;

procedure TForm1.Button1Click(Sender: TObject);
begin
    with TDDEClientConv.Create(Self) do
    begin
        ConnectMode := ddeManual;
        ServiceApplication := 'explorer.exe';
        SetLink('Folders','AppProperties');
        OpenLink;
        ExecuteMacro('[FindFolder(, C:\ DelphiTips)]', False);
        CloseLink;
        Free;
    end;
end;

function IsTrueTypeFont(FontName : string):boolean;
const
    PITCH_MASK: byte = $0F;
var
    TxMet: TTextMetric;
    TempCanvas : TCanvas;
    PitchTest : byte;118
begin
    TempCanvas := TCanvas.Create;
    TempCanvas.Handle := CreateCompatibleDC(0);
    TempCanvas.Font.Name := FontName;
    GetTextMetrics(TempCanvas.Handle, TxMet);
    PitchTest := TxMet.tmPitchAndFamily and PITCH_MASK;
    Result := (PitchTest and TMPF_TRUETYPE) <> 0;
    TempCanvas.free;
end;

function KillApp(const sCapt: PChar) : boolean;
var AppHandle:THandle;
begin
    AppHandle := FindWindow(Nil, sCapt);
    Result := PostMessage(AppHandle, WM_QUIT, 0, 0);
end;

// jalankan notepad

procedure TForm1.Button2Click(Sender: TObject);
begin
     KillApp('Untitled - Notepad');
end;

uses shlobj;

{$R *.dfm}

function CreateFolder(Foldername: string; aLocation: integer): boolean;
var pIdl: PItemIDList;
hPath: PChar;
begin
    Result := False;
    if SUCCEEDED(SHGetSpecialFolderLocation
    (0, aLocation, pidl)) then
    begin
        hPath := StrAlloc(max_path);
        SHGetPathFromIDList(pIdl, hPath);
        SetLastError(0);
        CreateDirectory(PChar(hPath +'\ \ ' + Foldername), nil );
        if (GetLastError()=0) or (GetLastError()=ERROR_ALREADY_EXISTS) then
           Result := true;

        StrDispose(hPath);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    CreateFolder('visibroker', CSIDL_PROGRAMS);
end;

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
     ShowDesktop(True);
end;

{Disable:}
EnableWindow(FindWindowEx(FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil),FALSE);

{Enable:}
EnableWindow(FindWindowEx(FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil),TRUE);