Шифр Хила

DFM}{.....................................................}procedure TMainForm.mbExitClick(Sender: TObject);begin Close;end;{.....................................................}procedure TMainForm.btExitClick(Sender: TObject);begin Close;end;{.............................................}procedure TMainForm.btNewClick(Sender: TObject);var IniData:IniType;beginSaveNewBase.FileName:='untitled1.cbf'; if SaveNewBase.Execute then begin If FileExists(SaveNewBase.FileName) then beginMessageBeep(MB_ICONQUESTION); if MessageDlg('File already exists! Owerwrite?',mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit; end; If SaveNewBase.FileName <> '' thenCreateBaseFile(SaveNewBase.FileName); //....IniData:=GetIniData;IniData.LastOpenedBase:='';IniData.OnStartOpenLastBase:=false;UpdateIniData(IniData); //....CategoryList.Clear;btAdd.Enabled:=true;btDel.Enabled:=true;btIncom.Enabled:=true;btOptions.Enabled:=true;btSale.Enabled:=true;ChangePopup.AutoPopup:=true;CategoryPopup.AutoPopup:=true; exit; end;MessageDlg(#13+'Ошибкаприсозданиибазы!',mtConfirmation, [mbOk], 0);end;{.............................................}procedure TMainForm.btAddClick(Sender: TObject);beginAddCategory;RefreshCategoryList;end;{.....................................................}procedure TMainForm.FormActivate(Sender: TObject);beginif Start then beginbtAdd.Enabled:=False;btDel.Enabled:=False;btIncom.Enabled:=False;btOptions.Enabled:=False;btSale.Enabled:=False;btUchet.Enabled:=False;btPrice.Enabled:=False;OpenedFile:='';ChangePopup.AutoPopup:=false;CategoryPopup.AutoPopup:=false;Start:=false;AssignFile(TmpItemFile,'TmpItem.lst');Rewrite(TmpItemFile,1); end;end;{.....................................................}procedure OpenBase(name:string);var Kurs:extended;c:integer;{ConfirmPass:string[16];}beginiData:=GetIniData; //... if iData.OnStartOpenLastBase = true then beginiData.LastOpenedBase:=Name;UpdateIniData(iData); end; OpenBaseFile(Name); If OpenedFile = '' then exit; {ConfirmPass:=ReturnText('Enter password!'); if mResult = mrCancel then MainForm.Close; if ConfirmPass = 'OnlyCreator' then Proverka:=false; if ConfirmPass = BaseHeader.Password then Proverka:=false; if ConfirmPass <> BaseHeader.Password then Proverka:=true;} {Fill list of category}MainForm.CategoryList.Clear;MainForm.ItemBox.Items.Clear; //............................................................................. if Not TodayIsSet then begin if iData.NoKurs = 0 then beginKurs:=GetKurs;CurKurs:=FloatToStrF(Kurs,ffNumber,18,2); end else Kurs:=1;AddKursRecord(Kurs); end; MainForm.label5.Caption:=FloatToStrF(CurrentKurs,ffNumber,18,2); //............................................................................. for c:=1 to TotalCategoryes do begin If BaseHeader.TableCategory[c].Number <> -1 thenMainForm.CategoryList.Items.Add(BaseHeader.TableCategory[c].Name); end; {End fill list of category}MainForm.btAdd.Enabled:=true;MainForm.btDel.Enabled:=true;MainForm.btIncom.Enabled:=true;MainForm.btOptions.Enabled:=true;MainForm.btSale.Enabled:=true;MainForm.btUchet.Enabled:=true;MainForm.btPrice.Enabled:=true;MainForm.ChangePopup.AutoPopup:=true;MainForm.CategoryPopup.AutoPopup:=true;MainForm.CategoryList.SetFocus; if MainForm.CategoryList.Items.Count > 1 then beginMainForm.CategoryList.ItemIndex:=0;MainForm.CategoryList.Selected[0]; end; if MainForm.CategoryList.Items.Count = 0 then beginMainForm.CategoryList.ItemIndex:=-1; {MainForm.CategoryList.Selected[0];} end;end;{.....................................................}procedure TMainForm.btOpenClick(Sender: TObject);{varc:integer;kurs:extended;}beginCreateKursFile; If not OpenBaseDialog.Execute then begin Exit; end; if Not FileExists(OpenBaseDialog.FileName) then beginMessageBeep(MB_ICONASTERISK);MessageDlg(#13+'Такогофайланесуществует!',mtError, [mbOk], 0);exit; end;OpenBase(OpenBaseDialog.FileName);HideAboutForm;end;{.....................................................}procedure TMainForm.CategoryListClick(Sender: TObject);var Base:file;tHeader:bHeader;Counter:integer;cNumber:word;iItem:ItemType;ItemCount:integer;CurPos:integer;Total:integer;beginTotal:=0; If OpenedFile = '' then exit;Screen.Cursor:=crHourGlass;cNumber:=ReturnCategoryNumber; if cNumber > 50 then cNumber:=1;Caption:=BaseHeader.TableCategory[cNumber].name+': Категория №' +IntToStr(cNumber);ItemBox.Clear;ItemCount:=0; //...................................AssignFile(TmpItemFile,'TmpItem.lst');Rewrite(TmpItemFile,1); //...................................AssignFile(Base,OpenedFile);Reset(Base,1);BlockRead(Base,tHeader,BaseHeaderTypeSize);Seek(Base,BaseHeaderTypeSize); for counter:=0 to tHeader.TotalItem-1 do beginCurPos:=FilePos(Base);BlockRead(Base,iItem,ItemTypeSize); if iItem.CategoryNumber = cNumber then beginItemBox.Items.Add(iItem.Name);BlockWrite(TmpItemFile,CurPos,4);BlockWrite(TmpItemFile,iItem,ItemTypeSize);Inc(ItemCount);Total:=Total+iItem.Count; end; end;tHeader.TableCategory[cNumber].ItemsCount:=total;seek(Base,0);BlockWrite(Base,tHeader,BaseHeaderTypeSize);CloseFile(Base);ItemsCount:=ItemCount;SelectedItem:=ReturnSelectedItemNumber; If ItemBox.Items.Count <> 0 then btDel.Enabled:=false else btDel.Enabled:=true;CategoryList.SetFocus;Screen.Cursor:=crDefault;end;{.....................................................}procedure TMainForm.btDelClick(Sender: TObject);var c:word;Name:string;nn:word;begin If CategoryList.Items.Count = 0 then exit; for c:=0 to CategoryList.Items.Count-1 do begin if CategoryList.Selected[c] then beginName:=CategoryList.Items.Strings[c];nn:=GetCategory(Name);OpenBaseFile(OpenedFile); if BaseHeader.TableCategory[nn].ItemsCount <> 0 thenbeginMessageBeep(MB_iconasterisk);MessageDlg(#13+'Вы не можете удалить эту категорию,'+#13 +'т.к. на неё в базе имеются ссылки!', mtInformation, [mbOk], 0);exit; end;MessageBeep(MB_ICONQUESTION);If MessageDlg(#13+'Выдействительнохотитеудалить'+#13+'категорию: '+Name+' ?', mtConfirmation, [mbOk,mbCancel], 0) = mrOk thenDeleteCategory(Name) else exit; break; end; end; _RefreshCategoryes;CategoryList.Clear; for c:=1 to TotalCategoryes do begin if BaseHeader.TableCategory[c].number <> -1 then CategoryList.Items.Add(BaseHeader.TableCategory[c].Name); end;end;{.....................................................}procedure TMainForm.btIncomClick(Sender: TObject);beginOpenBaseFile(OpenedFile); If BaseHeader.CategoryCount <=0 then beginMessageBeep(MB_ICONHAND);MessageDlg(#13'Несозданониоднойкатегории!', mtWarning, [mbOk], 0);exit; end;ShowNaklad; //Update Category and Item boxesCategoryListClick(Sender);end;//.......................................................................procedure TMainForm.N1Click(Sender: TObject);var c:integer;rName:string;NewCategory:string;OldNumber:word;chItem:ItemType;chPos:integer;fFile:file;NewNumber:word;OldCategoryNumber:word;NewCat:string;beginrName:='';OpenBaseFile(OpenedFile);rName:=ReturnSelectedItem; if rName = '' then exit; //........................ //Change requestScreen.Cursor:=crHourGlass; Form2.ComboBox1.Items.Clear; {Fill list of category} for c:=1 to TotalCategoryes do beginNewCat:=BaseHeader.TableCategory[c].Name; if NewCat = '' then continue; Form2.ComboBox1.Items.Add(NewCat); end; {End fill list of category}Screen.Cursor:=crDefault; Form2.ComboBox1.Style:=csOwnerDrawVariable;NewCategory:=ReturnText('В какую категорию перенести: '+rName);Form2.ComboBox1.Style:=csDropDown; If mResult = mrCancel then exit; //...............................OldNumber:=ReturnSelectedItemNumber;chItem:=ReturnItem(OldNumber,chPos);OldCategoryNumber:=chItem.CategoryNumber;NewNumber:=CategoryNumberByName(NewCategory);chItem.CategoryNumber:=NewNumber; //.......................................................Dec(BaseHeader.TableCategory[OldCategoryNumber].ItemsCount,chItem.Count);Inc(BaseHeader.TableCategory[NewNumber].ItemsCount,chItem.Count);AssignFile(bbFile,OpenedFile); Reset(bbFile,1);BlockWrite(bbFile,BaseHeader,BaseHeaderTypeSize);CloseFile(bbFile); //........................................................AssignFile(fFile,OpenedFIle); Reset(fFile,1); //.................................... Seek(fFile,chPos);BlockWrite(fFile,chItem,ItemTypeSize);CloseFile(fFile); //.......................................................ItemBox.Clear;CategoryList.SetFocus;CategoryListClick(Sender);end;//........................................................................//This function returns name of selected line in the ItemBoxfunction ReturnSelectedItem:string;var c:integer;beginResult:='';if MainForm.ItemBox.Items.Count = 0 then exit;for c:=0 to MainForm.ItemBox.Items.Count-1 do begin if MainForm.ItemBox.Selected[c] then beginResult:=MainForm.ItemBox.Items.Strings[c]; exit; end; end;end;//........................................................................//........................................................................//This function returns number of selected line in the ItemBoxfunction ReturnSelectedItemNumber:word;var c:integer;beginResult:=0;if MainForm.ItemBox.Items.Count = 0 then exit;for c:=0 to MainForm.ItemBox.Items.Count-1 do begin if MainForm.ItemBox.Selected[c] then beginResult:=c; exit; end; end;end;//........................................................................//This function returns name of selected line in the CategoryListfunction ReturnSelectedCategory:string;var c:integer;beginResult:='';if MainForm.CategoryList.Items.Count = 0 then exit;for c:=0 to MainForm.CategoryList.Items.Count-1 do begin if MainForm.CategoryList.Selected[c] then beginResult:=MainForm.CategoryList.Items.Strings[c]; exit; end; end;end;//........................................................................//.........................................................................procedure TMainForm.ItemBoxKeyPress(Sender: TObject; var Key: Char);begin if Key = #13 then ItemBoxDblClick(Sender);end;//..........................................................................function ReturnCategoryNumber:Integer;var c,d:word;beginReturnCategoryNumber:=1; If OpenedFile = '' then Exit;OpenBaseFile(OpenedFile); for c:=1 to BaseHeader.CategoryCount do begin if MainForm.CategoryList.Selected[c-1] then beginfor d:=1 to TotalCategoryes do begin if MainForm.CategoryList.Items.Strings[c-1] = BaseHeader.TableCategory[d].name then beginCurrentCategoryNumber:=BaseHeader.TableCategory[d].number;Result:=BaseHeader.TableCategory[d].number; exit; end; end; end; end;end;//..........................................................................//..........................................................................function CategoryNumberByName(name:string):Integer;var d:word;beginCategoryNumberByName:=-1; If OpenedFile = '' then Exit;OpenBaseFile(OpenedFile);for d:=1 to TotalCategoryes do begin if name = BaseHeader.TableCategory[d].name then beginResult:=BaseHeader.TableCategory[d].number; exit; end; end;end;//..........................................................................//...........................................................................procedure TMainForm.CategoryListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);begin Case Key of38:CategoryListClick(Sender);40:CategoryListClick(Sender);45:btIncomClick(Sender); {39:beginItemBox.SetFocus;ItemBox.ItemIndex:=0; end;} end; {Caption:=IntToStr(Key);}end;//.............................................................................procedure TMainForm.ItemBoxKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);begin Case Key of45:btIncomClick(Sender); end; {if Key = 9 then CategoryList.SetFocus;} {Caption:=IntToStr(Key);}end;//.............................................................................procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);begin {if FileExists('TmpItem.lst') then CloseFile(TmpItemFile);} //Erase(TmpItemFile);end;//.........................................................................procedure TMainForm.N3Click(Sender: TObject);var NewName:string[200];dNumber:integer;hItem:ItemType;NeedPos:integer;fFile:file;begin if ItemBox.Items.Count<=0 then beginMessageBeep(MB_ICONHAND);MessageDlg(#13+'Вэтойкатегориинечегопереименовывать!', mtInformation, [mbOk], 0);exit; end; dNumber:=ReturnSelectedItemNumber;hItem:=ReturnItem(dNumber,NeedPos); Form2.ComboBox1.Items.Clear;NewName:=RenameText('Новоеназваниедля: '+hItem.Name,hItem.Name); if mResult = mrCancel then exit;AssignFile(fFile,OpenedFIle); Reset(fFile,1); //check item Seek(fFile,NeedPos);BlockRead(fFile,hItem,ItemTypeSize); //....................................hItem.Name:=NewName; Seek(fFile,NeedPos);BlockWrite(fFile,hItem,ItemTypeSize);CloseFile(fFile); //.......................................................ItemBox.Clear;CategoryList.SetFocus;CategoryListClick(Sender);end;//.........................................................................procedure TMainForm.N4Click(Sender: TObject);var nomer,ItemPos:integer;ReItem:ItemType;ReFile:file;Count:integer;beginOpenBaseFile(OpenedFile); If ItemBox.Items.Count <=0 then beginMessageBeep(MB_ICONHAND);MessageDlg(#13+'Вэтойкатегорииизменятьнечего!', mtWarning, [mbOk], 0);exit; end;Nomer:=ReturnSelectedItemNumber;ReItem:=ReturnItem(Nomer,ItemPos);Count:=ReItem.Count;ReDataShow(ReItem,ReItem.Name); if ReDataResult = mrCancel then exit; if Count <> ReItem.Count then begin if Count < ReItem.Count then Count:=ReItem.Count-Count; if Count > ReItem.Count then Count:=-(Count-ReItem.Count); end; //Update item in the baseAssignFile(ReFile,OpenedFile);Reset(ReFile,1);BlockRead(ReFile,BaseHeader,BaseHeaderTypeSize);BaseHeader.TableCategory[ReItem.CategoryNumber].ItemsCount:= BaseHeader.TableCategory[ReItem.CategoryNumber].ItemsCount+Count;Seek(ReFile,0);BlockWrite(ReFile,BaseHeader,BaseHeaderTypeSize); //check item //Seek(ReFile,ItemPos); //BlockRead(ReFile,ReItem,ItemTypeSize); //....................................Seek(ReFile,ItemPos);BlockWrite(ReFile,ReItem,ItemTypeSize);CloseFile(ReFile); //Update Category and Item boxesCategoryListClick(Sender); if NewData.Visible then Show_ShowForm(ReItem);end;//.............................................procedure TMainForm.N2Click(Sender: TObject);var dNumber:word;dPos:integer;dItem:ItemType;begin If ItemBox.Items.Count = 0 then exit;dNumber:=ReturnSelectedItemNumber;dItem:=ReturnItem(dNumber,dPos); if dItem.Count >= 0 then beginMessageBeep(MB_ICONQUESTION);if MessageDlg('Выдействительнохотитеудалить '+dItem.Name+'?', mtConfirmation, [mbOk,mbCancel], 0)=mrCancelthen exit else DeleteItem(dPos); end; //Update Category and Item boxesCategoryListClick(Sender);end;//...............................................................procedure DeleteItem(pos:integer);var ddFile:file;NewFile:file;tItem:ItemType;PosOfEnd:integer;SaveItem:ItemType;Counter:integer;CurPos:integer;bbHeader:bHeader;begin //...........................AssignFile(ddFile,OpenedFile); Reset(ddFile,1); //...AssignFile(NewFile,'newname.tmp');Rewrite(NewFile,1); //...PosOfEnd:=FileSize(ddFile)-ItemTypeSize; //... Seek(ddFile,Pos);BlockRead(ddFile,tItem,ItemTypeSize); //Rewrite header Seek(ddFile,0);BlockRead(ddFile,bbHeader,BaseHeaderTypeSize);Dec(bbHeader.TableCategory[tItem.CategoryNumber].ItemsCount,tItem.Count); //...Seek(NewFile,0);BlockWrite(NewFile,bbHeader,BaseHeaderTypeSize); //End of rewrite header if Pos = PosOfEnd then beginDec(bbHeader.TotalItem); Seek(ddFile,0);BlockWrite(ddFile,bbHeader,BaseHeaderTypeSize); Seek(ddFile,Pos); Truncate(ddFile);CloseFile(ddFile);CloseFile(NewFile);Erase(NewFile); exit; end; //... Seek(ddFile,BaseHeaderTypeSize);Seek(NewFile,BaseHeaderTypeSize); //... for Counter:=0 to bbHeader.TotalItem-1 do beginCurPos:=FilePos(ddFile);BlockRead(ddFile,SaveItem,ItemTypeSize); if CurPos <> Pos then BlockWrite(NewFile,SaveItem,ItemTypeSize); end; //...Dec(bbHeader.TotalItem); Rewrite(ddFile,1); Seek(ddFile,0);BlockWrite(ddFile,bbHeader,BaseHeaderTypeSize); //... Seek(ddFile,BaseHeaderTypeSize);Seek(NewFile,BaseHeaderTypeSize); for Counter:=0 to bbHeader.TotalItem-1 do beginBlockRead(NewFile,SaveItem,ItemTypeSize);BlockWrite(ddFile,SaveItem,ItemTypeSize); end;CloseFile(ddFile);CloseFile(NewFile);Erase(NewFile);OpenBaseFile(OpenedFile);end;//........................................................procedure TMainForm.btOptionsClick(Sender: TObject);begin If CategoryList.Items.Count = 0 then beginMessageBeep(MB_ICONASTERISK);MessageDlg('Несозданониоднойкатегории!', mtInformation, [mbOk], 0);exit; end;ShowOptions;label5.Caption:=FloatToStrF(CurrentKurs,ffNumber,18,2);end;//....................................................procedure TMainForm.ReCalcClick(Sender: TObject);Var Num:word;f:file;c:word;ItemsCount:integer;Counter:integer;It:ItemType;beginScreen.Cursor:=crHourGlass; if CategoryList.Items.Count = 0 then exit;ItemsCount:=0;Num:=ReturnCategoryNumber;AssignFile(f,OpenedFile); Reset(f,1);Blockread(f,BaseHeader,BaseHeaderTypeSize); //... for Counter:=0 to BaseHeader.TotalItem-1 do beginBlockRead(f,it,ItemTypeSize); if It.CategoryNumber = Num thenInc(ItemsCount,it.Count); end;BaseHeader.TableCategory[num].ItemsCount:=ItemsCount; Seek(f,0);BlockWrite(f,BaseHeader,BaseHeaderTypeSize);CloseFile(f); _RefreshCategoryes;CategoryList.Clear; for c:=1 to TotalCategoryes do begin if BaseHeader.TableCategory[c].number <> -1 thenCategoryList.Items.Add(BaseHeader.TableCategory[c].Name); end;Screen.Cursor:=crDefault;end;