unit Percent;

interface
uses WinProcs,WinTypes,Frames,Strings,BWCC,WObjects;

const OutWidth=3;
			max_Lines=2;

type
	PPercentDlg = ^TPercentDlg;
	TPercentDlg = object(TDlgWindow)
		Blank : array[0..1] of char;
		PctColor,TextColor:TColorRef;
		PctLow,PctHigh,PctCurrent,PctOld:array[1..max_Lines] of integer;
		DisplayPct:boolean;
		Lines:integer;
		BackBrush:HBrush;
		PctR:array[1..max_Lines] of TRect;
		CancelBool:boolean;
		constructor Init(AParent:PWindowsObject; AName:PChar; NumLines:integer; DrawTxt:boolean);
		destructor Done; virtual;
		procedure SetupWindow; virtual;
		function GetClassName:PChar; virtual;
		procedure GetWindowClass(var AWndClass:TWndClass); virtual;
		procedure SetDefaults; virtual;
		procedure SetPctLevel(PctLevel:integer; Line:integer); virtual;
		procedure AddPctLevel(PctLevel:integer; Line:integer); virtual;
		procedure DelPctLevel(PctLevel:integer; Line:integer); virtual;
		procedure DrawPct; virtual;
		procedure DrawPercent(Line:integer); virtual;
		procedure DrawPctText(Line:integer); virtual;
		procedure SetText(Text:PChar;Line:integer); virtual;
		procedure WMPaint(var Msg:TMessage); virtual $0088;
		procedure Cancel(var Msg:TMessage); virtual id_First+id_Cancel;
		procedure Update; virtual;
	end;

implementation

constructor TPercentDlg.Init(AParent:PWindowsObject; AName:PChar; NumLines:integer; DrawTxt:boolean);
begin
	TDlgWindow.Init(AParent,AName);
	CancelBool := false;
	Lines := NumLines;
	if Lines > max_Lines then Lines := max_Lines;
	EnableKBHandler;
	DisplayPct := DrawTxt;
	StrCopy(Blank,' ');
end;

destructor TPercentDlg.Done;
begin
	DeleteObject(BackBrush);
	TDlgWindow.Done;
end;

procedure TPercentDlg.SetupWindow;
begin
	TDlgWindow.SetupWindow;
	SetDefaults;
	SendMessage(HWindow,wm_SetText,0,longint(@Blank));
	DrawPct;
end;

function TPercentDlg.GetClassName:PChar;
begin
	GetClassName := 'Percent_Dialog';
end;

procedure TPercentDlg.GetWindowClass(var AWndClass:TWndClass);
begin
	TDlgWindow.GetWindowClass(AWndClass);
	AWndClass.lpfnWndProc := Addr(BWCCDefWindowProc);
end;

procedure TPercentDlg.SetDefaults;
var DC:HDC;
		Point:TPoint;
		DlgR:TRect;
		count:integer;
begin
	for count := 1 to Lines do
	begin
		PctLow[count]:=0;
		PctHigh[count]:=100;
		PctCurrent[count]:=PctLow[count];
		PctOld[count]:=-1;
	end;

	GetClientRect(HWindow,DlgR);
	Point.X := DlgR.left; Point.Y := DlgR.top;
	ClientToScreen(HWindow,Point);
	DlgR.left := Point.X; DlgR.top := Point.Y;
	Point.X := DlgR.right; Point.Y := DlgR.bottom;
	ClientToScreen(HWindow,Point);
	DlgR.right := Point.X; DlgR.bottom := Point.Y;

	for count := 1 to Lines do
	begin
		GetWindowRect(GetDlgItem(HWindow,200+count),PctR[count]);
		with PctR[count] do
		begin
			top := top - DlgR.top;
			bottom := bottom - DlgR.top;
			left := left - DlgR.left;
			right := right - DlgR.left;
		end;
	end;
	PctColor:=RGB(64,64,64);
	TextColor:=RGB(0,0,128);
end;

procedure TPercentDlg.SetPctLevel(PctLevel:integer;Line:integer);
begin
	PctCurrent[Line]:=PctLevel;
	if PctLevel>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
	if PctLevel<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
	Update;
	DrawPct;
end;

procedure TPercentDlg.AddPctLevel(PctLevel:integer;Line:integer);
begin
	PctCurrent[Line]:=PctCurrent[Line]+PctLevel;
	if PctCurrent[Line]>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
	if PctCurrent[Line]<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
	Update;
	DrawPct;
end;

procedure TPercentDlg.DelPctLevel(PctLevel:integer;Line:integer);
begin
	PctCurrent[Line]:=PctCurrent[Line]-PctLevel;
	if PctCurrent[Line]>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
	if PctCurrent[Line]<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
	Update;
	DrawPct;
end;

procedure TPercentDlg.DrawPct;
var count:integer;
begin
	for count := 1 to Lines do
		if PctOld[count] <> PctCurrent[count] then
		begin
			PctOld[count] := PctCurrent[count];
			DrawPercent(count);
			if DisplayPct and (count = Lines) then
				DrawPctText(count);
		end;
	if PctCurrent[Lines] = PctLow[Lines] then
		DrawPercent(Lines);
end;

procedure TPercentDlg.DrawPercent(Line:integer);
var InR,OutR:TRect;
		TempR:TRect;
		PaintDC:HDC;
		TheBrush,OldBrush:HBrush;
		ThePen,OldPen:HPen;
		BuffS:string;
		Buffer:array[0..10] of char;
		MemDC:HDC;
		TheBits,OldBits:HBitmap;
