Tips dan Trik Delphi

Menghilangkan icon pada taskbar / Form / Windows / Delphi 7 - XE

procedure TForm1.FormCreate(Sender: TObject);
begin
     ShowWindow(Application.Handle, SW_HIDE);
     SetWindowLong(Application.Handle, GWL_EXSTYLE,
     getWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW );
     ShowWindow( Application.Handle, SW_SHOW );
end;

Membuat text berotasi 45 derajat / Form / Windows / Delphi 7 - XE

procedure TForm1.Button1Click(Sender: TObject);
var
   lf : TLogFont;
   tf : TFont;
begin
    with Form1.Canvas do
    begin
        Font.Name := 'Arial';
        Font.Size := 24;
        tf := TFont.Create;
        try
            tf.Assign(Font);
            GetObject(tf.Handle,sizeof(lf), @lf);
            lf.lfEscapement := 450;
            lf.lfOrientation := 450;
            tf.Handle := CreateFontIndirect(lf);
            Font.Assign(tf);
        finally
           tf.Free;
        end;
        TextOut(20, Height div 2, 'Rotated Text!');
    end;
end;

Form transparan button seperti melayang / Form / Windows / Delphi 7 - XE

procedure TForm1.FormCreate(Sender: TObject);
var
    FullRgn, ClientRgn, ButtonRgn: THandle;
    Margin, X, Y: Integer;
begin
    Margin := (Width - ClientWidth) div 2;
    FullRgn:= CreateRectRgn(0, 0,Width, Height);
    X := Margin;
    Y := Height- ClientHeight - Margin;
    ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
    CombineRgn(FullRgn,FullRgn, ClientRgn, RGN_DIFF);
    X := X + Button1.Left;
    Y := Y + Button1.Top;
    ButtonRgn := CreateRectRgn
    (X, Y, X + Button1.Width, Y + Button1.Height);
    CombineRgn(FullRgn,FullRgn,ButtonRgn,RGN_OR);
    SetWindowRgn(Handle, FullRgn,True);
end;

Ceil Delphi untuk penggajian / Matematika / Windows Android / Delphi 7 - XE

Var Nilai_awal_temp, Nilai_awal_temp1, Nilai_awal_temp2, Simpanan : Integer;
    Nilai_awal_str1, Nilai_awal_str2 : String;
    Tambahan : String;
    Hasil, Simpanan_STR : String;

FunCtion Strkeint(Str:String):integer;
begin
    if str='' Then
       result:=0 else
    begin
       try
          result:=strtoint(str);
       Except
          Result:=0;
       end;
    end;
end;

function MakeNDigit(myVal:String; myLen:byte):String;
var
  vlTempVal: String;
  vlCount, vlNewDigit: Byte;
begin
    vlNewDigit := 0;
    vlTempVal := myVal;
    if length(vlTempVal) >= myLen then
       result := vlTempVal
    else
    vlNewDigit := myLen-Length(vlTempVal);
    for vlCount := 1 to vlNewDigit do
        vlTempVal := '0'+vlTempVal;
    result := vlTempVal;
end;

Function Ceil_Gaji(Nilai_awal, Nilai_bulat : Integer) : Integer;
Begin
     Result := 0;
     Nilai_awal_str1 :=''; Nilai_awal_str2 := '';
     Nilai_awal_temp := Trunc(Nilai_awal);
     Nilai_awal_str1 := LeftStr(inttostr(Nilai_awal_temp),
                        length(inttostr(Nilai_awal_temp)) - length(inttostr(Nilai_bulat)));

     Nilai_awal_str2 := RightStr(inttostr(Nilai_awal_temp),
                        length(inttostr(Nilai_bulat)));

     Nilai_awal_temp1 := Strkeint(Nilai_awal_str1);
     Nilai_awal_temp2 := Strkeint(Nilai_awal_str2);

     Tambahan := MakeNDigit('', length(inttostr(Nilai_bulat)));

     if Nilai_awal_temp2 = 0 Then
     Begin
          hasil := Nilai_awal_str1 + (Tambahan);
          Result := Strkeint(hasil);
     End else
     if Nilai_awal_temp2 < Nilai_bulat Then
     Begin
          hasil := Nilai_awal_str1 + inttostr(Nilai_bulat);
          Result := Strkeint(hasil);
     End else
     if Nilai_awal_temp2 > Nilai_bulat Then
     Begin
          Simpanan_STR := Nilai_awal_str1 + (Tambahan);
          Simpanan := Strkeint(Simpanan_STR);
          Result := Simpanan + (Nilai_bulat + Nilai_bulat)
     End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit3.Text := inttostr(Ceil_Gaji(Strkeint(Edit1.text), Strkeint(Edit2.text)));
end;

Floor delphi untuk pembulatan gaji / Matematika / Windows / Delphi 7 - XE

FunCtion Strkeint(Str:String):integer;
begin
    if str='' Then
       result:=0 else
    begin
       try
          result:=strtoint(str);
       Except
          Result:=0;
       end;
    end;
end;

function MakeNDigit(myVal:String; myLen:byte):String;
var
  vlTempVal: String;
  vlCount, vlNewDigit: Byte;
