Окошко About

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Окошко About

Сообщение Little_Roo » 23.01.2010 20:20:47

Просматривая темы форума, наткнулся на, правда боковое, но все же затрагивающее...
Несколько лет назад, когда потребовалось выводить САБЖ, долго тр@хался - дельфя7 ну никак не хотела обновлять номер свежескомпиленной версии базы...
После долгих поисков нашел - честно скажу, где хз...не помню, НО - работала !!! кроме...обновленя версии скрмпиленного...
При переводе (поэтапного) с дельфей на лазарь подключил этот модуль - и О ЧУДО !!!! версии показываются правильно, жрет не много...
Только некоторые глючки есть - ну это мои ручки кривые - я ж просто взял и в uses' ах пристыковал... размер окна автоматом не считается...

Кто-то возьмется подправить???
Просто даю фай модуля (а в дельфях я его еще и градиентной заливкой из Raize Lib красил ...эх...)
А может, кому-то пригодится? Мне понравился.
Код: Выделить всё
{

Данная процедура показывает небольшое диалоговое окно с данными о программе взятыми из Version Info
Окно автоматически изменяет свой размер в зависимости от данных Version Info.

Жилин С.В.
jilin@list.ru
////////////////////////////////////
            Огромное СПАСИБО автору !!!
            Чуть подправил-изменил...
            Почти все работает, но... при переводе с Delphi7 - нет изменений размеров окна и....
                 ручками добился эффектов - кто подточит  - тому большой смайл :-)

                 Игорь Плещенков (Little_Roo)
            Lazarus 0.9.29 r23335 FPC 2.3.1 i386-win32-win32/win64

///////////////////////////////////
}

unit AboutF;

interface

uses
  Windows, SysUtils,Graphics,Controls, Forms,
  StdCtrls,ExtCtrls;

procedure ShowAbout;

implementation

uses  unit1;

