+62 812-1171-5379 Fast Respond

Tips dan Trik Delphi - Tool

Mengetahui lokasi drive dan folder program berjalan / Tool / Windows / Delphi 7 - XE


ExtractFilePath(Application.EXEName);

Format date dalam SQL / Tool / Windows / Delphi 7 - XE


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

Membaca file CSV dan memasukkan ke Stringgrid / Tool / Windows / Delphi 7 - XE


Function ListGetAt(List: string; const Position: integer; const Delimiter: string = ';'): string;
var
 i, NP, DL: integer;
Begin
     NP := 1;
     DL := Length(Delimiter);
     for i := 1 to Position do
     Begin
          List := Copy(List, NP, Length(List)-NP+1);
          NP := Pos(Delimiter, List)+DL;
          if i = Position then
          begin
             if Pos(Delimiter, List) = 0 then Break;
             Delete(List, NP-DL, Length(List)-(NP-DL-1));
          End Else
          if NP = DL then
          begin
               List := '';
               Break;
          end;
     End;
     Result := List;
End;

Function ListSetAt(List: string; const Position: integer; const Value: string; const Delimiter: string = ';'): string;
var
   i, NP, DL: integer;
   BegStr, EndStr: string;
Begin
     NP := 1;
     DL := Length(Delimiter);
     BegStr := '';
     EndStr := '';
     For i := 1 to Position do
     Begin
          if i > 1 then
             BegStr := BegStr+Copy(List, 1, Pos(Delimiter, List)+DL-1);

          List := Copy(List, NP, Length(List)-NP+DL);
          NP := Pos(Delimiter, List)+DL;
          if (NP = DL) and (i < Position) then
          Begin
               List := List + Delimiter;
               NP := Pos(Delimiter, List)+DL;
          End;
          if i = Position then
          Begin
              if Pos(Delimiter, List) = 0 then
                 Break;
              EndStr := Copy(List, NP-DL, Length(List)-(NP-DL-1));
          End;
     End;
     Result := BegStr + Value + EndStr;
End;

Function ListLen(List: string; const Delimiter: string): integer;
var DL: integer;
Begin
     DL := Length(Delimiter);
     Result := Ord(List > '');
     While Pos(Delimiter, List) > 0 do
     Begin
          Delete(List, 1, Pos(Delimiter, List) + DL-1);
          Inc(Result);
     End;
End;

procedure ProcessData(namaSTG: TStringGrid; Value1, Value2, Value3, Value4, Value5, Value6, value7, value8, value9, value10, value11: string);
Begin
     namaSTG.Cells[0,Barisimport]:= (Value1);
     namaSTG.Cells[1,Barisimport]:= (Value2);
     namaSTG.Cells[2,Barisimport]:= (Value3);
     namaSTG.Cells[3,Barisimport]:= (Value4);
     namaSTG.Cells[4,Barisimport]:= (Value5);
     namaSTG.Cells[5,Barisimport]:= (Value6);
     namaSTG.Cells[6,Barisimport]:= (Value7);
     namaSTG.Cells[7,Barisimport]:= (Value8);
     namaSTG.Cells[8,Barisimport]:= (value9);
     namaSTG.Cells[9,Barisimport]:= (Value10);
     namaSTG.Cells[10,Barisimport]:= (value11);
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
     MyCSVData: TStringList;
begin
     if OpenDialog1.Execute Then
     Begin
          MyCSVData := TStringList.Create;
          MyCSVData.LoadFromFile(OpenDialog1.FileName);
          Barisimport := 0;
          For Barisimport := 1 to MyCSVData.Count-1 do
          Begin
               ProcessData(StgHeader,
                           ListGetAt(MyCSVData[Barisimport -1], 1),
                           ListGetAt(MyCSVData[Barisimport -1], 2),
                           ListGetAt(MyCSVData[Barisimport -1], 3),
                           ListGetAt(MyCSVData[Barisimport -1], 4),
                           ListGetAt(MyCSVData[Barisimport -1], 5),
                           ListGetAt(MyCSVData[Barisimport -1], 6),
                           ListGetAt(MyCSVData[Barisimport -1], 7),
                           ListGetAt(MyCSVData[Barisimport -1], 8),
                           ListGetAt(MyCSVData[Barisimport -1], 9),
                           ListGetAt(MyCSVData[Barisimport -1], 10),
                           ListGetAt(MyCSVData[Barisimport -1], 11));
               StgHeader.RowCount := Barisimport + 2;
          End;
     End;
