Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 1133
Благодарности: 581

Профиль | Отправить PM | Цитировать


Цитата Krekerpro:
Соедините кто нибудь пожалуйста »
Ну такого, я ещё ни разу не видел, что весь код в одну строку...
Подробнее
Код: Выделить весь код
type
  TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);

var
  n: Integer;
  FreeMB, TotalMB: Cardinal;
  VolumeName, FileSystemName: String;
  VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint;
  ListBox: TListBox;
  StartMenuTreeView: TStartMenuFolderTreeView;
  baseDisk, baseDir: string;

  TimerID: LongWord;
  currTime: Integer;
  SplashImage: TBitmapImage;

const
  oneMB = 1024*1024;

function GetLogicalDrives: DWord; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: String): Longint; external 'GetDriveTypeA@kernel32.dll stdcall';
function GetVolumeInformation(PathName,VolumeName: PChar; VolumeNameSize,VolumeSerialNumber,MaxComponentLength,FileSystemFlags: Longint; FileSystemName: PChar; FileSystemNameSize: Longint): Longint;
  external 'GetVolumeInformationA@kernel32.dll stdcall';
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer;
  external 'MessageBoxA@user32.dll stdcall';

function WrapTimerProc(callback:TProc; paramcount:integer):longword;
  external 'wrapcallback@files:InnoCallback.dll stdcall';
function SetTimer(hWnd: LongWord; nIDEvent, uElapse: LongWord; lpTimerFunc: LongWord): LongWord;
  external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd: LongWord; nIDEvent: LongWord): LongWord;
  external 'KillTimer@user32.dll stdcall';

procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
begin
  currTime := currTime + 1;
    case currTime of
      {#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_2.bmp'))
        end;
      2*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_3.bmp'))
        end;
      3*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_4.bmp'))
        end;
      4*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_5.bmp'))
        end;
      5*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_6.bmp'))
        end;
      6*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_7.bmp'))
        end;
      7*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_8.bmp'))
        end;
      8*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_9.bmp'))
        end;
      9*{#TIME_FOR_VIEW}:
        begin
          SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_10.bmp'))
        end;
    end;
  if CurrTime = 9*{#TIME_FOR_VIEW} then CurrTime := -1;
end;

Function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
{ Перевод числа в значение бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)}
Begin
  if not noMB then Result:= FloatToStr(Int(Bytes)) +' Мб' else
  if Bytes < 1024 then Result:= FloatToStr(Int(Bytes)) +' Бт' else
  if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Кб' else
  If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Мб' else
  If Bytes/oneMB/1000 < 1024 then Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Гб' else
  Result:= FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Тб' StringChange(Result, ',', '.')
End;

Function DelSP(String: String): String;
{ Удаление начальных, конечных и повторных пробелов }
Begin
  while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1);
  Result:= Trim(String);
End;

Function CutString(String: String; MaxLength: Longint): String;
{ Обрезать строку до заданного кол-ва символов}
Begin
  if Length(String) > MaxLength then
  Result:= Copy(String, 1, 6) +'...'+ Copy(String, Length(String) - MaxLength +9, MaxLength) else
  Result:= String;
End;

Procedure GetDiskInfo(Disk: String);
Begin
  FileSystemName:= StringOfChar(' ', 32);
  VolumeName:= StringOfChar(' ', 256);
  GetVolumeInformation(Disk, VolumeName, 255, VolumeSerialNo, MaxComponentLength, FileSystemFlags, FileSystemName, 31);
  FileSystemName:= DelSp(FileSystemName);
  VolumeName:= DelSp(VolumeName);
  if VolumeName='' then VolumeName:='без метки';
End;

Procedure ListBoxRefresh;
var
  FreeB, TotalB: Cardinal;
  Path, String: string;
Begin
  ListBox.Items.Clear
  for n:= 1 to 31 do // диск 'А' пропустить
  if (GetLogicalDrives and (1 shl n)) > 0 then
  if (GetDriveType(Chr(ord('A') + n) +':\') = 2) or (GetDriveType(Chr(ord('A') + n) +':\') = 3) then
  if GetSpaceOnDisk(Chr(ord('A') + n) +':\', True, FreeMB, TotalMB) then
  ListBox.Items.Add(Chr(ord('A') + n) +':');
  for n:= 0 to ListBox.Items.Count -1 do
  begin
    Path:= Copy(ListBox.Items[n],1,2) +'\'
    { если в накопителе нет диска, пропустить обновление }
    if GetSpaceOnDisk(Path, False, FreeB, TotalB) and GetSpaceOnDisk(Path, True, FreeMB, TotalMB) then
    begin
      GetDiskInfo(Path);
      if FreeB >= $7FFFFFFF then
      String:= PadL(ByteOrTB(FreeMB*oneMB, true),10) else
      String:= PadL(ByteOrTB(FreeB, true),10);
      if TotalB >= $7FFFFFFF then
      begin
        TotalB:= TotalMB;
        FreeB:= FreeMB;
        String:= PadL(ByteOrTB(TotalMB*oneMB, true),11) +' всего -'+ String
      end else
      String:= PadL(ByteOrTB(TotalB, true),11) +' всего| '+ String; ListBox.Items[n]:= Copy(Path,1,2) + String + PadL(FloatToStr(round(FreeB/TotalB*100)),3)+ '% своб|'+ PadL(FileSystemName,5)+ '| '+ CutString(VolumeName,9);
    end;
  end;
End;

Procedure ObjectOnClick(Sender: TObject);
Begin
  Case TObject(Sender) of
  ListBox:
    for n:= 0 to ListBox.Items.Count-1 do if ListBox.Selected[n] then
    if baseDisk = ListBox.Items[n][1] then
      WizardForm.DirEdit.Text:= baseDir else
    WizardForm.DirEdit.Text:= ListBox.Items[n][1] +':\'+ ExtractFileName(WizardForm.DirEdit.Text)
  StartMenuTreeView:
    if StartMenuTreeView.Directory <> '' then
    WizardForm.GroupEdit.Text:= StartMenuTreeView.Directory else
    WizardForm.GroupEdit.Text:= '{#SetupSetting("DefaultGroupName")}'
  WizardForm.NoIconsCheck:
    begin
      WizardForm.GroupEdit.Enabled:= not(WizardForm.GroupEdit.Enabled);
      StartMenuTreeView.Enabled:= WizardForm.GroupEdit.Enabled;
      WizardForm.GroupBrowseButton.Enabled:= WizardForm.GroupEdit.Enabled
      end;
    end;
End;

/////////////////////////////////////////////////////////////////////////
procedure InitializeWizard;
begin
  ExtractTemporaryFile('Image_1.bmp');
  ExtractTemporaryFile('Image_2.bmp');
  ExtractTemporaryFile('Image_3.bmp');
  ExtractTemporaryFile('Image_4.bmp');
  ExtractTemporaryFile('Image_5.bmp');
  ExtractTemporaryFile('Image_6.bmp');
  ExtractTemporaryFile('Image_7.bmp');
  ExtractTemporaryFile('Image_8.bmp');
  ExtractTemporaryFile('Image_9.bmp');
  ExtractTemporaryFile('Image_10.bmp');

  currTime := 0;

  WizardForm.ProgressGauge.Parent := WizardForm;
  WizardForm.ProgressGauge.Top := WizardForm.CancelButton.Top + ScaleY(12);
  WizardForm.ProgressGauge.Left := ScaleX(10);
  WizardForm.ProgressGauge.Width := WizardForm.MainPanel.Width - ScaleX(20);
  WizardForm.ProgressGauge.Height := 16;
  WizardForm.ProgressGauge.Hide;
  WizardForm.FileNameLabel.Parent := WizardForm;
  WizardForm.FileNameLabel.Top := WizardForm.ProgressGauge.Top - ScaleY(18);
  WizardForm.FileNameLabel.Left := ScaleX(10);
  WizardForm.FileNameLabel.Width := ScaleX(397);
  WizardForm.FileNameLabel.Hide;

  SplashImage := TBitmapImage.Create(WizardForm);
  SplashImage.Top := 0;
  SplashImage.Left := 0;
  SplashImage.Width := WizardForm.MainPanel.Width;
  SplashImage.Height := WizardForm.Bevel.Top;
  SplashImage.Parent := WizardForm.InnerPage;
  SplashImage.Stretch := True;
  SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_1.bmp'));
  SplashImage.Hide;

  ListBox:= TListBox.Create(WizardForm)
  ListBox.SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 8, WizardForm.DirBrowseButton.Left + WizardForm.DirBrowseButton.Width - WizardForm.DirEdit.Left, WizardForm.DiskSpaceLabel.Top - (WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 12))
  ListBox.Font.Size:= 9
  ListBox.Font.Style:= [fsBold]
  ListBox.Font.Name:= 'Courier New';
  ListBox.OnClick:= @ObjectOnClick;
  ListBox.Parent:= WizardForm.SelectDirPage;
  baseDir:= WizardForm.DirEdit.Text
  baseDisk:= WizardForm.DirEdit.Text[1]
end;

procedure CurPageChanged(CurPageID: Integer);
var
  pfunc: LongWord;
begin
  if CurPageID = wpSelectDir then ListBoxRefresh
  if CurPageID = wpInstalling then
  begin
    pfunc := WrapTimerProc(@OnTimer, 5);
    TimerID := SetTimer(0, 0, 1000, pfunc);
    WizardForm.PageNameLabel.Visible:=false
    WizardForm.PageDescriptionLabel.Visible:=false
    WizardForm.InnerNotebook.Hide;
    WizardForm.Bevel1.Hide;
    WizardForm.MainPanel.Hide;
    WizardForm.PageNameLabel.Hide;
    WizardForm.PageDescriptionLabel.Hide;
    WizardForm.ProgressGauge.Show;
    WizardForm.FileNameLabel.Show;
    SplashImage.Show;
    WizardForm.CancelButton.Enabled :=True
    WizardForm.CancelButton.Top := WizardForm.Bevel.Top + ScaleY(100)
  end else
  begin
    WizardForm.ProgressGauge.Hide;
    SplashImage.Hide;
    WizardForm.FileNameLabel.Hide;
    if (CurPageID > wpInstalling) and (CurPageID < wpFinished) then
    begin
      WizardForm.InnerNotebook.Show;
      WizardForm.Bevel1.Show;
      WizardForm.MainPanel.Show;
      WizardForm.PageNameLabel.Show;
      WizardForm.PageDescriptionLabel.Show;
    end
    If CurPageID=wpFinished then
  end;
end;

procedure DeInitializeSetup();
begin
  KillTimer(0, TimerID);
end;

-------
Книги нужны, чтобы напоминать человеку, что его оригинальные мысли не так уж новы... Авраам Линкольн.

Это сообщение посчитали полезным следующие участники:

Отправлено: 00:03, 11-06-2009 | #919