begin
	TempR := PctR[Line];
	TempR.right:=TempR.right-TempR.left;
	TempR.left:=0;
	TempR.bottom:=TempR.bottom-TempR.top;
	TempR.top:=0;
	InR:=TempR;
	OutR:=TempR;
	InflateRect(InR,-1,-1);
	InflateRect(OutR,-1,-1);
	InR.bottom:=InR.bottom+1;
	InR.right:=InR.right+1;
	OutR.bottom:=OutR.bottom-1;
	if (PctCurrent[Line]-PctLow[Line])<>0 then
	InR.left:=InR.left+integer(Trunc((InR.right-InR.left) * ((PctCurrent[Line]-PctLow[Line]) / (PctHigh[Line]-PctLow[Line]))) );
	OutR.right:=InR.left+1;
	PaintDC:=GetDC(HWindow);
	MemDC:=CreateCompatibleDC(PaintDC);
	TheBits:=CreateCompatibleBitmap(PaintDC,TempR.right,TempR.bottom);
	OldBits:=SelectObject(MemDC,TheBits);

	TheBrush:=GetStockObject(Null_Brush);
	OldBrush:=SelectObject(MemDC,TheBrush);
	ThePen:=CreatePen(ps_Solid,1,GetSysColor(color_WindowFrame));
	OldPen:=SelectObject(MemDC,ThePen);
	Rectangle(MemDC,TempR.left,TempR.top,TempR.right,TempR.bottom);
	SelectObject(MemDC,OldBrush);
	DeleteObject(TheBrush);
	SelectObject(MemDC,OldPen);
	DeleteObject(ThePen);

	if (PctCurrent[Line]<>PctHigh[Line]) then
	begin
		TheBrush:=CreateSolidBrush($00C0C0C0);
		OldBrush:=SelectObject(MemDC,TheBrush);
		ThePen:=GetStockObject(Null_Pen);
		OldPen:=SelectObject(MemDC,ThePen);
		Rectangle(MemDC,InR.left,InR.top,InR.right,InR.bottom);
		InR.right:=InR.right-2; InR.bottom:=InR.bottom-2;
		InflateRect(InR,-2,-2);
		DrawInFrame(MemDC,InR,true,1);
		InflateRect(InR,2,2);
		InR.right:=InR.right+2; InR.left:=InR.left+1; InR.bottom:=InR.bottom+2;
		SelectObject(MemDC,OldBrush);
		DeleteObject(TheBrush);
		SelectObject(MemDC,OldPen);
		DeleteObject(ThePen);
	end;

	if PctCurrent[Line]<>PctLow[Line] then
	begin
		if OutR.right>(TempR.right-2) then OutR.right:=TempR.right-2;
		if Lines = Line then
			DrawOutFrame(MemDC,OutR,true,OutWidth) else
			DrawOutFrame(MemDC,OutR,true,OutWidth-1);
	end;

	BitBlt(PaintDC,PctR[Line].left,PctR[Line].top,TempR.right,TempR.bottom,MemDC,0,0,srcCopy);
	SelectObject(MemDC,OldBits);
	DeleteObject(TheBits);
	ReleaseDC(GetDlgItem(HWindow,201),PaintDC);
	DeleteDC(MemDC);
end;

procedure TPercentDlg.DrawPctText(Line:integer);
var PaintR:TRect;
		Buffer:array[0..10] of char;
		BuffS:string[10];
		Extent:longint;
		PaintDC:HDC;
begin
	PaintDC := GetDC(HWindow);
	SetTextAlign(PaintDC,ta_Top or ta_Left);
	SetBkMode(PaintDC,Transparent);
	SetTextColor(PaintDC,TextColor);
	Str(PctCurrent[Line],BuffS);
	BuffS := BuffS + '%';
	StrPCopy(Buffer,BuffS);
	Extent := GetTextExtent(PaintDC,Buffer,StrLen(Buffer));
	TextOut(PaintDC,
			PctR[Line].left+((PctR[Line].right-PctR[Line].left-Loword(Extent)) div 2),
			PctR[Line].top+((PctR[Line].bottom-PctR[Line].top-Hiword(Extent)) div 2),
			Buffer,StrLen(Buffer));
	ReleaseDC(HWindow,PaintDC);
end;

procedure TPercentDlg.SetText(Text:PChar;Line:integer);
var Buffer:array[0..100] of char;
begin
	if Text <> nil then
		StrCopy(Buffer,Text) else
		StrCopy(Buffer,Blank);
	if Line <> 0 then
		SendDlgItemMsg(100+Line,wm_SetText,0,longint(@Buffer)) else
		SendMessage(HWindow,wm_SetText,0,longint(@Buffer));
	Update;
end;

procedure TPercentDlg.WMPaint(var Msg:TMessage);
var count:integer;
begin
	for count := 1 to Lines do
		PctOld[count] := -1;
	DrawPct;
end;

procedure TPercentDlg.Cancel(var Msg:TMessage);
begin
	CancelBool := true;
end;

procedure TPercentDlg.Update;
var Msg:TMsg;
begin
	if Parent <> nil then
	begin
		while PeekMessage(Msg,0,0,0,pm_Remove) do
		if not IsDialogMessage(HWindow,Msg) then
		begin
			TranslateMessage(Msg);
			DispatchMessage(Msg);
		end;
	end;
end;

End.