Tips dan Trik Delphi

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 form transparan / Form / Windows / Delphi 7 - XE


Procedure TForm1.Transparan;
Begin
    AlphaBlend := true;
    AlphaBlendValue := 120;
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Transparan;
end;

Download file dari internet / Internet / Windows / Delphi 7 - XE


uses
  Wininet;

function DownloadURL(const aUrl: string): Boolean;
var
  hSession: HINTERNET;
  hService: HINTERNET;
  lpBuffer: array[0..1024 + 1] of Char;
  dwBytesRead: DWORD;
begin
  Result := False;
  // hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if Assigned(hSession) then
    begin
      hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, 0, 0);
      if Assigned(hService) then
        try
          while True do
          begin
            dwBytesRead := 1024;
            InternetReadFile(hService, @lpBuffer, 1024, dwBytesRead);
            if dwBytesRead = 0 then break;
            lpBuffer[dwBytesRead] := #0;
            Form1.Memo1.Lines.Add(lpBuffer);
          end;
          Result := True;
        finally
          InternetCloseHandle(hService);
        end;
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

var
  s: String;
begin
 if DownloadURL('http://www.kursusdelphi.com/') then
   ShowMessage(s);
end;

Menyimpan Quickreport pada stream / Printing / Windows / Delphi 7 - XE


uses QRPrntr;

procedure SaveQuickReportToStream(AQuickReport: TQuickRep; AStream: TStream);
var
  PL: TQRPageList;
  I: Integer;
begin
  PL := nil;
  try
    PL := TQRPageList.Create;
    PL.Stream := TQRStream.Create(100000);
    AQuickReport.Prepare;
    PL.LockList;
    try
      for I := 1 to AQuickReport.QRPrinter.PageCount do
        PL.AddPage(AQuickReport.QRPrinter.GetPage(I));
      PL.Finish;
    finally
      PL.UnlockList;
    end;
    PL.Stream.SaveToStream(AStream);
  finally
    FreeAndNil(PL);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  stream: TFileStream;
begin
  stream := TFileStream.Create('c:\quickreport.dat', fmCreate);
  QuickReportToStream(QuickRep1, stream);
  stream.Free;
end;

Menambahkan autonomor pada DBGrid / Database / Windows / Delphi 7 - XE


procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if DataSource1.DataSet.RecNo > 0 then
  begin
    if Column.Title.Caption = 'No' then
      DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top, IntToStr(DataSource1.DataSet.RecNo));
  end;
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;

Memblokir usb flasdisk pada windows system / Registry / Windows / Delphi 7 - XE


procedure LockUSB(RegName: String;sRegPolicies:WideString);
var
  Reg : TRegistry;
Begin
     Reg := TRegistry.Create;
     try
       Reg.RootKey:=HKEY_LOCAL_MACHINE;
       if Reg.OpenKey(sRegPolicies, True) then
          begin
            Reg.WriteInteger(RegName,4);
            Reg.CloseKey;
            //ShowMessage('Lock USB Berhasil.'+#13+'Restart Komputer !!');
          end;
     finally
       Reg.Free;
       //inherited;
     end;
end;
Cara memanggil procedure
LockSUB('Start','\HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR')

Menampilkan Nama Hari / Tool / Windows / Delphi 7 - XE


Function Namahari(tgl : Tdatetime) : String;
Begin
     case DayOfTheWeek(tgl) of
        0 : Result := 'Minggu';
        1 : Result := 'Senin';
        2 : Result := 'Selasa';
        3 : Result := 'Rabu';
        4 : Result := 'Kamis';
        5 : Result := 'Jumat';
        6 : Result := 'Sabtu';
        7 : Result := 'Minggu';
     end;
End;

Function Nama_hari(Const Hari : TDateTime) : String;
var
RsltHari : String;
const NamaHari: Array [1..7] of string = ('Minggu','Senin',
                                     'Selasa','Rabu','Kamis',
                                     'Jumat','Sabtu');
begin
   RsltHari := NamaHari[DayOfWeek(Hari)];
   result := rsltHari;
end;

Tips dan Trik Delphi

Kategori