Часто у новичков бывают проблемы при работе с датой. По просьбе одного из участников форума, Alex2009 любезно согласился помочь по некоторым типичным задачам.

Используя объектно – ориентированную среду Делфи напишите программу определения:

А) даты вчерашнего дня;

const
stDay : array[1..7] of string[11] =
('Воскресенье','Понедельник','Вторник','Среда','Четверг','Пятница','Суббота');
stMonth : array[1..12] of string[8] =
('Января','Февраля','Марта','Апреля ','Мая','Июня','Июля',
'Августа','Сентября','Октября','Ноя бря','Декабря');

procedure TForm1.FormCreate(Sender: TObject);
var
Present: TDateTime;
Year, Month, Day : Word;
begin
Present:=Now;
DecodeDate(Present, Year, Month, Day);
Caption := 'Сегодня '+IntToStr(Day)+ ' ' +
stMonth[Month] +' '+IntToStr(Year)+' года, '+
stDay[DayOfWeek(Present)];
end;

Б) дату, которая была за m дней до указанной даты;

const
stDay : array[1..7] of string[11] =
('Воскресенье','Понедельник','Вторник','Среда','Четверг','Пятница','Суббота');
stMonth : array[1..12] of string[8] =
('Января','Февраля','Марта','Апреля ','Мая','Июня','Июля',
'Августа','Сентября','Октября','Ноя бря','Декабря');

procedure TForm1.FormCreate(Sender: TObject);
var
Present: TDateTime;
Year, Month, Day : Word;
begin
Present:=Now;
Present:=Present-1;
Day:=Day-day;
DecodeDate(Present, Year, Month, Day);
Caption := 'Вчера '+IntToStr(Day)+ ' ' +
stMonth[Month] +' '+IntToStr(Year)+' года, '+
stDay[DayOfWeek(Present)];
end;

В) количество дней, прошедших от даты t до t 2

uses DateUtils;
........
procedure TForm1.Button1Click(Sender: TObject);
var d,d2:TDate;
begin
 showmessage('Вчерашняя дата '+formatdatetime('dd mmmm yyyyг.',yesterday));
 d:=Now;
 d:=incDay(d,-10);
 showmessage('Дата которая была 10 дней назад '+formatdatetime('dd mmm yyyyг.',d));
 d:=StrToDate('12.03.2010');
 d2:=StrToDate('25.04.2010');
 showmessage('Кол-во дней между датами составляет '+inttostr(DaysBetween(d2,d))+' дней');
end;

Посмотреть тему на форуме.

Alex_sim:

\\привет вот накидал 100% работающий вариант перевода числа в любую СС извини только на с++ ну думаю переделать не составит труда))
#include
#include
#include
#include

int main()
{
   setlocale(LC_ALL, “Russian”);

   // пример организации ввода с ограничением
   int n;
   do {
     printf(”Введите положительное число: “);
     scanf_s(”%d”, &n);
     fflush(stdin); // сброс нераспознаваемого “мусора”
   } while( n<0 );

   const int radix = 7; // основание СС тоже можно спросить у пользователя
   char buffer[]=”00000000″;
   int i=7; // позиция в буфере первой записываемой цифры

   do {
     int x = n % radix;
     n = n / radix;
     char z;
     if( x<10 )
       z='0'+x;
     else
       z=’A’-10+x;
     //printf(”%c”, z );
     buffer=z; // вместо вывода на экран, записываем в буфер в обратном порядке
     i–;
   } while (n>0);

   // только в конце выводим результат
   printf(”\nЗапись в %d-чной системе счисления: %s\n”, radix, buffer);

   _getch();
}

Перейти к теме на форуме

Всем привет! Попал в такую ситуацию: есть 2 временных TPNGImage; один загружен из файла, второй – пустой, предназначен для вывода растянутого/ужатого первого.

При копировании первого во второй и его последующем ресайзе теряется альфа-канал.

Как можно заново просчитать маску прозрачности (или как это делается), учитывая новые размеры?

Код:

var
  Src,Dst:TPngImage;

type
  PRGBAArray = ^TRGBAArray;
  TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;