End;

Mengetahui bulan berapa sekarang / Tool / Windows / Delphi 7 - XE


function DaysInMonth: Integer;
var
  Year, Month, Day: Word;
begin
  DecodeDate(Now, Year, Month, Day);
  Result := MonthDays[IsLeapYear(Year), Month];
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(DaysInMonth));
end;


Konversi dari pengurangan tanggal menjadi jumlah menit / Tool / Windows / Delphi 7 - XE


Function TForm1.konversitanggalkemenit(Dari, Sampai : Tdatetime) : Double;
Var Hasil_Temp, Hasil_Selisih, Hasil_belakangkoma : Double;
    Hasil_Str_Temp : String;
    menit : Ttime;
Begin
     Hasil_Selisih := Sampai - dari;
     if Hasil_Selisih >= 0.0000000000000001 then
     Begin
          hasil_temp := ((Hasil_Selisih * 24 * 60));
          Result := Trunc(hasil_temp);
     End Else
     Begin
          menit := Timeof(Sampai) - TimeOf(dari);
          Result := menit;
     End;
End;

// Cara memanggilnya
Edit3.Text := FloatToStr(konversitanggalkemenit(StrToDateTime(EdtDari.text), StrToDateTime(EdtSampai.text)));

Konversi dari pengurangan tanggal menjadi jumlah jam / Tool / Windows / Delphi 7 - XE


Function konversitanggalkejam(Dari, Sampai : Tdatetime) : Double;
Var Hasil_Temp, Hasil_Selisih, Hasil_belakangkoma : Double;
    Hasil_Str_Temp : String;
    Jam : Ttime;
Begin
     Hasil_Selisih := Sampai - dari;
     if Hasil_Selisih >= 0.0001 then
     Begin
          hasil_temp := ((Hasil_Selisih * 24) + 0.000000001);

          Hasil_Str_Temp := FormatFloat('0#.00', hasil_temp);
          if length(Hasil_Str_Temp) >= 3 then
          begin
               Hasil_belakangkoma := StrToFloat(copy(Hasil_Str_Temp,4,2));
               Hasil_belakangkoma := (Hasil_belakangkoma * 0.6) /100;
               Hasil_Str_Temp := FormatFloat('0#.00', Hasil_belakangkoma);
               Result := Trunc(hasil_temp) + Strtofloat(Hasil_Str_Temp);
          end else
          begin
               Result := Trunc(hasil_temp);
          end;
     End Else
     Begin
          Jam := Timeof(Sampai) - TimeOf(dari);
          Result := Jam;
     End;
End;

Cara memanggilnya :
Edit3.Text := FloatToStr(konversitanggalkejam(StrToDateTime(EdtDari.text), StrToDateTime(EdtSampai.text)));

Membuat enkripsi dan dekripsi sendiri / Tool / Windows / Delphi 7 - XE


Function TForm1.Enkripsi(str:String) : String;
var
  i,x: Integer;
  h: Char;
  Kata: String;
  Hasil1, Hasil2 : String;
begin

    Result := '';
    Kata := str;
    Hasil1 := ''; Hasil2 := '';

    i := 0;
    For i:=1 to Length(kata) do
    begin
        if i = 1 Then
        begin
             x := ord(kata[i]) + 75;
        end;

        if i = 2 Then
        begin
             x := ord(kata[i]) + 20;
        end;

        if i = 3 Then
        begin
             x := ord(kata[i]) + 100;
        end;

        if i = 4 Then
        begin
             x := ord(kata[i]) + 35;
        end;

        if i >= 5 Then
        begin
             x := ord(kata[i]) + 40;
        end;

        hasil1 := hasil1 + char(x);
    end;

    Result := hasil1;
