Source code of file oscpmwin_v0.1.1.875/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:     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
0028:     Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;
0029:   
0030:   CONST
0031:     PDCallDebug = TRUE;
0032:   
0033:   type
0034:     Topm_Form_Progress = class(TForm)
0035:       Panel1: TPanel;
0036:       opm_Label_ProgressMsg1: TLabel;
0037:       opm_ProgressBar_Progress1: TProgressBar;
0038:       opm_ProgressBar_Progress2: TProgressBar;
0039:       opm_BitBtn_ProgressCancel: TBitBtn;
0040:       opm_Label_ProgressMsg2: TLabel;
0041:       procedure FormCreate(Sender: TObject);
0042:       procedure FormShow(Sender: TObject);
0043:       procedure opm_BitBtn_ProgressCancelClick(Sender: TObject);
0044:       procedure FormClose(Sender: TObject; var Action: TCloseAction);
0045:     private
0046:       PDCanClose : BOOLEAN;
0047:       PDIntProgress : LONGINT;
0048:       PDWinList : POINTER;
0049:       PDNowPlaying : BOOLEAN;
0050:     public
0051:       PDAllowCancel : BOOLEAN;
0052:       PDCanceled : BOOLEAN;
0053:       PDDoubleBars : BOOLEAN;
0054:       PDMessage1 : STRING;
0055:       PDMessage2 : STRING;
0056:       PDIgnoreProgress : BOOLEAN;
0057:       PROCEDURE PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0058:       PROCEDURE PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0059:       PROCEDURE PRopm_PDClose;
0060:     end;
0061:   
0062:   var
0063:     opm_Form_Progress: Topm_Form_Progress;
0064:   
0065:   implementation
0066:   
0067:   {$R *.dfm}
0068:   
0069:   uses gnugettext, balloons, attention, oscpmdata;
0070:   
0071:   
0072:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0073:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0074:   procedure Topm_Form_Progress.FormCreate(Sender: TObject);
0075:   begin
0076:     PDCanClose := TRUE;
0077:     PDAllowCancel := FALSE;
0078:     PDCanceled := FALSE;
0079:     PDDoubleBars := TRUE;
0080:     PDMessage1 := '';
0081:     PDMessage2 := '';
0082:     PDIgnoreProgress := FALSE;
0083:     PDIntProgress := 0;
0084:     PDWinList := NIL;
0085:     PDNowPlaying := FALSE;
0086:     TranslateComponent (self);
0087:   end;
0088:   
0089:   
0090:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0091:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0092:   procedure Topm_Form_Progress.FormShow(Sender: TObject);
0093:   begin
0094:     PDCanClose := FALSE;
0095:     PDNowPlaying := TRUE;
0096:     PDCanceled := FALSE;
0097:     IF (PDDoubleBars = TRUE) THEN
0098:       BEGIN
0099:         opm_ProgressBar_Progress1.Height := 16;
0100:         opm_ProgressBar_Progress2.Visible := TRUE;
0101:       END
0102:     ELSE
0103:       BEGIN
0104:         opm_ProgressBar_Progress1.Height := 32;
0105:         opm_ProgressBar_Progress2.Visible := FALSE;
0106:       END;
0107:     opm_ProgressBar_Progress1.Position := 0;
0108:     opm_ProgressBar_Progress1.Min := 0;
0109:     opm_ProgressBar_Progress1.Max := 100;
0110:     opm_ProgressBar_Progress2.Position := 0;
0111:     opm_ProgressBar_Progress2.Min := 0;
0112:     opm_ProgressBar_Progress2.Max := 100;
0113:     IF (PDAllowCancel = TRUE) THEN
0114:       BEGIN
0115:         opm_BitBtn_ProgressCancel.Visible := TRUE;
0116:         opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + opm_BitBtn_ProgressCancel.Height + (opm_BitBtn_ProgressCancel.Height DIV 2);
0117:         Screen.Cursor := opmC_Normal_Mouse;
0118:       END
0119:     ELSE
0120:       BEGIN
0121:         opm_BitBtn_ProgressCancel.Visible := FALSE;
0122:         opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + (opm_BitBtn_ProgressCancel.Height DIV 2);
0123:         Screen.Cursor := opmC_Wait_Mouse;
0124:       END;
0125:     opm_Label_ProgressMsg1.Caption := PDMessage1;
0126:     opm_Label_ProgressMsg2.Caption := PDMessage2;
0127:     PDIntProgress := 0;
0128:     Application.ProcessMessages;
0129:   end;
0130:   
0131:   
0132:   
0133:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0134:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0135:   PROCEDURE Topm_Form_Progress.PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0136:   BEGIN
0137:     IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0138:       BEGIN
0139:         IF (PDIgnoreProgress = FALSE) THEN
0140:           BEGIN
0141:             IF (PDDoubleBars = TRUE) THEN
0142:               BEGIN
0143:                 IF (Bar = 1) THEN
0144:                   BEGIN
0145:                     IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0146:                     opm_ProgressBar_Progress1.Position := Position;
0147:                     IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0148:                   END
0149:                 ELSE
0150:                   BEGIN
0151:                     IF (Position > opm_ProgressBar_Progress2.Max) THEN Position := opm_ProgressBar_Progress2.Max;
0152:                     opm_ProgressBar_Progress2.Position := Position;
0153:                     IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg2.Caption := ProgressMessage;
0154:                   END;
0155:               END
0156:             ELSE
0157:               BEGIN
0158:                 IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0159:                 opm_ProgressBar_Progress1.Position := Position;
0160:                 IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0161:               END;
0162:           END
0163:         ELSE
0164:           BEGIN
0165:             IF (PDIntProgress < 100) THEN INC (PDIntProgress, 10) ELSE PDIntProgress := 0;
0166:             opm_ProgressBar_Progress1.Position := PDIntProgress;
0167:           END;
0168:       END
0169:     ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error UPDATE', mtWarning, [mbOk], opmG_UISilent);
0170:     Application.ProcessMessages;
0171:   END;
0172:   
0173:   
0174:   
0175:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0176:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0177:   PROCEDURE Topm_Form_Progress.PRopm_PDClose;
0178:   BEGIN
0179:     IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0180:       BEGIN
0181:         EnableTaskWindows (PDWinList);
0182:         PDWinList := NIL;
0183:         PDNowPlaying := FALSE;
0184:         PDCanClose := TRUE;
0185:         Close;
0186:       END
0187:     ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error CLOSE', mtWarning, [mbOk], opmG_UISilent);
0188:   END;
0189:   
0190:   
0191:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0192:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0193:   PROCEDURE Topm_Form_Progress.PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0194:   BEGIN
0195:     IF ((PDWinList = NIL) AND (PDNowPlaying = FALSE)) THEN
0196:       BEGIN
0197:         PDWinList := DisableTaskWindows (Handle);
0198:         PDAllowCancel := AllowCancel;
0199:         PDDoubleBars := TwoBars;
0200:         PDNowPlaying := TRUE;
0201:         Show;
0202:       END
0203:     ELSE IF (PDCallDebug = TRUE) THEN  FNopm_Message ('Progress Coding Error SHOW', mtWarning, [mbOk], opmG_UISilent);
0204:   END;
0205:   
0206:   
0207:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0208:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0209:   procedure Topm_Form_Progress.opm_BitBtn_ProgressCancelClick (Sender: TObject);
0210:   BEGIN
0211:     PDCanceled := TRUE;
0212:   END;
0213:   
0214:   
0215:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0216:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0217:   procedure Topm_Form_Progress.FormClose(Sender: TObject; var Action: TCloseAction);
0218:   BEGIN
0219:     IF (PDCanClose = TRUE) THEN
0220:       BEGIN
0221:         Screen.Cursor := opmC_Normal_Mouse;
0222:         Action := caHide;
0223:       END
0224:     ELSE Action := caNone;
0225:   END;
0226:   
0227:   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