...
procedure Resize;
var BTOut:TBitmap;
    BT:Tbitmap;
    bt_tmp_rgb,bt_tmp_a:tbitmap;
    bt_tmp_rgb2,bt_tmp_a2:tbitmap;
    iii,ii:integer;
    fff:PRGBAArray;
    aaa:pByteArray;
begin
  BTOut:=TBitmap.Create;
  BTOut.PixelFormat:=pf32bit;

  BT:=TBitmap.Create;
  BT.PixelFormat:=pf32bit;

  bt_tmp_rgb:=TBitmap.Create;
  bt_tmp_a:=TBitmap.Create;
  bt_tmp_rgb.PixelFormat:=pf32bit;
  bt_tmp_a.PixelFormat:=pf32bit;

  BT.Assign(Src);
  for ii:=0 to BT.Height-1 do begin
    fff:=BT.ScanLine[ii];
    aaa:=Src.AlphaScanline[ii];
    for iii:=0 to BT.Width-1 do begin
      fff[iii].rgbReserved:=aaa[iii];
    end;
  end;
  BTOut.SetSize(Dst.Width,Dst.Height);
  bt_tmp_rgb.SetSize(BT.Width,BT.Height);
  bt_tmp_a.SetSize(BT.Width,BT.Height);

  //Разделяем битмап-подложку на "видимый" битмап RGB и альфаканал
  GetLayerBitmap(bt,bt_tmp_rgb,bt_tmp_a);
  BT.Free;
  bt_tmp_rgb2:=TBitmap.Create;
  bt_tmp_rgb2.PixelFormat:=pf32bit;
  bt_tmp_rgb2.SetSize(BTOut.Width,BTOut.Height);
  bt_tmp_rgb2.Canvas.StretchDraw(bt_tmp_rgb2.Canvas.ClipRect,bt_tmp_rgb);
  bt_tmp_rgb.Free;
  bt_tmp_a2:=TBitmap.Create;
  bt_tmp_a2.PixelFormat:=pf32bit;
  bt_tmp_a2.SetSize(BTOut.Width,BTOut.Height);
  bt_tmp_a2.Canvas.StretchDraw(bt_tmp_a2.Canvas.ClipRect,bt_tmp_a);
  bt_tmp_a.Free;

  //собираем временные битмапы в один 32-битный, который потом будет отображен
  Build32(bt_tmp_rgb2,bt_tmp_a2,BTOut);
  bt_tmp_rgb2.Free;
  bt_tmp_a2.Free;
  Dst.Assign(BTOut);
  Dst.CreateAlpha;

  for ii:=0 to BTOut.Height-1 do begin
    fff:=BTOut.ScanLine[ii];
    aaa:=Layer.StretchPNG.AlphaScanline[ii];
    for iii:=0 to BTOut.Width-1 do begin
      aaa[iii]:=fff[iii].rgbReserved;
    end;
  end;

  BTOut.Free;
end;

procedure GetLayerBitmap(_B_res:TBitmap;  _Brgb,_Bmask:Tbitmap);
var x, y: Integer; RowOut,RowIn,RowOutM: PRGBAArray;
begin
  for y:=0 to _B_res.Height-1 do begin
    RowOut:= _Brgb.ScanLine[y];
    RowOutM:= _Bmask.ScanLine[y];
    RowIn:= _B_res.ScanLine[y];
    for x:=0 to _B_res.Width-1 do begin

     RowOutM[x].rgbReserved:=255;
     RowOutM[x].rgbBlue:=RowIn[x].rgbReserved;
     RowOutM[x].rgbGreen:=RowIn[x].rgbReserved;
     RowOutM[x].rgbRed:=RowIn[x].rgbReserved;

     RowOut[x].rgbReserved:=255;
     RowOut[x].rgbBlue:=RowIn[x].rgbBlue;
     RowOut[x].rgbGreen:=RowIn[x].rgbGreen;
     RowOut[x].rgbRed:=RowIn[x].rgbRed;
     end;
  end;
end;

