home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
wks
/
tpw
/
stddlgsb.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-09-08
|
7KB
|
268 lines
{*******************************************************}
{ }
{ Turbo Pascal for Windows }
{ Standard dialogs unit for ObjectWindows }
{ Modified for use with BWCC.dll }
{ }
{ Copyright (c) 1991 Borland International }
{ }
{*******************************************************}
unit StdDlgsB;
interface
{$ifdef BWCC}
{ add bwcc at end of uses list}
uses WinTypes, WinProcs, WinDos, WObjectB, Strings, Bwcc;
{alternate res file}
{$R STDDLGSB}
{$else}
uses WinTypes, WinProcs, WinDos, WObjects, Strings;
{$R STDDLGS}
{$endif}
const
sd_FileOpen = $7F00;
sd_FileSave = $7F01;
const
id_FName = 100;
id_FPath = 101;
id_FList = 102;
id_DList = 103;
const
fsFileSpec = fsFileName + fsExtension;
type
PFileDialog = ^TFileDialog;
TFileDialog = object(TDialog)
Caption: PChar;
FilePath: PChar;
PathName: array[0..fsPathName] of Char;
Extension: array[0..fsExtension] of Char;
FileSpec: array[0..fsFileSpec] of Char;
constructor Init(AParent: PWindowsObject; AName, AFilePath: PChar);
function CanClose: Boolean; virtual;
procedure SetupWindow; virtual;
procedure HandleFName(var Msg: TMessage); virtual id_First + id_FName;
procedure HandleFList(var Msg: TMessage); virtual id_First + id_FList;
procedure HandleDList(var Msg: TMessage); virtual id_First + id_DList;
private
procedure SelectFileName;
procedure UpdateFileName;
function UpdateListBoxes: Boolean;
end;
const
sd_InputDialog = $7F02;
const
id_Prompt = 100;
id_Input = 101;
type
PInputDialog = ^TInputDialog;
TInputDialog = object(TDialog)
Caption: PChar;
Prompt: PChar;
Buffer: PChar;
BufferSize: Word;
constructor Init(AParent: PWindowsObject;
ACaption, APrompt, ABuffer: PChar; ABufferSize: Word);
function CanClose: Boolean; virtual;
procedure SetupWindow; virtual;
end;
implementation
function GetFileName(FilePath: PChar): PChar;
var
P: PChar;
begin
P := StrRScan(FilePath, '\');
if P = nil then P := StrRScan(FilePath, ':');
if P = nil then GetFileName := FilePath else GetFileName := P + 1;
end;
function GetExtension(FilePath: PChar): PChar;
var
P: PChar;
begin
P := StrScan(GetFileName(FilePath), '.');
if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
end;
function HasWildCards(FilePath: PChar): Boolean;
begin
HasWildCards := (StrScan(FilePath, '*') <> nil) or
(StrScan(FilePath, '?') <> nil);
end;
{ TFileDialog }
constructor TFileDialog.Init(AParent: PWindowsObject;
AName, AFilePath: PChar);
begin
TDialog.Init(AParent, AName);
Caption := nil;
FilePath := AFilePath;
end;
function TFileDialog.CanClose: Boolean;
var
PathLen: Word;
begin
CanClose := False;
GetDlgItemText(HWindow, id_FName, PathName, fsPathName + 1);
FileExpand(PathName, PathName);
PathLen := StrLen(PathName);
if (PathName[PathLen - 1] = '\') or HasWildCards(PathName) or
(GetFocus = GetDlgItem(HWindow, id_DList)) then
begin
if PathName[PathLen - 1] = '\' then
StrLCat(PathName, FileSpec, fsPathName);
if not UpdateListBoxes then
begin
MessageBeep(0);
SelectFileName;
end;
Exit;
end;
StrLCat(StrLCat(PathName, '\', fsPathName), FileSpec, fsPathName);
if UpdateListBoxes then Exit;
PathName[PathLen] := #0;
if GetExtension(PathName)[0] = #0 then
StrLCat(PathName, Extension, fsPathName);
AnsiLower(StrCopy(FilePath, PathName));
CanClose := True;
end;
procedure TFileDialog.SetupWindow;
begin
SendDlgItemMessage(HWindow, id_FName, em_LimitText, fsPathName, 0);
if Caption <> nil then SetWindowText(HWindow, Caption);
StrLCopy(PathName, FilePath, fsPathName);
StrLCopy(Extension, GetExtension(PathName), fsExtension);
if HasWildCards(Extension) then Extension[0] := #0;
if not UpdateListBoxes then
begin
StrCopy(PathName, '*.*');
UpdateListBoxes;
end;
SelectFileName;
end;
procedure TFileDialog.HandleFName(var Msg: TMessage);
begin
if Msg.LParamHi = en_Change then
EnableWindow(GetDlgItem(HWindow, id_Ok),
SendMessage(Msg.LParamLo, wm_GetTextLength, 0, 0) <> 0);
end;
procedure TFileDialog.HandleFList(var Msg: TMessage);
begin
case Msg.LParamHi of
lbn_SelChange, lbn_DblClk:
begin
DlgDirSelect(HWindow, PathName, id_FList);
UpdateFileName;
if Msg.LParamHi = lbn_DblClk then Ok(Msg);
end;
lbn_KillFocus:
SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
end;
end;
procedure TFileDialog.HandleDList(var Msg: TMessage);
begin
case Msg.LParamHi of
lbn_SelChange, lbn_DblClk:
begin
DlgDirSelect(HWindow, PathName, id_DList);
StrCat(PathName, FileSpec);
if Msg.LParamHi = lbn_DblClk then
UpdateListBoxes else
UpdateFileName;
end;
lbn_KillFocus:
SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
end;
end;
procedure TFileDialog.SelectFileName;
begin
SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
SetFocus(GetDlgItem(HWindow, id_FName));
end;
procedure TFileDialog.UpdateFileName;
begin
SetDlgItemText(HWindow, id_FName, AnsiLower(PathName));
SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
end;
function TFileDialog.UpdateListBoxes: Boolean;
var
Result: Integer;
Path: array[0..fsPathName] of Char;
begin
UpdateListBoxes := False;
if GetDlgItem(HWindow, id_FList) <> 0 then
begin
StrCopy(Path, PathName);
Result := DlgDirList(HWindow, Path, id_FList, id_FPath, 0);
if Result <> 0 then DlgDirList(HWindow, '*.*', id_DList, 0, $C010);
end else
begin
StrLCopy(Path, PathName, GetFileName(PathName) - PathName);
StrLCat(Path, '*.*', fsPathName);
Result := DlgDirList(HWindow, Path, id_DList, id_FPath, $C010);
end;
if Result <> 0 then
begin
StrLCopy(FileSpec, GetFileName(PathName), fsFileSpec);
StrCopy(PathName, FileSpec);
UpdateFileName;
UpdateListBoxes := True;
end;
end;
{ TInputDialog }
constructor TInputDialog.Init(AParent: PWindowsObject;
ACaption, APrompt, ABuffer: PChar; ABufferSize: Word);
begin
TDialog.Init(AParent, PChar(sd_InputDialog));
Caption := ACaption;
Prompt := APrompt;
Buffer := ABuffer;
BufferSize := ABufferSize;
end;
function TInputDialog.CanClose: Boolean;
begin
GetDlgItemText(HWindow, id_Input, Buffer, BufferSize);
CanClose := True;
end;
procedure TInputDialog.SetupWindow;
begin
TDialog.SetupWindow;
SetWindowText(HWindow, Caption);
SetDlgItemText(HWindow, id_Prompt, Prompt);
SetDlgItemText(HWindow, id_Input, Buffer);
SendDlgItemMessage(HWindow, id_Input, em_LimitText, BufferSize - 1, 0);
end;
end.