Tips dan Trik Delphi

ShellExecute(Application.Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);

ShellExecute(Application.Handle, 'open', 'c:\windows\notepad.exe', 'c:\SomeText.txt', nil, SW_SHOWNORMAL);

ShellExecute(Application.Handle, 'open', 'c:\MyDocuments\Letter.doc', nil, nil, SW_SHOWNORMAL);

ShellExecute(Application.Handle, 'open', 'https://example.com', nil, nil, SW_SHOWNORMAL);

Mengirim email dari outlook berdasarkan data dari Delphi

var em_subject, em_body, em_mail: string;

begin
  em_subject := 'latiham mengirim email dari XE 10';
  em_body := 'Latihan pertama';
  em_mail := 'mailto:delphi.guide@about.com?subject=' + em_subject + '&body=' + em_body ;
  ShellExecute(Application.Handle, 'open', PChar(em_mail), nil, nil, SW_SHOWNORMAL);
end;

Uses Registry;

procedure TForm1.ClearRecentlyOpenedProjects;
var
  iCount  : Integer;
  Reg     : TRegistry;
  sList   : TStrings;
begin
  sList := TStringList.Create;
  Reg   := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software\Borland\BDS\5.0\Closed Projects', True) then
      Reg.GetValueNames(sList);
    if sList.Count > 0 then
      begin
        for iCount := 0 to Pred(sList.Count) do
          Reg.DeleteValue(sList[icount]);
      end
    else
      MessageDlg('No registry items to be cleaned at this time.',
        mtInformation, [mbOk], 0);
  finally
    sList.Free;
    Reg.Free;
  end;
end;

function IntToRoman(num: Cardinal): string;
const
  Nvals = 13;
  vals: array [1..Nvals] of word =
    (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
  roms: array [1..Nvals] of string[2] =
    ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C',
    'CD', 'D', 'CM', 'M');
var
  b: 1..Nvals;
begin
  result := '';
  b := Nvals;
  while num > 0 do
  begin
    while vals[b] > num do
      dec(b);
    dec (num, vals[b]);
    result := result + roms[b]
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit2.Text := IntToRoman(Strtoint(Edit1.Text));
end;

uses JPEG;

var
  JPEG: TJPEGImage;
  Bitmap: TBitmap;
begin
  JPEG := TJPEGImage.Create;
  Bitmap := TBitmap.Create;
  try
    // Silahkan di rubah sesuai direktori anda masing masing
    Bitmap.LoadFromFile('C:\MyDir\MyFile.bmp');
    JPEG.Assign(Bitmap);
    Image1.Picture.Assign(JPEG);
  finally
    JPEG.Free;
    Bitmap.Free;
  end;
end;

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
    SA: TSecurityAttributes;
    SI: TStartupInfo;
    PI: TProcessInformation;
    StdOutPipeRead, StdOutPipeWrite: THandle;
    WasOK: Boolean;
    Buffer: array[0..255] of AnsiChar;
    BytesRead: Cardinal;
    WorkDir: string;
    Handle: Boolean;
begin
    Result := '';
    with SA do
    begin
          nLength := SizeOf(SA);
          bInheritHandle := True;
          lpSecurityDescriptor := nil;
    end;
    CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
    try
      with SI do
      begin
        FillChar(SI, SizeOf(SI), 0);
        cb := SizeOf(SI);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
        hStdOutput := StdOutPipeWrite;
        hStdError := StdOutPipeWrite;
      end;
      WorkDir := Work;
      Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                              nil, nil, True, 0, nil,
                              PChar(WorkDir), SI, PI);
      CloseHandle(StdOutPipeWrite);
      if Handle then
        try
          repeat
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
            if BytesRead > 0 then
            begin
              Buffer[BytesRead] := #0;
              Result := Result + Buffer;
            end;
          until not WasOK or (BytesRead = 0);
          WaitForSingleObject(PI.hProcess, INFINITE);
        finally
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
    finally
      CloseHandle(StdOutPipeRead);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Memo1.Text := GetDosOutput(Edit1.Text);
end;

procedure Load_Setting_DB_Grid(nama_dbgrid : Tdbgrid; nama_form : TForm; nama_file: String);
var i : byte;
    Namamemo : TMemo;
    inistr : String;
begin
     i := 0;
     myINI := TINIFile.Create(ExtractFilePath(Application.EXEName) + 'Setting\' + nama_file);
     Namamemo := TMemo.Create(nama_form);
     Namamemo.Parent := nama_form;

     Namamemo.Lines.Clear;
     Namamemo.Lines.LoadFromFile(myINI.FileName);
     Namamemo.Visible := False;
     inistr := myINI.FileName;
     if FileExists(inistr)=true then
     begin
          For i := 0 to Namamemo.Lines.Count -2 do
          Begin
                nama_dbgrid.Columns[i].Width := StrToInt(myINI.ReadString(nama_dbgrid.Name, inttostr(i), Namamemo.Lines.Strings[i]));
          End;
     end;
     Namamemo.Free;
end;

procedure Save_Setting_DB_Grid(nama_dbgrid : Tdbgrid; nama_file: String);
var i : byte;
begin
     i := 0;
     myINI := TINIFile.Create(ExtractFilePath(Application.EXEName) + '\Setting\' + nama_file);
     for i := 0 to nama_dbgrid.Columns.Count -1 do
     Begin
          nama_dbgrid.Columns[1].Width;
          myINI.WriteString(nama_dbgrid.Name, inttostr(i), inttostr(nama_dbgrid.Columns[i].width));
     End;
End;

function TForm1.GetFileSize(FName: string): Int64;
var
  ch: File;
  OldMode: Integer;
begin
     OldMode := FileMode;
     Result := -1;
     if not FileExists(FName) then Exit;
     try
        AssignFile(ch, FName);
        FileMode := 0;
        Reset(ch,1);
        Result := FileSize(ch);
     finally
        CloseFile(ch);
        FileMode := OldMode;
     end;
end;

// Atau bisa cara seperti dibawah ini
function TextfileSize(const name: string): LongInt; 
var
  SRec: TSearchRec;
begin
  if FindFirst(name, faAnyfile, SRec) = 0 then
  begin
    Result := SRec.Size;
    Sysutils.FindClose(SRec);
  end
  else
    Result := 0;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
     if OpenDialog1.Execute then
     begin
          Edit1.Text := FormatFloat('###.###,##',(GetFileSize(OpenDialog1.FileName))) +' byte';
     end;
end;

function Peringatanku(isi:String):word;
Begin
    Application.RestoreTopMosts;
    MessageDlg(isi, mtWarning, [mbOk],0);
    Application.RestoreTopMosts;
end;