Tips dan Trik Delphi - Tool

Procedure TForm1.FirstUppercase;
var
    GetString : string;
    GetLength : Integer;
    I : Integer;
    T : String;
begin
    if edit1.SelLength > 0 then
    GetString := Edit1.Seltext
    else GetString:= Edit1.Text;
    GetLength := Length(Edit1.Text);
    if GetLength>0 then
    begin
        for I := 0 to GetLength do
        begin
            if (GetString[I] = ' ') or (I=0) then
            begin
            if GetString[I+1] in ['a'..'z'] then
            begin
                T := GetString[I+1];
                T := UpperCase(T);
                GetString[I+1] := T[1];
            end;
        end;
    end;
    if edit1.Sellength>0 then
       Edit1.Seltext := GetString
    else Edit1.Text := GetString;
end;

function SearchAndReplace(sSrc, sLookFor, sReplaceWith : string) : string;
var
   nPos, nLenLookFor : integer;
begin
    nPos := Pos(sLookFor,sSrc);
    nLenLookFor := Length(sLookFor);
    while (nPos > 0) do
    begin
         Delete(sSrc, nPos, nLenLookFor);
         Insert(sReplaceWith, sSrc, nPos);
         nPos := Pos(sLookFor, sSrc);
    end;
    Result := sSrc;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s : string;
begin
    s := SearchAndReplace(Edit1.Text, ';', ' ');
    Edit1.Text := s;
end;

Function String_Reverse(S : String): String;
Var
i : Integer;
Begin
    Result := '';
    For i := Length(S) DownTo 1 Do
    Begin
         Result := Result + Copy(S,i,1);
    End;
End;

function RightStr(Const Str: String; Size: Word): String;
begin
    if Size > Length(Str) then
       Size := Length(Str);
    RightStr := Copy(Str, Length(Str)-Size+1, Size)
end;

function MidStr(Const Str: String; From, Size: Word): String;
begin
    MidStr := Copy(Str, From, Size)
end;

function LeftStr(Const Str: String; Size: Word): String;
begin
    LeftStr := Copy(Str, 1, Size)
end;

  private
    { Private declarations }
  public
    { Public declarations }
    Function hitung : longint; overload;
    Function hitung(a, b : integer) : longint; overload;
  end;

var
  Form1: TForm1;
  c, d : integer;

implementation

{$R *.dfm}

Function TForm1.hitung : longint;
Begin
     result := c + d;
End;

Function TForm1.hitung(a, b : integer) : longint;
Begin
     result := a + b;
End;

end.

procedure TForm1.Button8Click(Sender: TObject);
var i :integer;
begin
    for i:=0 to 9999999 do
    begin
        Label1.Caption := IntToStr(i);
        {.... loop main body here ...}
        Application.ProcessMessages;
        {ESC key stops the loop}
        if GetKeyState(VK_Escape) AND 128=128 then
           break;
    end;
end;

function tombol(Key:Char):Char;
begin
    if (Key>='0') and (Key<='9') or (Key=#8) or (Key=#13) then
    begin
        Result:=Key;
    end else Result:=Chr(0);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
     key := tombol(key);
end;

Function Pertanyaanku(isipertanyaan : String) : byte;
var
    AMsgDialog:TForm;
    ACheckBox: TCheckBox;
    Image, image2 : TImage;
begin
    AMsgDialog := CreateMessageDialog(isipertanyaan,  mtCustom, [mbYes, mbNo]);

    ACheckBox := TCheckBox.Create(AMsgDialog);
    with AMsgDialog do
    try
        AMsgDialog.Caption := 'Pertanyaan';
        AMsgDialog.BorderStyle := bsDialog;
        AMsgDialog.Color := clGreen;
        AMsgDialog.Font.Size := 10;
        AMsgDialog.Font.Color := clWhite;
        AMsgDialog.Height := 169;
        AMsgDialog.Width := 200;

        with ACheckBox do
        begin
            Parent := AMsgDialog;
            Caption := 'Jangan tampil lagi.';
            Top := 101;
            Width := 201;
            Left := 10;
        end;

        if (ShowModal = ID_YES) then
        begin
            Result := Id_yes;
            if ACheckBox.Checked then
            begin

            end else
            Begin

            End;
        end else
        Begin
             Result := ID_NO;
        End;

    finally
       ACheckBox.Free;
       Free;
    end;
end;

function TForm1.Encrypt(S: string): string;
var
    Angka, i: Integer;
begin
    Result := ' ' + S;
    Angka := 32;
    for i := 1 to Length(S) do
    begin
        Angka := Angka + Ord(S[i]);
        while Angka > 126 do
              Angka := Angka - 95;
        end;
        Result[1] := Chr(Angka);

        for i := 2 to Length(Result) do
        begin
            Angka := Ord(Result[i]) + Ord(Result[i - 1]);
            while Angka > 126 do
                Angka := Angka - 95;
                Result[i] := Chr(Angka);
        end;
end;

function TForm1.Decrypt(S: string): string;
var
    Angka1, Angka2,
    Angka, i: Integer;
begin
    Result := S;
    for i := Length(S) downto 2 do
    begin
        Angka1 := Ord(S[i]);
        Angka2 := Ord(S[i - 1]);
        if Angka1 >= Angka2 then
        Angka := Angka1 - Angka2
        else
        Angka := (Angka1 + 95) - Angka2;
        while Angka < 32 do
        Angka := Angka + 95;
        Result[i] := Chr(Angka);
    end;
    Delete(Result, 1, 1);
end;

var
  Form1: TForm1;
  OldWidth, OldHeight: integer;

implementation

{$R *.dfm}

function TForm1.SetScreenResolution(Width, Height: integer): Longint;
var
    DeviceMode: TDeviceMode;
begin
    with DeviceMode do
    begin
        dmSize := SizeOf(TDeviceMode);
        dmPelsWidth := Width;
        dmPelsHeight := Height;
        dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    end;
    Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      SetScreenResolution(800, 600);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     SetScreenResolution(OldWidth, OldHeight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     OldWidth := GetSystemMetrics(SM_CXSCREEN);
     OldHeight := GetSystemMetrics(SM_CYSCREEN);
end;