begin
    vlNewDigit := 0;
    vlTempVal := myVal;
    if length(vlTempVal) >= myLen then
       result := vlTempVal
    else
    vlNewDigit := myLen-Length(vlTempVal);
    for vlCount := 1 to vlNewDigit do
        vlTempVal := '0'+vlTempVal;
    result := vlTempVal;
end;

Function Floor_Gaji(Nilai_awal, Nilai_bulat : Integer) : Integer;
Var Nilai_awal_temp, Nilai_awal_temp1, Nilai_awal_temp2 : Integer;
    Nilai_awal_str1, Nilai_awal_str2 : String;
    Tambahan : String;
    Hasil : String;
Begin
     Result := 0;
     Nilai_awal_str1 :=''; Nilai_awal_str2 := '';
     Nilai_awal_temp := Trunc(Nilai_awal);
     Nilai_awal_str1 := LeftStr(inttostr(Nilai_awal_temp),
                        length(inttostr(Nilai_awal_temp)) - length(inttostr(Nilai_bulat)));

     Nilai_awal_str2 := RightStr(inttostr(Nilai_awal_temp),
                        length(inttostr(Nilai_bulat)));

     Nilai_awal_temp1 := Strkeint(Nilai_awal_str1);
     Nilai_awal_temp2 := Strkeint(Nilai_awal_str2);
     Tambahan := MakeNDigit('', length(inttostr(Nilai_bulat)));

     if Nilai_awal_temp2 < Nilai_bulat Then
     Begin
          hasil := Nilai_awal_str1 + tambahan;
          Result := Strkeint(hasil);
     End;

     if Nilai_awal_temp2 >= Nilai_bulat Then
     Begin
          hasil := Nilai_awal_str1 + inttostr(Nilai_bulat);
          Result := Strkeint(hasil);
     End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit3.Text := inttostr(Floor_Rp(Strkeint(Edit1.text), Strkeint(Edit2.text)));
end;

Hapus file dan bisa dibatalkan kembali / Files / Windows / Delphi 7 - XE

uses ShellAPI;

function FileDeleteRB(FileName:string): boolean;
var
    fos : TSHFileOpStruct;
begin
    FillChar(fos, SizeOf(fos), 0);
    with fos do
    begin
        wFunc :=FO_DELETE;
        pFrom := PChar(FileName);
        fFlags := FOF_ALLOWUNDO
        or FOF_NOCONFIRMATION
        or FOF_SILENT;
    end;
    Result := (ShFileOperation(fos)=0);
end;

Menampilkan pencarian windows explorer / Windows / Windows / Delphi 7 - XE

uses ddeman;

procedure TForm1.Button1Click(Sender: TObject);
begin
    with TDDEClientConv.Create(Self) do
    begin
        ConnectMode := ddeManual;
        ServiceApplication := 'explorer.exe';
        SetLink('Folders','AppProperties');
        OpenLink;
        ExecuteMacro('[FindFolder(, C:\ DelphiTips)]', False);
        CloseLink;
        Free;
    end;
end;

Melihat isi file pada folder / Files / Windows / Delphi 7 - XE

procedure FindAll(const Path: String; Attr: Integer; List: TStrings);
var
    Res: TSearchRec;
    EOFound: Boolean;
begin
    EOFound:= False;
    if FindFirst(Path, Attr, Res) < 0 then
    exit else
    while not EOFound do
    begin
        List.Add(Res.Name);
        EOFound:= FindNext(Res) <> 0;
    end;
    FindClose(Res);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     FindAll('C:\Windows\*.*', faAnyFile, ListBox1.Items);
end;

Melihat tanggal date modified pada file / Files / Windows / Delphi 7 - XE

function FileLastModified(const TheFile: string): string;
var
    FileH :THandle;
    LocalFT :TFileTime;
    DosFT :DWORD;
    LastAccessedTime : TDateTime;
    FindData :TWin32FindData;
begin
    Result := '';
    FileH := FindFirstFile(PChar(TheFile), FindData);
    if FileH <> INVALID_HANDLE_VALUE then
    begin
          Windows.FindClose(Application.Handle);
          if (FindData.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
          begin
              FileTimeToLocalFileTime
              (FindData.ftLastWriteTime,LocalFT);
              FileTimeToDosDateTime
              (LocalFT,LongRec(DosFT).Hi,LongRec(DosFT).Lo);
              LastAccessedTime :=FileDateToDateTime(DosFT);
              Result := DateTimeToStr(LastAccessedTime);
          end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    label1.Caption := FileLastModified('c:\autoexec.bat');
end;

Hapus folder beserta folder didalamnya / Files / Windows / Delphi 7 - XE

uses ShellAPI;

Function DelTree(DirName : string):Boolean;
var
    SHFileOpStruct : TSHFileOpStruct;
    DirBuf : array[0..255]of char;
begin
    try
        Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0);
        FillChar(DirBuf, Sizeof(DirBuf), 0 );
        StrPCopy(DirBuf, DirName);
        with SHFileOpStruct do
        begin
            Wnd := 0;
            pFrom :=@DirBuf;
            wFunc :=FO_DELETE;
            fFlags := FOF_ALLOWUNDO;
            fFlags := fFlags or FOF_NOCONFIRMATION;
            fFlags := fFlags or FOF_SILENT;
        end;
        Result := (SHFileOperation(SHFileOpStruct) = 0);
    except
        Result := False;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    DelTree('C:\Temp');
end;

Tips dan Trik Delphi

Kategori