+62 812-1171-5379 Fast Respond

Tips dan Trik Delphi

Mengganti IP komputer / Windows / Windows / Delphi 7 - XE
 uses ActiveX, Comobj, Winsock;
function SetComputerName(AComputerName: string): Boolean;
var
  ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
  Size: Cardinal;
begin
  StrPCopy(ComputerName, AComputerName);
  Result := Windows.SetComputerName(ComputerName);
end;

Mengganti nama komputer / Windows / Windows / Delphi 7 - XE
 uses ActiveX, Comobj, Winsock;
function SetComputerName(AComputerName: string): Boolean;
var
  ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
  Size: Cardinal;
begin
  StrPCopy(ComputerName, AComputerName);
  Result := Windows.SetComputerName(ComputerName);
end;

Menbuat combo didalam Stringgrid / Tool / Windows / Delphi 7 - XE
procedure TForm1.FormCreate(Sender: TObject);
begin
   StringGrid1.DefaultRowHeight := ComboBox1.Height;
   ComboBox1.Visible := False;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  R: TRect;
begin
  if ((ACol = 3) AND (ARow <> 0)) then
  begin
      R := StringGrid1.CellRect(ACol, ARow);
      R.Left := R.Left + StringGrid1.Left;
      R.Right := R.Right + StringGrid1.Left;
      R.Top := R.Top + StringGrid1.Top;
      R.Bottom := R.Bottom + StringGrid1.Top;
      ComboBox1.Left := R.Left + 0 ;
      ComboBox1.Top := R.Top + 0 ;
      ComboBox1.Width := (R.Right + 0 ) - R.Left;
      ComboBox1.Height := (R.Bottom + 0 ) - R.Top;
      ComboBox1.Visible := True;
      ComboBox1.SetFocus;
  end;
  CanSelect := True;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
     if key=13 Then
        StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Text;
end;

Mengunakan fungsi IN / Tool / Windows Android / Delphi 7 - XE
var
  Nilai : byte;

procedure TForm1.Button1Click(Sender: TObject);
begin
     nilai := Strtoint(Edit1.text);
     if Nilai in[1,6,9] Then
     Begin
          // jika nilai dimasukkan 1 atau 6 atau 9 maka muncul pesan ini
          ShowMessage('Ada kesamaan nilai');
     End else
     Begin
          // jika nilai dimasukkan tidak ditemukan maka muncul pesan ini
          ShowMessage('Tidak ditemukan kesamaan nilai');
     End;
end;

Penggunaan set pada delphi / Tool / Windows / Delphi 7 - XE
Type
   TNums = set of 1..9;

var
  Form1: TForm1;
  nums1, nums2, nums3, nums4, nums5, nums6 : TNums;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
     nums1 := [1,2,3];
     nums2 := [1,2,4];
     nums3 := [1,2,3,4,5,6,7,8,9];

     // Menguji kesetaraan
     if nums1 = nums2 then
     begin
          ShowMessage('nums1 =  nums2')
     end else
     begin
          ShowMessage('nums1 <> nums2');
     end;

     // Menguji ketidaksetaraan
     if nums1 <> nums3 Then
     begin
          ShowMessage('nums1 <> nums3')
     end else
          ShowMessage('nums1 =  nums3');

     // Apakah nums1 adalah dari bagian nums3?
     if nums1 <= nums3 then
     begin
          ShowMessage('nums1 bagian dari himpunan nums3')
     end else
          ShowMessage('nums1 bukan bagian dari himpunan nums3');

end;

Membalik kata atau kalimat / Tool / Windows Android / Delphi 7 - XE
function ReverseString1(const s: string): string;
var
  i, len: Integer;
begin
  len := Length(s);
  SetLength(Result, len);
  for i := len downto 1 do
  begin
    Result[len - i + 1] := s[i];
  end;
end;

Memeriksa kebenaran nama email / Internet / Windows Android / Delphi 7 - XE
procedure TForm3.Button1Click(Sender: TObject);
begin
     if IsValidEmail(Edit1.Text) Then
     begin
          if Cek_Domain(Edit1.Text) Then
          begin
               ShowMessage('Email Benar');
          end else
          begin
               ShowMessage('Cek kembali email anda');
          end;
     end else
     begin
          ShowMessage('Email Salah');
     end;
end;

