Tips dan Trik Delphi

procedure TForm1.SetTopmost(AForm: TForm; ATop: boolean);
begin
     if ATop then
        SetWindowPos(AForm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
      else
        SetWindowPos(AForm.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

program Project1;

uses
  Forms, Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;

  CreateMutex(nil, True, 'kursusdelphi.com');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
       ShowMessage('Program anda sudah running');
       Halt;
  end;

  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


                                        

Untuk menghilangkan belakang koma silahkan gunakan fungsi Trunc(nilai), dan sedangkan untuk mengambil angka setelah koma gunakan fungsi Frac(nilai)

Function Bulatkan(Nilai : Double) : Double;
Var Hasilfrac : Double;
Begin
     Result := Nilai;
     Hasilfrac := Frac(Nilai);
     if Hasilfrac >= 0.5 Then
     Begin
          Result := TRUNC(nilai) + 1;
     End else
     if Hasilfrac < 0.5 Then
     Begin
          Result := TRUNC(nilai);
     End;
End;

Zoom pada StringGrid

procedure TForm1.gridZoom(FFact: Real);
var
  x: Integer;
begin
      for x := 0 to StringGrid1.colcount - 1 do
        StringGrid1.colwidths[x] := round(StringGrid1.colwidths[x] * FFact);

      for x := 0 to StringGrid1.RowCount - 1 do
        StringGrid1.rowheights[x] := round(StringGrid1.rowheights[x] * FFact);

      StringGrid1.Font.Size := round(StringGrid1.rowheights[0] * 0.65);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
      html: TStrings;
      htmpart, txtpart: TIdText;
      bmppart: TIdAttachment;
      email: TIdMessage;
begin
      IDSMTP.Host := Trim(cmbhost.Text);
      IDSMTP.Port := StrToInt(EdtPort.Text);

      html := TStringList.Create();
      html.Add('Halloooooo kursusdelphi.com, saya inden kursus Pak');
      email := TIdMessage.Create(nil);
      email.From.Text := trim('saya@gmail.com');
      email.Subject := Trim(EdtSubject.Text);
      email.ContentType := 'multipart/mixed';
      email.Body.Assign(html);
      email.Recipients.EMailAddresses := Trim('info@kursusdelphi.com');

      txtpart := TIdText.Create(email.MessageParts);
      txtpart.ContentType := 'text/plain';
      txtpart.Body.Text := '';

      htmpart := TIdText.Create(email.MessageParts, html);
      htmpart.ContentType := 'text/html';

      try
          idSMTP.Connect();
          try
              idSMTP.Send(email);
              // ShowMessage('Sent');
          except
          on E: Exception do
              // ShowMessage('Failed: ' + E.Message);
          end;
      finally
          idSMTP.Disconnect();
          // email.Free();
          // html.Free();
      end;
      ShowMessage('Selesai');
end;

ExtractFilePath(Application.EXEName);

function GetDateMMDDYYYY(TheDate: TDatetime):String;
var vYY,vMM,vDD : Word;
begin
   DecodeDate(TheDate,vYY,vMM,vDD);
   Result:=IntToStr(vMM)+'/'+IntToStr(vDD)+'/'+IntToStr(vYY);
end;

uses Registry;

procedure TForm1.SimpanSetting;
var
   Reg : TRegistry;
begin
     Reg := TRegistry.Create;
     try
         if Reg.OpenKey('\Software\www.kursusdelphi.com', True) then
         begin
             Reg.WriteInteger('Setting1', Strtoint(Edit1.text));
             Reg.WriteString('Setting2', Edit2.text);
             Reg.WriteTime('Setting3', StrToTime(Edit3.text));
             Reg.CloseKey;
         end;
     finally
         Reg.Free;
         inherited;
     end;
end;

procedure TForm1.BacaSetting;
var
    Reg : TRegistry;
begin
    Reg := TRegistry.Create;
    try
        if Reg.OpenKey('\Software\www.kursusdelphi.com', True) then
        begin

             if Reg.ValueExists('Setting1') then
                Edit4.Text := inttostr(Reg.ReadInteger('Setting1'));

             if Reg.ValueExists('Setting2') then
                Edit5.Text := Reg.ReadString('Setting2');

             if Reg.ValueExists('Setting3') then
                Edit6.Text := TimeToStr(Reg.ReadTime('Setting3'));

            Reg.CloseKey;
        end;
    finally
      Reg.Free;
      inherited;
    end;
end;

Uses Wininet;

function TForm1.IsConnected: Boolean;
const
  // Local system has a valid connection to the Internet, but it might or might
  // not be currently connected.
  INTERNET_CONNECTION_CONFIGURED = $40;

  // Local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_LAN = $02;

  // Local system uses a modem to connect to the Internet
  INTERNET_CONNECTION_MODEM = $01;

  // Local system is in offline mode.
  INTERNET_CONNECTION_OFFLINE = $20;

  // Local system uses a proxy server to connect to the Internet
  INTERNET_CONNECTION_PROXY = $04;

  // Local system has RAS installed.
  INTERNET_RAS_INSTALLED = $10;

var
  InetState: DWORD;
  hHttpSession, hReqUrl: HInternet;
begin
  Result:= InternetGetConnectedState(@InetState, 0);
  if (
    Result
    and
    (
      InetState and INTERNET_CONNECTION_CONFIGURED
        = INTERNET_CONNECTION_CONFIGURED)
    ) then
  begin
    // so far we ONLY know there's a valid connection. See if we can grab some
    // known URL ...
    hHttpSession:= InternetOpen(
      PChar(Application.Title), // this line is the agent string
      INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0
    );
    try
      hReqUrl:= InternetOpenURL(
        hHttpSession,
        PChar('https://www.kursusdelphi.com'{ the URL to check }),
        nil,
        0,
        0,
        0
      );
      Result := hReqUrl <> nil;
      InternetCloseHandle(hReqUrl);
    finally
      InternetCloseHandle(hHttpSession);
    end;
  end
  else
    if (
      InetState and INTERNET_CONNECTION_OFFLINE = INTERNET_CONNECTION_OFFLINE
    ) then
      Result := False; // we know for sure we are offline.
end;

function TForm1.GetMACAdress: string;
var
  NCB: PNCB;
  Adapter: PAdapterStatus;

  URetCode: PChar;
  RetCode: char;
  I: integer;
  Lenum: PlanaEnum;
  _SystemID: string;
  TMPSTR: string;
begin
  Result    := '';
  _SystemID := '';
  Getmem(NCB, SizeOf(TNCB));
  Fillchar(NCB^, SizeOf(TNCB), 0);

  Getmem(Lenum, SizeOf(TLanaEnum));
  Fillchar(Lenum^, SizeOf(TLanaEnum), 0);

  Getmem(Adapter, SizeOf(TAdapterStatus));
  Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);

  Lenum.Length    := chr(0);
  NCB.ncb_command := chr(NCBENUM);
  NCB.ncb_buffer  := Pointer(Lenum);
  NCB.ncb_length  := SizeOf(Lenum);
  RetCode         := Netbios(NCB);

  i := 0;
  repeat
    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command  := chr(NCBRESET);
    Ncb.ncb_lana_num := lenum.lana[I];
    RetCode          := Netbios(Ncb);

    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command  := chr(NCBASTAT);
    Ncb.ncb_lana_num := lenum.lana[I];
    // Must be 16
    Ncb.ncb_callname := '*               ';

    Ncb.ncb_buffer := Pointer(Adapter);

    Ncb.ncb_length := SizeOf(TAdapterStatus);
    RetCode        := Netbios(Ncb);
    //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
    if (RetCode = chr(0)) or (RetCode = chr(6)) then
    begin
      _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[5]), 2);
    end;
    Inc(i);
  until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
  FreeMem(NCB);
  FreeMem(Adapter);
  FreeMem(Lenum);
  GetMacAdress := _SystemID;
end;