Source code of file oscpmwin_v0.4.1.683/progress.pas from the
osCommerce Product Manager for Windows.


0000:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001:   osCommerce Product Manager for Windows (oscpmwin).
0002:   0003:   
0004:   You can contact Mario A. Valdez-Ramirez
0005:   by email at mario@mariovaldez.org or paper mail at
0006:   Olmos 809, San Nicolas, NL. 66495, Mexico.
0007:   
0008:   This program is free software; you can redistribute it and/or modify
0009:   it under the terms of the GNU General Public License as published by
0010:   the Free Software Foundation; either version 2 of the License, or (at
0011:   your option) any later version.
0012:   
0013:   This program is distributed in the hope that it will be useful, but
0014:   WITHOUT ANY WARRANTY; without even the implied warranty of
0015:   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0016:   General Public License for more details.
0017:   
0018:   You should have received a copy of the GNU General Public License
0019:   along with this program; if not, write to the Free Software
0020:   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0021:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0022:   unit progress;
0023:   
0024:   interface
0025:   
0026:   uses
0027:     Controls, Forms, Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Classes;
0028:   
0029:   CONST
0030:     PDCallDebug = TRUE;
0031:   
0032:   type
0033:     Topm_Form_Progress = class(TForm)
0034:       Panel1: TPanel;
0035:       opm_Label_ProgressMsg1: TLabel;
0036:       opm_ProgressBar_Progress1: TProgressBar;
0037:       opm_ProgressBar_Progress2: TProgressBar;
0038:       opm_BitBtn_ProgressCancel: TBitBtn;
0039:       opm_Label_ProgressMsg2: TLabel;
0040:       procedure FormCreate(Sender: TObject);
0041:       procedure FormShow(Sender: TObject);
0042:       procedure opm_BitBtn_ProgressCancelClick(Sender: TObject);
0043:       procedure FormClose(Sender: TObject; var Action: TCloseAction);
0044:     private
0045:       PDCanClose : BOOLEAN;
0046:       PDIntProgress : LONGINT;
0047:       PDWinList : POINTER;
0048:       PDNowPlaying : BOOLEAN;
0049:     public
0050:       PDAllowCancel : BOOLEAN;
0051:       PDCanceled : BOOLEAN;
0052:       PDDoubleBars : BOOLEAN;
0053:       PDMessage1 : STRING;
0054:       PDMessage2 : STRING;
0055:       PDIgnoreProgress : BOOLEAN;
0056:       PROCEDURE PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0057:       PROCEDURE PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0058:       PROCEDURE PRopm_PDClose;
0059:     end;
0060:   
0061:   var
0062:     opm_Form_Progress: Topm_Form_Progress;
0063:   
0064:   implementation
0065:   
0066:   {$R *.dfm}
0067:   
0068:   uses gnugettext, attention, oscpmdata;
0069:   
0070:   
0071:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0072:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0073:   procedure Topm_Form_Progress.FormCreate(Sender: TObject);
0074:   begin
0075:     PDCanClose := TRUE;
0076:     PDAllowCancel := FALSE;
0077:     PDCanceled := FALSE;
0078:     PDDoubleBars := TRUE;
0079:     PDMessage1 := '';
0080:     PDMessage2 := '';
0081:     PDIgnoreProgress := FALSE;
0082:     PDIntProgress := 0;
0083:     PDWinList := NIL;
0084:     PDNowPlaying := FALSE;
0085:     TranslateComponent (self);
0086:   end;
0087:   
0088:   
0089:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0090:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0091:   procedure Topm_Form_Progress.FormShow(Sender: TObject);
0092:   begin
0093:     PDCanClose := FALSE;
0094:     PDNowPlaying := TRUE;
0095:     PDCanceled := FALSE;
0096:     IF (PDDoubleBars = TRUE) THEN
0097:       BEGIN
0098:         opm_ProgressBar_Progress1.Height := 16;
0099:         opm_ProgressBar_Progress2.Visible := TRUE;
0100:       END
0101:     ELSE
0102:       BEGIN
0103:         opm_ProgressBar_Progress1.Height := 32;
0104:         opm_ProgressBar_Progress2.Visible := FALSE;
0105:       END;
0106:     opm_ProgressBar_Progress1.Position := 0;
0107:     opm_ProgressBar_Progress1.Min := 0;
0108:     opm_ProgressBar_Progress1.Max := 100;
0109:     opm_ProgressBar_Progress2.Position := 0;
0110:     opm_ProgressBar_Progress2.Min := 0;
0111:     opm_ProgressBar_Progress2.Max := 100;
0112:     IF (PDAllowCancel = TRUE) THEN
0113:       BEGIN
0114:         opm_BitBtn_ProgressCancel.Visible := TRUE;
0115:         opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + opm_BitBtn_ProgressCancel.Height + (opm_BitBtn_ProgressCancel.Height DIV 2);
0116:         Screen.Cursor := opmC_Normal_Mouse;
0117:       END
0118:     ELSE
0119:       BEGIN
0120:         opm_BitBtn_ProgressCancel.Visible := FALSE;
0121:         opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + (opm_BitBtn_ProgressCancel.Height DIV 2);
0122:         Screen.Cursor := opmC_Wait_Mouse;
0123:       END;
0124:     opm_Label_ProgressMsg1.Caption := PDMessage1;
0125:     opm_Label_ProgressMsg2.Caption := PDMessage2;
0126:     PDIntProgress := 0;
0127:     Application.ProcessMessages;
0128:   end;
0129:   
0130:   
0131:   
0132:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0133:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0134:   PROCEDURE Topm_Form_Progress.PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0135:   BEGIN
0136:     IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0137:       BEGIN
0138:         IF (PDIgnoreProgress = FALSE) THEN
0139:           BEGIN
0140:             IF (PDDoubleBars = TRUE) THEN
0141:               BEGIN
0142:                 IF (Bar = 1) THEN
0143:                   BEGIN
0144:                     IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0145:                     opm_ProgressBar_Progress1.Position := Position;
0146:                     IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0147:                   END
0148:                 ELSE
0149:                   BEGIN
0150:                     IF (Position > opm_ProgressBar_Progress2.Max) THEN Position := opm_ProgressBar_Progress2.Max;
0151:                     opm_ProgressBar_Progress2.Position := Position;
0152:                     IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg2.Caption := ProgressMessage;
0153:                   END;
0154:               END
0155:             ELSE
0156:               BEGIN
0157:                 IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0158:                 opm_ProgressBar_Progress1.Position := Position;
0159:                 IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0160:               END;
0161:           END
0162:         ELSE
0163:           BEGIN
0164:             IF (PDIntProgress < 100) THEN INC (PDIntProgress, 10) ELSE PDIntProgress := 0;
0165:             opm_ProgressBar_Progress1.Position := PDIntProgress;
0166:           END;
0167:       END
0168:     ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error UPDATE', mtWarning, [mbOk], opmG_UISilent);
0169:     Application.ProcessMessages;
0170:   END;
0171:   
0172:   
0173:   
0174:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0175:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0176:   PROCEDURE Topm_Form_Progress.PRopm_PDClose;
0177:   BEGIN
0178:     IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0179:       BEGIN
0180:         EnableTaskWindows (PDWinList);
0181:         PDWinList := NIL;
0182:         PDNowPlaying := FALSE;
0183:         PDCanClose := TRUE;
0184:         Close;
0185:       END
0186:     ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error CLOSE', mtWarning, [mbOk], opmG_UISilent);
0187:   END;
0188:   
0189:   
0190:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0191:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0192:   PROCEDURE Topm_Form_Progress.PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0193:   BEGIN
0194:     IF ((PDWinList = NIL) AND (PDNowPlaying = FALSE)) THEN
0195:       BEGIN
0196:         PDWinList := DisableTaskWindows (Handle);
0197:         PDAllowCancel := AllowCancel;
0198:         PDDoubleBars := TwoBars;
0199:         PDNowPlaying := TRUE;
0200:         Show;
0201:       END
0202:     ELSE IF (PDCallDebug = TRUE) THEN  FNopm_Message ('Progress Coding Error SHOW', mtWarning, [mbOk], opmG_UISilent);
0203:   END;
0204:   
0205:   
0206:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0207:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0208:   procedure Topm_Form_Progress.opm_BitBtn_ProgressCancelClick (Sender: TObject);
0209:   BEGIN
0210:     PDCanceled := TRUE;
0211:   END;
0212:   
0213:   
0214:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0215:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0216:   procedure Topm_Form_Progress.FormClose(Sender: TObject; var Action: TCloseAction);
0217:   BEGIN
0218:     IF (PDCanClose = TRUE) THEN
0219:       BEGIN
0220:         Screen.Cursor := opmC_Normal_Mouse;
0221:         Action := caHide;
0222:       END
0223:     ELSE Action := caNone;
0224:   END;
0225:   
0226:   end.
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2017 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link