home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
01
/
ln1101
/
selecto.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-10
|
5KB
|
164 lines
PROGRAM Selecto;
{$R Selecto}
{$D Copyright (c) 1991 by Neil J. Rubenking}
Uses WinTypes, WinProcs, WObjects;
CONST
AppName : PChar = 'Selecto';
CONST
id_lb1 = 101;
id_lb2 = 102;
id_SelButn = 103;
id_RejButn = 104;
TYPE
TMyApplication = object(TApplication)
procedure InitMainWindow; virtual;
end;
PSelDialog = ^TSelDialog;
TSelDialog = OBJECT(TDlgWindow)
LB1, LB2 : PListBox;
isMult : Boolean;
CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
DESTRUCTOR Done; Virtual;
PROCEDURE SetUpWindow; Virtual;
FUNCTION GetClassName : PChar; Virtual;
PROCEDURE GetWindowClass(var AWndClass: TWndClass); virtual;
PROCEDURE IDLB1(VAR Msg : TMessage); Virtual id_First + id_Lb1;
PROCEDURE IDLB2(VAR Msg : TMessage); Virtual id_First + id_Lb2;
PROCEDURE IDSelButn(VAR Msg : TMessage); Virtual id_First + id_SelButn;
PROCEDURE IDRejButn(VAR Msg : TMessage); Virtual id_First + id_RejButn;
PROCEDURE TransSelect(L1, L2 : PListBox);
END;
{--------------------------------------------------}
{ TSelDialog's methods }
{--------------------------------------------------}
CONSTRUCTOR TSelDialog.Init(AParent : PWindowsObject; AName : PChar);
BEGIN
TDlgWindow.Init(AParent, AName);
New(LB1, InitResource(@Self, id_lb1));
New(LB2, InitResource(@Self, id_lb2));
END;
PROCEDURE TSelDialog.SetUpWindow;
VAR
N : LongInt;
mul2 : Boolean;
Name : ARRAY[0..20] OF Char;
BEGIN
TDlgWindow.SetUpWindow;
N := GetWindowLong(LB1^.hWindow, gwl_Style);
IsMult := (N AND lbs_MultipleSel) <> 0;
N := GetWindowLong(LB2^.hWindow, gwl_Style);
mul2 := (N AND lbs_MultipleSel) <> 0;
IF IsMult XOR mul2 THEN
BEGIN
MessageBox(hWindow,'BOTH listboxes must be '+
'multiple, or NEITHER!',
'ERROR IN RESOURCE', mb_Ok + mb_IconHand);
Exit;
END;
N := 1;
WHILE LoadString(hInstance, N, Name, 20) <> 0 DO
BEGIN
LB1^.AddString(Name);
Inc(N);
END;
EnableWindow(GetItemHandle(id_RejButn), FALSE);
END;
DESTRUCTOR TSelDialog.Done;
BEGIN TDlgWindow.Done; END;
FUNCTION TSelDialog.GetClassName;
BEGIN GetClassName := AppName; END;
PROCEDURE TSelDialog.GetWindowClass(VAR AWndClass : TWndClass);
BEGIN
TDlgWindow.GetWindowClass(AWndClass);
AWndClass.hIcon := LoadIcon(HInstance, AppName);
END;
PROCEDURE TSelDialog.IDLB1(VAR Msg : TMessage);
BEGIN
CASE Msg.lParamHi OF
lbn_DblClk : IF NOT IsMult THEN TransSelect(LB1, LB2);
lbn_SetFocus : BEGIN
EnableWindow(GetItemHandle(id_SelButn), TRUE);
EnableWindow(GetItemHandle(id_RejButn), FALSE);
END;
ELSE DefNotificationProc(Msg);
END;
END;
PROCEDURE TSelDialog.IDLB2(VAR Msg : TMessage);
BEGIN
CASE Msg.lParamHi OF
lbn_DblClk : IF NOT IsMult THEN TransSelect(LB2, LB1);
lbn_SetFocus : BEGIN
EnableWindow(GetItemHandle(id_RejButn), TRUE);
EnableWindow(GetItemHandle(id_SelButn), FALSE);
END;
ELSE DefNotificationProc(Msg);
END;
END;
PROCEDURE TSelDialog.TransSelect(L1, L2 : PListBox);
TYPE SelBuff = ARRAY[1..32760] OF Integer;
VAR
Num, N : Integer;
Name : ARRAY[0..20] OF Char;
Sels : ^SelBuff;
BEGIN
IF IsMult THEN
BEGIN
Num := SendDlgItemMsg(L1^.GetID,
lb_GetSelCount, 0, 0);
IF Num > 0 THEN
BEGIN
GetMem(Sels, Num*2);
Num := SendDlgItemMsg(L1^.GetID,
lb_GetSelItems, 26, LongInt(Sels));
FOR N := Num DOWNTO 1 DO
BEGIN
L1^.GetString(Name, Sels^[N]);
L2^.AddString(Name);
L1^.DeleteString(Sels^[N]);
END;
FreeMem(Sels, Num*2);
END;
END
ELSE
BEGIN
N := L1^.GetSelIndex;
IF (N >= 0) AND (N <= L1^.GetCount) THEN
BEGIN
L1^.GetSelString(Name, 20);
L2^.AddString(Name);
L1^.DeleteString(N);
END;
END;
END;
PROCEDURE TSelDialog.IDSelButn(VAR Msg : TMessage);
BEGIN TransSelect(LB1, LB2); END;
PROCEDURE TSelDialog.IDRejButn(VAR Msg : TMessage);
BEGIN TransSelect(LB2, LB1); END;
{--------------------------------------------------}
{ TMyApplication's method implementations: }
{--------------------------------------------------}
PROCEDURE TMyApplication.InitMainWindow;
BEGIN MainWindow := New(PSelDialog, Init(NIL, AppName)); END;
{--------------------------------------------------}
{ Main program: }
{--------------------------------------------------}
VAR MyApp: TMyApplication;
BEGIN
MyApp.Init(AppName);
MyApp.Run;
MyApp.Done;
END.