procedure ShowAbout;
var
About1: TForm;
S,TS: ansistring;
h,sz,Len: DWORD;
Buf: PChar;
Value: Pointer;
LabelLeft,i: Integer;
begin
S := Application.ExeName;
sz := GetFileVersionInfoSize(PChar(S), h);
if sz > 0 then
  begin
   Buf := AllocMem(sz);
   GetFileVersionInfo(PChar(S), h, sz, Buf);

   VerQueryValue(Buf, '\VarFileInfo\Translation', Value, Len);
   TS := IntToHex(MakeLong(HiWord(Longint(Value^)), LoWord(Longint(Value^))), 8);
   About1 := TForm.Create(Application);
   With About1 do
    try
     Caption := 'О программе... '{+Application.Title};
     Position := poScreenCenter;
     BorderStyle := bsDialog;

     {  With TImage.Create(Application) do
      try
        begin
         Picture.LoadFromFile('Foto\1.bmp');
         Left := 2;
         Top  := About1.Height - Height - 35;
         Parent := About1;
         AutoSize := True;

        end;
      except
        Picture.Free;
      end;
    }
     With TImage.Create(Application) do
      begin
       Picture.Icon := Application.Icon;
       Left := 10;
       Top  := 10;
       Parent := About1;
       AutoSize := True;
       LabelLeft := Left+Width + 50;
      end;


     VerQueryValue(Buf, PChar('StringFileInfo\'+TS+'\ProductName'), Pointer(Value), Len);
     if Len > 1 then
      With TLabel.Create(Application) do
       begin
        Left := LabelLeft - 100;
        Top  := About1.Controls[About1.ControlCount-1].Top;
        Font.Size := 10;
        Font.Style := [fsBold];
        Font.Color := clRed;
        Transparent := true;
        Parent := About1;
        //Caption := StrPas(PChar(Value));
        Caption := 'СУБД Международного лицея СПбГУП';
       end;

     VerQueryValue(Buf, PChar('StringFileInfo\'+TS+'\FileVersion'), Pointer(Value), Len);
     if Len > 1 then
      With TLabel.Create(Application) do
       begin
        Left := LabelLeft -100;
        Font.Style := [fsBold];
        Top  := About1.Controls[About1.ControlCount-1].Top+About1.Controls[About1.ControlCount-1].Height+5;
        Caption := 'Версия: '+StrPas(PChar(Value));
        Transparent := true;
        Parent := About1;
       end;

     VerQueryValue(Buf, PChar('StringFileInfo\'+TS+'\CompanyName'), Pointer(Value), Len);
     if Len > 1 then
      With TLabel.Create(Application) do
       begin
        Left := LabelLeft - 100;
        Top  := About1.Controls[About1.ControlCount-1].Top+About1.Controls[About1.ControlCount-1].Height+5;
        Caption := 'Компания: '+StrPas(PChar(Value));
        Transparent := true;
        Parent := About1;
       end;

     VerQueryValue(Buf, PChar('StringFileInfo\'+TS+'\Author'), Pointer(Value), Len);
    // if Len > 1 then
      With TLabel.Create(Application) do
       begin
        Left := LabelLeft - 100;
        Top  := About1.Controls[About1.ControlCount-1].Top+About1.Controls[About1.ControlCount-1].Height+5;
        //Caption := 'Автор: '+StrPas(PChar(Value));
        Caption := 'Автор: Игорь Н. Плещенков (Little Roo)';
        Transparent := true;
        Parent := About1;
       end;

     VerQueryValue(Buf, PChar('StringFileInfo\'+TS+'\LegalCopyright'), Pointer(Value), Len);
     if Len > 1 then
      With TLabel.Create(Application) do
       begin
        Left := LabelLeft - 100;
        Top  := About1.Controls[About1.ControlCount-1].Top+About1.Controls[About1.ControlCount-1].Height+5;
        Caption := 'Copyright: ' + StrPas(PChar(Value));
        Transparent := true;
        Parent := About1;
       end;

     Height := Controls[ControlCount-1].Top+Controls[ControlCount-1].Height+85;
     Width := 10;
     for i := 0 to ControlCount-1 do
      if Controls[i] is TLabel then
       if Controls[i].Left+Controls[i].Width+20 > Width then
         Width := Controls[i].Left+Controls[i].Width + 210;

     With TButton.Create(Application) do
      begin
       Caption := 'Ok';
       Left := Trunc((About1.Width/2)-(Width/2));
       Top := Trunc(About1.Height-40);
       ModalResult := mrOk;
       Cursor := crHandPoint;
       Parent := About1;
      end;


     ShowModal;
   finally
    Free;
   end;
  end;
end;

end.
Аватара пользователя
Little_Roo
энтузиаст
 
Сообщения: 639
Зарегистрирован: 27.02.2009 19:56:36
Откуда: Санкт-Петербург

Re: Окошко About

Сообщение Mr.Smart » 23.01.2010 21:11:37

Little_Roo
Ну этож под Винвуз только! Давай кроссплатформенное решение :wink:
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: Окошко About

Сообщение Little_Roo » 23.01.2010 21:18:40

Mr.Smart писал(а):Little_Roo
Ну этож под Винвуз только! Давай кроссплатформенное решение :wink:

Звиняй, пока (ПОКА :) мой мозг так далеко не простирается :-(
Но пробуем -
Аватара пользователя
Little_Roo
энтузиаст
 
Сообщения: 639
Зарегистрирован: 27.02.2009 19:56:36
Откуда: Санкт-Петербург

Re: Окошко About

Сообщение Brainenjii » 25.01.2010 00:10:28

http://fsweb.info/art_lazarus/file_info.html - не то? Правда в 2.4.0 потерялось, вроде...
Аватара пользователя
Brainenjii
энтузиаст
 
Сообщения: 1351
Зарегистрирован: 10.05.2007 00:04:46

Re: Окошко About

Сообщение Mr.Smart » 25.01.2010 00:38:19

Brainenjii
Опять же Виндуз. В линукс лайк системах в бинарнике не содержится информация об версии файла и подобной лабуде!
з.ы. поправьте если не прав :wink:
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: Окошко About

Сообщение Vadim » 25.01.2010 09:01:53

Mr.Smart писал(а):В линукс лайк системах в бинарнике не содержится информация об версии файла...

Позволь, коллега, с тобой не согласиться. :D
Вот я, к примеру, хочу узнать версию проги. Запускаю:
/usr/bin/amixer -v
и вижу его версию - amixer version 1.0.11rc2
Ну, думаю, неужели он ещё и rpm запрашивает? Смотрю в mc этот самый amixer через F4 и вижу прямо внутри файла строку "amixer version 1.0.11rc2". ;)
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Окошко About

Сообщение Mr.Smart » 25.01.2010 11:51:18

Vadim
Ну и что? Это обычная константа и искать её в бинарнике проблемотично.
Mr.Smart
долгожитель
 
Сообщения: 1796
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

Re: Окошко About

Сообщение Vadim » 25.01.2010 12:24:56

Mr.Smart
Тем не менее эта константа есть и есть она именно в бинарнике. Проблематично или не проблематично её искать - я не знаю, не специалист. Но она есть и пусть проблемой её поиска поделятся спецы в линукс-программировании. ;)
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 47

Рейтинг@Mail.ru
cron