Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Shut Down - Shutdown2.pas

Shutdown2.pas

Caricato da: Phi
Scarica il programma completo

  1. { $Id: gplprog.pt,v 1.2 2002/09/07 15:40:47 peter Exp 2010/04/30 20:21:54 peter Exp $
  2.    This file is part of ShutDown
  3.    Copyright (c) 2010 by Phi
  4.  
  5.    Main File
  6.  
  7.    See the file COPYING.FPC, included in this distribution,
  8.    for details about the copyright.
  9.  
  10.    This program is distributed in the hope that it will be useful,
  11.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. **********************************************************************}
  14. //COMPILATO CON FREE PASCAL
  15.  
  16. program Shutdown;
  17. {$R Resourcesht2.RES}
  18. {$apptype gui}
  19.  
  20. uses winsys, Windows,  graph;
  21.  
  22. const
  23. G1 : smallint = VGA;
  24. G2 : smallint = 1;
  25.  
  26. procedure delay(ms:longint);
  27. begin
  28. sleep(ms);
  29. end;
  30.  
  31. Var
  32.  Icona, freccia : Hicon;
  33.  letto : boolean;
  34.  I : longword;
  35.  sc : byte;
  36.  pos:point;
  37.  
  38.  
  39. procedure wrimm(x,y : word;contorno:boolean);
  40. begin
  41. if contorno then bar3d(x,y,x+37,y+37,0,true);
  42. drawicon(windc,x+3,y+3,icona);
  43. drawicon(bitmapdc,x+3,y+3,icona);
  44. end;
  45.  
  46. function mouse(finestra:hwnd;msg:uint;wp:wparam;lp:lparam):longint;stdcall;
  47.  function intasto(x,y:word):boolean;
  48.  begin
  49.   intasto:=(pos.x>=x)and(pos.y>=y)and(pos.x<(x+38))and(pos.y<(y+38));
  50.  end;
  51. begin
  52. if (msg=wm_lbuttondblclk)or(msg=wm_lbuttondown)then begin
  53.  getcursorpos(@pos);
  54.  screentoclient(Graphwindow,@pos);
  55.  if intasto(602,0) then halt;
  56.  if intasto(145,150) then begin
  57.   sc := 1;
  58.   letto := true;
  59.  end;
  60.  if intasto(305,150) then begin
  61.   sc := 2;
  62.   letto := true;
  63.  end;
  64.  if intasto(465,150) then begin
  65.   sc := 3;
  66.   letto := true;
  67.  end;
  68. end;
  69. mouse:=0;
  70. end;
  71.  
  72. function tastiera(finestra:hwnd;msg:uint;wp:wparam;lp:lparam):longint;stdcall;
  73. begin
  74. if (msg = wm_char) and (char(wp)=#13) then letto := true;
  75. if (msg = wm_keydown) then case (wp) of
  76.  vk_left: if sc = 1 then sc := 3 else sc:=sc-1;
  77.  vk_right: if sc = 3 then sc := 1 else sc:=sc+1;
  78.  vk_end:sc:=3;
  79.  vk_home:sc:=1;
  80. end;
  81. tastiera:=0;
  82. end;
  83.  
  84. procedure disegno;
  85. begin
  86. setcolor(0);
  87. for I := 0 to 639 do begin
  88.  if i < 320 then setrgbpalette(0,32-(I div 10),32-(I div 10),150)
  89.   else setrgbpalette(0,((I-320) div 10),((I-320) div 10),150);
  90.  line(I,0,I,60);
  91.  line(I,300,I,350);
  92.  if i < 320 then setrgbpalette(0,(I div 3),(I div 3),250)
  93.   else setrgbpalette(0,106-((I-320) div 3),106-((I-320) div 3),250);
  94.  line(I,64,I,300);
  95. end;
  96. setcolor(14);setrgbpalette(14,255,255,0);
  97. line(0,61,639,61);line(0,62,639,62);line(0,63,639,63);
  98. line(0,301,639,301);line(0,302,639,302);
  99. icona := icon; wrimm(5,10,false);
  100. icona:=extracticon(hinstance,'phi immgrd.dll',0);
  101. wrimm(5,310,false);
  102. settextstyle(0,0,2);outtextxy(100,18,'Spegni il computer');settextstyle(0,0,0);
  103.  
  104. setcolor(15);
  105. outtextxy(140,130,'SPEGNI');
  106. outtextxy(285,130,'DISCONETTI');
  107. outtextxy(455,130,'RIAVVIA');
  108.  
  109. setcolor(0);setrgbpalette(0,0,0,0);
  110. icona:=loadicon(hinstance,pchar(1)); wrimm(145,150,true);
  111. icona:=loadicon(hinstance,pchar(3)); wrimm(305,150,true);
  112. icona:=loadicon(hinstance,pchar(2)); wrimm(465,150,true);
  113. icona:=loadicon(hinstance,pchar(4)); wrimm(602,0,false);
  114. outtextxy(160,332,'Software developed by Andrea Agnolin');
  115. outtextxy(60,341,'You can redistribute it under the terms of the GNU GPL, see copying.txt');
  116. end;
  117.  
  118.  
  119. BEGIN
  120. startx := (getsystemmetrics(sm_cxscreen)-640) div 2;
  121. starty := (getsystemmetrics(sm_cyscreen)-480) div 2;
  122. ws_graph := ws_popupwindow;
  123. icon := loadicon(hinstance,pchar(0));
  124. freccia := loadicon(hinstance,pchar(5));
  125. windowtitle := 'Shutdown  v2';
  126. graph.mousemessagehandler:=@mouse;
  127. graph.charmessagehandler:=@tastiera;
  128. initgraph(G1,G2,'');
  129. disegno;
  130. sc := 1;
  131. repeat
  132.  for I := 69 to 561 do begin
  133.   if i < 320 then setrgbpalette(0,(I div 3),(I div 3),250)
  134.    else setrgbpalette(0,106-((I-320) div 3),106-((I-320) div 3),250);
  135.   line(I,200,I,240);
  136.  end;
  137.  delay(1);
  138.  drawicon(windc,120+(sc-1)*160,200,freccia);
  139.  drawicon(bitmapdc,120+(sc-1)*160,200,freccia);
  140.  delay(100);
  141. until letto or not(iswindow(graphwindow));
  142. if not(iswindow(graphwindow)) then halt(0);
  143. case sc of
  144.  1:Spegni(EWX_POWEROFF);
  145.  3:Spegni(EWX_REBOOT);
  146.  2:Spegni(EWX_LOGOFF);
  147.  else MessageBox(0, 'Choose SHUTDOWN, RESTART or LOGOFF.', 'Shutdown', MB_OK + MB_ICONEXCLAMATION);
  148. end;
  149. END.