This source code for mp3 player
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MPlayer, ComCtrls, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
mp3: TMediaPlayer;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
ProgressBar1: TProgressBar;
Timer1: TTimer;
Timer2: TTimer;
Timer3: TTimer;
Timer4: TTimer;
Panel1: TPanel;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Image8: TImage;
Image9: TImage;
Image10: TImage;
BitBtn1: TBitBtn;
Image11: TImage;
ListBox1: TListBox;
Image13: TImage;
ComboBox1: TComboBox;
Image14: TImage;
Image15: TImage;
Image16: TImage;
Image17: TImage;
Image12: TImage;
Image21: TImage;
Image19: TImage;
Image20: TImage;
Image18: TImage;
Label1: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Image8Click(Sender: TObject);
procedure Image7Click(Sender: TObject);
procedure Image9Click(Sender: TObject);
procedure Image10Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure Image6Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Image18Click(Sender: TObject);
procedure Image19Click(Sender: TObject);
procedure Image21Click(Sender: TObject);
procedure Image20Click(Sender: TObject);
Private
public
procedure mp3next;
end;
var
Form1: TForm1;
implementation
uses ShellAPI, ShlObj, Math;
{$R *.dfm}
procedure FillMP3FileList(Folder: string; sl: TStrings);
var Rec : TSearchRec;
begin
if SysUtils.FindFirst(Folder + '*.mp3', faAnyFile, Rec) = 0 then
try
repeat
sl.Add(Rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
end;
function BrowseDialog(const Title: string; const Flag: integer): string;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:='';
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Title);
ulFlags := Flag;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
Result := IncludeTrailingBackslash(TempPath);
GlobalFreePtr(lpItemID);
end;
end;
procedure TForm1.mp3next;
var mp3File: string;
begin
if (ListBox1.Count<>0) and (ListBox1.ItemIndex<>-1) then
begin
if ListBox1.ItemIndex=ListBox1.Count-1 then
begin
ListBox1.ItemIndex:=0;
end else
if ListBox1.ItemIndex<>ListBox1.Count-1 then
begin
ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
end;
end else
if ListBox1.ItemIndex=-1 then
begin
ListBox1.ItemIndex:=0;
end;
mp3File := Concat(Edit1.Text, ListBox1.Items[ListBox1.ItemIndex]);
ProgressBar1.Max:=0;
mp3.FileName:=mp3File;
ListBox1.Selected[ListBox1.ItemIndex]:=true;
mp3.Open;
mp3.Play;
ProgressBar1.Max := mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var mp3File: string;
begin
if ProgressBar1.Max <> 0 then
ProgressBar1.Position:=mp3.Position;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text:= ExtractFilePath(Application.ExeName);
FillMP3FileList(Edit1.Text, ListBox1.Items);
ProgressBar1.Max:=100;
Image2.Enabled:=False;
Image3.Enabled:=False;
Image4.Enabled:=False;
Image1.Enabled:=False;
Image5.Enabled:=False;
Image7.Enabled:=False;
Timer2.Enabled:=false;
Timer3.Enabled:=false;
Timer4.Enabled:=false;
Image8.Visible:=False;
Image9.Visible:=False;
Image10.Visible:=False;
BitBtn1.Enabled:=False;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var mp3File: string;
begin
mp3File := Concat(Edit1.Text, ListBox1.Items.Strings[ListBox1.ItemIndex]);
mp3.FileName:=mp3File;
if ListBox1.ItemIndex <> 0 then
ListBox1.Selected[ListBox1.ItemIndex];
Image2.Enabled:=True;
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
ProgressBar1.Max:=0;
mp3.Open;
mp3.Play;
ProgressBar1.Max := mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
Image1.Enabled:=True;
Image5.Enabled:=True;
Image7.Enabled:=True;
Timer4.Enabled:=True;
BitBtn1.Enabled:=True;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var mp3File: string;
begin
if mp3.Position = mp3.TrackLength[1]
then begin
if (ListBox1.Count<>0) and (ListBox1.ItemIndex<>-1) then
begin
if ListBox1.ItemIndex=ListBox1.Count-1 then
begin
ListBox1.ItemIndex:=0;
end else
if ListBox1.ItemIndex<>ListBox1.Count-1 then
begin
ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
end;
end else
if ListBox1.ItemIndex=-1 then
begin
ListBox1.ItemIndex:=0;
end;
mp3File := Concat(Edit1.Text, ListBox1.Items[ListBox1.ItemIndex]);
ProgressBar1.Max:=0;
mp3.FileName:=mp3File;
ListBox1.Selected[ListBox1.ItemIndex]:=true;
mp3.Open;
mp3.Play;
ProgressBar1.Max := mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
end;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var mp3File: string;
begin
if mp3.Position = mp3.TrackLength[1] then
begin
mp3File := Concat(Edit1.Text, ListBox1.Items[ListBox1.ItemIndex]);
ProgressBar1.Max:=0;
mp3.FileName:=mp3File;
ListBox1.Selected[ListBox1.ItemIndex]:=true;
mp3.Open;
mp3.Play;
ProgressBar1.Max := mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
end;
end;
procedure TForm1.Timer4Timer(Sender: TObject);
begin
if mp3.Position = mp3.TrackLength[1] then
begin
Image7.Enabled:=False;
Image2.Enabled:=True;
Image3.Enabled:=False;
Image4.Enabled:=False;
Image5.Enabled:=False;
Image1.Enabled:=False;
end
else
if ListBox1.ItemIndex<>0 then
Timer4.Enabled:=False;
end;
procedure TForm1.Image3Click(Sender: TObject);
begin
Image8.Visible:=True;
Image3.Visible:=False;
mp3.Pause;
Image5.Enabled:=False;
Image1.Enabled:=False;
Image7.Enabled:=False;
end;
procedure TForm1.Image8Click(Sender: TObject);
begin
Image3.Visible:=True;
Image8.Visible:=false;
mp3.Play;
Image5.Enabled:=true;
Image1.Enabled:=true;
Image7.Enabled:=true;
end;
procedure TForm1.Image7Click(Sender: TObject);
begin
Image7.Visible:=False;
Image9.Visible:=True;
Timer4.Enabled:=false;
Timer2.Enabled:=True;
end;
procedure TForm1.Image9Click(Sender: TObject);
begin
Image9.Visible:=False;
Image10.Visible:=True;
Timer2.Enabled:=False;
Timer3.Enabled:=true;
end;
procedure TForm1.Image10Click(Sender: TObject);
begin
Image10.Visible:=False;
Image7.Visible:=True;
Timer3.Enabled:=False;
Timer4.Enabled:=true;
end;
procedure TForm1.Image2Click(Sender: TObject);
begin
ProgressBar1.Max:=0;
mp3.Open;
mp3.Play;
ProgressBar1.max:=mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
Image1.Enabled:=True;
Image5.Enabled:=True;
Image7.Enabled:=True;
Timer4.Enabled:=True;
BitBtn1.Enabled:=True;
end;
procedure TForm1.Image1Click(Sender: TObject);
var mp3File: string;
begin
if ListBox1.Count<>0 then
begin
if ListBox1.ItemIndex=0 then
begin
ListBox1.ItemIndex:=ListBox1.Count-1;
end else
if ListBox1.ItemIndex<>0 then
begin
ListBox1.ItemIndex:=ListBox1.ItemIndex-1;
end;
end;
if ListBox1.ItemIndex=-1 then
begin
ListBox1.ItemIndex:=0;
end;
mp3File := Concat(Edit1.Text, ListBox1.Items[ListBox1.ItemIndex]);
ProgressBar1.Max:=0;
mp3.FileName:=mp3File;
ListBox1.Selected[ListBox1.ItemIndex]:=true;
mp3.Open;
mp3.Play;
ProgressBar1.Max := mp3.Length;
Image2.Enabled:=False;
Image3.Enabled:=True;
Image4.Enabled:=True;
end;
procedure TForm1.Image4Click(Sender: TObject);
begin
mp3.Stop;
mp3.Open;
Image2.Enabled:=True;
Image3.Enabled:=False;
Image4.Enabled:=False;
Image5.Enabled:=False;
Image1.Enabled:=False;
Image7.Enabled:=False;
end;
procedure TForm1.Image5Click(Sender: TObject);
begin
mp3next;
end;
procedure TForm1.Image6Click(Sender: TObject);
var mp3Folder : string;
begin
mp3Folder := BrowseDialog('Choose a folder with mp3 files', BIF_RETURNONLYFSDIRS);
if mp3Folder = '' then Exit;
Edit1.Text := mp3Folder;
FillMP3FileList(mp3Folder, ListBox1.Items);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
ListBox1.Clear;
Image1.Enabled:=False;
Image5.Enabled:=False;
Image2.Enabled:=False;
Image3.Enabled:=False;
Image4.Enabled:=False;
Image7.Enabled:=False;
Timer2.Enabled:=False;
Timer3.Enabled:=False;
Timer4.Enabled:=true;
Image10.Visible:=False;
Image7.Visible:=True;
Image9.Visible:=False;
BitBtn1.Enabled:=False;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
if ComboBox1.ItemIndex=0 then
begin
Image11.Visible:=True;
Image12.Visible:=False;
Image13.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=False;
Image16.Visible:=False;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=1 then
begin
Image13.Visible:=True;
Image12.Visible:=False;
Image11.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=False;
Image16.Visible:=False;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=2 then
begin
Image13.Visible:=False;
Image12.Visible:=True;
Image11.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=False;
Image16.Visible:=False;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=3 then
begin
Image13.Visible:=False;
Image12.Visible:=False;
Image11.Visible:=False;
Image14.Visible:=True;
Image15.Visible:=False;
Image16.Visible:=False;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=4 then
begin
Image13.Visible:=False;
Image12.Visible:=False;
Image11.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=True;
Image16.Visible:=False;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=5 then
begin
Image13.Visible:=False;
Image12.Visible:=False;
Image11.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=False;
Image16.Visible:=True;
Image17.Visible:=False;
end
else
if ComboBox1.ItemIndex=6 then
begin
Image13.Visible:=False;
Image12.Visible:=False;
Image11.Visible:=False;
Image14.Visible:=False;
Image15.Visible:=False;
Image16.Visible:=False;
Image17.Visible:=True;
end
end;
procedure TForm1.Image18Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Image19Click(Sender: TObject);
begin
Form1.WindowState:=wsMaximized;
Image19.Visible:=False;
Image21.Visible:=True;
ComboBox1.Top:=40;
ComboBox1.Left:=64;
ComboBox1.Width:=73;
ComboBox1.Height:=21;
ProgressBar1.Top:=72;
ProgressBar1.Left:=64;
ProgressBar1.Width:=889;
ProgressBar1.Height:=17;
Edit1.Top:=96;
Edit1.Left:=64;
Edit1.Width:=889;
Edit1.Height:=17;
Panel1.Top:=128;
Panel1.Left:=64;
Panel1.Width:=185;
Panel1.Height:=17;
BitBtn1.Top:=128;
BitBtn1.Left:=254;
BitBtn1.Width:=75;
BitBtn1.Height:=17;
ListBox1.Top:=160;
ListBox1.Left:=64;
ListBox1.Width:=889;
ListBox1.Height:=550;
Image20.Top:=40;
Image20.Left:=880;
Image20.Width:=17;
Image20.Height:=17;
Image18.Top:=40;
Image18.Left:=928;
Image18.Width:=17;
Image18.Height:=17;
Image19.Top:=40;
Image19.Left:=904;
Image19.Width:=17;
Image19.Height:=17;
Image21.Top:=40;
Image21.Left:=904;
Image21.Width:=17;
Image21.Height:=17;
Label1.Top:=40;
Label1.Left:=184;
Label1.Width:=73;
Label1.Height:=16;
end;
procedure TForm1.Image21Click(Sender: TObject);
begin
Form1.WindowState:=wsNormal;
Image21.Visible:=False;
Image19.Visible:=True;
ComboBox1.Top:=16;
ComboBox1.Left:=24;
ComboBox1.Width:=73;
ComboBox1.Height:=21;
ProgressBar1.Top:=48;
ProgressBar1.Left:=24;
ProgressBar1.Width:=265;
ProgressBar1.Height:=17;
Edit1.Top:=72;
Edit1.Left:=24;
Edit1.Width:=265;
Edit1.Height:=17;
Panel1.Top:=96;
Panel1.Left:=24;
Panel1.Width:=185;
Panel1.Height:=17;
BitBtn1.Top:=96;
BitBtn1.Left:=214;
BitBtn1.Width:=75;
BitBtn1.Height:=17;
ListBox1.Top:=120;
ListBox1.Left:=24;
ListBox1.Width:=265;
ListBox1.Height:=153;
Image20.Top:=16;
Image20.Left:=224;
Image20.Width:=17;
Image20.Height:=17;
Image18.Top:=16;
Image18.Left:=272;
Image18.Width:=17;
Image18.Height:=17;
Image19.Top:=16;
Image19.Left:=248;
Image19.Width:=17;
Image19.Height:=17;
Image21.Top:=16;
Image21.Left:=248;
Image21.Width:=17;
Image21.Height:=17;
Label1.Top:=16;
Label1.Left:=112;
Label1.Width:=73;
Label1.Height:=16;
end;
procedure TForm1.Image20Click(Sender: TObject);
begin
Form1.WindowState:=wsMinimized;
end;
end.
Rabu, 03 September 2008
HOW TO MAKE APLICATION FOTO EDITOR AND IMAGE EDITOR WITH VISUALBASIC 6.0?
Open the visual basic, klik File and chose New Project, then you will see the dialogbox from New Project, klik Standard EXE and klik OK. Then change form to appear to like this image.
copy this code to visual basic
Private Down As Boolean
Private startX As Long
Private startY As Long
Private Sub about_Click()
MsgBox "Program ini dibuat berdasarkan referensi" & vbCrLf & _
"dari berbagai sumber di internet," & vbCrLf & _
"dan dimodifikasi oleh Aji dan as'ari..." & vbCrLf & _
"", vbInformation, " about this program"
End Sub
Private Sub cmdnew_Click()
new_Click
End Sub
Private Sub cmdopen_Click()
open_Click
End Sub
Private Sub cmdprint_Click()
printt_Click
End Sub
Private Sub cmdredo_Click()
redo_Click
End Sub
Private Sub cmdsave_Click()
save_Click
End Sub
Private Sub changecolor_Click()
'merubah warna
CommonDialog1.ShowColor
Picture1.ForeColor = CommonDialog1.Color
Picture1.FillColor = CommonDialog1.Color
End Sub
Private Sub chkAirBrush_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkPencil.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\SPRAY.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkErase_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
cursor = App.Path + "\gbr\erase.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkFill_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\FLOOD.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkPencil_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\Pencil.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub cmdundo_Click()
undo_Click
End Sub
Private Sub crsr_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
Picture1.MousePointer = 0
End Sub
Private Sub exit_Click()
Dim ma As String
If Paint.Caption = "Image" Then
End
Else
m = MsgBox("Save Image?", vbQuestion + vbYesNoCancel, "Save")
If m = vbYes Then
save_Click
Else
If m = vbNo Then
End
End If
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim m As String
If cmdsave.Enabled = True Then
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Else
If m = vbCancel Then
Cancel = -1
End If
End If
Exit Sub
End If
End Sub
Private Sub new_Click()
Dim m As String
If Paint.Caption = "Image" Then
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Paint.Caption = "Image - Image1"
Else
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
Else
If m = vbNo Then
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
End If
End If
End If
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
End Sub
Private Sub open_Click()
Dim m As String
If Paint.Caption = "Image" Then
op
Else
m = MsgBox("Simpan Image", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
op
Else
If m = vbNo Then
op
End If
End If
End If
If Picture1.Width > 14220 Or Picture1.Height > 10260 Then GoTo toobig
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
GoTo e
toobig:
ans = MsgBox("Image terlalu besar untuk di lihat.", vbInformation, "Memory Error")
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
e:
End Sub
Private Sub Picture1_Click()
If chkFill.Value = Checked Then
Picture1.BackColor = CommonDialog1.Color
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
startX = X
startY = Y
Call Oldpic
undo.Enabled = True
cmdundo.Enabled = True
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If chkPencil.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y)
Else
If chkAirBrush.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.PSet (X, Y)
Else
If chkErase.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y), vbWhite
End If
End If
End If
End If
startX = X
startY = Y
End Sub
Private Sub printt_Click()
CommonDialog2.ShowPrinter
End Sub
Private Sub redo_Click()
Call Oldpic
Picture1.Picture = RedoBox.Image
redo.Enabled = False
cmdredo.Enabled = False
End Sub
Private Sub save_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "Save Current Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.FileName
End Sub
Private Sub Text1_Change()
If Text1 = "" Then
Text1 = 1
ElseIf Text1 < 1 Then
Text1 = 1
End If
End Sub
Private Sub Timer1_Timer()
If Picture1.Visible = True Then
cmdsave.Enabled = True
cmdprint.Enabled = True
save.Enabled = True
printt.Enabled = True
Else
If Picture1.Visible = False Then
cmdsave.Enabled = False
cmdprint.Enabled = False
save.Enabled = False
printt.Enabled = False
End If
End If
End Sub
Private Sub toolbar_Click()
If toolbar.Checked = True Then toolbar.Checked = False: Toolbar1.Visible = False Else toolbar.Checked = True: Toolbar1.Visible = True
End Sub
Private Sub toolbox_Click()
If toolbox.Checked = True Then toolbox.Checked = False: Picture2.Visible = False Else toolbox.Checked = True: Picture2.Visible = True
End Sub
Sub op()
CommonDialog1.DialogTitle = "Open a Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowOpen
Set Picture1 = LoadPicture(CommonDialog1.FileName)
Paint.Caption = CommonDialog1.FileName
If Paint.Caption = "" Then
Picture1.Visible = False
Paint.Caption = "Image"
Else
Picture1.Visible = True
End If
End Sub
Private Sub undo_Click()
redo.Enabled = True
cmdredo.Enabled = True
RedoBox.Picture = Picture1.Image
Picture1.Picture = UndoPicBox(0).Image
For a = 1 To 4: UndoPicBox(a - 1).Picture = UndoPicBox(a).Image
Next a
End Sub
and add this code to make modul in visual basic
Public Function Oldpic()
Dim a
For a = 4 To 1 Step -1
Paint.UndoPicBox(a).Picture = Paint.UndoPicBox(a - 1).Image
Paint.UndoPicBox(a).Refresh
Next a
Paint.UndoPicBox(0).Picture = Paint.Picture1.Image
Paint.UndoPicBox(0).Refresh
End Function
copy this code to visual basic
Private Down As Boolean
Private startX As Long
Private startY As Long
Private Sub about_Click()
MsgBox "Program ini dibuat berdasarkan referensi" & vbCrLf & _
"dari berbagai sumber di internet," & vbCrLf & _
"dan dimodifikasi oleh Aji dan as'ari..." & vbCrLf & _
"", vbInformation, " about this program"
End Sub
Private Sub cmdnew_Click()
new_Click
End Sub
Private Sub cmdopen_Click()
open_Click
End Sub
Private Sub cmdprint_Click()
printt_Click
End Sub
Private Sub cmdredo_Click()
redo_Click
End Sub
Private Sub cmdsave_Click()
save_Click
End Sub
Private Sub changecolor_Click()
'merubah warna
CommonDialog1.ShowColor
Picture1.ForeColor = CommonDialog1.Color
Picture1.FillColor = CommonDialog1.Color
End Sub
Private Sub chkAirBrush_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkPencil.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\SPRAY.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkErase_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
cursor = App.Path + "\gbr\erase.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkFill_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\FLOOD.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub chkPencil_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
cursor = App.Path + "\gbr\Pencil.ico": Picture1.MousePointer = 99: Picture1.MouseIcon = LoadPicture(cursor)
End Sub
Private Sub cmdundo_Click()
undo_Click
End Sub
Private Sub crsr_Click()
chkPencil.Value = 0
chkAirBrush.Value = 0
chkFill.Value = 0
chkErase.Value = 0
Picture1.MousePointer = 0
End Sub
Private Sub exit_Click()
Dim ma As String
If Paint.Caption = "Image" Then
End
Else
m = MsgBox("Save Image?", vbQuestion + vbYesNoCancel, "Save")
If m = vbYes Then
save_Click
Else
If m = vbNo Then
End
End If
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim m As String
If cmdsave.Enabled = True Then
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Else
If m = vbCancel Then
Cancel = -1
End If
End If
Exit Sub
End If
End Sub
Private Sub new_Click()
Dim m As String
If Paint.Caption = "Image" Then
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Paint.Caption = "Image - Image1"
Else
m = MsgBox("Simpan Image?", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
Else
If m = vbNo Then
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
End If
End If
End If
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
End Sub
Private Sub open_Click()
Dim m As String
If Paint.Caption = "Image" Then
op
Else
m = MsgBox("Simpan Image", vbQuestion + vbYesNoCancel, "Simpan")
If m = vbYes Then
save_Click
op
Else
If m = vbNo Then
op
End If
End If
End If
If Picture1.Width > 14220 Or Picture1.Height > 10260 Then GoTo toobig
UndoPicBox(0).Picture = Picture1.Image
UndoPicBox(1).Picture = Picture1.Image
UndoPicBox(2).Picture = Picture1.Image
UndoPicBox(3).Picture = Picture1.Image
UndoPicBox(4).Picture = Picture1.Image
GoTo e
toobig:
ans = MsgBox("Image terlalu besar untuk di lihat.", vbInformation, "Memory Error")
Picture1.Visible = True
Picture1.Picture = LoadPicture()
Picture1.Height = 6060
Picture1.Width = 9660
Paint.Caption = "Image - Image1"
e:
End Sub
Private Sub Picture1_Click()
If chkFill.Value = Checked Then
Picture1.BackColor = CommonDialog1.Color
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
startX = X
startY = Y
Call Oldpic
undo.Enabled = True
cmdundo.Enabled = True
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If chkPencil.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y)
Else
If chkAirBrush.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.PSet (X, Y)
Else
If chkErase.Value = Checked Then
Picture1.DrawWidth = Text1.Text
Picture1.Line (startX, startY)-(X, Y), vbWhite
End If
End If
End If
End If
startX = X
startY = Y
End Sub
Private Sub printt_Click()
CommonDialog2.ShowPrinter
End Sub
Private Sub redo_Click()
Call Oldpic
Picture1.Picture = RedoBox.Image
redo.Enabled = False
cmdredo.Enabled = False
End Sub
Private Sub save_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "Save Current Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.FileName
End Sub
Private Sub Text1_Change()
If Text1 = "" Then
Text1 = 1
ElseIf Text1 < 1 Then
Text1 = 1
End If
End Sub
Private Sub Timer1_Timer()
If Picture1.Visible = True Then
cmdsave.Enabled = True
cmdprint.Enabled = True
save.Enabled = True
printt.Enabled = True
Else
If Picture1.Visible = False Then
cmdsave.Enabled = False
cmdprint.Enabled = False
save.Enabled = False
printt.Enabled = False
End If
End If
End Sub
Private Sub toolbar_Click()
If toolbar.Checked = True Then toolbar.Checked = False: Toolbar1.Visible = False Else toolbar.Checked = True: Toolbar1.Visible = True
End Sub
Private Sub toolbox_Click()
If toolbox.Checked = True Then toolbox.Checked = False: Picture2.Visible = False Else toolbox.Checked = True: Picture2.Visible = True
End Sub
Sub op()
CommonDialog1.DialogTitle = "Open a Picture File"
CommonDialog1.Filter = "JPEG Files (*.JPG)|*.JPG|Bitmap Picture (*.BMP)|*.BMP|"
CommonDialog1.ShowOpen
Set Picture1 = LoadPicture(CommonDialog1.FileName)
Paint.Caption = CommonDialog1.FileName
If Paint.Caption = "" Then
Picture1.Visible = False
Paint.Caption = "Image"
Else
Picture1.Visible = True
End If
End Sub
Private Sub undo_Click()
redo.Enabled = True
cmdredo.Enabled = True
RedoBox.Picture = Picture1.Image
Picture1.Picture = UndoPicBox(0).Image
For a = 1 To 4: UndoPicBox(a - 1).Picture = UndoPicBox(a).Image
Next a
End Sub
and add this code to make modul in visual basic
Public Function Oldpic()
Dim a
For a = 4 To 1 Step -1
Paint.UndoPicBox(a).Picture = Paint.UndoPicBox(a - 1).Image
Paint.UndoPicBox(a).Refresh
Next a
Paint.UndoPicBox(0).Picture = Paint.Picture1.Image
Paint.UndoPicBox(0).Refresh
End Function
Langganan:
Postingan (Atom)