home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 February / Chip_2004-02_cd1.bin / zkuste / konfig / download / msic / Demos / 6 / Main.pas < prev    next >
Pascal/Delphi Source File  |  2003-07-09  |  5KB  |  191 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, MSI_Processes, ComCtrls, ExtCtrls, StdCtrls, MSI_Common;
  8.  
  9. type
  10.   Twnd_Main = class(TForm)
  11.     List: TListView;
  12.     pTitle: TPanel;
  13.     Image1: TImage;
  14.     Bevel1: TBevel;
  15.     bRefresh: TButton;
  16.     bSave: TButton;
  17.     bClose: TButton;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     eName: TEdit;
  21.     ePri: TEdit;
  22.     sd: TSaveDialog;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.     procedure ListCompare(Sender: TObject; Item1, Item2: TListItem;
  26.       Data: Integer; var Compare: Integer);
  27.     procedure ListColumnClick(Sender: TObject; Column: TListColumn);
  28.     procedure ListAdvancedCustomDrawItem(Sender: TCustomListView;
  29.       Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  30.       var DefaultDraw: Boolean);
  31.     procedure ListAdvancedCustomDrawSubItem(Sender: TCustomListView;
  32.       Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  33.       Stage: TCustomDrawStage; var DefaultDraw: Boolean);
  34.     procedure TimerTimer(Sender: TObject);
  35.     procedure bRefreshClick(Sender: TObject);
  36.     procedure bCloseClick(Sender: TObject);
  37.     procedure ListSelectItem(Sender: TObject; Item: TListItem;
  38.       Selected: Boolean);
  39.     procedure bSaveClick(Sender: TObject);
  40.   private
  41.     ProcList: TProcessList;
  42.   public
  43.     procedure RefreshData;
  44.   end;
  45.  
  46. var
  47.   wnd_Main: Twnd_Main;
  48.  
  49. implementation
  50.  
  51. uses MiTeC_CtrlRtns, MiTeC_Datetime;
  52.  
  53. {$R *.dfm}
  54.  
  55. procedure Twnd_Main.FormCreate(Sender: TObject);
  56. begin
  57.   ProcList:=TProcessList.Create;
  58.   if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
  59.     List.Columns[2].Caption:='Threads';
  60.     List.Columns[3].Caption:='Usage';
  61.   end;
  62.   RefreshData;
  63. end;
  64.  
  65. procedure Twnd_Main.FormDestroy(Sender: TObject);
  66. begin
  67.   ProcList.Destroy;
  68. end;
  69.  
  70. procedure Twnd_Main.RefreshData;
  71. var
  72.   i: Integer;
  73. begin
  74.   with ProcList do
  75.     try
  76.       List.Items.BeginUpdate;
  77.       List.Items.Clear;
  78.       //Screen.Cursor:=crHourglass;
  79.       GetInfo;
  80.       for i:=0 to ProcessCount-1 do
  81.         with List.Items.Add do begin
  82.           Caption:=Processes[i].Name;
  83.           if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
  84.             SubItems.Add(Format('%x',[Processes[i].PID]));
  85.             SubItems.Add(Format('%d',[Processes[i].ThreadCount]));
  86.             SubItems.Add(Format('%d',[Processes[i].Usage]));
  87.           end else begin
  88.             SubItems.Add(Format('%d',[Processes[i].PID]));
  89.             SubItems.Add(FormatSeconds((Processes[i].UserTime.QuadPart+Processes[i].KernelTime.QuadPart)/10000000,True,False,True));
  90.             SubItems.Add(Format('%d KB',[Processes[i].VMCounters.WorkingSetSize div 1024]));
  91.           end;
  92.         end;
  93.     finally
  94.       List.Items.EndUpdate;
  95.       pTitle.Caption:=Format('               %d processes',[List.Items.Count]);
  96.       //Screen.Cursor:=crDefault;
  97.     end;
  98. end;
  99.  
  100. procedure Twnd_Main.ListCompare(Sender: TObject; Item1, Item2: TListItem;
  101.   Data: Integer; var Compare: Integer);
  102. begin
  103.   Compare:=ListView_CustomSort(Item1,Item2,ListView_SortColumn);
  104.   if ListView_SortDescending then
  105.     Compare:=-Compare;
  106. end;
  107.  
  108. procedure Twnd_Main.ListColumnClick(Sender: TObject; Column: TListColumn);
  109. begin
  110.   TListView(Sender).SortType:=stNone;
  111.   if Column.Index<>ListView_SortColumn then begin
  112.     ListView_SortColumn:=Column.Index;
  113.     ListView_SortDescending:=False;
  114.   end else
  115.     ListView_SortDescending:=not ListView_SortDescending;
  116.   TListView(Sender).SortType:=stText;
  117. end;
  118.  
  119. procedure Twnd_Main.ListAdvancedCustomDrawItem(Sender: TCustomListView;
  120.   Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  121.   var DefaultDraw: Boolean);
  122. begin
  123.   if ListView_SortColumn=0 then
  124.     Sender.Canvas.Brush.Color:=clInfoBk
  125.   else
  126.     Sender.Canvas.Brush.Color:=clWhite
  127. end;
  128.  
  129. procedure Twnd_Main.ListAdvancedCustomDrawSubItem(Sender: TCustomListView;
  130.   Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  131.   Stage: TCustomDrawStage; var DefaultDraw: Boolean);
  132. begin
  133.   if ListView_SortColumn=SubItem then
  134.     Sender.Canvas.Brush.Color:=clInfoBk
  135.   else
  136.     Sender.Canvas.Brush.Color:=clWhite
  137. end;
  138.  
  139. procedure Twnd_Main.TimerTimer(Sender: TObject);
  140. begin
  141.   RefreshData;
  142. end;
  143.  
  144. procedure Twnd_Main.bRefreshClick(Sender: TObject);
  145. begin
  146.   RefreshData;
  147. end;
  148.  
  149. procedure Twnd_Main.bCloseClick(Sender: TObject);
  150. begin
  151.   Close;
  152. end;
  153.  
  154. procedure Twnd_Main.ListSelectItem(Sender: TObject; Item: TListItem;
  155.   Selected: Boolean);
  156. var
  157.   idx: Integer;
  158.   pid: DWORD;
  159. begin
  160.   idx:=-1;
  161.   if Assigned(Item) and Selected then begin
  162.     if Win32Platform<>VER_PLATFORM_WIN32_NT then
  163.       pid:=StrToInt('$'+Item.SubItems[0])
  164.     else
  165.       pid:=StrToInt(Item.SubItems[0]);
  166.     idx:=ProcList.FindProcess(pid);
  167.     if idx<>-1 then begin
  168.       eName.Text:=ProcList.Processes[idx].ImageName;
  169.       ePri.Text:=Format('%d',[ProcList.Processes[idx].Priority]);
  170.     end;
  171.   end;
  172.   if idx=-1 then begin
  173.     eName.Text:='';
  174.     ePri.Text:='';
  175.   end;
  176. end;
  177.  
  178. procedure Twnd_Main.bSaveClick(Sender: TObject);
  179. var
  180.   sl: TStringList;
  181. begin
  182.   sl:=TStringList.Create;
  183.   if sd.Execute then begin
  184.     ProcList.Report(sl,True);
  185.     sl.SaveToFile(sd.FileName);
  186.   end;
  187.   sl.Free;
  188. end;
  189.  
  190. end.
  191.