End;


Function TForm1.Deskripsi(Str:String):String;
var
  i,x: Integer;
  h: Char;
  Kata: String;
  Hasil1, Hasil2 : String;
begin
    Result := '';
    Kata := Str;
    Hasil1 := ''; Hasil2 := '';

    i := 0;
    For i := 1 to Length(kata) do
    begin
        if i = 1 Then
        begin
             x := ord(kata[i]) - 75;
        end;

        if i = 2 Then
        begin
             x := ord(kata[i]) - 20;
        end;

        if i = 3 Then
        begin
             x := ord(kata[i]) - 100;
        end;

        if i = 4 Then
        begin
             x := ord(kata[i]) - 35;
        end;

        if i >= 5 Then
        begin
             x := ord(kata[i]) - 40;
        end;

        hasil1 := hasil1 + char(x);
    End;
    Result := hasil1;
End;


Membuat terbilang dengan format Indonesia / Tool / Windows / Delphi 7 - XE


Function TerbilangIndonesia(dblValue : Double) : String;
var
  ones,one : array[0..9] of String;
  teens : array[0..9] of String;
  tens : array[0..9] of String;
  thousands : array[0..4] of String;
  i, nPosition, nDigit, bAllZeros : Integer;
  strResult, strTemp, tmpBuff : String;
begin
      ones[0] := 'NOL';
      ones[1] := 'SATU';
      ones[2] := 'DUA';
      ones[3] := 'TIGA';
      ones[4] := 'EMPAT';
      ones[5] := 'LIMA';
      ones[6] := 'ENAM';
      ones[7] := 'TUJUH';
      ones[8] := 'DELAPAN';
      ones[9] := 'SEMBILAN';

      one[1] := 'SE';

      teens[0] := 'SEPULUH';
      teens[1] := 'SEBELAS';
      teens[2] := 'DUA BELAS';
      teens[3] := 'TIGA BELAS';
      teens[4] := 'EMPAT BELAS';
      teens[5] := 'LIMA BELAS';
      teens[6] := 'ENAM BELAS';
      teens[7] := 'TUJUH BELAS';
      teens[8] := 'DELAPAN BELAS';
      teens[9] := 'SEMBILAN BELAS';

      tens[0] := '';
      tens[1] := '';
      tens[2] := 'DUA PULUH';
      tens[3] := 'TIGA PULUH';
      tens[4] := 'EMPAT PULUH';
      tens[5] := 'LIMA PULUH';
      tens[6] := 'ENAM PULUH';
      tens[7] := 'TUJUH PULUH';
      tens[8] := 'DELAPAN PULUH';
      tens[9] := 'SEMBILAN PULUH';

      thousands[0] := '';
      thousands[1] := 'RIBU ';
      thousands[2] := 'JUTA ';
      thousands[3] := 'MILIAR ';
      thousands[4] := 'TRILIUN ';
       Try
        strResult := '';
        strTemp := FloatToStr(dblValue);
        //Iterate through string
        For i := Length(strTemp) DownTo 1 do
        begin
          //Get value of this digit
          nDigit := StrToInt(MidStr(strTemp, i, 1));
          //Get column position
          nPosition := (Length(strTemp) - i) + 1;
          //Action depends on 1's, 10's or 100's column
          //Select Case (nPosition Mod 3)
          Case (nPosition Mod 3) of
              1 : begin
                    //Case 1  //'1's position
                      bAllZeros := 0;
                      if i = 1 Then
                      begin
                         if (length(strTemp) = 4) and (copy(strTemp,1,1)='1') Then
                         Begin
                            tmpBuff :='SE';
                         End else
                            tmpBuff := ones[nDigit] + ' '
                      end Else
                      if MidStr(strTemp, i - 1, 1) = '1' Then
                      begin
                        tmpBuff := teens[nDigit] + ' ';
                      end Else
                      if nDigit > 0 Then
                        tmpBuff := ones[nDigit] + ' '
                      else
                      begin
                            //If next 10s & 100s columns are also
                            //zero, then don't show 'thousands'
                            bAllZeros := 1;
                            if i > 1 Then

                            begin
                              If MidStr(strTemp, i - 1, 1) <> '0' Then
                                bAllZeros := 0;
                            end;
                            If i > 2 Then

                            begin
                              If MidStr(strTemp, i - 2, 1) <> '0' Then
                                bAllZeros := 0;

                            End;
                            tmpBuff := '';
                      end;
                      If (bAllZeros = 0) and (nPosition > 1) Then
                         tmpBuff := tmpBuff + thousands[nPosition div 3] + ' ';

                      strResult := tmpBuff + strResult;
                  end;
              2 : begin
                      if nDigit > 0 Then
                      if nDigit = 1 Then
                      begin

                      end Else
                          StrResult := tens[nDigit] +  ' ' + strResult;
                   end;
              0 :  begin
                      if nDigit > 0 Then
                          if nDigit = 1 Then
                          begin
                           if (nPosition mod 3) = 0 then
                               strResult := one[nDigit] + 'RATUS ' + strResult;
                          end  else
                          strResult := ones[nDigit] + ' RATUS ' + strResult;
                    end;
              end; // Case
        end;  //  For i := Length(strTemp) downTo 1 do
        Result := '( ' + trim(strResult) + ' RUPIAH )';
       except
           Result := '';
       end;

