Другие компоненты

HeaderControl с дополнительной возможностью отображения стрелок

2017-09-28T20:57:23+07:00

Обычный HeaderControl с дополнительной возможностью отображения стрелок

Подробнее...

Глюк при запуске приложений через ShellListView

2017-09-28T20:26:59+07:00

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

Подробнее...

Загрузка файлов в THTMLViewer и TFrameBrowser

2017-09-28T20:55:58+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Readhtml, FramView, FramBrwz, HtmlView;

type

TForm1 = class(TForm)

FrameBrowser1: TFrameBrowser;

procedure FormCreate(Sender: TObject);

procedure FrameBrowser1GetPostRequest(Sender: TObject; IsGet: Boolean;

const URL, Query: String; Reload: Boolean; var NewURL: String;

var DocType: ThtmlFileType; var Stream: TMemoryStream);

procedure FrameBrowser1ImageRequest(Sender: TObject; const SRC: String;

var Stream: TMemoryStream);

public

BaseDir: string;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

BaseDir := 'F:\Download\';

FrameBrowser1.LoadURL('file://F:\Download\index.htm');

end;

procedure TForm1.FrameBrowser1GetPostRequest(Sender: TObject;

IsGet: Boolean; const URL, Query: String; Reload: Boolean;

var NewURL: String; var DocType: ThtmlFileType;

var Stream: TMemoryStream);

var

S, sType: string;

F: TFileStream;

P: Integer;

begin

S := StringReplace(URL, '|', ':', [rfReplaceAll]);

P := Pos(':', S) + 2;

sType := Copy(S, 1, P);

Stream := TMemoryStream.Create;

if AnsiLowerCase(sType) = 'file://' then

begin

S := StringReplace(Copy(S, P + 1, MaxInt), '/', '\', [rfReplaceAll]);

F := TFileStream.Create(S, fmOpenRead);

try

Stream.CopyFrom(F, F.Size);

finally

F.Free;

end;

procedure TForm1.FrameBrowser1ImageRequest(Sender: TObject;

const SRC: String; var Stream: TMemoryStream);

begin

{}

end;

end.

Как использовать ChartFX?

2017-09-28T20:11:06+07:00

Code:

with ChartFX do begin

Visible := false;

{ Устанавливаем режим ввода значений }

{ 1 - количество серий (в нашем случае 1), 3 - количество значений }

OpenData [COD_VALUES] := MakeLong (1,3);

{ Hомер текущей серии }

ThisSerie := 0;

{ Value [i] - значение с индексом i }

{ Legend [i] - комментарий к этому значению }

Value [0] := a;

Legend [0] := 'Значение переменной A';

Value [1] := b;

Legend [1] := 'Значение переменной B';

Value [2] := c;

Legend [2] := 'Значение переменной C';

{ Закрываем режим }

CloseData [COD_VALUES] := 0;

{ Ширина поля с комментариями на экране (в пикселах) }

LegendWidth := 150;

Visible := true;

end;

Как использовать IP Address Control у себя?

2017-09-28T20:17:58+07:00

Microsoft ® Internet Explorer представляет элемент управления IP-адрес, новый элемент управления похож на элемент управления редактирования, что позволяет пользователю ввести

числовой адрес в сети Интернет-протокола (IP). Этот формат состоит из четырех трехзначных полей. Каждое поле обрабатывается индивидуально; номера полей основываются на нулях и

перейдите слева направо.

Подробнее...

Как поставить свой формат в TDateTimePicker?

2017-09-28T20:12:53+07:00

Code:

uses CommCtrl;

const fmt: PChar = 'hh:mm';

SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, LongInt(fmt));

Как удалить сегодняшнюю дату из TDateTimePicker?

2017-09-28T20:12:24+07:00

Code:

uses

CommCtrl;

procedure TForm1.DateTimePicker1DropDown(Sender: TObject);

var

wnd: HWND;

Style: Integer;

begin

wnd := DateTime_GetMonthCal(DateTimePicker1.Handle);

if wnd <> 0 then

begin

Style := GetWindowLong(wnd, GWL_STYLE);

SetWindowLong(wnd, GWL_STYLE, Style or MCS_NOTODAY or MCS_NOTODAYCIRCLE);

end;

{

The calendar will still highlite the current day but the circle and the

today display at the bottom are gone.

}

Пример компонента HotSpot

2017-09-28T20:19:57+07:00

Вот пример HotSpot-компонента, основанного на TPanel (небольшая переделка). Управляя событиями MouseDown и MouseUp можно получить эффект резинового контура.

Подробнее...

Расширенный Label для отображения имени файла

2017-09-28T20:58:09+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;

procedure FormCreate(Sender: TObject);

end;

var

Form1: TForm1;

implementation

uses Types;

{$R *.dfm}

type

TPathLabel = class(TLabel)

private

FHintWindow: THintWindow;

procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;

procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

protected

procedure Paint; override;

public

constructor Create(AOwner: TComponent); override;

end;

{ TPathLabel }

procedure TPathLabel.CMHintShow(var Message: TMessage);

var

P: TPoint;

R: TRect;

begin

Message.Result := 1;

end;

procedure TPathLabel.CMMouseEnter(var Message: TMessage);

var

P: TPoint;

R: TRect;

W: Integer;

begin

W := Canvas.TextWidth(Caption);

if W > ClientWidth then

begin

P := ClientToScreen(Point(0, 0));

R := ClientRect;

R := Rect(P.X, P.Y,

P.X + W + 5,

P.Y + ClientHeight);

FHintWindow.ActivateHint(R, Caption);

Message.Result := 1;

end;

inherited;

end;

procedure TPathLabel.CMMouseLeave(var Message: TMessage);

begin

FHintWindow.ReleaseHandle;

inherited;

end;

procedure TPathLabel.CMTextChanged(var Message: TMessage);

begin

if Canvas.TextWidth(Caption) > ClientWidth then

begin

ShowHint := True;

Hint := Caption;

end else begin

ShowHint := False;

Hint := '';

end;

inherited;

end;

constructor TPathLabel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoSize := False;

FHintWindow := THintWindow.Create(Self);

FHintWindow.Color := Application.HintColor;

end;

procedure TPathLabel.Paint;

var

R: TRect;

begin

R := ClientRect;

if Transparent then

Canvas.Brush.Style := bsClear

else begin

Canvas.Brush.Style := bsSolid;

Canvas.Brush.Color := Color;

end;

DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_PATH_ELLIPSIS);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

R: TRect;

begin

R := Label1.BoundsRect;

Inc(R.Top, 50);

Inc(R.Bottom, 50);

with TPathLabel.Create(Self) do

begin

Parent := Self;

Color := clLime;

BoundsRect := R;

Caption := Label1.Caption;

end;

end.

Что такое фреймы?

2017-09-28T20:18:42+07:00

Фрэйм - это чтото-типа TForm только его можна размещать в любом окне программы.

Надо создать его File -> New -> Frame. Появится окошко. Растянуть на форме этот TFrameБ выбрать из списка нужный и работать как с обычной формой. Все просто.