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;
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;
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;
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;
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;
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;
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;
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;
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;
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;