program DiskC;

{$R MemStat.RES}

uses WObjects, WinTypes, WinProcs, Strings, WinDOS, Frames;

type
	TDiskCApp = object(TApplication)
		procedure InitMainWindow; virtual;
	end;

	PDiskCWindow = ^TDiskCWindow;
	TDiskCWindow = object(TWindow)
		function GetClassName: PChar; virtual;
		procedure SetupWindow; virtual;
		procedure GetWindowClass(var AWndClass: TWndClass); virtual;
		procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct); virtual;
		procedure WMDestroy(var Msg:TMessage); virtual wm_First+wm_Destroy;
		procedure About;
		procedure WMQueryOpen(var Msg:TMessage); virtual wm_First+wm_QueryOpen;
		procedure WMSysCommand(var Msg:TMessage); virtual wm_First+wm_SysCommand;
		procedure WMTimer(var Msg:TMessage); virtual wm_First+wm_Timer;
	end;

var
	R:TRect;
	PctTxt:array[0..4] of Char;

const
	sc_About=100;
	sc_Options=101;

procedure TDiskCApp.InitMainWindow;
begin
	MainWindow := New(PDiskCWindow, Init(nil, 'Space on C:'));
end;

function TDiskCWindow.GetClassName: PChar;
begin
	GetClassName := 'DiskC'
end;

procedure TDiskCWindow.GetWindowClass(var AWndClass: TWndClass);
begin
	TWindow.GetWindowClass(AWndClass);
	AWndClass.HIcon := 0; {This is a necessary line. It tells Windows to
												 leave the iconized window blank, allowing a
												 program to draw on it.}
end;

procedure TDiskCWindow.SetupWindow;
var ResMenu:HMenu;
		T:longint;
begin
	TWindow.SetupWindow;
	if SetTimer(HWindow,20,5000,nil)=0 then  {timer set for 1/2 second}
	begin
		MessageBox(HWindow,'Too many timers in use. Cannot load.',
							 'DiskC Stats',mb_IconExclamation or mb_OK);
		CloseWindow;
	end;
	UpdateWindow(HWindow);
	ResMenu:=GetSystemMenu(HWindow,false);
	DeleteMenu(ResMenu,sc_Restore,mf_ByCommand);
	DeleteMenu(ResMenu,sc_Maximize,mf_ByCommand);
{	AppendMenu(ResMenu,mf_String,0,nil);
	AppendMenu(ResMenu,mf_String,sc_About,'&About Memory Stats...');}
	SendMessage(HWindow,wm_Timer,1,0);
end;

procedure TDiskCWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var TextMetrics:TTextMetric;
		LogicFont:HFont;
		size:integer;
		wout:boolean;
begin
	with R do
	begin
		Right:=GetSystemMetrics(sm_CXIcon)+3;
		Bottom:=GetSystemMetrics(sm_CYIcon)+3;
		Left:=0;Top:=0;
	end;
	DrawBorderFrame(PaintDC,R,true);
	size:=15;
	wout:=true;
	while wout do
	begin
		LogicFont := CreateFont(size,0,0,0,900,0,0,0,0,0,0,0,ff_Swiss+Variable_Pitch,'MS Sans Serif');
		SelectObject(PaintDC,LogicFont);
		If Loword(GetTextExtent(PaintDC,'100%',4))<(R.right-2) then wout:=false
		else
			begin
				DeleteObject(LogicFont);
				size:=size-1;
			end;
	end;
	SetBkMode(PaintDC,Transparent);
	SetTextAlign(PaintDC,ta_Bottom);
	SetTextColor(PaintDC,RGB(0,0,0));
	GetTextMetrics(PaintDC,TextMetrics);
	TextOut(PaintDC,Round((R.right-Loword(GetTextExtent(PaintDC,PctTxt,StrLen(PctTxt))))/2),
		R.bottom-Round((R.bottom-TextMetrics.tmHeight-2)/2),PctTxt,StrLen(PctTxt));
	DeleteObject(LogicFont);
end;

procedure TDiskCWindow.WMTimer(var Msg:TMessage);
var
	wFree,wSize:word;
	GDIPct,UserPct,dwInfo:longint;
	PctTxtT:array[0..4] of char;
	PctNum:string;
begin
	Str(Round(DiskFree(3)/DiskSize(3)*100),PctNum);
	StrPCopy(PctTxtT,PctNum+'%');
	if (StrPas(PctTxtT) <> StrPas(PctTxt)) or (Msg.wParam=1) then
	begin
		StrPCopy(PctTxt,PctTxtT);
		InvalidateRect(HWindow,nil,false);
		UpdateWindow(HWindow);
	end;
end;

procedure TDiskCWindow.WMQueryOpen(var Msg:TMessage);
begin
	Msg.Result:=0;
end;

procedure TDiskCWindow.WMDestroy(var Msg:TMessage);
begin
	KillTimer(HWindow,20);
	TWindow.WMDestroy(Msg);
end;

procedure TDiskCWindow.WMSysCommand(var Msg:TMessage);
begin
	case Msg.wParam of
		sc_About:
				About  {I was thinking about adding an Options... menu item.}
		else			 {That's why this unnecessary Case command is here.}
			DefWndProc(Msg);
	end;
end;

procedure TDiskCWindow.About;
var Dialog:TDialog;
begin
	Dialog.Init(@Self, 'About');
	Dialog.Execute;
	Dialog.Done;
end;

var
	DiskCApp: TDiskCApp;

begin
	CmdShow:=sw_Minimize;
	DiskCApp.Init('DiskCApp');
	DiskCApp.Run;
	DiskCApp.Done;
end.