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.
NEW HTML Version is available