(*****************************************************************************)
(* *)
(* PackData *)
(* *)
(* 11/4/95 *)
(* Randall L. Hyde *)
(* Copyright 1995, All Rights Reserved Unless Otherwise Noted *)
(* *)
(* This program allows the user to input a month value (1..12), a day *)
(* value (1..31), and a year value (0..99). It packs these three values *)
(* into 16 bits and displays the results. *)
(* *)
(* Runs under Windows 3.1, Windows 95, and Windows NT. *)
(* Source Code: Borland Delphi (object Pascal). *)
(* *)
(*****************************************************************************)
unit Packedu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls,
{ Useful conversion routines: bin <-> dec <-> hexadecimal }
Converts;
type
TPackedData = class(TForm)
Panel1: TPanel;
BoundingBox: TGroupBox;
{ Button objects }
ExitBtn: TButton;
AboutBtn: TButton;
{ Data Entry Text Boxes }
MonthBin: TEdit;
DayBin: TEdit;
YearBin: TEdit;
MonthDec: TEdit;
DayDec: TEdit;
YearDec: TEdit;
{ Data output strings }
BinResult: TLabel;
HexResult: TLabel;
{ Labels appearing on the form }
MonthLbl: TLabel;
DayLbl: TLabel;
YearLbl: TLabel;
DataPackLbl: TLabel;
DecimalLbl: TLabel;
BinaryLbl: TLabel;
PackResLbl: TLabel;
{ Methods to handle various events }
procedure ExitBtnClick(Sender: TObject);
procedure AboutBtnClick(Sender: TObject);
procedure MonthBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure MonthDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure DayDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure DayBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure YearDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure YearBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure BoundingBoxClick(Sender: TObject);
private
public
end;
var
PackedData: TPackedData;
implementation
{$R *.DFM}
{ RangeUnsigned checks the first parameter (a string of decimal digits) }
{ to see if it is a legal unsigned decimal number. If it is, then it }
{ converts the value to an integer and checks to make sure it is in the }
{ range start..stop. The function returns true if this is the case, }
{ false otherwise. }
function RangeUnsigned(const value:string; start, stop:integer):boolean;
var intValue:word;
begin
result := CheckUnsigned(value);
if result then begin
intValue := StrToInt(Value);
result := (intValue >= Start) and (intValue <= Stop);
end;
end;
{ RangeBin is like RangeUnsigned above, except it checks for binary }
{ values rather than decimal values. }
function RangeBin(const value:string; start, stop:integer):boolean;
var intValue:word;
begin
result := CheckBin(value);
if result then begin
intValue := BinToInt(Value);
result := (intValue >= Start) and (intValue <= Stop);
end;
end;
{ The program executes the following procedure when the user hits the }
{ QUIT button. }
procedure TPackedData.ExitBtnClick(Sender: TObject);
begin
Halt;
end;
{ The program executes the following procedure when the user hits the }
{ ABOUT button. }
procedure TPackedData.AboutBtnClick(Sender: TObject);
begin
MessageDlg(
'Packed Data Demonstration, Copyright 1995 by Randall Hyde',
mtInformation, [mbOk], 0);
end;
{ MonthDecKeyUp- }
{ The program calls this procedure whenever the user presses and re- }
{ leases a key in the decimal month data entry text box. This routine }
{ converts the new string to an integer, verifies that it is in the }
{ range 1..12, packs the new month value into packed data object, and }
{ then displays the new packed data. }
{ This procedure turns the decimal month background red if there is a }
{ user input error. }
procedure TPackedData.MonthDecKeyUp( Sender:TObject;
var Key:Word;
Shift:TShiftState
);
var
Year,
Month,
Day :word;
begin
{First, see if this is a legal decimal value in the range 1..12 }
if (RangeUnsigned(MonthDec.Text, 1, 12)) then begin
{ Okay, convert the month, day, and year values into integers }
{ so we can pack them into a 16-bit value. }
Month := StrToInt(MonthDec.Text);
Day := StrToInt(DayDec.Text);
Year := StrToInt(YearDec.Text);
{ Since the month has just changed, update the binary represen- }
{ tation of the month. }
MonthBin.Text := IntToBin(Month,4);
{ Output the packed data to the appropriate fields on the form. }
BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
{ Since there was no error, clear any red background that may }
{ have previously appeared in this field. }
MonthDec.Color := clWindow;
MonthBin.Color := clWindow;
end
else begin
{ Come down here if the month just typed is illegal or out of }
{ range. Beep the speaker and color the background red. }
MessageBeep($ffff);
MonthDec.Color := clRed;
end;
end;
{ MonthBinKeyUp- }
{ Just like the routine above, except this one handles binary input }
{ rather than decimal input. See the comments above for a running }
{ commentary about this procedure. }
procedure TPackedData.MonthBinKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Year,
Month,
Day :word;
begin
if (RangeBin(MonthBin.Text, 1, 12)) then begin
Month := BinToInt(MonthBin.Text);
Day := BinToInt(DayBin.Text);
Year := BinToInt(YearBin.Text);
MonthDec.Text := IntToStr(Month);
BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 6);
HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
MonthBin.Color := clWindow;
MonthDec.Color := clWindow;
end
else begin
MessageBeep($ffff);
MonthBin.Color := clRed;
end;
end;
{ DayDecKeyUp- }
{ Like the above routines, handles a key up event in the decimal day }
{ text entry box. }
procedure TPackedData.DayDecKeyUp( Sender: TObject;
var Key: Word;
Shift: TShiftState);
var
Year,
Month,
Day :word;
begin
if (RangeUnsigned(DayDec.Text, 1, 31)) then begin
Day := StrToInt(DayDec.Text);
Month := StrToInt(MonthDec.Text);
Year := StrToInt(YearDec.Text);
DayBin.Text := IntToBin(Day, 5);
BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
HexResult.Caption:=IntToHex((Month shl 12) or(Day shl 7) or Year, 4);
DayDec.Color := clWindow;
DayBin.Color := clWindow;
end
else begin
MessageBeep($ffff);
DayDec.Color := clRed;
end;
end;
{ Binary data entry version of the routine above. }
procedure TPackedData.DayBinKeyUp( Sender:TObject;
var Key:Word;
Shift:TShiftState
);
var
Year,
Month,
Day :word;
begin
if (RangeBin(DayBin.Text, 1, 31)) then begin
Day := BinToInt(DayBin.Text);
Month := BinToInt(MonthBin.Text);
Year := BinToInt(YearBin.Text);
DayDec.Text := IntToStr(Day);
BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
DayBin.Color := clWindow;
DayDec.Color := clWindow;
end
else begin
MessageBeep($ffff);
DayBin.Color := clRed;
end;
end;
{ YearDecKeyUp- }
{ Keystroke event handler for the decimal year data entry text box. }
procedure TPackedData.YearDecKeyUp( Sender: TObject;
var Key: Word;
Shift: TShiftState
);
var
Year,
Month,
Day :word;
begin
if (RangeUnsigned(YearDec.Text, 0, 99)) then begin
Year := StrToInt(YearDec.Text);
Month := StrToInt(MonthDec.Text);
Day := StrToInt(DayDec.Text);
YearBin.Text := IntToBin(Year, 7);
BinResult.Caption:=IntToBin((month shl 12) or (Day shl 7) or Year, 16);
HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
YearDec.Color := clWindow;
YearBin.Color := clWindow;
end
else begin
MessageBeep($ffff);
YearDec.Color := clRed;
end;
end;
{ Binary version of the above code. }
procedure TPackedData.YearBinKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Year,
Month,
Day :word;
begin
if (RangeBin(DayBin.Text, 0, 99)) then begin
Year := BinToInt(YearBin.Text);
Month:= StrToInt(MonthDec.Text);
Day:= StrToInt(DayDec.Text);
YearDec.Text := IntToStr(Year);
BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
YearDec.Color := clWindow;
YearBin.Color := clWindow;
end
else begin
MessageBeep($ffff);
YearDec.Color := clRed;
end;
end;
procedure TPackedData.BoundingBoxClick(Sender: TObject);
var
Year,
Month,
Day :word;
begin
Year := BinToInt(YearBin.Text);
Month:= StrToInt(MonthDec.Text);
Day:= StrToInt(DayDec.Text);
YearDec.Text := IntToStr(Year);
YearBin.Text := IntToBin(Year,7);
MonthDec.Text := IntToStr(Month);
MonthBin.Text := IntToBin(Month,4);
DayDec.Text := IntToStr(Day);
DayBin.Text := IntToBin(Day,5);
end;
end.
