home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol11n01.zip / LN1101.ZIP / SELECTO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-10  |  5KB  |  164 lines
  1. PROGRAM Selecto;
  2. {$R Selecto}
  3. {$D Copyright (c) 1991 by Neil J. Rubenking}
  4. Uses WinTypes, WinProcs, WObjects;
  5. CONST
  6.   AppName : PChar = 'Selecto';
  7. CONST
  8.   id_lb1     = 101;
  9.   id_lb2     = 102;
  10.   id_SelButn = 103;
  11.   id_RejButn = 104;
  12. TYPE
  13.   TMyApplication = object(TApplication)
  14.     procedure InitMainWindow; virtual;
  15.   end;
  16.  
  17.   PSelDialog = ^TSelDialog;
  18.   TSelDialog = OBJECT(TDlgWindow)
  19.     LB1, LB2 : PListBox;
  20.     isMult   : Boolean;
  21.     CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
  22.     DESTRUCTOR Done; Virtual;
  23.     PROCEDURE SetUpWindow; Virtual;
  24.     FUNCTION GetClassName : PChar; Virtual;
  25.     PROCEDURE GetWindowClass(var AWndClass: TWndClass); virtual;
  26.     PROCEDURE IDLB1(VAR Msg : TMessage); Virtual id_First + id_Lb1;
  27.     PROCEDURE IDLB2(VAR Msg : TMessage); Virtual id_First + id_Lb2;
  28.     PROCEDURE IDSelButn(VAR Msg : TMessage); Virtual id_First + id_SelButn;
  29.     PROCEDURE IDRejButn(VAR Msg : TMessage); Virtual id_First + id_RejButn;
  30.     PROCEDURE TransSelect(L1, L2 : PListBox);
  31.   END;
  32.  
  33. {--------------------------------------------------}
  34. { TSelDialog's methods                             }
  35. {--------------------------------------------------}
  36.   CONSTRUCTOR TSelDialog.Init(AParent : PWindowsObject; AName : PChar);
  37.   BEGIN
  38.     TDlgWindow.Init(AParent, AName);
  39.     New(LB1, InitResource(@Self, id_lb1));
  40.     New(LB2, InitResource(@Self, id_lb2));
  41.   END;
  42.  
  43.   PROCEDURE TSelDialog.SetUpWindow;
  44.   VAR
  45.     N    : LongInt;
  46.     mul2 : Boolean;
  47.     Name : ARRAY[0..20] OF Char;
  48.   BEGIN
  49.     TDlgWindow.SetUpWindow;
  50.     N := GetWindowLong(LB1^.hWindow, gwl_Style);
  51.     IsMult := (N AND lbs_MultipleSel) <> 0;
  52.     N := GetWindowLong(LB2^.hWindow, gwl_Style);
  53.     mul2 := (N AND lbs_MultipleSel) <> 0;
  54.     IF IsMult XOR mul2 THEN
  55.       BEGIN
  56.         MessageBox(hWindow,'BOTH listboxes must be '+
  57.           'multiple, or NEITHER!',
  58.           'ERROR IN RESOURCE', mb_Ok + mb_IconHand);
  59.         Exit;
  60.       END;
  61.     N := 1;
  62.     WHILE LoadString(hInstance, N, Name, 20) <> 0 DO
  63.       BEGIN
  64.         LB1^.AddString(Name);
  65.         Inc(N);
  66.       END;
  67.     EnableWindow(GetItemHandle(id_RejButn), FALSE);
  68.   END;
  69.  
  70.   DESTRUCTOR TSelDialog.Done;
  71.   BEGIN TDlgWindow.Done; END;
  72.  
  73.   FUNCTION TSelDialog.GetClassName;
  74.   BEGIN GetClassName := AppName; END;
  75.  
  76.   PROCEDURE TSelDialog.GetWindowClass(VAR AWndClass : TWndClass);
  77.   BEGIN
  78.     TDlgWindow.GetWindowClass(AWndClass);
  79.     AWndClass.hIcon := LoadIcon(HInstance, AppName);
  80.   END;
  81.  
  82.   PROCEDURE TSelDialog.IDLB1(VAR Msg : TMessage);
  83.   BEGIN
  84.     CASE Msg.lParamHi OF
  85.       lbn_DblClk : IF NOT IsMult THEN TransSelect(LB1, LB2);
  86.       lbn_SetFocus : BEGIN
  87.         EnableWindow(GetItemHandle(id_SelButn), TRUE);
  88.         EnableWindow(GetItemHandle(id_RejButn), FALSE);
  89.       END;
  90.       ELSE DefNotificationProc(Msg);
  91.     END;
  92.   END;
  93.  
  94.   PROCEDURE TSelDialog.IDLB2(VAR Msg : TMessage);
  95.   BEGIN
  96.     CASE Msg.lParamHi OF
  97.       lbn_DblClk : IF NOT IsMult THEN TransSelect(LB2, LB1);
  98.       lbn_SetFocus : BEGIN
  99.         EnableWindow(GetItemHandle(id_RejButn), TRUE);
  100.         EnableWindow(GetItemHandle(id_SelButn), FALSE);
  101.       END;
  102.       ELSE DefNotificationProc(Msg);
  103.     END;
  104.   END;
  105.  
  106.   PROCEDURE TSelDialog.TransSelect(L1, L2 : PListBox);
  107.   TYPE SelBuff = ARRAY[1..32760] OF Integer;
  108.   VAR
  109.     Num, N : Integer;
  110.     Name : ARRAY[0..20] OF Char;
  111.     Sels : ^SelBuff;
  112.   BEGIN
  113.     IF IsMult THEN
  114.       BEGIN
  115.         Num := SendDlgItemMsg(L1^.GetID,
  116.                  lb_GetSelCount, 0, 0);
  117.         IF Num > 0 THEN
  118.           BEGIN
  119.             GetMem(Sels, Num*2);
  120.             Num := SendDlgItemMsg(L1^.GetID,
  121.                      lb_GetSelItems, 26, LongInt(Sels));
  122.             FOR N := Num DOWNTO 1 DO
  123.               BEGIN
  124.                 L1^.GetString(Name, Sels^[N]);
  125.                 L2^.AddString(Name);
  126.                 L1^.DeleteString(Sels^[N]);
  127.               END;
  128.             FreeMem(Sels, Num*2);
  129.           END;
  130.       END
  131.     ELSE
  132.       BEGIN
  133.         N := L1^.GetSelIndex;
  134.         IF (N >= 0) AND (N <= L1^.GetCount) THEN
  135.           BEGIN
  136.             L1^.GetSelString(Name, 20);
  137.             L2^.AddString(Name);
  138.             L1^.DeleteString(N);
  139.           END;
  140.       END;
  141.   END;
  142.  
  143.   PROCEDURE TSelDialog.IDSelButn(VAR Msg : TMessage);
  144.   BEGIN TransSelect(LB1, LB2); END;
  145.  
  146.   PROCEDURE TSelDialog.IDRejButn(VAR Msg : TMessage);
  147.   BEGIN TransSelect(LB2, LB1); END;
  148.  
  149. {--------------------------------------------------}
  150. { TMyApplication's method implementations:         }
  151. {--------------------------------------------------}
  152.   PROCEDURE TMyApplication.InitMainWindow;
  153.   BEGIN MainWindow := New(PSelDialog, Init(NIL, AppName)); END;
  154.  
  155. {--------------------------------------------------}
  156. { Main program:                                    }
  157. {--------------------------------------------------}
  158. VAR MyApp: TMyApplication;
  159. BEGIN
  160.   MyApp.Init(AppName);
  161.   MyApp.Run;
  162.   MyApp.Done;
  163. END.
  164.