Tips dan Trik Delphi

Merubah huruf besar pada awal kata / Tool / Windows Android / Delphi 7 - XE

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;

Mengganti kata atau karakter lainnya / Tool / Windows Android / Delphi 7 - XE

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;

Membalik kalimat atau kata / Tool / Windows Android / Delphi 7 - XE

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;

Membuat kopi string sendiri / Tool / Windows Android / Delphi 7 - XE

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;

Mengunci tombol ALT+TAB, CTRL+ESC, CTRL+ALT+DEL / Form / Windows / Delphi 7 - XE

procedure SystemKeys(Disable: Boolean);
varOldVal :LongInt;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING,
Word(Disable), @OldVal, 0);
end;

validasi font yang tersedia di windows / Windows / Windows / Delphi 7 - XE

function IsTrueTypeFont(FontName : string):boolean;
const
    PITCH_MASK: byte = $0F;
var
    TxMet: TTextMetric;
    TempCanvas : TCanvas;
    PitchTest : byte;118
begin
    TempCanvas := TCanvas.Create;
    TempCanvas.Handle := CreateCompatibleDC(0);
    TempCanvas.Font.Name := FontName;
    GetTextMetrics(TempCanvas.Handle, TxMet);
    PitchTest := TxMet.tmPitchAndFamily and PITCH_MASK;
    Result := (PitchTest and TMPF_TRUETYPE) <> 0;
    TempCanvas.free;
end;

Menutup aplikasi lain dari caption / Windows / Windows / Delphi 7 - XE

function KillApp(const sCapt: PChar) : boolean;
var AppHandle:THandle;
begin
    AppHandle := FindWindow(Nil, sCapt);
    Result := PostMessage(AppHandle, WM_QUIT, 0, 0);
end;

// jalankan notepad

procedure TForm1.Button2Click(Sender: TObject);
begin
     KillApp('Untitled - Notepad');
end;

Mencetak isi memo / Form / Windows / Delphi 7 - XE

procedure TForm1.PrintIt(Sender:TObject);
var
   PrintBuf: TextFile;
   i : integer;
begin
    AssignPrn(PrintBuf);
    Rewrite(PrintBuf);
    try
        for i := 0to Memo1.Lines.Count-1 do
        WriteLn(PrintBuf, Memo1.Lines[i]);
    finally
        CloseFile(PrintBuf);
    end;
End;


procedure TForm1.Button1Click(Sender: TObject);
begin
     PrintIt(self);
end;

Mengganti caption pada dialog / Form / Windows / Delphi 7 - XE

procedure TForm1.OpenDialog1Show(Sender: TObject);
begin
     {"OPEN" - > "Do Open"}
      SetDlgItemText (GetParent (Opendialog1.Handle),
      IDOK, PChar ('&Do Open'));
      {"Cancel" - > "No, Dismiss"}
      SetDlgItemText (GetParent (Opendialog1.Handle),
      IDCANCEL, PChar ('&No, Dismiss'));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     OpenDialog1.Execute;
end;

Membuat folder group start menu / Windows / Windows / Delphi 7 - XE

uses shlobj;

{$R *.dfm}

function CreateFolder(Foldername: string; aLocation: integer): boolean;
var pIdl: PItemIDList;
hPath: PChar;
begin
    Result := False;
    if SUCCEEDED(SHGetSpecialFolderLocation
    (0, aLocation, pidl)) then
    begin
        hPath := StrAlloc(max_path);
        SHGetPathFromIDList(pIdl, hPath);
        SetLastError(0);
        CreateDirectory(PChar(hPath +'\ \ ' + Foldername), nil );
        if (GetLastError()=0) or (GetLastError()=ERROR_ALREADY_EXISTS) then
           Result := true;

        StrDispose(hPath);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    CreateFolder('visibroker', CSIDL_PROGRAMS);
end;

Tips dan Trik Delphi

Kategori