Анализирует лог файлы Border Manager, WinRoute. Если ваш файрволл или прокси ведет логи стандартного формата, не исключено, что и для вас эта программа может быть полезна.
»»» Скачать: исходные тексты
Разные программы с исходниками на TP и Delphi-=CrazyFish=-crazy-fish@narod.ru (15.10.01 16:02)
Набор небольших программ с исходниками на Delphi и Turbo Pascal. В основном они были написаны мной во время учебы в БГТУ ("Военмех") как задания по информатике и реализуют различные математические алгоритмы. Так же есть Морской бой на Delphi (игровое поле - компонент), но пока без исходников.
»»» Скачать: исходные тексты
unit unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; // это просто кнопка на форме - для демонстрации protected procedure RebuildWindowRgn; procedure Resize; override; public constructor Create(AOwner: TComponent); override; end; var Form1 : TForm1; implementation // ресурс этой формы {$R *.DFM}
{ Прозрачная форма } constructor TForm1.Create(AOwner: TComponent); begin inherited; // убираем сколлбары, чтобы не мешались // при изменении размеров формы HorzScrollBar.Visible:= False; VertScrollBar.Visible:= False; // строим новый регион RebuildWindowRgn; end;
procedure TForm1.Resize; begin inherited; // строим новый регион RebuildWindowRgn; end;
procedure TForm1.RebuildWindowRgn; var FullRgn, Rgn: THandle; ClientX, ClientY, I: Integer; begin // определяем относительные координаты клиенской части ClientX:= (Width - ClientWidth) div 2; ClientY:= Height - ClientHeight - ClientX; // создаем регион для всей формы FullRgn:= CreateRectRgn(0, 0, Width, Height); // создаем регион для клиентской части формы // и вычитаем его из FullRgn Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY + ClientHeight); CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff); // теперь добавляем к FullRgn регионы каждого контрольного элемента for I:= 0 to ControlCount -1 do with Controls[I] dobegin Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left + Width, ClientY + Top + Height); CombineRgn(FullRgn, FullRgn, Rgn, rgn!
_Or); end; // устанавливаем новый регион окна SetWindowRgn(Handle, FullRgn, True); end; end.
CONST TitlColors : ARRAY[Boolean] OF TColor = (clInactiveCaption, clActiveCaption); TxtColors : ARRAY[Boolean] OF TColor = (clInactiveCaptionText, clCaptionText);
procedure TForm1.FormCreate(Sender: TObject); VAR rTemp, rTemp2 : THandle; Vertices : ARRAY[0..2] OF TPoint; X, Y : INteger; begin Caption := 'OOOH! Doughnuts!'; BorderStyle := bsNone; {required} IF Width > Height THEN Width := Height ELSE Height := Width; {harder to calc if width <> height} Center := Point(Width DIV 2, Height DIV 2); CapY := GetSystemMetrics(SM_CYCAPTION)+8; rTemp := CreateEllipticRgn(0, 0, Width, Height); rTemp2 := CreateEllipti!
cRgn((Width DIV 4), (Height DIV 4), 3*(Width DIV 4), 3*(Height DIV 4)); CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF); SetWindowRgn(Handle, rTemp, True); DeleteObject(rTemp2); rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4); rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY); CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF); Vertices[0] := Point(0,0); Vertices[1] := Point(Width, 0); Vertices[2] := Point(Width DIV 2, Height DIV 2); rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE); CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND); DeleteObject(rTemp); RL := ArcTan(Width / Height); RR := -RL + (22 / Center.X); X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR)); Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR)); SB1 := TSpeedButton.Create(Self); WITH SB1 DO BEGIN Parent := Self; Left := X; Top := Y; Width := 14; Height := 14; OnClick := Button1Click; Caption := 'X'; Font.Style := [fsBold]; END; end;
procedure TForm1.Button1Click(Sender: TObject); begin Close; End;
procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest); begin Inherited; WITH Msg DO WITH ScreenToClient(Point(XPos,YPos)) DO IF PtInRegion(rTitleBar, X, Y) AND (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN Result := htCaption; end;
procedure TForm1.WMNCActivate(var Msg: TWMncActivate); begin Inherited; TitleBar(Msg.Active); end;
procedure TForm1.WMSetText(var Msg: TWMSetText); begin Inherited; TitleBar(Active); end;
procedure TForm1.TitleBar(Act: Boolean); VAR TF : TLogFont; R : Do!
uble; N, X, Y : Integer; begin IF Center.X = 0 THEN Exit; WITH Canvas DO begin Brush.Style := bsSolid; Brush.Color := TitlColors[Act]; PaintRgn(Handle, rTitleBar); R := RL; Brush.Color := TitlColors[Act]; Font.Name := 'Arial'; Font.Size := 12; Font.Color := TxtColors[Act]; Font.Style := [fsBold]; GetObject(Font.Handle, SizeOf(TLogFont), @TF); FOR N := 1 TO Length(Caption) DO BEGIN X := Center.X-Round((Center.X-6)*Sin(R)); Y := Center.Y-Round((Center.Y-6)*Cos(R)); TF.lfEscapement := Round(R * 1800 / pi); Font.Handle := CreateFontIndirect(TF); TextOut(X, Y, Caption[N]); R := R - (((TextWidth(Caption[N]))+2) / Center.X); IF R < RR THEN Break; END; Font.Name := 'MS Sans Serif'; Font.Size := 8; Font.Color := clWindowText; Font.Style := []; end; end;
procedure TForm1.FormPaint(Sender: TObject); begin WITH Canvas DO BEGIN Pen.Color := clBlack; Brush.Style := bsClear; Pen.Width := 1; Pen.Color := clWhite; Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height); Arc((Width DIV 4)-1, (Height DIV 4)-1, 3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0); Pen.Color := clBlack; Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0); Arc((Width DIV 4)-1, (Height DIV 4)-1, 3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height); TitleBar(Active); END; end;
Поля типа array ...
Как работать с полями типа array? Запросами они не обновляются:
Удаляю процедуру и выводит сообщение...
Удаляю процедуру ,в которой есть вызов другой процедуры. Перед удалением я изменил входящие параметры вызываемой ...
Отчет о встрече Delphi.Mastak.Ru-Орел 12-14 октября 2001 года.
История от Lel-а. Как и было обещано на второй недели октября, представители, хоть и призрачные, сайта посетили славный город-герой Орел. История от Savva Поcле длительного ожидания в минувшие выходные все-таки состоялась выездная сессия сайта http://delpi.mastak.ru (или просто пирушка :)) в составе : Lel со стороны сайта, да и не только и Ваш покорный слуга, чье повествование собственно сейчас и перед Вами. Встреча не планировалась на конкретный срок (октябрь ± пол года 8)), поэтому прошу прошения у орловских посетителей сайта и всех тех, кто мог бы приехать.
-=CrazyFish=- Сайт для программистов Сайт посвящен вопросам программирования. Содержит описания алгоритмов и исходные тексты программ на Turbo Pascal и Delphi.
Давно витающая в воздухе нашего сайта идея создания журнала, посвященного всеми нами любимой среде разработки Delphi, похоже, обретает зримую форму. Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
Для души
Хокку дня
матричный принтер стрекочет пронзительно и отчаянно он обречен
Афоризмы
Женский свитер должен так плотно обтягивать грудь, чтобы у мужчины перехватило дыхание (Некий мичиганский политик)
Фраза дня
Уходя, гасите всех.
И на закуску коротенький анекдот
Надпись на надгробной плите: "Не все йогурты одинаково полезны!"