VPF::отображение вкладок в браузере, русские шриф. нет

s2004

Дата 10.11.2012, 21:18 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 174
Регистрация: 30.10.2006

Репутация: нет
Всего: нет

Код


procedure TForm1.AddUrl1Click(Sender: TObject);
begin
Caption := AddToFavorites(IEAddress1.Text, '', 'Delphi');
end;

в uses файл DlgAddToFavourites.pas

Код


unit DlgAddToFavourites;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ShlObj;

type
  TfAddToFavorites = class(TForm)
    GroupBox1: TGroupBox;
    eUrl: TEdit;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    eName: TEdit;
    cbFolder: TComboBox;
    BitBtn1: TBitBtn;
    bOk: TBitBtn;
    bCancel: TBitBtn;
    procedure cbFolderDrawItem(Control: TWinControl; Index: Integer;
      r: TRect; State: TOwnerDrawState);
    procedure bOkClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    fFileName: string;
    function GetFolder: string;
    function GetUName: string;
    function GetUrl: string;
    procedure SetFolder(const Value: string);
    procedure SetUName(const Value: string);
    procedure SetUrl(const Value: string);
    procedure RescanFolders;
    function GetFavourites: string;
  public
    function Execute(AUrl: string; AName: string = ''; AFolder: string = ''): Boolean;
    property FovouritesFolder: string read GetFavourites;
    constructor Create(AOwner: TComponent); override;
  published
    property URL: string read GetUrl write SetUrl;
    property UName: string read GetUName write SetUName;
    property Folder: string read GetFolder write SetFolder;
    property FileName: string read fFileName write fFileName;
  end;

function AddToFavorites(AUrl, AName, AFolder: string): string;

implementation

{$R *.dfm}

{ TfAddToFavorites }

constructor TfAddToFavorites.Create(AOwner: TComponent);
begin
  inherited;
  RescanFolders;
end;

function TfAddToFavorites.Execute(AUrl, AName, AFolder: string): Boolean;
begin
  UName := AName;
  Url := AUrl;
  if AFolder <> '' then
    AFolder := ExtractFileName(GetFavourites) + '\' + AFolder;
  cbFolder.ItemIndex := cbFolder.Items.IndexOf(AFolder);
  if (cbFolder.ItemIndex = -1) then cbFolder.ItemIndex := 0;
  Result := ShowModal = mrOk;
end;

function TfAddToFavorites.GetFavourites: string;
var s:  string;
begin
  SetLength(s, MAX_PATH);
  if not SHGetSpecialFolderPath(0, PChar(s), CSIDL_FAVORITES, true)
  then s := '';
  result := PChar(s);
end;

function TfAddToFavorites.GetFolder: string;
begin
  Result := cbFolder.Text;
end;

function TfAddToFavorites.GetUName: string;
begin
  Result := eName.Text;
end;

function TfAddToFavorites.GetUrl: string;
begin
  Result := eUrl.Text;
end;

procedure ScanFolder(path: string; sl: TStrings; pref: string);
var
  sr: TSearchRec;
