Friday, May 13, 2011

Membuat Internet Browser


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Unit2, Unit3, ExtCtrls, ComCtrls, Sockets;

type
  TForm1 = class(TForm)
    MM: TMainMenu;
    File1: TMenuItem;
    NewTab1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    SB: TStatusBar;
    Timer1: TTimer;
    TC: TTcpClient;
    procedure NewTab1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.NewTab1Click(Sender: TObject);
begin
   TForm2.Create(Self);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Application.Title := 'ZS Browser';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'Bookmarks') then
   CreateDir(ExtractFilePath(Application.ExeName)+'Bookmarks');
   EB;
   EM;
   EF;
   ET;
   SB.Panels[2].Text := TC.LocalHostAddr;
   SB.Panels[3].Text := TC.LocalHostName;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   SB.Panels[0].Text := DateToStr(Date);
   SB.Panels[1].Text := TimeToStr(Time);
end;

end.

//---------------------------------------------------------------------->

{ Created By : Zephio
  URL :    http://amateur-guide.blogspot.com}
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, OleCtrls, SHDocVw, StdActns, ActnList, ExtCtrls, StdCtrls,
  ComCtrls, Buttons, FileCtrl, ShellApi;

type
  TForm2 = class(TForm)
    WB: TWebBrowser;
    MM: TMainMenu;
    File1: TMenuItem;
    NewTab1: TMenuItem;
    Close1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    AL: TActionList;
    WindowClose1: TWindowClose;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowArrange1: TWindowArrange;
    Windows1: TMenuItem;
    ile1: TMenuItem;
    Cascade1: TMenuItem;
    Arrange1: TMenuItem;
    MinimizeAll1: TMenuItem;
    ile21: TMenuItem;
    PIU: TPanel;
    CB: TComboBox;
    OnEnterUrl1: TAction;
    PBM: TPanel;
    SpeedButton1: TSpeedButton;
    PHBM: TPanel;
    PHBC: TPanel;
    Bookmarks1: TMenuItem;
    N2: TMenuItem;
    PAB: TPanel;
    FLB: TFileListBox;
    EAT: TEdit;
    EAU: TEdit;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Panel1: TPanel;
    Panel2: TPanel;
    LH: TListBox;
    Panel4: TPanel;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Panel3: TPanel;
    Panel5: TPanel;
    EGS: TEdit;
    SpeedButton7: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    View1: TMenuItem;
    Back1: TMenuItem;
    Forward1: TMenuItem;
    Reload1: TMenuItem;
    N3: TMenuItem;
    Stop1: TMenuItem;
    Info1: TMenuItem;
    Contact1: TMenuItem;
    Web1: TMenuItem;
    About1: TMenuItem;
    N4: TMenuItem;
    Open1: TMenuItem;
    OD: TOpenDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NewTab1Click(Sender: TObject);
    procedure OnEnterUrl1Execute(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure PHBMMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PIUMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LBMMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PHBCMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Bookmarks1Click(Sender: TObject);
    procedure PHBCClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FLBDblClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FLBClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure EATClick(Sender: TObject);
    procedure EAUClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure LHDblClick(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure EGSClick(Sender: TObject);
    procedure WBStatusTextChange(Sender: TObject; const Text: WideString);
    procedure WBTitleChange(Sender: TObject; const Text: WideString);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure LHClick(Sender: TObject);
    procedure Back1Click(Sender: TObject);
    procedure Forward1Click(Sender: TObject);
    procedure Reload1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Contact1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Web1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure EUS(Sender: TObject);
    procedure EHS(Sender: TObject);
  end;

var
  Form2: TForm2;

implementation




uses Unit1;

{$R *.dfm}

procedure TForm2.EHS(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('http://amateur-guide.blogspot.com');
   SL.Add('http://myspace.com/zephio');
   SL.Add('http://facebook.com/zephio85');
   SL.Add('http://twitter.com/zephio');
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'History') then
   CreateDir(ExtractFilePath(Application.ExeName)+'History');
if not FileExists(ExtractFilePath(Application.ExeName)+'History\Log.his') then
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   SL.Free;
end;

procedure TForm2.EUS(Sender: TObject);
begin
if CB.Text = '' then
   Exit
else
   WB.Navigate(CB.Text);
   EHS(Self);
   CB.Items.Add(CB.Text);
   CB.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Clear;
   LH.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := CaFree;
end;

procedure TForm2.NewTab1Click(Sender: TObject);
begin
   Form1.NewTab1Click(Self);
end;

procedure TForm2.OnEnterUrl1Execute(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.PHBMMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PHBC.Font.Color := ClBlack;
end;

procedure TForm2.PIUMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PAB.Font.Color := ClBlack;
end;

procedure TForm2.LBMMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PIU.Font.Color := ClBlack;
end;

procedure TForm2.PHBCMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PHBC.Font.Color := ClRed;
end;

procedure TForm2.Bookmarks1Click(Sender: TObject);
begin
   PBM.Visible := not PBM.Visible;
   Bookmarks1.Checked := not Bookmarks1.Checked;
end;

procedure TForm2.PHBCClick(Sender: TObject);
begin
   Bookmarks1Click(Self);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
   EHS(Self);
   CB.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FLBDblClick(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
if not FileExists(ExtractFilePath(Application.ExeName)+'Bookmarks\'+FLB.Items[FLB.ItemIndex]) then
   Exit;
   SL.LoadFromFile(FLB.Items[FLB.ItemIndex]);
   CB.Text := Copy(SL.Strings[1], 5, Length(SL.Strings[1]));
   EUS(Self);
   SL.Free;
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FLBClick(Sender: TObject);
begin
   FLB.Hint := 'Visit '+ChangeFileExt(FLB.Items[FLB.ItemIndex],'');
end;

procedure TForm2.SpeedButton2Click(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
if (EAU.Text = '') or
   (EAU.Text = 'Enter URL Here') then
   Exit
else
   SL.Add('[InternetShortcut]');
   SL.Add('URL='+EAU.Text);
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\'+EAT.Text+'.url');
   SL.Free;
   EAT.Text := 'Untitled';
   EAT.Font.Color := ClGray;
   EAU.Text := 'Enter URL Here';
   EAU.Font.Color := ClGray;
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
end;

procedure TForm2.EATClick(Sender: TObject);
begin
if EAT.Text <> 'Untitled' then
   Exit
else
   EAT.Clear;
   EAT.Font.Color := CLBlack;
end;

procedure TForm2.EAUClick(Sender: TObject);
begin
if EAU.Text <> 'Enter URL Here' then
   Exit
else
   EAU.Clear;
   EAU.Font.Color := CLBlack;
end;

procedure TForm2.SpeedButton3Click(Sender: TObject);
begin
if {(FLB.Selected[FLB.ItemIndex] = false) or }
   (FLB.Count = 0) then
   Exit
else
   DeleteFile(ExtractFilePath(Application.ExeName)+'BookMarks\'+FLB.Items[FLB.ItemIndex]);
if FLB.ItemIndex >= 0 then
     FLB.Items.Delete(FLB.ItemIndex);
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
end;

procedure TForm2.SpeedButton4Click(Sender: TObject);
begin
if LH.ItemIndex >= 0 then
     LH.Items.Delete(LH.ItemIndex);
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.SpeedButton5Click(Sender: TObject);
var
   S : String;
begin
   S := Copy(CB.Text, 0, Length(CB.Text));
   LH.Clear;
   CB.Clear;
   DeleteFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   CB.Text := S;
end;

procedure TForm2.LHDblClick(Sender: TObject);
begin
if LH.Count = 0 then
   Exit
else
   CB.Text := LH.Items[LH.ItemIndex];
   EUS(Self);
end;

procedure TForm2.SpeedButton7Click(Sender: TObject);
begin
if (EGS.Text = '') or
   (EGS.Text = 'Google Search Engine') then
   Exit
else
   CB.Text := 'http://www.google.com/search?q='+EGS.Text+'&num=10&ie=utf-8';
   EUS(Self);
end;

procedure TForm2.EGSClick(Sender: TObject);
begin
if EGS.Text <> 'Google Search Engine' then
   Exit
else
   EGS.Clear;
   EGS.Font.Color := CLBlack;
end;

procedure TForm2.WBStatusTextChange(Sender: TObject;
  const Text: WideString);
begin
   Form1.SB.Panels[4].Text := WB.LocationURL;
end;

procedure TForm2.WBTitleChange(Sender: TObject; const Text: WideString);
begin
   Caption := WB.LocationName;
end;

procedure TForm2.SpeedButton6Click(Sender: TObject);
begin
    WB.GoBack;
end;

procedure TForm2.SpeedButton8Click(Sender: TObject);
begin
   WB.GoForward;
end;

procedure TForm2.SpeedButton9Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.SpeedButton10Click(Sender: TObject);
begin
   WB.Stop;
end;

procedure TForm2.LHClick(Sender: TObject);
begin
   LH.Hint := LH.Items[LH.ItemIndex];
end;

procedure TForm2.Back1Click(Sender: TObject);
begin
   WB.GoBack;
end;

procedure TForm2.Forward1Click(Sender: TObject);
begin
   WB.GoForward;
end;

procedure TForm2.Reload1Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.Stop1Click(Sender: TObject);
begin
   WB.Stop;
end;

procedure TForm2.Contact1Click(Sender: TObject);
begin
   ShellExecute(0,'open','mailto:zephio@myspace.com?subject=Hi, Zephio...','','',SW_SHOW);
end;

procedure TForm2.About1Click(Sender: TObject);
begin
   ShowMessage('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'+#13+
               'Apps Name : ZS Browser'+#13+
               'Apps Type : Internet Browser'+#13+
               'Platform : Win XP'+#13+
               'Created By : Zephio'+#13+
               'URL : http://amateur-guide.blogspot.com'+#13+
               '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
end;

procedure TForm2.Web1Click(Sender: TObject);
begin
   WB.Navigate('http://amateur-guide.blogspot.com');
end;

procedure TForm2.Open1Click(Sender: TObject);
begin
if not OD.Execute then
   Exit;
   CB.Text := OD.FileName;
   EUS(Self);
end;

procedure TForm2.Exit1Click(Sender: TObject);
begin
   Application.Terminate;
end;

end.


//---------------------------------------------------------------------->

unit Unit3;

interface


uses
   Forms, SysUtils, Classes;

procedure EB;
procedure EM;
procedure EF;
procedure ET;


implementation

procedure EB;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://amateur-guide.blogspot.com');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Blog Spot.url');
   SL.Free;
end;

procedure EM;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://myspace.com/zephio');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\My Space.url');
   SL.Free;
end;

procedure EF;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://facebook.com/zephio85');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Face Book.url');
   SL.Free;
end;

procedure ET;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://twitter.com/zephio');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Twitter.url');
   SL.Free;
end;

end.
DL SC : http://www.mediafire.com/?c859v61ajfksj5e
Posted by at No comments:
Labels:

Membuat Shortcut Internet

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    SD: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ESF(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ESF(Sender: TObject);
var
   SL : TStringList;
begin
   SD.DefaultExt := '*.url';
   SD.Filter := 'Internet Shorcut|*.url';
if not SD.Execute then
   exit;
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL='+Edit1.Text);
   SL.SaveToFile(SD.FileName);
   SL.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Edit1.Text := 'http://amateur-guide.blogspot.com';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ESF(Self);
end;

end.

Posted by at No comments:
Labels:

Saturday, May 7, 2011

Membuat Kamus/Dictionary

By : Zephio
//Bagian Data
unit Data;

interface

Uses
   IniFiles, SysUtils, Forms;

procedure Translate;

var
   Ini : TIniFile;

implementation

procedure Translate;
begin
try
   Ini := TIniFile.Create(ChangeFileExt(Application.ExeName,'.zsd'));
// Jawa - Indonesia
   Ini.WriteString('Zephio Soft - 2010', 'Koen', 'Kamu, Anda');
   Ini.WriteString('Zephio Soft - 2010', 'Aku', 'Saya, Aku');
// Indonesia - Jawa
   Ini.WriteString('Zephio Soft - 2010', 'Saya', 'Aku, Awakku');
   Ini.WriteString('Zephio Soft - 2010', 'Kamu', 'Koen, Kowe, Awakmu, Sampeyan');
 finally
   Ini.Free;
 end;
end;

end.
 
 
//Engine
unit Engine;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, IniFiles, Data;

type
  TForm1 = class(TForm)
    E1: TEdit;
    M1: TMemo;
    B1: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    E3: TEdit;
    E4: TEdit;
    Label3: TLabel;
    B2: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure B2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Ini : TIniFile;
 
implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
if not FileExists(ChangeFileExt(ExtractFileName(Application.ExeName),'.zsd')) then
   Translate;
end;

procedure TForm1.B1Click(Sender: TObject);
begin
if (E1.Text = '') then
   ShowMessage('Input Masih Kosong'+#13#10+'Silahkan Isi Kata yang hendak ditranslate!....')
else
try
   Ini := TIniFile.Create(ChangeFileExt(Application.ExeName,'.zsd'));
   M1.Lines.Text := Ini.ReadString('Zephio Soft - 2010', E1.Text, '');
 finally
   Ini.Free;
 end;
end;

procedure TForm1.B2Click(Sender: TObject);
begin
if (E3.Text = '') or
   (E4.Text = '') then
begin
   ShowMessage('Input Masih Kosong'+#13#10+'Silahkan Isi Kata yang hendak ditambahkan');
   Exit
end
else
   Ini := TIniFile.Create(ChangeFileExt(Application.ExeName,'.zsd'));
   Ini.WriteString('Zephio Soft - 2010', E3.Text, E4.Text);
   Ini.Free;
end;

end.
DL SC : http://www.mediafire.com/?b1r6ggpp77pba2p
Posted by at No comments:
Labels:

Extract File Name

//Extract File Name
//By : Zephio
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls;

type
  TForm1 = class(TForm)
    E1: TEdit;
    E2: TEdit;
    E3: TEdit;
    E4: TEdit;
    B1: TSpeedButton;
    OD: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    E5: TEdit;
    Label5: TLabel;
    E6: TEdit;
    Label6: TLabel;
    E7: TEdit;
    Label7: TLabel;
    E8: TEdit;
    E9: TEdit;
    E10: TEdit;
    E11: TEdit;
    procedure B1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.B1Click(Sender: TObject);
begin
if OD.Execute then
begin
   E1.Text := OD.FileName;
   E2.Text := ExtractFileName(E1.Text);
   E3.Text := ExpandFileName(E2.Text);
//------------------------------------------------------------------------------>
   E4.Text := ExtractFileName(ExtractFileExt(E1.Text));
//or
   E11.Text := LowerCase(ExtractFileExt(OD.FileName));
//------------------------------------------------------------------------------>
   E5.Text := ChangeFileExt(ExtractFileName(OD.FileName),'');
   E6.Text := ExtractFileDrive(OD.FileName);
   E7.Text := ExtractFilePath(OD.FileName);
   E8.Text := ExtractFileDir(OD.FileName);
   E9.Text := ExtractFileDir(ExtractFileDir(OD.FileName));
   E10.Text := ExtractShortPathName(OD.FileName);
end;
end;
end.
Posted by at No comments:
Labels:

Windows System Menu

//Windows System menu
//By : Zephio
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//Minimize 1
procedure TForm1.Button1Click(Sender: TObject);
begin
   Form1.Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

//Minimize 2
procedure TForm1.Button2Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_Minimize, 1);
end;

//Minimize 3
procedure TForm1.Button3Click(Sender: TObject);
begin
  Application.Minimize;
end;

//Restore 1
procedure TForm1.Button4Click(Sender: TObject);
begin
   Application.Restore;
end;

//Restore 2
procedure TForm1.Button5Click(Sender: TObject);
begin
   Form1.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
end;

//Restore 3
procedure TForm1.Button6Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 1);
end;

//Maximize 1
procedure TForm1.Button7Click(Sender: TObject);
begin
  Form1.Perform(WM_SYSCOMMAND, SC_ZOOM, 0);
end;

//Maximize 2
procedure TForm1.Button8Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_ZOOM, 1);
end;

//Maximize 3
procedure TForm1.Button9Click(Sender: TObject);
begin
   Form1.Perform(WM_SYSCOMMAND, SC_MAXIMIZE, 0);
//or:  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1);
end;

//Close 1
procedure TForm1.Button10Click(Sender: TObject);
begin
  Close;
//Atau gaya BCB: Close();
end;

//Close 2
procedure TForm1.Button11Click(Sender: TObject);
begin
   Application.Terminate;
end;

//Close 3
procedure TForm1.Button12Click(Sender: TObject);
begin
   Form1.Perform(WM_SYSCOMMAND, SC_CLOSE, 0);
end;

//Close 4
procedure TForm1.Button13Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_CLOSE, 1);
end;

//Klik Start menu
procedure TForm1.Button14Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_TASKLIST, 1);
end;

//Sembunyikan Apps pada Task Bar
procedure TForm1.Button15Click(Sender: TObject);
begin
   ShowWindow(Application.Handle, SW_HIDE);
end;

//Tampilkan Apps pada Task Bar
procedure TForm1.Button16Click(Sender: TObject);
begin
   ShowWindow(Application.Handle, SW_SHOWNORMAL);
end;

//ScreenSaver Mode
procedure TForm1.Button17Click(Sender: TObject);
begin
   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);
end;

end.
Posted by at No comments:
Labels:

Executed DLL

//Bagian Executed DLL
// By : Zephio
// Untuk Membuat DLL, Klik Main Menu : File -> New -> Other...-> DLL Wizard.

library ZS;

uses
  SysUtils,
  Windows,
  ShellApi;

{$R *.res}

procedure EA;
var
   MsgText, MsgCaption : String;
   MsgType, UserResp : integer;
begin
   MsgCaption := '.About :.';
   MsgText := MsgText + 'Created By : Zephio' +#13#10;
   MsgText := MsgText + 'URL :http://amateur-guide.blogspot.com';
   MsgType := MB_OK + MB_ICONINFORMATION + MB_DEFBUTTON1 + MB_APPLMODAL;
   UserResp := MessageBox( 0, PChar(MsgText), PChar(MsgCaption), MsgType);
end;

procedure EE;
begin
   ShellExecute(0,'open','mailto:zephio@myspace.com?subject=Hi, Zephio...','','',SW_SHOW);
end;

procedure EF;
begin
   ShellExecute(0,'open','C:\WINDOWS\system32\cmd.exe',nil,nil,SW_SHOW);
end;



procedure EU;
begin
   ShellExecute(0,'open','http://amateur-guide.blogspot.com',nil,nil,SW_SHOW);
end;

exports EF, EE, EU, EA;
begin
end.

//Bagian Form

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  procedure EF; external 'ZS.dll';
  procedure EA; external 'ZS.dll';
  procedure EE; external 'ZS.dll';
  procedure EU; external 'ZS.dll';
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   Button1.Caption := 'Contact';
   Button2.Caption := 'URL';
   Button3.Caption := 'Open CMD';
   Button4.Caption := 'About';
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
   EU;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   EF;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   EA;
end;

end.
Posted by at No comments:
Labels:

Membuat Playlist Dengan Delphi

//Membuat Play List dengan Delphi
{
Created By : Zephio
Contact :  zephio@myspace.com
URL : http://amateur-guide.blogspot.com
Copyright © 2011, Zephio.
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MPlayer;

type
  TForm1 = class(TForm)
  //Component yg digunakan------------------------------------------------------>
    ListBox1: TListBox;
    Button1: TButton;
    OD: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    SD: TSaveDialog;
    MP: TMediaPlayer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    //Export To Playlist-------------------------------------------------------->
    function ETPL(S : String) : String;
    { Public declarations }
  end;

var
  Form1: TForm1;
Const
   //Default Title
   DS : String = 'ZS-Play List v1.0';
implementation

{$R *.dfm}

//Export To Playlist------------------------------------------------------------>
function TForm1.ETPL(S : String) : String;
var
   I : Integer;
   SL : TStringList; //Temporary String----------------------------------------->
begin
   SL := TStringList.Create;
   SL.Add('<Head>');
   Sl.Add('<Author>Zephio</Author>');
   SL.Add('<Title>Zephio Soft Play List v1.0</Title>');
   SL.Add(' <Body>');
   SL.Add('  <Total>'+IntToHex(ListBox1.Count, 4)+'</Total>');
for I := 0 to ListBox1.Count  - 1 do
   SL.Add('   <Path="'+ListBox1.Items[I]+'"/>');
   SL.Add(' </body>');
   SL.Add('</Head>');
   SL.SaveToFile(S);
   SL.Free;
end;

//Load Playlist----------------------------------------------------------------->
procedure TForm1.Button1Click(Sender: TObject);
const
   AB : array[0..6] of Char='<Path="';// array 0 - 6 of char = 7---------------->
   AE : array[0..2] of Char='"/>';// array 0 - 2 of char = 3-------------------->
var
   I : Integer;
   SL : TStringList;
begin
   OD.DefaultExt := '*.zs';
   OD.Filter := 'ZS Files|*.zs';
   SL := TStringList.Create;
if not OD.Execute then
   Exit;
   ListBox1.Clear;
   SL.LoadFromFile(OD.FileName);
//Jika tidak ditemukan kata dibawah ini dalam playlist,
// maka applikasi akan menolak playlist tsb
if (SL.Strings[0] <> '<Head>') and
   (SL.Strings[1] <> '<Author>Zephio</Author>') and
   (SL.Strings[2] <> '<Title>Zephio Soft Play List v1.0</Title>') and
   (SL.Strings[3] <> ' <Body>') then
   Exit
else
   Caption := DS+' - [ '+Copy(SL.Strings[1], 9, Length(SL.Strings[1]) - 17)+' ]'+' '+IntToStr(Length(AB))+' '+IntToStr(Length(AE));
{
I = 5 trhitung dari:
1. <Head>
2. <Author>Zephio</Author>
3. <Title>Zephio Soft Play List v1.0</Title>
4. <Body>
5. mengambil Path yg pertama
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SL.Count - 3 = Total Baris pd playlist tsb dikurangi
3. </body>
2. </Head>
1. '' dari I = 0 - Total Baris
}
for I := 5 to SL.Count - 3 do
   ListBox1.Items.Add(Copy(SL.Strings[I], 11, Length(SL.Strings[I]) - 13));
   SL.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   I : Integer;
begin
   OD.DefaultExt := '*.mp3';
   OD.Filter := 'MP3 Files|*.mp3';
if not OD.Execute then
   Exit;
   ListBox1.Clear;
//I = 0 - Total File pada Open Dialog------------------------------------------->
// atau juga for I := 1 to Total File pada Open Dialog-------------------------->
for I := 0 to OD.Files.Count - 1 do
   ListBox1.Items.Add(OD.Files[I]);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if not SD.Execute then
   Exit;
//Export Playlist dari Temporay ke File----------------------------------------->
   ETPL(SD.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Caption := 'ZS-2011';
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
   MP.FileName := ListBox1.Items[ListBox1.ItemIndex];
   MP.Open;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   Caption := DS;
   Application.Title := DS;
end;

end.

{ untuk versi Console Apps cuma load playlist'e saja }

program ZS;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

const
   AB : array[0..6] of Char='<Path="';
   AE : array[0..2] of Char='"/>';
var
   I : Integer;
   SL : TStringList;
begin
   SL := TStringList.Create;
if not FileExists('ZS.zs') then
   Exit
else
   SL.LoadFromFile('ZS.zs');//Nama file'e
if (SL.Strings[0] <> '<Head>') and
   (SL.Strings[1] <> '<Author>Zephio</Author>') and
   (SL.Strings[2] <> '<Title>Zephio Soft Play List v1.0</Title>') and
   (SL.Strings[3] <> ' <Body>') then
   Exit
else
   WriteLn('Author : '+Copy(SL.Strings[1], 9, Length(SL.Strings[1]) - 17));
   WriteLn('Title  : '+Copy(SL.Strings[2], 8, Length(SL.Strings[2]) - 15));
   WriteLn('=========================================================================');
for I := 5 to SL.Count - 3 do
   WriteLn(Copy(SL.Strings[I], 11, Length(SL.Strings[I]) - 13));
While true do
   Sleep(1000);
   SL.Free;
end.


Download Source Code : Link
MH : Media Fire
FS : 259KB

Posted by at 5 comments:
Labels:
Subscribe to: Posts (Atom)