Function TForm3.Cek_Domain(const Nomor: string) : Boolean;
begin
     result := False;
      if (LowerCase(RightStr(Nomor,4)) ='.ac.id') or
             (LowerCase(RightStr(Nomor,6)) ='.go.id') or
             (LowerCase(RightStr(Nomor,3)) ='.asia') or
             (LowerCase(RightStr(Nomor,4)) ='.biz') or
             (LowerCase(RightStr(Nomor,4)) ='.name') or
             (LowerCase(RightStr(Nomor,4)) ='.id') or
             (LowerCase(RightStr(Nomor,4)) ='.tv') or
             (LowerCase(RightStr(Nomor,4)) ='.info') or
             (LowerCase(RightStr(Nomor,4)) ='.in') or
             (LowerCase(RightStr(Nomor,4)) ='.net') or
             (LowerCase(RightStr(Nomor,4)) ='.edu') or
             (LowerCase(RightStr(Nomor,4)) ='.sch.id') or
             (LowerCase(RightStr(Nomor,4)) ='.int') or
             (LowerCase(RightStr(Nomor,4)) ='.co') or
             (LowerCase(RightStr(Nomor,4)) ='.co.id') or
             (LowerCase(RightStr(Nomor,4)) ='.org') or
             (LowerCase(RightStr(Nomor,4)) ='.or.id') or
             (LowerCase(RightStr(Nomor,4)) ='.com') Then
          Begin
               result := True;
          End;
end;

function TForm3.IsValidEmail(const Value: string): boolean;
        function CheckAllowed(const s: string): boolean;
        var
          i: integer;
        begin
          Result:= False;
          for i:= 1 to Length(s) do
          begin
            // illegal char - no valid address
            if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.','+']) then
              Exit;
          end;
          Result:= True;
        end;
var
  i: integer;
  namePart, serverPart: string;
begin
    Result := False;

    i:= Pos('@', Value);
    if (i = 0) then
      Exit;

    if(pos('..', Value) > 0) or (pos('@@', Value) > 0) or (pos('.@', Value) > 0)then
      Exit;

    if(pos('.', Value) = 1) or (pos('@', Value) = 1) then
      Exit;

    namePart:= Copy(Value, 1, i - 1);
    serverPart:= Copy(Value, i + 1, Length(Value));
    if (Length(namePart) = 0)  or (Length(serverPart) < 5)    then
      Exit;                      // too short

    i:= Pos('.', serverPart);
    // must have dot and at least 3 places from end
    if (i=0) or (i>(Length(serverPart)-2)) then
      Exit;

    Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;


Menggunakan Chart / Tool / Windows / Delphi 7 - XE
procedure TForm1.Button1Click(Sender: TObject);
var
  i, j, kum: Integer;
  s, t: TLineSeries;
begin
    with Chart1 do
    begin
        Title.Text.Clear;
        Title.Text.Add('Tampilan Penjualan');

        s := TLineSeries.Create(nil);
        s.Clear;
        s.Title := 'Fathin';
        s.ParentChart := Chart1;
        s.XValues.DateTime := True;

        t := TLineSeries.Create(nil);
        t.Clear;
        t.Title       := 'DZaki';
        t.ParentChart := Chart1;
        t.XValues.DateTime := True;
        t.VertAxis := aRightAxis;

        for i := 0 to 3 do
        begin
            j := Random(100);
            s.AddXY(Date + i, j);
            kum := kum + j;
            t.AddXY(Date + i, kum);
        end;
    end;
End;

Membuat form bulat / Form / Windows / Delphi 7 - XE
procedure TForm1.FormCreate(Sender: TObject);
var
  R: HRgn;
  a: integer;
begin
  a      := -25;
  Height := 500;
  Width  := 550;
  R      := CreateEllipticRgn(-a, - a, Width - 45, Height - 45);
  SetWindowRgn(Handle, R, True);
end;

Membuat tulisan miring / Form / Windows / Delphi 7 - XE
var
  lf : TLogFont;
  tf : TFont;
begin
    with Form1.Canvas do
    begin
        Font.Name := 'Arial';
        Font.Size := 24;
        tf := TFont.Create;
        tf.Assign(Font);
        GetObject(tf.Handle, sizeof(lf), @lf);
        lf.lfEscapement := 450;
        lf.lfOrientation := 450;
        tf.Handle := CreateFontIndirect(lf);
        Font.Assign(tf);
        tf.Free;
        TextOut(20, Height div 2, 'Rotated Text!');
    end;
end;