begin
  path := path + '\';
  if FindFirst(path + '*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((sr.Attr and faDirectory) = faDirectory) then
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        sl.Add(pref + sr.Name);
        ScanFolder(path + sr.Name, sl, pref + '\' + sr.Name);
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

procedure TfAddToFavorites.RescanFolders;
var
  sl: TStrings;
  p:  string;
begin
  p := GetFavourites;
  sl := cbFolder.Items;
  sl.Add(ExtractFileName(p));
  ScanFolder(p, sl, ExtractFileName(p) + '\');
end;

procedure TfAddToFavorites.SetFolder(const Value: string);
begin
  cbFolder.Text := Value;
end;

procedure TfAddToFavorites.SetUName(const Value: string);
begin
  eName.Text := Value;
end;

procedure TfAddToFavorites.SetUrl(const Value: string);
begin
  eUrl.Text := Value;
end;

function AddToFavorites(AUrl, AName, AFolder: string): string;
var f: TfAddToFavorites;
begin
  Application.CreateForm(TfAddToFavorites, f);
  if f.Execute(AUrl, AName, AFolder) then Result := f.FileName
  else Result := '';
  f.Free;
end;

procedure TfAddToFavorites.cbFolderDrawItem(Control: TWinControl;
  Index: Integer; r: TRect; State: TOwnerDrawState);
var
  i,o,l,d: integer;
  s,n: string;
  cb: TComboBox;
begin
  cb := TComboBox(Control);
  s := cb.Items[Index];
  n := ExtractFileName(s);
  o := 0;
  for i := 1 to Length(s) do if s[i] = '\' then Inc(o);
  with cb.Canvas do
  begin
    if odHotLight    in State then cb.Brush.Color := clHighlight
    else cb.Brush.Color := clWindow;
    cb.Canvas.FillRect(Rect(0, r.Top, cb.Width, r.Bottom));
    l := r.Left + o * 10; d := r.Top + (r.Bottom - r.Top) div 2;
    Polyline([Point(l-1, d), Point(l-5, d), Point(l-5, r.Top), Point(l-5, r.Bottom)]);
    cb.Canvas.TextOut(l, r.Top, n);
  end;
end;

procedure TfAddToFavorites.bOkClick(Sender: TObject);
var
  f: string;
  sl: TStringList;
begin
  f := ExtractFilePath(GetFavourites) + Folder;
  ForceDirectories(f);
  sl := TStringList.Create;
  sl.Add('[InternetShortcut]');
  sl.Add('URL=' + url);
  f := f + '\' + UName + '.url';
  try
    sl.SaveToFile(f);
  finally
    sl.Free;
  end;
  Close;
end;

procedure TfAddToFavorites.BitBtn1Click(Sender: TObject);
var
  f: TForm;
  e: TEdit;
  b: TBitBtn;
  s: string;
begin
  f := TForm.Create(nil);
  f.Width := 300;
  f.Caption := 'Add New Folder';
  f.Position := poScreenCenter;
  e := TEdit.Create(f);
  e.Parent := f;
  f.ClientHeight := e.Height;
  e.Align := alTop;
  b := TBitBtn.Create(f);
  b.Top := e.BoundsRect.Bottom + 4;
  b.Left := 8;
  b.Parent := f;
  b.Kind := bkOK;
  b := TBitBtn.Create(f);
  b.Top := e.BoundsRect.Bottom + 4;
  b.Parent := f;
  b.Kind := bkCancel;
  b.Left := f.ClientWidth - b.Width - 8;
  b.Anchors := [akTop, akRight];
  f.ClientHeight := b.BoundsRect.Bottom + 4;
  if f.ShowModal = mrOk then
  begin
    if e.Text = '' then Exit;
    s := cbFolder.Text + '\' + e.Text;
    cbFolder.Items.Insert(cbFolder.ItemIndex + 1, s);
    cbFolder.ItemIndex := cbFolder.ItemIndex + 1;
  end;
end;

end.

английский шрифт выводится нормально, но если русский то какарябины.

s2004

Дата 11.11.2012, 18:40 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 174
Регистрация: 30.10.2006

Репутация: нет
Всего: нет

Код


Saved8087CW := Default8087CW;
{$IFDEF VER120UP}
  bMsgHandler := False;
{$ENDIF}
  OleInitialize(nil);
finalization
  Set8087CW(Saved8087CW);

это шрифт set8087?

Illusion Dolphin

Дата 11.11.2012, 22:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Цитата

set8087

Это не шрифт.

Какая версия делфи? Если до-юникодная - то неправильная кодировка по умолчанию стоит (не русская).

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

s2004

Дата 12.11.2012, 19:38 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 174
Регистрация: 30.10.2006

Репутация: нет
Всего: нет

дельфи 2006, но при чём она я же о вкладке embeddedwb

p.s.тут мне на одном форуме выдали, что связано с настройками сайта или ослика....

Это сообщение отредактировал(а) s2004 - 12.11.2012, 21:53

Illusion Dolphin

Дата 13.11.2012, 00:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Цитата

дельфи 2006, но при чём она

Так строки по умолчанию неюникодные.

Цитата

f := f + '\' + UName + '.url';

Если строка неюникодная - проверьте, как имя файла выглядит в проводнике. (Как я понимаю - чтобы добавить в favorite - создаётся простой файл на диске)

--------------------

s2004

Дата 13.11.2012, 20:14 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 174
Регистрация: 30.10.2006

Репутация: нет
Всего: нет

ну и как я могу проверить эту строку?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »