home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctchnqs
/
1991
/
number4
/
prsetup.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-13
|
6KB
|
225 lines
{ prsetup.pas -- Demonstrate printer setup dialogs }
program prSetup;
{$R prsetup.res}
uses WinTypes, WinProcs, WObjects, Strings;
const
id_Menu = 100; { Menu resource ID }
cm_FileSetup = 101; { File:Printer setup command ID }
cm_FileExit = 102; { File:Exit command ID }
id_Setup = 100; { Setup dialog resource ID }
id_ListBox = 101; { Setup's listbox control ID }
id_SetupButton = 102; { Setup's setup button control ID }
type
TAppObject = object(TApplication)
procedure InitMainWindow; virtual;
end;
PTMainWindow = ^TMainWindow;
TMainWindow = object(TWindow)
DefaultDevice: array[0 .. 40] of Char; { Default printer }
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure CMFileSetup(var Msg: TMessage);
virtual cm_First + cm_FileSetup;
procedure CMFileExit(var Msg: TMessage);
virtual cm_First + cm_FileExit;
end;
PTSetupDialog = ^TSetupDialog;
TSetupDialog = object(TDialog)
Selection: PChar; { Selected device }
constructor Init(AParent: PWindowsObject;
AName: PChar; OwnerSelection: PChar);
procedure SetupWindow; virtual;
procedure Ok(var Msg: TMessage);
virtual id_First + id_Ok;
procedure Setup(var Msg: TMessage);
virtual id_First + id_SetupButton;
end;
TExtDeviceMode = function(HWindow: HWnd; HDriver: THandle;
DevModeOutput: PDevMode; DeviceName, OutputName: PChar;
DevModeInput: PDevMode; Profile: PChar;
Mode: Word): Integer;
var
ExtDeviceMode: TExtDeviceMode;
DeviceMode: TDeviceMode;
{- Return pointer to next token in P or previous P if P = nil }
function NextToken(P: PChar; C: Char): PChar;
const
Next: PChar = nil;
begin
if P = nil then P := Next;
Next := StrScan(P, C);
if Next <> nil then
begin
Next^ := #0;
Next := @Next[1]
end;
NextToken := P
end;
{ TAppObject }
{- Initialize the application }
procedure TAppObject.InitMainWindow;
begin
MainWindow := New(PTMainWindow,
Init(nil, 'Printer Setup Demonstration'))
end;
{ TMainWindow }
{- Construct main window object }
constructor TMainWindow.Init(AParent: PWindowsObject;
ATitle: PChar);
var
P: PChar;
Buffer: array[0 .. 1024] of Char;
begin
TWindow.Init(AParent, ATitle);
Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
GetProfileString('windows', 'device', ',,', Buffer,
Sizeof(Buffer));
P := NextToken(Buffer, ',');
if P <> nil then
StrLCopy(DefaultDevice, P, 40)
else
DefaultDevice[0] := #0;
end;
{- Execute File:Printer setup command }
procedure TMainWindow.CMFileSetup(var Msg: TMessage);
begin
Application^.ExecDialog(New(PTSetupDialog,
Init(@Self, PChar(id_Setup), DefaultDevice)))
end;
{- Execute File:Exit command }
procedure TMainWindow.CMFileExit(var Msg: TMessage);
begin
CloseWindow
end;
{ TSetupDialog }
{- Construct TSetupDialog object }
constructor TSetupDialog.Init(AParent: PWindowsObject;
AName: PChar; OwnerSelection: PChar);
begin
TDialog.Init(AParent, AName);
Selection := OwnerSelection;
end;
{- Insert DeviceNames strings into dialog list box }
procedure TSetupDialog.SetupWindow;
var
I: Integer;
P: PChar;
Buffer: array[0 .. 4096] of Char;
begin
GetProfileString('devices', nil, #0'', Buffer,Sizeof(Buffer));
I := 0;
P := NextToken(Buffer, #0);
while StrLen(P) <> 0 do
begin
SendDlgItemMsg(id_ListBox, lb_AddString, 0, LongInt(P));
if StrComp(Selection, P) = 0 then
SendDlgItemMsg(id_ListBox, lb_SetCurSel, I, 0);
P := NextToken(nil, #0);
Inc(I)
end;
end;
{- Respond to Ok button selection }
procedure TSetupDialog.Ok(var Msg: TMessage);
var
Item: Word; { Selected listbox-item index }
Len: Integer; { Length of selected item }
Buffer: array[0 .. 80] of Char;
begin
Item := SendDlgItemMsg(id_Listbox, lb_GetCurSel, 0, 0);
if Item <> lb_Err then
SendDlgItemMsg(id_Listbox, lb_GetText, Item,
LongInt(Selection));
TDialog.Ok(Msg)
end;
{- Respond to Setup button selection }
procedure TSetupDialog.Setup(var Msg: TMessage);
var
Item: Word;
DriverName, OutputName: PChar;
Buffer: array[0 .. 80] of Char;
DeviceName: array[0 .. 40] of Char;
HDriver: THandle;
Size: Integer; { Size of DevMode structure }
DriverExtName: array[0 .. 12] of Char;
DevModeOutput: PDevMode;
P: TFarProc;
begin
Item := SendDlgItemMsg(id_Listbox, lb_GetCurSel, 0, 0);
if Item <> lb_Err then
begin
SendDlgItemMsg(id_Listbox, lb_GetText, Item,
LongInt(@DeviceName));
GetProfileString('devices', DeviceName, ',,', Buffer,
Sizeof(Buffer));
DriverName := NextToken(Buffer, ',');
OutputName := NextToken(nil, ',');
if (StrLen(DriverName) = 0) or (StrLen(OutputName) = 0) then
begin
MessageBox(HWindow, 'Bad device format', 'Error', mb_Ok);
Exit
end;
StrLCat(StrCopy(DriverExtName, DriverName), '.DRV', 12);
HDriver := LoadLibrary(DriverExtName);
if HDriver < 32 then
MessageBox(HWindow, 'Failed to load driver', 'Error',
mb_IconExclamation or mb_Ok)
else begin
P := GetProcAddress(HDriver, 'ExtDeviceMode');
if P <> nil then
begin
ExtDeviceMode := TExtDeviceMode(P);
Size := ExtDeviceMode(HWindow, HDriver, nil, DeviceName,
OutputName, nil, nil, 0);
GetMem(DevModeOutput, Size);
ExtDeviceMode(HWindow, HDriver, DevModeOutput,
DeviceName, OutputName, nil, nil,
dm_Prompt or dm_Copy);
FreeMem(DevModeOutput, Size)
end else
begin
P := GetProcAddress(HDriver, 'DeviceMode');
if P <> nil then
begin
DeviceMode := TDeviceMode(P);
DeviceMode(HWindow, HDriver, DeviceName, OutputName)
end
end;
FreeLibrary(HDriver);
end;
end;
end;
var
App: TAppObject;
begin
App.Init('PrSetup');
App.Run;
App.Done
end.