procedure Build32(_B_in,_B_inM:TBitmap; _Bout:Tbitmap);
var x, y: Integer; RowOut: PRGBAArray; RowIn,RowM:PRGBAArray;
begin
  for y:=0 to _B_in.Height-1 do begin
     RowOut:= _Bout.ScanLine[y];
     RowIn:= _B_in.ScanLine[y];
     RowM:= _B_inM.ScanLine[y];
    for x:=0 to _B_in.Width-1 do begin
          RowOut[x].rgbBlue:=RowIn[x].rgbBlue;
          RowOut[x].rgbGreen:=RowIn[x].rgbGreen;
          RowOut[x].rgbRed:=RowIn[x].rgbRed;
          RowOut[x].rgbReserved:=RowM[x].rgbRed;
    end;
  end;
end;

Тема на форуме.

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.DoubleBuffered:=true;
end;

Перейти к теме на форуме

procedure TForm1.Button1Click(Sender: TObject);
var data:tstringlist;
PageProfile, pic:string;
error:boolean;
beginpos, endpos : Integer;
ms:   TMemoryStream;
jpeg: TJpegImage;
begin
IdHTTP1.AllowCookies:=true;
IdHTTP1.HandleRedirects:=false;
data:=tstringlist.create;
data.Add('email=ЛОГИН'); // логин для авторизации
data.Add('pass=ПАРОЛЬ');  // пароль для авторизации
data.Add('expire=');
data.Add('vk=');
error:=false;
try
PageProfile:=IdHTTP1.Post('http://login.vk.com/?act=login', data);
except
error:=true;
end;

if not(error) then
begin
data.Clear;
data.Add('s='+Copy(PageProfile, Pos('value', PageProfile)+7, 56));
data.Add('op=slogin');
data.Add('redirect=1');
data.Add('expire=0');
data.Add('to=');
IdHTTP1.HandleRedirects:=true;
try
PageProfile:=IdHTTP1.Post('http://vkontakte.ru/login.php', data);
except
end;
beginpos := Pos('center', PageProfile);
endpos := PosEx('/>', PageProfile, beginpos + 21);
pic := Copy(PageProfile, beginpos + 21, endpos - (beginpos + 21));
Memo1.Lines.Add(pic);

ms := TMemoryStream.Create;
jpeg := TJpegImage.Create;
try
IdHTTP1.Get(pic, ms);
ms.Position := 0;
jpeg.LoadFromStream(ms);
Image1.Picture.Graphic := jpeg;
finally
jpeg.Free; ms.Free;
end;
end
else
Memo1.Lines.Add('Авторизация не удалась');

Data.Free;
end;

Alex2009:

uses
   URLMon, ShellApi;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
   try
     Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
   except
     Result := False;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
SourceFile = ‘http://rap-zt.at.ua/style/photo/cover2/mafon.jpg’;
DestFile = ‘c:\temp\mafon.jpg’;
begin
   if DownloadFile(SourceFile, DestFile) then
   begin
     ShowMessage(’Файл скачанl!’);
     ShellExecute(Application.Handle, PChar(’open’), PChar(DestFile),
       PChar(”), nil, SW_NORMAL)
   end
   else
     ShowMessage(’Ошибка закачки ‘ + SourceFile)
end;

Перейти к обсуждению на форуме

ShellExecute(handle, ‘open’, ‘http://www.programmersforum.ru’, nil, nil, SW_SHOW);

Перейти к теме на форуме

Баламут:

Для подключения запароленной базы используется строка подключения примерно следующего вида:

AdoConnection1.ConnectionString:= ‘Provider=Microsoft.Jet.OLEDB.4.0;’+
  ’Data Source=имя_базы.mdb;Persist Security Info=False;’+
  ’Jet OLEDB:Database Password=ПАРОЛЬ‘;

Перейти к теме на форуме

От ведущего рассылки.

Приветствую Вас в Клубе ПРОграммистов!! Сегодня выходит очередной 57 выпуск рассылки от клуба.
В этом номере будут самые интересные темы и статьи клуба, форума, а так же статьи из журнала ПРОграммист,  который ведут наши участники, ну и немного юмора.

(читать всё…)

Человек_Борща:

Интересует вопрос.. в чем отличия Borland Delphi 7 от Embracode RAD 2010?

Присоеденится к обсуждению