end;


Menghapus satu baris pada Stringgrid / Tool / Windows / Delphi 7 - XE


Var vlrow : smallint;
begin
     Result := False;
     if StringGrid1.RowCount <=2 then Exit;

     vlrow := StringGrid1.Row;
     for vlrow := StringGrid1.Row to StringGrid1.RowCount -1 do
     begin
          StringGrid1.Cells[0,vlrow] := StringGrid1.Cells[0,vlrow + 1];
          StringGrid1.Cells[1,vlrow] := StringGrid1.Cells[1,vlrow + 1];
          StringGrid1.Cells[2,vlrow] := StringGrid1.Cells[2,vlrow + 1];
          StringGrid1.Cells[3,vlrow] := StringGrid1.Cells[3,vlrow + 1];
          StringGrid1.Cells[4,vlrow] := StringGrid1.Cells[4,vlrow + 1];
          StringGrid1.Cells[5,vlrow] := StringGrid1.Cells[5,vlrow + 1];
     end;
     Result := True;
end;

// atau gunakan procedure dibawah ini :

Procedure DeleteRow(AGrid : TStringGrid);
var i, cr : integer;
begin
    If assigned(AGrid) then
    begin
      cr := AGrid.Selection.Top;
      for i := cr + 1 to AGrid.RowCount - 1 do
        AGrid.Rows[i-1].Assign(AGrid.Rows[i]);
      AGrid.RowCount := AGrid.RowCount - 1;
    end;
end;

// atau perintah dibawah ini
procedure RemoveRows(RowIndex, RCount: Integer);
var
  i: Integer;
begin
  for i := RowIndex to RowCount - 1 do
    Rows[i] := Rows[i + RCount];
  RowCount := RowCount -RCount;
end;

// Cara memanggil removerows
myStringGrid.RemoveRows(0, 4);


Menampilkan tanggal terakhir pada bulan tertentu / Tool / Windows / Delphi 7 - XE


function Akhirbulan(Tahun, bulan : Smallint) : Smallint;
Const DaysinMonth : array[1..12] of smallint = (31,28,31,30,31,31,30,31,30,31,30,31);
Begin
    Result := DaysInMonth[bulan];
    if (bulan = 2) and IsLeapYear(Tahun) Then
       inc(Result);
End;