This tool works great for converting pictures or clipboard objects to pictures It supports JPEG Bitmap Icons and Metafiles. It can draw directly to the screen or default printer. Very simple and easy to do. Great for photographers
!
To see how to use it just unzip the .DLL file and .exe file to a folder and
type imgconvert.exe to see the help page
unit imgconvert1;
interface
uses windows,classes,graphics,sysutils,jpeg,clipbrd,printers,controls,scanimg,
mmsystem;
function delphianMain(parameters:tstringlist):DWORD;
type
EOutFileType=class(Exception);
{$RESOURCE IMGCONVERT32.RES}
implementation
procedure ScreenShot(Bild: TBitMap);
var
c: TCanvas;
r,desk: TRect;
begin
c := TCanvas.Create;
getwindowrect(getdesktopwindow,desk);
c.Handle := GetWindowDC(GetDesktopWindow);
try
r := Rect(0, 0,desk.right, desk.bottom);
Bild.Width := desk.right;
Bild.Height := desk.bottom;
Bild.Canvas.CopyRect(r, c, r);
finally
ReleaseDC(0, c.Handle);
c.Free;
end;
end;
procedure ScreenShotActiveWindow(Bild: TBitMap);
var
c: TCanvas;
r, t: TRect;
h: THandle;
begin
c := TCanvas.Create;
c.Handle := GetWindowDC(GetDesktopWindow);
h := GetForeGroundWindow;
if h <> 0 then
GetWindowRect(h, t);
try
r := Rect(0, 0, t.Right - t.Left, t.Bottom - t.Top);
Bild.Width := t.Right - t.Left;
Bild.Height := t.Bottom - t.Top;
Bild.Canvas.CopyRect(r, c, t);
finally
ReleaseDC(0, c.Handle);
c.Free;
end;
end;
function GetConsoleWindow:hwnd;stdcall;external'kernel32.dll';
procedure screenshotfrommouse(bild:tbitmap);
var mouse:tpoint;
c: TCanvas;
r, t: TRect;
h: THandle;
begin
c := TCanvas.Create;
playsound('SNAP',HInstance,snd_resource or snd_sync);
getcursorpos(mouse);
c.Handle := GetWindowDC(GetDesktopWindow);
h := windowfrompoint(mouse);
if h <> 0 then
GetWindowRect(h, t);
try
r := Rect(0, 0, t.Right - t.Left, t.Bottom - t.Top);
Bild.Width := t.Right - t.Left;
Bild.Height := t.Bottom - t.Top;
Bild.Canvas.CopyRect(r, c, t);
finally
ReleaseDC(0, c.Handle);
c.Free;
end;
end;
function ReadScanner:tbitmap;
begin
result:=tbitmap.Create;
TWAIN_SelectImageSource(getconsolewindow);
if (TWAIN_LoadSourceManager >0) Then
Begin
if (TWAIN_AcquireToClipboard(getconsolewindow,TWAIN_ANYTYPE)>0)
Then
result.LoadFromClipboardFormat(
cf_BitMap,
ClipBoard.GetAsHandle(cf_Bitmap),
0
);
ClipBoard.Clear;
TWAIN_UnLoadSourceManager;
End;
end;
function GetGIFFile(filename:PChar):hbitmap;stdcall;external'gifview.dll';
function delphianMain(parameters:tstringlist):DWORD;
//Main Function
var pic:tpicture;
desktop:tcanvas;
sshot,bmp:tbitmap;
text,extout,extin:String;
ico:ticon;
il:timagelist;
i:integer;
jpg:tjpegimage;
htxt:thandle;
written:dword;
mf:tmetafile;
begin
result:=0;
if parameters.Count<2 then begin
writeln('Usage: ',extractfilename(paramstr(0)),' picture_read picture_write [/monochrome]');
writeln('Converts picture_read to picture_write file format');
writeln('Formats supported(Read and write formats): BMP,JPG,ICO');
writeln('Read-only formats: GIF,WMF,EMF');
writeln('Set picture_read to clipboard and a filename ending .TXT to create a text file from clipboard');
writeln('Set picture_read to scan: to scan a picture');
writeln('Set picture read to screen:mouse to capture the window where the mouse is covering');
writeln('Set picture_read to screen: to capture the entire screen.');
writeln('Set picture_read to window: to capture the window behind the console window.');
writeln('Set picture_write to screen: to write to the screen');
writeln('set picture_write to print: to print the picture');
writeln(
'Set either or both picture_read or picture_write to clipboard: to import or export from the clipboard');
writeln('Press enter to return...');
readln;
exit;
end;
try
pic:=tpicture.Create;
extin:=extractfileext(parameters[0]);
extout:=extractfileext(parameters[1]);
if(StrIComp('.emf',pchar(extin))=0)then begin
mf:=tmetafile.Create;
mf.Enhanced:=true;
mf.LoadFromFile(parameters[0]);
pic.Bitmap.Height:=mf.Height;
pic.Bitmap.Width:=mf.Width;
pic.Bitmap.Canvas.Draw(0,0,mf);
end else if(StrIComp('.wmf',pchar(extin))=0)then begin
mf:=tmetafile.Create;
mf.Enhanced:=false;
mf.LoadFromFile(parameters[0]);
pic.Bitmap.Height:=mf.Height;
pic.Bitmap.Width:=mf.Width;
pic.Bitmap.Canvas.Draw(0,0,mf);
end else
if stricomp('screen:mouse',pchar(parameters[0]))=0then begin
writeln('Screenshot will begin in...');
for i:=10downto 1do begin writeln(i,' seconds...');sleep(1000);end;
sshot:=tbitmap.Create;
screenshotfrommouse(sshot);
pic.Bitmap.Handle:=sshot.Handle;
end else
if stricomp('scan:',pchar(parameters[0]))=0 then pic.Bitmap:=readscanner else
if pos('text:',lowercase(parameters[0]))=1then
begin
text:=copy(parameters[0],6,maxint);
pic.Bitmap.height:=pic.Bitmap.Canvas.TextHeight(text);
pic.Bitmap.Width:=pic.Bitmap.Canvas.TextWidth(text);
pic.Bitmap.Canvas.TextOut(0,0,text);
end else if stricomp('screen:',pchar(parameters[0]))=0then
begin
showwindow(getconsolewindow,sw_hide);
sshot:=tbitmap.Create;
screenshot(sshot);
pic.Bitmap.Handle:=sshot.Handle;
showwindow(getconsolewindow,sw_show);
end else if stricomp('window:',pchar(parameters[0]))=0then
begin
showwindow(getconsolewindow,sw_hide);
sshot:=tbitmap.Create;
screenshotactivewindow(sshot);
pic.Bitmap.Handle:=sshot.Handle;
showwindow(getconsolewindow,sw_show);
end else if stricomp('clipboard:',PChar(parameters[0]))=0then begin
if stricomp('.txt',pchar(extout))=0then
text:=clipboard.AsText else
pic.Assign(clipboard);
end else if stricomp('.gif',pchar(extractfileext(parameters[0])))=0 then
pic.Bitmap.Handle:= getgiffile(pchar(parameters[0]))else
pic.LoadFromFile(Parameters[0]);
if parameters.IndexOf('/monochrome')>-1then pic.Bitmap.Monochrome:=true;
if stricomp('clipboard:',pchar(parameters[1]))=0then clipboard.Assign(pic)else
if stricomp('screen:',pchar(parameters[1]))=0then begin
desktop:=tcanvas.Create;
desktop.Handle:=getwindowdc(getdesktopwindow);
desktop.Draw(0,0,pic.Graphic);
desktop.Free;
end else if stricomp('print:',pchar(parameters[1]))=0then begin
printer.BeginDoc;
printer.Canvas.Draw((printer.pagewidth - pic.graphic.width) div 2,
(printer.PageHeight-pic.graphic.height div 2),pic.Graphic);
printer.EndDoc;
end else if(stricomp('.txt',pchar(extout))=0)and(stricomp('clipboard:',
pchar(parameters[0]))=0)then begin
htxt:=createfile(pchar(parameters[1]),generic_write,file_share_read or
file_share_write,nil,create_always,file_attribute_normal,0);
if htxt=invalid_handle_value then begin writeln('Create:',syserrormessage(
getlasterror));result:=getlasterror;exit;end;
if not writefile(htxt,text[1],length(text),written,nil) then begin writeln('Write:',
syserrormessage(getlasterror));result:=getlasterror;closehandle(htxt);exit;end;
closehandle(htxt);
end else
if stricomp('.bmp',pchar(extout))=0then
pic.Bitmap.savetofile(parameters[1]) else
if stricomp('.ico',pchar(extout))=0 then begin
ico:=ticon.Create;
bmp:=tbitmap.Create;
if(stricomp('.jpg',pchar(extin))=0)or(stricomp('.jpeg',pchar(extin))=0)then begin
jpg:=tjpegimage.Create;
jpg.LoadFromFile(parameters[0]);
bmp.Assign(jpg);
end else if(stricomp('.bmp',pchar(extin))=0)then
bmp.Handle:=pic.Bitmap.Handle else
if(stricomp('.gif',pchar(extin))=0)then
bmp.Handle:=getgiffile(pchar(parameters[0]))else
if(stricomp('.emf',PChar(extin))=0)then
begin
mf:=tmetafile.Create;
mf.Enhanced:=true;
mf.LoadFromFile(parameters[0]);
bmp.Height:=mf.Height;bmp.Width:=mf.Width;
bmp.Canvas.Draw(0,0,mf);
end else if(stricomp('.wmf',PChar(extin))=0)then
begin
mf:=tmetafile.Create;
mf.Enhanced:=false;
mf.LoadFromFile(parameters[0]);
bmp.Height:=mf.Height;bmp.Width:=mf.Width;
bmp.Canvas.Draw(0,0,mf);
end;
il:= timagelist.CreateSize(bmp.width,bmp.height);
il.AddMasked(bmp,bmp.TransparentColor);
il.GetIcon(0,ico);
ico.SaveToFile(parameters[1]);
end else if(stricomp('.jpg',pchar(extout))=0)or(stricomp('.jpeg',pchar(extout))=0)
then begin
jpg:=tjpegimage.Create;
jpg.assign(pic.bitmap);
jpg.savetofile(parameters[1]);
end else
raise eoutfiletype.Create('Unknown file type: '+extout);
except on e:exception do begin result:=getlasterror;writeln('Error:',e.message);
exit;end;
end;
writeln('Picture converted successfully');
end;
end.
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
This is golf solitaire that runs as a text based console program. I choose to do it this way to be creative and unqic.It should work with most 32-bit versions of windows including windows 10.
ScreenShots:
unit golfsol1;
//GolfSolitaire() is the main function
interface
uses graphics,windows,classes,sysutils,shellapi;
const
SCORES_SHOW_ONLY=126;
SCORES_INIT=127;
CurrentVersion=$01000000;
procedure GolfSolitaire(params:tstringlist);
implementation
type TRandom=function(range:integer):integer;stdcall;
TCard=record
face,suit,deck,notused:byte;
end;
TGolfScore=record
Name:shortstring;
gametype:byte;
score:shortint;
end;
TGolfGame=record
gamenum:integer;
decks:byte;
cardcount:array[-1..9]of byte;
drawpile:array[1..40]of pointer;
discardpile:array[1..104]of pointer;
end;
PGolfScore=^TGolfScore;
TGetConsoleWindow=Function:HWND;stdcall;
var rand:hmodule=0;
suits:array[1..4]of longint;
drandom:TRandom;
GetConsoleWindow:TGetConsoleWindow;//for compatiblity with older windows
carddeck:array[1..4,1..14]of byte;
tableua:array[-1..9]of tlist;
hout:thandle;
gameover,inGame:boolean;
defattrib: word;
currentscore:shortint;
scores:array[0..9]of tgolfscore;
hk:hkey;
gamenum,intour:integer;
lost,win,jokersused,aceking,decks,showdiscard,oldestver:dword;
drawpile_bonus_points:Shortint;
function AllUsedJokers:boolean;
begin
result:=(carddeck[1,14]=jokersused);
end;
procedure SaveGame;
var sav:tgolfgame;
i:integer;
begin
sav.gamenum:=gamenum;
sav.decks:=decks;
for i:=-1to 9do sav.cardcount[i]:=tableua[i].count;
for i:=1to tableua[-1].count do
sav.drawpile[i]:=tableua[-1][i-1];
for i:=1to tableua[0].count do
sav.discardpile[i]:=tableua[0][i-1];
regsetvalueex(hk,'SavedGame',0,reg_binary,@sav,sizeof(sav));
end;
function allused:boolean;
var i,j:integer;
begin
result:=allusedjokers;
for i:=1to 4do
for j:=1to 13do
result:=result and(carddeck[i,j]>=decks);
end;
function drawcard:pointer;
var car:tcard;
label shuffle;
begin
car.face:=16;
car.suit:=5;
result:=pointer(car);
if allused then exit;
shuffle:if jokersused>0then car.face:=drandom(14)+1 else car.face:=drandom(13)+1;
car.suit:=drandom(4)+1;
if(car.face=14) and (car.suit>1) then goto shuffle;
if carddeck[car.suit,car.face]=decks then goto shuffle;
inc(carddeck[car.suit,car.face]);
car.deck:=carddeck[car.suit,car.face];
result:=pointer(car);
end;
procedure clearconsole;
var co:coord;
written:dword;
begin
co.x:=0;
co.y:=0;
setconsolecursorposition(hout,co);
fillconsoleoutputcharacter(hout,#32,$ffff,co,written);
setconsolecursorposition(hout,co);
end;
procedure Randominit(gamenum:integer);
var i,j:integer;
begin
if decks=1then
drawpile_bonus_points:=-(16+JokersUsed);
if decks=2then
drawpile_bonus_points:=-(40+jokersused);
zeromemory(@carddeck,sizeof(carddeck));
if rand<>0then
freelibrary(rand);
zeromemory(@carddeck,sizeof(carddeck));
rand:=LoadLibrary('random32.dll');
@drandom:=getprocaddress(rand,'MyRandom');
if not assigned(drandom)then begin writeln('Could'#39't load random32.dll');readln;
regclosekey(hk);exitprocess(0);end;
for i:=0to gamenum do drandom(gamenum);
setconsoletitle(pchar('Golf Solitaire #'+inttostr(gamenum)));
if decks=1then
for i:=1to 7do begin tableua[i].clear;
for j:=1to 5do tableua[i].add(drawcard);
end;
if decks=2then
for i:=1to 9do begin tableua[i].clear;
for j:=1to 7do tableua[i].add(drawcard);
end;
tableua[0].clear;
tableua[-1].clear;
tableua[0].add(drawcard);
while not allused do tableua[-1].add(drawcard);
end;
const background_white=background_red or background_green or background_blue or
background_intensity;
char_heart=#3;
char_diamond=#4;
char_club=#5;
char_spade=#6;
function cardtostring(card:tcard):string;
var attrib:word;
begin
if lobyte(hiword(suits[card.suit]))=ord('R')then attrib:=foreground_red or foreground_intensity or
background_white else
attrib:=background_white;
if card.suit=0then attrib:=0;
setconsoletextattribute(hout, attrib);
case card.face of
0,16:result:=#32;
1:result:='A';
10:result:='T';
11:result:='J';
12:result:='Q';
13:result:='K';
14:begin result:='??';exit;end;//Joker
else result:=inttostr(card.face);end;
case card.suit of
1,2,3,4:result:=result+chr(hibyte(hiword(suits[card.suit])));
else result:=result+#32;
end;
end;
function sortscores(Item1, Item2: pointer): Integer;
begin
if pgolfscore(item1).score<pgolfscore(item2).score then result:=-1;
if pgolfscore(item1).score=pgolfscore(item2).score then result:=0;
if pgolfscore(item1).score>pgolfscore(item2).score then result:=1;
end;
function ScoreStr(score:PGolfScore):string;
begin
result:=inttostr(score.score);
if score.score=scores_init then result:='N/A';
end;
function gametypetostr(gt:byte):string;
begin
result:='';
if gt and 1=1then result:='AceKing ';
if gt and 2=2then result:=result+'2-decks';
end;
procedure ShowScores(score:shortint);
var cbscores:dword;
I:integer;
thisscore:TGolfScore;
scorea:array[0..9]of tgolfscore;
sortedscores:tlist;
begin
setconsoletextattribute(hout,defattrib);
sortedscores:=tlist.Create;
thisscore.gametype:=0;
cbscores:=0;
if(aceking=1)then thisscore.gametype:=1;
if(decks=2)then thisscore.gametype:=thisscore.gametype or 2;
if score<scores_show_only then begin write('Enter your name:');readln(thisscore.name);
thisscore.score:=score;end;
regqueryvalueex(hk,'Scores',nil,nil,nil,@cbscores);
if cbscores=sizeof(scores)then
regqueryvalueex(hk,'Scores',nil,nil,@scores,@cbscores);
for i:=0to 9do sortedscores.Add(@scores[i]);
if score<126then sortedscores.Add(@thisscore);
sortedscores.Sort(sortscores);
writeln('Place,Score,Name,GameType');
for i:=0to 9do begin write(i+1,'. ',scorestr(sortedscores[i]),' ',pgolfscore(
sortedscores[i]).name,' ',gametypetostr(pgolfscore(sortedscores[i]).gametype));
if sortedscores[i]=@thisscore then write('<--');writeln;copymemory(@scorea[i],
sortedscores[i],sizeof(tgolfscore));
end;
copymemory(@scores,@scorea,sizeof(scorea));
regsetvalueex(hk,'Scores',0,reg_binary,@scores,sizeof(scores));
sortedscores.Free;
writeln('Wins: ',win,' Lost: ',lost,' Games Played: ',win+lost);
write('Press enter to return...');readln;
clearconsole;
end;
procedure loadgame;
var sav:tgolfgame;
i,j,colcount:integer;
cb:dword;
Begin
cb:=sizeof(sav);
RegQueryValueEx(hk,'SavedGame',nil,nil,@sav,@cb);
decks:=sav.decks;
if decks=1 then colcount:=5 else colcount:=7;
gamenum:=sav.gamenum;
randominit(gamenum);
for i:=1to 9do
if tableua[i].count>0then for j:=1to colcount-sav.cardcount[i] do tableua[i].remove(
tableua[i].last);
tableua[0].clear;tableua[-1].clear;
for i:=1 to sav.cardcount[-1] do
tableua[-1].add(sav.drawpile[i]);
for i:=1to sav.cardcount[0]do tableua[0].add(sav.discardpile[i]);
end;
procedure youwinproc;
var
conrect:trect;
sortedscores:tlist;
ywbmp:graphics.tbitmap;
concan:tcanvas;
begin
ingame:=false;
GetWindowRect(getconsolewindow,conrect);
writeln('ÉÍÍÍÍÍÍÍÍÍÍ»');
writeln('º You win! º');
writeln('ÈÍÍÍÍÍÍÍÍÍͼ');
gameover:=true;
@getconsolewindow:=GetProcAddress(getmodulehandle('kernel32.dll'),
'GetConsoleWindow');
if assigned(getconsolewindow)then
if getconsolewindow<>0then begin
ywbmp:=graphics.tbitmap.create;
ywbmp.Handle:=loadbitmap(hinstance,'YOUWON');
Concan:=tcanvas.Create;
concan.Handle:=GetWindowDC(getconsolewindow);
concan.Draw((conrect.Right-ywbmp.width)div 2,(conrect.Bottom-ywbmp.height)div 2,
ywbmp);
releasedc(getconsolewindow,concan.handle);
concan.Free;
ywbmp.FreeImage;
ywbmp.Free;
end;
showscores(drawpile_bonus_points);
inc(win);
regdeletevalue(hk,'SavedGame');
regsetvalueex(hk,'Win',0,reg_dword,@win,4);
end;
{$RESOURCE GOLFSOL32.RES}
function quit(typ:dword):Bool;stdcall;
var dwGame:dword;
begin
result:=true;
dwGame:=gamenum;
if ingame then savegame;
regsetvalueex(hk,'Win',0,reg_dword,@win,4);
regsetvalueex(hk,'Lost',0,reg_dword,@lost,4);
regclosekey(hk);
exitprocess(0);
end;
function ismove(pile1,pile2:tlist):boolean;
var p1,p2:pointer;
c1,c2:tcard;
begin
result:=false;
if(pile1.Count*pile2.Count=0)then exit;
p1:=pile1.last;
p2:=pile2.last;
copymemory(@c1,@p1,4);
copymemory(@c2,@p2,4);
result:=(abs(c1.face-c2.face)=1)or(c1.face=14)or(c2.face=14);
if(((c1.face=1)and(c2.face=13))or((c1.face=13)and(c2.face=1)))and(aceking=1)then
result:=true;
end;
function AnyMoreMoves:byte;
var i:integer;
begin
result:=0;
for i:=1to 9 do if ismove(tableua[0],tableua[i])then inc(result);
end;
procedure ShowRules;
begin
clearconsole;
writeln('ÉÍÍÍÍÍÍÍÍÍÍ͹Golf RulesÌÍÍÍÍÍÍÍÍÍÍ»');
writeln('ºThe rules for golf solitaire are º');
writeln('ºvery simple. The whole idea of º');
writeln('ºgame is to get rid of all cards º');
writeln('ºin the seven columns(1 deck) or º');
writeln('ºnine columns(2 decks). As in º');
writeln('ºregular golf you want to get the º');
writeln('ºlowest points. When the game endsº');
writeln('ºwhatever cards are left count as º');
writeln('ºone point per card. If you go outº');
writeln('ºthe number of cards left will º');
writeln('ºbecome a negative points. You º');
writeln('ºwill try to move the cards from º');
writeln('ºthe columns to the discard pile. º');
writeln('ºThey must be one card bigger or º');
writeln('ºone card smaller.Example: a 5 canº');
writeln('ºbe moved to the discard pile onlyº');
writeln('ºif the top card is a 6 or a 4,theº');
writeln('ºsuit doesnt matter. You can choseº');
writeln('ºa column by entering the number 1º');
writeln('ºthough 9 and then pressng enter. º');
writeln('ºWhen there are no more moves you º');
writeln('ºcan type in 0 and hit enter or º');
writeln('ºtype in 10 and hit enter to go toº');
writeln('ºmenu. º');
writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
writeln('Press enter to return...');
readln;
intour:=2;
end;
procedure Tour;
begin
clearconsole;
writeln('ÉÍÍÍÍÍÍÍÍÍ͹Golf TourÌÍÍÍÍÍÍÍÍÍÍÍÍ»');
writeln('ºTo know how to use this game you º');
writeln('ºwill be entering in numbers to º');
writeln('ºtell the game your moves & what º');
writeln('ºyou want to do. The columns are º');
writeln('ºnumbered and so is the draw pile.º');
writeln('ºTo draw you enter in 0 and press º');
writeln('ºenter. Next we will look at the º');
writeln('ºrules. º');
writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
writeln('Press enter to continue...');
readln;
intour:=1;
end;
procedure GolfSolitaire(params:tstringlist);
var i,j,choice:integer;
topcard:tcard;
pc:pointer;
cb,sgame:dword;
label gamepmt,gameend,menu,trytour;
begin
hout:=getstdhandle(std_output_handle);
defattrib:=foreground_intensity or foreground_red or foreground_blue or
foreground_green;
decks:=1;
randomize;
ingame:=false;
setconsoleoutputcp(437);
oldestver:=0;
for i:=0to 9do begin scores[i].Name:='N/A';scores[i].score:=scores_init;end;
SetConsoleCtrlHandler(@quit,true);
regcreatekey(hkey_current_user,'Software\Justin\GolfSolitaire',hk);
intour:=0;
suits[1]:=makelong(ord('C'),makeword(ord('B'),ord(char_club)));
suits[2]:=makelong(ord('S'),makeword(ord('B'),ord(char_spade)));
suits[3]:=makelong(ord('H'),makeword(ord('R'),ord(char_heart)));
suits[4]:=makelong(ord('D'),makeword(ord('R'),ord(char_diamond)));
cb:=sizeof(suits);
regqueryvalueex(hk,'Suit',nil,nil,@suits,@cb);
regsetvalueex(hk,'Suit',0,reg_binary,@suits,sizeof(suits));
cb:=4;regqueryvalueex(hk,'Decks',nil,nil,@decks,@cb);
if(decks=0)or(decks>2)then decks:=1;
showdiscard:=0;
cb:=4;
lost:=0;
win:=0;
regqueryvalueex(hk,'Lost',nil,nil,@lost,@cb);
cb:=4;
gameover:=true;
regqueryvalueex(hk,'Win',nil,nil,@win,@cb);
cb:=4;
aceking:=0;jokersused:=0;sgame:=0;
//regqueryvalueex(hk,'JokersUsed',nil,nil,@jokersused,@cb);
//Jokers for some reason freeze up the game being delt.
regqueryvalueex(hk,'LastGame',nil,nil,@sgame,@cb);
cb:=4;
//if jokersused>2then jokersused:=0;
regqueryvalueex(hk,'AceKing',nil,nil,@aceking,@cb);
cb:=4;
if aceking>1then aceking:=0;
regqueryvalueex(hk,'ShowDiscard',nil,nil,@showdiscard,@cb);
if showdiscard>1then showdiscard:=0;
for i:=-1 to 9do tableua[i]:=tlist.create;
if regqueryvalueex(hk,'OldestVersion',nil,nil,nil,nil)<>error_success then
begin
trytour:
write('Would you like to take a tour? type in 1 for Yes or 0 for No:');
readln(choice);
case choice of
1:tour;
0:goto menu;
else goto trytour;
end;
oldestver:=currentversion;
regsetvalueex(hk,'OldestVersion',0,reg_dword,@oldestver,4);
if intour=1 then goto menu;
end;
menu:clearconsole;
setconsoletextattribute(hout,defattrib);
writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
writeln('ºWelcome to Golf Solitaire º');
writeln('ºWhat would you like to do? º');
writeln('º1. Start a new game º');
writeln('º2. Enter in a game number º');
writeln('º3. View top ten º');
cb:=4;
writeln('º4. See game rules º');
writeln('º5. Change rules and settings º');
if ingame then
writeln('º6. Return to game º');
if regqueryvalueex(hk,'SavedGame',nil,nil,nil,nil)=error_success then
writeln('º7. Load Saved Game º');
writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
if intour=1 then
writeln('To see rules type 4 and press enter');
write('Choice Number:');readln(choice);
case choice of
4:begin showrules;goto menu;end;
1:begin
gamenum:=random(maxint)+1; randominit(gamenum);end;
2:begin write('Enter game#:');readln(gamenum);randominit(gamenum);end;
3:begin showscores(scores_show_only);goto menu;end;
5:begin writeln('Current Settings:');
write('Aces can be played on kings: ');if aceking=1then writeln('Yes')else
writeln('No');//writeln('Jokers used: ',jokersused);
writeln('Number of card decks:',decks);
write('Show all cards in the discard pile:');
if showdiscard=1then writeln('Yes')else writeln('No');
writeln('2=DontChange 1=Yes 0=No Any Other number returns to menu');
Write('Play Kings on Aces? Number Choice:');readln(aceking);
if aceking>1then goto menu;
{tryjoker:
write('Number of jokers to use. 0 though 2 are valid numbers:');
readln(jokersused);
if(JokersUsed>2)then begin Writeln('Too many jokers.');goto tryjoker;end;
}
write('Show all cards in the discard pile?(0=No 1=yes)');readln(showdiscard);
regsetvalueex(hk,'ShowDiscard',0,reg_dword,@showdiscard,4);
//regsetvalueex(hk,'JokersUsed',0,reg_dword,@jokersused,4);
regsetvalueex(HK,'AceKing',0,reg_dword,@aceking,4);
write('Enter number of decks to use(1 or 2):');readln(decks);
regsetvalueex(hk,'Decks',0,reg_dword,@decks,4);
goto menu;
end;
6:if ingame then goto gamepmt else goto menu;
7:if RegQueryValueex(hk,'SavedGame',nil,nil,nil,nil)=error_success then
loadgame else goto menu;
else goto menu;
end;
gameover:=false;
drawpile_bonus_points:=-tableua[-1].count;
gamepmt:
clearconsole;
setconsoletextattribute(hout,defattrib);
ingame:=true;
write('Game#: ',gamenum,' Cards left:');
j:=0;
for i:=1to 9do j:=j+tableua[i].count;
write(j,' Draws left:',tableua[-1].count,' Type in 10 for menu');
writeln;
writeln('[1][2][3][4][5][6][7][8][9]');
if decks=1 then
for i:=0to 4do begin write(' ');
for j:=1to 9do begin if tableua[j].count>i then write(cardtostring(tcard(tableua[j][i])))
else write(' ');write(' ');end;
writeln;
end;
if decks=2 then
for i:=0to 6do begin write(' ');
for j:=1to 9do begin if tableua[j].count>i then write(cardtostring(tcard(tableua[j][i])))
else write(' ');write(' ');end;
writeln;
end;
setconsoletextattribute(hout,defattrib);
pc:=tableua[0].last;
copymemory(@topcard,@pc,4);
write('Draw[0]: ');
if showdiscard=0then
write(cardtostring(topcard))
else for i:=0to tableua[0].count-1do begin pc:=tableua[0][i];copymemory(@topcard,
@pc,4);write(cardtostring(topcard));end;
writeln;
setconsoletextattribute(hout,defattrib);
write('Choice:');
readln(choice);
case choice of
1,2,3,4,5,6,7,8,9:if ismove(tableua[0],tableua[choice])then
begin tableua[0].add(tableua[choice].last);tableua[choice].remove(
tableua[choice].last);if(tableua[-1].count=0) and(anymoremoves=0) then goto gameend;
end;
0:begin if((tableua[-1].count=0) and(anymoremoves=0)) then
goto gameend;tableua[0].add(tableua[-1].last);inc(drawpile_bonus_points);
tableua[-1].remove(tableua[-1].last);
end;
10:goto menu;
end;
if(tableua[1].count+tableua[2].count+tableua[3].count+tableua[4].count+
tableua[5].count+tableua[6].count+tableua[7].count+tableua[8].count+
tableua[9].count=0)then begin
youwinproc;
goto menu;
end;
goto gamepmt;
gameend:
regdeletevalue(hk,'SavedGame');
Writeln('Sorry, no more moves');
writeln('Tableua points: ',tableua[1].count+tableua[2].count+tableua[3].count+
tableua[4].count+tableua[5].count+tableua[6].count+tableua[7].count+
tableua[8].count+tableua[9].count);
gameover:=true;
inc(lost);
ingame:=false;
regsetvalueex(hk,'Lost',0,reg_dword,@lost,4);
showscores(tableua[1].count+tableua[2].count+tableua[3].count+tableua[4].count+
tableua[5].count+tableua[6].count+tableua[7].count);
//writeln('Press enter to return...');readln;
goto menu;
end;
end.
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
This is a fun card game that I learned from camp and I made a game for Windows. It’s easy to play and win. And soon will come more card decks to choose from. The card deck current;y included in
the game by default came from Microsoft Windows XP.
The game is fun and includes sound effects. The game is portable and doesn’t
need to be installed or have administrative rights. Just tell the web browser to
run or save the file. There is even a web version as well.
ScreenShots
How to build a card deck?
In order to build a card deck you must create a DLL Resource file with
bitmaps. No coding required! Just make sure to name it with a .CAR file
extension.
unit garbage1;
//Main Card Game Unit
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Menus, ComCtrls,shellapi,mmsystem, DBClient, MConnect;
const
Version=$100;
card_error=1;
card_visible=4;
card_flipped=8;
card_exists=2;
card_dead=16+card_flipped;
type
Tgarbagegame = class(TForm)
GroupBox1: TGroupBox;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Image8: TImage;
Image9: TImage;
Image10: TImage;
Image12: TImage;
Image11: TImage;
GroupBox2: TGroupBox;
Image13: TImage;
Image14: TImage;
Image15: TImage;
Image16: TImage;
Image17: TImage;
Image18: TImage;
Image19: TImage;
Image20: TImage;
Image21: TImage;
Image22: TImage;
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
Game1: TMenuItem;
ChangeBack1: TMenuItem;
Button1: TButton;
Help1: TMenuItem;
AboutGarbage1: TMenuItem;
ListBox1: TListBox;
Rules1: TMenuItem;
KingsAreWild1: TMenuItem;
DCOMConnection1: TDCOMConnection;
procedure FormCreate(Sender: TObject);
procedure ChangeBack1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image13Click(Sender: TObject);
procedure Image11Click(Sender: TObject);
procedure AboutGarbage1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure Rules1Click(Sender: TObject);
procedure KingsAreWild1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TPlayingCard=record
face,suit:byte;
flags:word;
end;
TPlayingCards=array[1..10]of tplayingcard;
procedure newgame;
function pcback(index:integer):pchar;
procedure updatecards;
var
garbagegame: Tgarbagegame;
playerpos:byte=10;
hdeck:hmodule;
computerpos:byte=10;
back:dword;
deck_pics:array[0..12,1..4]of HBITMAP;
hbacks:array[0..11]of hbitmap;
emptyslots:array[0..2]of hbitmap;
Faces:array[0..12]of string=('Ace','Two','Three','Four','Five','Six','Seven',
'Eight','Nine','Ten','Jack','Queen','King');
Suits:array[1..4]of string=('Clubs','Diamonds','Hearts','Spades');
discard:tlist;
kingswild:dword=1;
cturn,pturn:byte;
candraw:boolean;
gamenum,whoseturn:integer;
harrows:array[0..1]of hicon;
playercards,computercards:tplayingcards;
used:array[0..12,1..4]of boolean;
implementation
{$R *.DFM}
{$RESOURCE DECK.RES}
{$RESOURCE GARBAGE32.RES}
uses garbage2;
procedure endround;
var msg,par:array[0..512]of char;
i:integer;
hk:hkey;
begin
for i:=1to 10do begin if computercards[i].flags and card_flipped=0then
computercards[i].flags:=computercards[i].flags or card_dead;
if playercards[i].flags and card_flipped=0then playercards[i].flags:=
playercards[i].flags or card_dead;
end;
updatecards;
regcreatekey(hkey_current_user,'Software\Justin\Garbage',hk);
regdeletevalue(hk,'SavedGame');
regclosekey(hk);
if inttostr(playerpos)=garbagegame.StatusBar1.Panels[2].text then begin
dec(playerpos);
if playerpos=0 then begin
playsound('GOOD2',hinstance,snd_resource or snd_sync);
if messagebox(garbagegame.handle,strfmt(msg,
'You won!'#13#10'Your score:0 points'#13#10'Computer score:%d points'#13#10'Play again?',
[computerpos]),'Game Over',mb_yesno)=idno then exit;
computerpos:=10;
playerpos:=10;
gamenum:=0;
end else begin playsound('CLAP',hinstance,snd_resource or snd_sync);messagebox(
garbagegame.handle,strfmt(msg,
'You won this round!'#13#10'Your score:%d points'#13#10'Computer score:%d points',
[playerpos,computerpos]),'Garbage',0);
end;
end;
if inttostr(computerpos)=garbagegame.StatusBar1.Panels[3].text then begin
dec(computerpos);
if computerpos=0 then begin
if messagebox(garbagegame.handle,strfmt(msg,
'You lost!'#13#10'Your score:%d'#13#10'Computer score:0 points'#13#10'Play again?',
[playerpos]),'Game Over',mb_yesno)=idno then exit;
computerpos:=10;
playerpos:=10;
gamenum:=0;
end else messagebox(garbagegame.handle,strfmt(msg,
'You lost this round!'#13#10'Your score:%d points'#13#10'Computer score:%d points',
[playerpos,computerpos]),'Garbage',0);
end;
shellexecute(0,nil,pchar(application.exename),strfmt(par,'%d %d %d %d %d',[
playerpos,computerpos,gamenum,whoseturn,back]),nil,SW_SHOWNORMAL);
exitprocess(0);
end;
procedure reshuffle;
var i:integer;
p:pointer;
c:tplayingcard;
l:tlist;
begin
//With the game being two player I don't think this function will ever be called!
l:=tlist.Create;
for i:=0 to discard.Count-2do begin p:=discard[i];copymemory(@c,@p,4);l.Add(p);
used[c.face,c.suit]:=false;
end;
for i:=0to l.Count-1do discard.Remove(l[i]);
l.Free;
end;
function CardBack:byte;
var rs,rtyp:Dword;
hk:hkey;
begin
RegCreateKey(hkey_current_user,'Software\Justin\Garbage',hk);
back:=255;
rs:=4;
regqueryvalueex(hk,'CardBack',nil,@rtyp,@back,@rs);
result:=back;
regclosekey(hk);
if back>11then back:=strtointdef(paramstr(5),random(12));
end;
function allused:boolean;
var i,j:integer;
begin
result :=true;
for i:=0to 12do for j:=1to 4do result:= result and used[i,j];
end;
function drawcard:tplayingcard;
label newcard;
begin
result.flags:=card_error;
if allused then exit;
newcard:
result.suit:=Random(4)+1;
result.face:=random(13);
if used[result.face,result.suit] then goto newcard;
used[result.face,result.suit]:=true;
result.flags:=card_exists;
end;
procedure playermoveenable;
var p:pointer;
c:tplayingcard;
begin
garbagegame.Image13.Enabled:=false;
garbagegame.Image14.Enabled:=false;
garbagegame.Image15.Enabled:=false;
garbagegame.Image16.Enabled:=false;
garbagegame.Image17.Enabled:=false;
garbagegame.Image18.Enabled:=false;
garbagegame.Image19.Enabled:=false;
garbagegame.Image20.Enabled:=false;
garbagegame.Image21.Enabled:=false;
garbagegame.Image22.Enabled:=false;
p:=discard.Last;
copymemory(@c,@p,4);
if(c.face<10)then
if((1+c.face)>playerpos)and(c.face<12)then exit;
if(c.face<10)then
if playercards[c.face+1].flags and card_flipped>0then exit;
case c.face of
0:garbagegame.Image13.Enabled:=true;
1:garbagegame.Image14.Enabled:=true;
2:garbagegame.Image15.Enabled:=true;
3:garbagegame.Image16.Enabled:=true;
4:garbagegame.Image17.Enabled:=true;
5:garbagegame.Image18.Enabled:=true;
6:garbagegame.Image19.Enabled:=true;
7:garbagegame.Image20.Enabled:=true;
8:garbagegame.Image21.Enabled:=true;
9:garbagegame.Image22.Enabled:=true;
end;
if(kingswild=1)and(c.face=12)then begin
garbagegame.Image13.Enabled:=(playercards[1].flags and card_flipped=0);
garbagegame.Image14.Enabled:=(playercards[2].flags and card_flipped=0);
garbagegame.Image15.Enabled:=(playercards[3].flags and card_flipped=0);
garbagegame.Image16.Enabled:=(playercards[4].flags and card_flipped=0);
garbagegame.Image17.Enabled:=(playercards[5].flags and card_flipped=0);
garbagegame.Image18.Enabled:=(playercards[6].flags and card_flipped=0);
garbagegame.Image19.Enabled:=(playercards[7].flags and card_flipped=0);
garbagegame.Image20.Enabled:=(playercards[8].flags and card_flipped=0);
garbagegame.Image21.Enabled:=(playercards[9].flags and card_flipped=0);
garbagegame.Image22.Enabled:=(playercards[10].flags and card_flipped=0);
end;
end;
procedure AddCardToListBox(car:pointer;typ:integer;nturns:pbyte);
var c:tplayingcard;
p:pointer;
rwave:array[0..8]of char;
begin
p:=car;
copymemory(@C,@p,4);
if nturns<>nil then nturns^:=nturns^+1;
case typ of
0:garbagegame.ListBox1.Items.insert(0,format('You drawn an %s of %s.',[faces[c.face],
suits[c.suit]]));
1:begin garbagegame.ListBox1.Items.insert(0,format('You flipped over an %s of %s.',
[faces[c.face],suits[c.suit]]));if nturns=nil then playsound('DING',hinstance,
snd_Resource or SND_SYNC)else if nturns^>3 then playsound(strfmt(rwave,'GOOD%d',
[random(3)]),hinstance,snd_Resource or SND_SYNC)else playsound('DING',hinstance,
snd_Resource or SND_SYNC);end;
2:garbagegame.ListBox1.Items.insert(0,format('Computer has drawn an %s of %s.',[
faces[c.face],suits[c.suit]]));
3:Begin garbagegame.ListBox1.Items.insert(0,format(
'Computer has flipped over an %s of %s.',[faces[c.face],suits[c.suit]]));
if nturns=nil then playsound('DING',hinstance,snd_Resource or SND_SYNC)else if
nturns^>3 then playsound(strfmt(rwave,'GOOD%d',[random(3)]),hinstance,
snd_Resource or SND_SYNC)else playsound('DING',hinstance,snd_Resource or SND_SYNC);end;
end;
end;
procedure NewGame;
var i:integer;
begin
candraw:=true;
discard.clear;
Garbagegame.StatusBar1.Panels[1].text:=format('%d/%d',[playerpos,computerpos]);
for i:=2 to 3do
garbagegame.StatusBar1.Panels[i].text:='0';
inc(gamenum);
garbagegame.StatusBar1.Panels[0].text:=format('Game %d',[gamenum]);
zeromemory(@used,sizeof(used));
zeromemory(@playercards,sizeof(playercards));
zeromemory(@computercards,sizeof(computercards));
for i:=1to playerpos do playercards[i]:=drawcard;
for i:=1to computerpos do computercards[i]:= drawcard;
if allused then reshuffle;
discard.Add(pointer(drawcard));
addcardtolistbox(discard.Last,0,nil);
garbagegame.Image11.Enabled:=false;
playermoveenable;
garbagegame.Button1.visible:=true;
end;
function pccard(i,j:integer):pchar;
begin
result:=stralloc(8);
strfmt(result,'CARD%d%x',[j,i]);
end;
function pcback(index:integer):pchar;
begin
result:=stralloc(8);
strfmt(result,'BACK%d',[index]);
end;
procedure updatecards;
var p:pointer;
c:tplayingcard;
i,j:integer;
pc:pchar;
nocard:tbitmap;
begin
candraw:=not allused;
with garbagegame do begin
image1.Transparent:=(computercards[1].flags and card_dead=card_dead);
image2.Transparent:=(computercards[2].flags and card_dead=card_dead);
image3.Transparent:=(computercards[3].flags and card_dead=card_dead);
image4.Transparent:=(computercards[4].flags and card_dead=card_dead);
image5.Transparent:=(computercards[5].flags and card_dead=card_dead);
image6.Transparent:=(computercards[6].flags and card_dead=card_dead);
image7.Transparent:=(computercards[7].flags and card_dead=card_dead);
image8.Transparent:=(computercards[8].flags and card_dead=card_dead);
image9.Transparent:=(computercards[9].flags and card_dead=card_dead);
image10.Transparent:=(computercards[10].flags and card_dead=card_dead);
image13.Transparent:=(playercards[1].flags and card_dead=card_dead);
image14.Transparent:=(playercards[2].flags and card_dead=card_dead);
image15.Transparent:=(playercards[3].flags and card_dead=card_dead);
image16.Transparent:=(playercards[4].flags and card_dead=card_dead);
image17.Transparent:=(playercards[5].flags and card_dead=card_dead);
image18.Transparent:=(playercards[6].flags and card_dead=card_dead);
image19.Transparent:=(playercards[7].flags and card_dead=card_dead);
image20.Transparent:=(playercards[8].flags and card_dead=card_dead);
image21.Transparent:=(playercards[9].flags and card_dead=card_dead);
image22.Transparent:=(playercards[10].flags and card_dead=card_dead);
end;
for i:=0to 2do begin deleteobject(emptyslots[i]);pc:=pccard(i,0);emptyslots[i]:=loadbitmap(hdeck,pc);
strdispose(pc);end;
for i:=0to 11 do begin deleteobject(hbacks[i]);pc:=pcback(i);hbacks[i]:=loadbitmap(hdeck,pc);
strdispose(pc);end;
for i:=0 to 12do for j:=1to 4do begin deleteobject(deck_pics[i,j]);pc:=pccard(i,j);deck_pics[i,j]:=
loadbitmap(hdeck,pc);strdispose(pc);end;
if computercards[1].flags and card_flipped=0then
garbagegame.image1.picture.bitmap.handle:= hbacks[back] else
garbagegame.image1.picture.bitmap.handle:= deck_pics[computercards[1].face,
computercards[1].suit];
if computercards[2].flags and card_flipped=0then
garbagegame.image2.picture.bitmap.handle:= hbacks[back] else
garbagegame.image2.picture.bitmap.handle:= deck_pics[computercards[2].face,
computercards[2].suit];
if computercards[3].flags and card_flipped=0then
garbagegame.image3.picture.bitmap.handle:= hbacks[back] else
garbagegame.image3.picture.bitmap.handle:= deck_pics[computercards[3].face,
computercards[3].suit];
if computercards[4].flags and card_flipped=0then
garbagegame.image4.picture.bitmap.handle:= hbacks[back] else
garbagegame.image4.picture.bitmap.handle:= deck_pics[computercards[4].face,
computercards[4].suit];
if computercards[5].flags and card_flipped=0then
garbagegame.image5.picture.bitmap.handle:= hbacks[back] else
garbagegame.image5.picture.bitmap.handle:= deck_pics[computercards[5].face,
computercards[5].suit];
if computercards[6].flags and card_flipped=0then
garbagegame.image6.picture.bitmap.handle:= hbacks[back] else
garbagegame.image6.picture.bitmap.handle:= deck_pics[computercards[6].face,
computercards[6].suit];
if computercards[7].flags and card_flipped=0then
garbagegame.image7.picture.bitmap.handle:= hbacks[back] else
garbagegame.image7.picture.bitmap.handle:= deck_pics[computercards[7].face,
computercards[7].suit];
if computercards[8].flags and card_flipped=0then
garbagegame.image8.picture.bitmap.handle:= hbacks[back] else
garbagegame.image8.picture.bitmap.handle:= deck_pics[computercards[8].face,
computercards[8].suit];
if computercards[9].flags and card_flipped=0then
garbagegame.image9.picture.bitmap.handle:= hbacks[back] else
garbagegame.image9.picture.bitmap.handle:= deck_pics[computercards[9].face,
computercards[9].suit];
if computercards[10].flags and card_flipped=0then
garbagegame.image10.picture.bitmap.handle:= hbacks[back] else
garbagegame.image10.picture.bitmap.handle:= deck_pics[computercards[10].face,
computercards[10].suit];
if discard.Count=0 then garbagegame.Image12.Picture.Bitmap.Handle:=emptyslots[0]
else begin p:=discard.Last;Copymemory(@c,@p,4);
garbagegame.Image12.Picture.Bitmap.handle:=deck_pics[c.face,c.suit];
end;
if playercards[1].flags and card_flipped=0then
garbagegame.image13.picture.bitmap.handle:= hbacks[back] else
garbagegame.image13.picture.bitmap.handle:= deck_pics[playercards[1].face,
playercards[1].suit];
if playercards[2].flags and card_flipped=0then
garbagegame.image14.picture.bitmap.handle:= hbacks[back] else
garbagegame.image14.picture.bitmap.handle:= deck_pics[playercards[2].face,
playercards[2].suit];
if playercards[3].flags and card_flipped=0then
garbagegame.image15.picture.bitmap.handle:= hbacks[back] else
garbagegame.image15.picture.bitmap.handle:= deck_pics[playercards[3].face,
playercards[3].suit];
if playercards[4].flags and card_flipped=0then
garbagegame.image16.picture.bitmap.handle:= hbacks[back] else
garbagegame.image16.picture.bitmap.handle:= deck_pics[playercards[4].face,
playercards[4].suit];
if playercards[5].flags and card_flipped=0then
garbagegame.image17.picture.bitmap.handle:= hbacks[back] else
garbagegame.image17.picture.bitmap.handle:= deck_pics[playercards[5].face,
playercards[5].suit];
if playercards[6].flags and card_flipped=0then
garbagegame.image18.picture.bitmap.handle:= hbacks[back] else
garbagegame.image18.picture.bitmap.handle:= deck_pics[playercards[6].face,
playercards[6].suit];
if playercards[7].flags and card_flipped=0then
garbagegame.image19.picture.bitmap.handle:= hbacks[back] else
garbagegame.image19.picture.bitmap.handle:= deck_pics[playercards[7].face,
playercards[7].suit];
if playercards[8].flags and card_flipped=0then
garbagegame.image20.Picture.bitmap.handle:= hbacks[back] else
garbagegame.image20.picture.bitmap.handle:= deck_pics[playercards[8].face,
playercards[8].suit];
if playercards[9].flags and card_flipped=0then
garbagegame.image21.picture.bitmap.handle:= hbacks[back] else
garbagegame.image21.picture.bitmap.handle:= deck_pics[playercards[9].face,
playercards[9].suit];
if playercards[10].flags and card_flipped=0then
garbagegame.image22.picture.bitmap.handle:= hbacks[back] else
garbagegame.image22.picture.bitmap.handle:= deck_pics[playercards[10].face,
playercards[10].suit];
if allused then garbagegame.Image11.Picture.Bitmap.Handle:=emptyslots[2]
else garbagegame.Image11.Picture.Bitmap.handle:=hbacks[back];
end;
function computerthread(dummy:pointer):dword;stdcall;
var p:pointer;
c,cd:tplayingcard;
drawused:boolean;
i,kingpos:integer;
label draw,discard0,endturn,ktry;
begin
inc(whoseturn);
cturn:=0;
pturn:=0;
garbagegame.Button1.Visible:=false;
drawused:=false;
discard0:
p:=discard.Last;
copymemory(@c,@p,4);
if(c.face=12)and(kingswild=1)then begin
ktry:kingpos:=random(computerpos)+1;
if(computercards[kingpos].flags and card_flipped>0)then goto ktry;
i:=strtoint(garbagegame.statusbar1.panels[3].text)+1;
garbagegame.StatusBar1.Panels[3].text:=inttostr(i);
discard[discard.Count-1]:=pointer(computercards[kingpos]);
c.flags:=c.flags or card_flipped;
computercards[kingpos]:=c;
addcardtolistbox(discard.last,3,@cturn);
drawused:=true;
updatecards;
if i=computerpos then begin endround;exit;end;
goto discard0;
end;
if c.face+1>computerpos then goto draw;
if computercards[c.face+1].flags and card_flipped>0then goto draw;
i:=strtoint(garbagegame.statusbar1.panels[3].text)+1;
garbagegame.StatusBar1.Panels[3].text:=inttostr(i);
discard[discard.Count-1]:=pointer(computercards[c.face+1]);
c.flags:=c.flags or card_flipped;
computercards[c.face+1]:=c;
addcardtolistbox(discard.last,3,@cturn);
drawused:=true;
updatecards;
if i=computerpos then begin endround;exit;end;
goto discard0;
draw:
sleep(1000);
if drawused then goto endturn;
drawused:=true;
if allused then reshuffle;
discard.Add(pointer(drawcard));
addcardtolistbox(discard.last,2,nil);
goto discard0;
endturn:garbagegame.Button1.Visible:=true;
updatecards;
playermoveenable;
garbagegame.Image11.Enabled:=true;
end;
procedure Tgarbagegame.FormCreate(Sender: TObject);
var i,j:integer;
pc:pchar;
hk:hkey;
tid,rs:dword;
deckdll:array[0..max_path]of char;
begin
randomize;
candraw:=true;
discard:=tlist.Create;
regcreatekey(hkey_current_User,'Software\Justin\Garbage',hk);
if regqueryvalueex(hk,'DeckDLL',nil,nil,@deckdll,@rs)=error_success then
hdeck:=loadlibrary(deckdll)else hdeck:=hinstance;cardback;
rs:=4;
regqueryvalueex(hk,'KingsWild',nil,nil,@kingswild,@rs);
kingsarewild1.checked:=(kingswild=1);
playerpos:=strtointdef(paramstr(1),10);
computerpos:=strtointdef(paramstr(2),10);
gamenum:=strtointdef(paramstr(3),0);
regclosekey(hk);
whoseturn:=strtointdef(paramstr(4),0);
image1.Visible:=true;
image2.Visible:=(computerpos>1);
image3.Visible:=(computerpos>2);
image4.Visible:=(computerpos>3);
image5.Visible:=(computerpos>4);
image6.Visible:=(computerpos>5);
image7.Visible:=(computerpos>6);
image8.Visible:=(computerpos>7);
image9.Visible:=(computerpos>8);
image10.Visible:=(computerpos>9);
image13.Visible:=true;
image14.Visible:=(playerpos>1);
image15.Visible:=(playerpos>2);
image16.Visible:=(playerpos>3);
image17.Visible:=(playerpos>4);
image18.Visible:=(playerpos>5);
image19.Visible:=(playerpos>6);
image20.Visible:=(playerpos>7);
image21.Visible:=(playerpos>8);
image22.Visible:=(playerpos>9);
pturn:=0;
newgame;
updatecards;
end;
procedure Tgarbagegame.ChangeBack1Click(Sender: TObject);
begin
changebackwnd.Visible:=true;
changebackwnd.BringToFront;
visible:=false;
end;
procedure Tgarbagegame.Button1Click(Sender: TObject);
var tid:dword;
begin
createthread(nil,0,@computerthread,nil,0,tid);
end;
procedure Tgarbagegame.Image13Click(Sender: TObject);
var p:pointer;
c,cd:tplayingcard;
i:integer;
begin
inc(whoseturn);
p:=discard.Last;
copymemory(@c,@p,4);
if kingswild=0 then
if TImage(sender).tag<>c.face then exit;
cd:=playercards[TImage(sender).tag+1];
discard[discard.Count-1]:=pointer(cd);
addcardtolistbox(discard.last,1,@pturn);
playercards[timage(sender).tag+1]:=c;
playercards[timage(sender).tag+1].flags:=c.flags or card_flipped;
playermoveenable;
garbagegame.Image11.Enabled:=false;
updatecards;
i:=strtoint(statusbar1.panels[2].text)+1;
statusbar1.Panels[2].text:=inttostr(i);
if i=playerpos then begin endround;exit;end;
end;
procedure Tgarbagegame.Image11Click(Sender: TObject);
begin
if allused then reshuffle;
discard.add(pointer(drawcard));
addcardtolistbox(discard.last,0,nil);
updatecards;
image11.Enabled:=false;
playermoveenable;
end;
procedure Tgarbagegame.AboutGarbage1Click(Sender: TObject);
var aboutt:array[0..1024]of char;
begin
messagebox(handle,strfmt(aboutt,
'Garbage v%d.%d by Justin Roeder.'#13#10'Special thanks goes to Camp CILCA'#13#10'Website: https://delphijustin.biz',[
hibyte(version),lobyte(version)]),'About Garbage',0);
end;
procedure Tgarbagegame.ListBox1DblClick(Sender: TObject);
begin
messagebox(handle,PChar(Listbox1.items[listbox1.itemindex]),'Garbage',0);
end;
procedure Tgarbagegame.Rules1Click(Sender: TObject);
begin
shellexecute(handle,nil,'http://www.gathertogethergames.com/garbage',nil,nil,
sw_show);
end;
procedure Tgarbagegame.KingsAreWild1Click(Sender: TObject);
var hk:hkey;
begin
kingsarewild1.Checked:=not kingsarewild1.Checked;
if kingsarewild1.Checked then kingswild:=1 else kingswild:=0;
regcreatekey(hkey_current_user,'Software\Justin\Garbage',hk);
regsetvalueex(hk,'KingsWild',0,reg_dword,@kingswild,4);
regclosekey(hk);
end;
end.
unit garbage2;
//Change CardDeck Unit
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs,Shellapi;
type
Tchangebackwnd = class(TForm)
ScrollBar1: TScrollBar;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
Button3: TButton;
Button4: TButton;
OpenDialog1: TOpenDialog;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
changebackwnd: Tchangebackwnd;
implementation
{$R *.DFM}
uses garbage1;
procedure Tchangebackwnd.Button1Click(Sender: TObject);
var hk:hkey;
ba:dword;
begin
regcreatekey(hkey_current_user,'software\Justin\Garbage',hk);
if checkbox1.checked then ba:=255 else ba:=scrollbar1.Position;
Regsetvalueex(hk,'CardBack',0,reg_dword,@ba,4);
regclosekey(hk);
if ba=255then back:=random(12)else back:=ba;
updatecards;
close;
end;
procedure Tchangebackwnd.ScrollBar1Change(Sender: TObject);
begin
formpaint(nil);
end;
procedure Tchangebackwnd.Button2Click(Sender: TObject);
begin
close;
end;
procedure Tchangebackwnd.FormPaint(Sender: TObject);
var bmp:tbitmap;
backst:array[0..8]of char;
begin
bmp:=tbitmap.Create;
bmp.Handle:=loadbitmap(hdeck,strfmt(backst,'BACK%d',[scrollbar1.position]));
canvas.Draw(0,0,bmp);
bmp.FreeImage;
bmp.Free;
end;
procedure Tchangebackwnd.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
garbagegame.Visible:=true;
end;
procedure Tchangebackwnd.Button4Click(Sender: TObject);
var hk:hkey;
begin
regcreatekey(hkey_current_user,'Software\Justin\Garbage',hk);
regdeletevalue(hk,'DeckDLL');
Regdeletevalue(hk,'CardBack');
regclosekey(hk);
end;
procedure Tchangebackwnd.Button3Click(Sender: TObject);
var hk:hkey;
hdec:hmodule;
buff:array[0..max_path]of char;
begin
if not opendialog1.Execute then exit;
hdec:=loadlibrary(pchar(opendialog1.filename));
if hdec=0 then begin messagebox(handle,pchar(syserrormessage(getlasterror)),
'delphijustin Card Deck',mb_iconerror);exit;end;
hdeck:=hdec;
regcreatekey(hkey_current_user,'Software\Justin\Garbage',hk);
regsetvalueex(hk,'DeckDLL',0,reg_sz,strpcopy(buff,opendialog1.filename),length(
opendialog1.filename)+1);
Regclosekey(hk);
repaint;
end;
procedure Tchangebackwnd.Button5Click(Sender: TObject);
begin
shellexecute(handle,nil,'https://delphijustin.biz/bin/carddecks/',nil,nil,sw_show);
end;
end.
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
This tool allows
you to write stuff to the Eventlog. Good for debugging
batch files,
running it from your own program. Now with the capabillty to add a resource file
to the registry so that the message just shows what you want it to show.
The tool has several
different parameters,
“message” The
Message to write to the log file
[uncpath] A
path to a computer where it will be logged. you can
set
this parameter to the word NULL to use the local
computer.
[type] Used
for telling what the entry will look like in the
Event
Viewer. It can be a 16-bit integer or one of the
words
below:
Info information
type
error error
type
warning Warning
type
success audit
success type
fail audit
failure type
[categoryid] An
optional integer that represent the category
[eventid] An
optional integer that represent the event id
[logname] Source
name used in if you leave this parameter blank it
will
used “delphijustin” as the default source
/reg
Registers [logname] with this file.
NOTE ALL ENTRIES
WILL BE UNDER THE APPLICATION LOG.
Heres a example
that add a message “hello admin” into the Eventlog
elwrite
“hello admin” info
And here’s
how to write to the eventlog and register the logname “mylog”
elwrite “hi there” null info 0 0 mylog /reg
Note: You must use all parameters when registering a
logname.
program ELWrite;
{$RESOURCE ELWrite32.res}
{$APPTYPE Console}
uses
SysUtils,
windows,
Classes;
type TMyEventData=record
MajorV,MinerV:Byte;
tickcount,unsize:dword;
username:array[0..255]of char;
eventid,cate:word;
end;
var hel:thandle;
etype:word;
en:tmyeventdata;
logkey:hkey;
s:string;
dwtypes:dword;
data,logname:array[0..255]of char;
text:array[0..0]of pchar;
begin
en.majorv:=2;
en.minerv:=0;
if paramcount=0 then begin
writeln('Parameters must be in same order as shown');
writeln('Usage: ',ExtractFileName(paramstr(0)),' "message" [uncpath] [type] [categoryid] [eventid] [logname] [/reg]');
writeln('Type can be an 16-bit integer or one of the following names:');
writeln('error Error type');
writeln('info Information type(default type used)');
writeln('warning Warning Type');
writeln('success Audit Success type');
writeln('fail Audit Failure type');
writeln('/reg Registers the [logname] to this file.');
writeln('');
writeln('You can use the word NULL for the [uncpath] if its the local computer');
exitprocess(0);
end;
text[0]:=strpcopy(data,paramstr(1));
en.unsize:=256;getusername(en.username,en.unsize);
if paramstr(6)=''then logname:='delphijustin'else strpcopy(logname,paramstr(6));
if stricomp('/reg',pchar(paramstr(7)))=0then
begin
regcreatekey(HKEY_LOCAL_MACHINE,pchar(
'SYSTEM\CurrentControlSet\Services\Eventlog\Application\'+strpas(logname)),logkey);
s:=paramstr(0);
dwtypes:=31;
if(regsetvalueex(logkey,'EventMessageFile',0,reg_sz,@s[1],length(s)+1)<>error_success)
or(regsetvalueex(logkey,'TypesSupported',0,reg_dword,@dwtypes,4)<>error_success)then
writeln('Failed to register handler');
regclosekey(logkey);
end;
en.cate:=strtointdef(paramstr(4),0);
en.eventid:=strtointdef(paramstr(5),0);
en.tickcount:=gettickcount;
if(paramstr(2)='') or(stricomp('NULL',pchar(paramstr(2)))=0) then
hel:=registereventsource(nil,logname)else
hel:=registereventsource(pchar(paramstr(2)),logname);
if hel=0 then begin
writeln(syserrormessage(getlasterror));
exitprocess(getlasterror);
end;
etype:=strtointdef(paramstr(3), eventlog_information_type);
if stricomp('error',PChar(paramstr(3)))=0then etype:=eventlog_error_type;
if stricomp('warning',PChar(paramstr(3)))=0then etype:=eventlog_warning_type;
if stricomp('success',PChar(paramstr(3)))=0then etype:=eventlog_audit_success;
if stricomp('fail',PChar(paramstr(3)))=0then etype:=eventlog_audit_failure;
setlasterror(0);
if not reportevent(hel,etype,en.eventid,en.cate,nil,1,sizeof(en),@text,@en)then
writeln(syserrormessage(getlasterror))else begin
writeln('Successfully written to the eventlog');
deregistereventsource(hel);
exitprocess(0);
end;
deregistereventsource(hel);
exitprocess(getlasterror);
end.
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
This tool is great for network administrators who may ghost their harddrives
with duplicate versions of windows starting off with the same computername. The
tool can use a database,random number or even harddrive serial number. You must
run it as an administrator in order to work. It checks to see if it can lookup
it’s computername. So if you use the number range make sure to reboot the
computer before going to the next computer.
Here are some examplescompname.exe name=server?x /d
The command above takes the harddrive serial number in hexadecimal and puts
it into the computer name
The command above sets the computername with its number variable(?d) to a
number between 1000 and 1005 and puts it in decimal and stores it into
example.txt file.
compname.exe name=justin-?d end=128 /r
Sets the computer name wirh a random number between 0 to 127
compname.exe name=mailserver
Sets the computer name to “mailserver”
System Requirements:
Windows XP or higher maybe 2000 or NT4 it will not work on non-NT Type windows such as(windows 95, 98 or Me)
unit compname1;
interface
uses windows,sysutils,classes,winsock;
function delphianMain(commandline:tstringlist):dword;
implementation
var config:tstringlist;
storetodatabase:boolean=false;
hdd:dword;
fn:string;
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
hToken: THandle;
TokenPriv: TOKEN_PRIVILEGES;
PrevTokenPriv: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
begin
Result := True;
// Only for Windows NT/2000/XP and later.
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
Result := False;
// obtain the processes token
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
try
// Get the locally unique identifier (LUID) .
if LookupPrivilegeValue(nil, PChar(sPrivilege),
TokenPriv.Privileges[0].Luid) then
begin
TokenPriv.PrivilegeCount := 1; // one privilege to set
case bEnabled of
True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
False: TokenPriv.Privileges[0].Attributes := 0;
end;
ReturnLength := 0; // replaces a var parameter
PrevTokenPriv := TokenPriv;
// enable or disable the privilege
AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
PrevTokenPriv, ReturnLength);
end;
finally
CloseHandle(hToken);
end;
result:=getlasterror=error_success;
end;
end;
procedure RebootSystem(compn:pchar);
begin
if not ntsetprivilege('SeShutdownPrivilege',true)then writeln('PrivilegeErr:',
syserrormessage(getlasterror));
if not InitiateSystemShutdown(nil,pchar('ComputerName was changed to '+strpas(
compn)),10,true,true)then messagebox(0,pchar('The computer is now called '+
strpas(compn)+#13#10'But failed to reboot'#13#10+syserrormessage(getlasterror)),
'compname',mb_iconinformation);
ntsetprivilege('SeShutdownPrivilege',false);
end;
procedure AddComputerConfig(compn:pchar);
begin
if (not storetodatabase) then exit;
try
config.Values[IntToHex(hdd,8)]:=strpas(compn);
config.SaveToFile(fn);
except on e:exception do writeln('Failed to store name into database: ',
e.message);end;
end;
function delphianMain(commandline:tstringlist):dword;
var data:wsadata;
i,start,endn:integer;
fname:string;
dummy1,dummy2:dword;
windir:array[0..max_path]of char;
compn:array[0..max_computername_length]of char;
label rndname,spotfound,skipover;
{$RESOURCE COMPNAME32.RES}
begin
result:=0;
hdd:=0;
storetodatabase:=(Commandline.IndexOf('/w')>-1);
if storetodatabase and (commandline.Values['name']='')then begin
result:=DWord(-2);
writeln('The /w command switch needs a name= parameter');
exit;
end;
if storetodatabase and (commandline.Values['file']='')then begin
result:=dword(-3);
writeln('Can'#39't store the name into a file without a filename');
exit;
end;
getwindowsdirectory(windir,max_path+1);
getvolumeinformation(pchar(windir[0]+':\'),nil,0,@hdd,dummy1,dummy2,nil,0);
if (commandline.values['name']='')and(commandline.values['file']='')then begin
if commandline.Count>0then
writeln(
'You forgot to define name= or file= in the command, please choose one and try again');
writeln('Usage: ',extractfilename(paramstr(0)),' [start=] [end=] [name=] [file=] [/w] [/r] [/re] [/d]');
writeln('start Starting number, 0 is default');
writeln('end Ending number default is start+255');
writeln('name Computernaming, this or file must be specified');
writeln('/w Writes to the text file the computer name chosen plus the hdd serial number(if not found in the database) the filename is from file= parameter.');
writeln('/re Reboot the computer on a successful change.');
writeln('/r Generates a random number in the name. Only [end=] is the optional parameter for this switch.');
writeln('/d Uses the main harddrive serialnumber');
writeln('file Gets computername from a text file and uses harddrive serial number to lookup the name');
writeln('Number Format specifers:');
writeln('?d Decimal number');
writeln('?x Hexadecimal number');
writeln('example: ',extractfilename(paramstr(0)),
' start=100 end=199 name=client?d');
writeln('This computer'#39's harddrive serial number is ',inttohex(hdd,8));
writeln('Max. length:',max_computername_length,' characters.');
writeln('Press enter to return...');
readln;
exit;
end;
randomize;
if commandline.Values['file']<>''then begin
config:=tstringlist.Create;
if fileexists(commandline.values['file']) then
config.LoadFromFile(commandline.values['file']);
fn:=commandline.Values['file'];
if(config.Values[inttohex(hdd,8)]='')and(commandline.IndexOf('/w')>-1)then goto skipover;
if setcomputername(Pchar(config.values[inttohex(hdd,8)]))then writeln('My name is ',
config.values[inttohex(hdd,0)])else begin result:=getlasterror;writeln(
syserrormessage(getlasterror));exit;end;
end;
skipover:
wsastartup($101,data);
fname:=stringreplace(commandline.values['name'],'?','%',[rfreplaceall]);
// Use ? instead of % in the name to make batch files easier
setlasterror(0);
if commandline.IndexOf('/d')>-1then begin
if setcomputername(strfmt(compn,pchar(fname),[hdd]))then writeln('My name is ',
compn)else begin
result:=getlasterror;
writeln(syserrormessage(getlasterror));
wsacleanup;
exit;
end;
AddComputerConfig(compn);
if commandline.indexof('/re')>-1then rebootsystem(compn);
wsacleanup;
exit;
end;
if commandline.IndexOf('/r')>-1Then begin
rndname:
if gethostbyname(strfmt(compn,pchar(fname),[random(strtointdef(commandline.values[
'end'],maxint))]))<>nil then goto rndname;
if setcomputername(compn) then writeln('My name is ',compn) else
begin
writeln(syserrormessage(getlasterror));
result:=getlasterror;
wsacleanup;exit;
end;
addcomputerconfig(compn);
if commandline.indexof('/re')>-1then rebootsystem(compn);
wsacleanup;
exit;
end;
start:=strtointdef(commandline.values['start'],0);
endn:=strtointdef(commandline.values['end'],0);
if endn-start<=0then endn:=start+255;
for i:=start to endn do if gethostbyname(strfmt(compn,pchar(fname),[i]))=nil then
goto spotfound;
writeln('All spots taken.');
wsacleanup;
result:=dword(-1);
exit;
spotfound:if setcomputername(strfmt(compn,pchar(fname),[i]))then
writeln('My name is ',compn)else begin result:=getlasterror;writeln(syserrormessage(
getlasterror));
addcomputerconfig(compn);
if commandline.indexof('/re')>-1then
rebootsystem(compn);
wsacleanup;
end;
end;
end.
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
This screensaver shows the LED Binary Clock on the desktop. It can be used as a screensaver or as a regular app.
It has features such as:
* Can use UTC instead of local timezone
* Use a different TimeZone rather than what windows was setup for.
* Can display 12-hour format time(default) or 24-hour format.
* Can change the way things look in it, such as LED Colors,LED Styles, Background color and font.
NEW VERSION 3.0
* can put the clock onto wallpaper
* use the delphijustin time server or your own.
* You can now have separate LED colors.
* Have it update the time or show the pattern used in binary clock to tell you that the time needs to be set(just like a real binary clock)
* A optional AM/PM LED
New improvement in 2.0 is the design, works with control panel preview monitor and many more!
Small Window ScreenshotIt now displays something in the preview monitor in Control Panel
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
Tired of having to replace fuses for your projects? Different projects require different current ratings? Then you should build this circuit!
All you need is
1x Voltage Comparator(Like LM311) or an Opamp make sure that they are compatible with a single supply
1x Shunt Resistor(use 1 ohm if you are planing on using panel voltmeter(the voltmeters should be around the expected current measurement)
A potentiometer for adjusting the maximum current, it is used as a variable Voltage Divider. its voltage equals maximum current to which if greather than or equal to the voltage it will turn the project off.
Normally Closed for the reset button
Normally Open for turn off button(NOTE: CURRENT STILL FLOWS WHEN TURNED OFF/TRIPPED).
A NPN transistor, relay and snubber diode.
The relay acts as the switching element which can turn off the project when too much current is drawn. The voltage comparator/Opamp compares the voltage and outputs a logic 1 or 0 depending on how much more the voltage is on the positive input and negative input pins.
This circuit can be used for flashing lights to sound coming from a computer,iPod,mp3, CD Player, etc… The circuit works as a Single Transistor Amplifier. It works best with songs with a lot of bass. Works well even with House Current! The transistor can almost be any NPN transistor, as long as the relay doesn’t draw too much current or wattage(whichever comes first). I decided to use this circuit to flash Christmas Lights.
Figure A. Circuit with outlets for flashing Christmas Lights
delphijustin Industries is an Autism Supported Business