Настройки иконки
unit Unit_icons;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellApi, Grids, ExtCtrls, StdCtrls;
type
TForm_icons = class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Bevel1: TBevel;
StringGrid1: TStringGrid;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1DblClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
CurItem: LongInt;
a,b:integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form_icons: TForm_icons;
implementation
{$R *.dfm}
procedure TForm_icons.FormCreate(Sender: TObject);
begin
CurItem:=0;
end;
procedure TForm_icons.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if StringGrid1.Objects[aCol,aRow] is Ticon then
StringGrid1.Canvas.Draw(Rect.Left+56,Rect.Top+24,Ticon(StringGrid1.Objects[aCol,aRow]));
end;
procedure TForm_icons.Button1Click(Sender: TObject);
var
PName: array[0..255]of char;
FName: string[13];
N: word;
iconH: Hicon;
begin
with OpenDialog1 do
begin
if not execute then exit;
FName:= ExtractFileName(FileName);
StrPcopy(PName,FileName);
end;
n:=0;
with StringGrid1 do
repeat
iconH:=Extracticon(Hinstance, Pname,n);
if iconH<= 1 then break;
col:=CurItem mod ColCount;
if (CurItem div ColCount)>=Rowcount then
Rowcount:=RowCount+1;
row:=CurItem div ColCount;
Cells[Col,Row]:=Fname+'#'+inttostr(n);
Objects[col,Row]:=Ticon.create;
with Objects [Col,Row] as Ticon do
Handle:=iconH;
CurItem:=CurItem+1;
n:=n+1;
until false;
end;
procedure TForm_icons.Button2Click(Sender: TObject);
begin
if SaveDialog1.execute then
with StringGrid1 do
with Objects[Col,Row] as Ticon do
SaveToFile(SaveDialog1.FileName);
end;
procedure TForm_icons.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
a:=acol;
b:=arow;
end;
procedure TForm_icons.StringGrid1DblClick(Sender: TObject);
begin
icon:=TIcon(stringgrid1.Objects[a,b]);
end;
procedure TForm_icons.Button3Click(Sender: TObject);
begin
Application.icon:=TIcon(stringgrid1.Objects[a,b]);
end;
end.
Настройки шрифта
unit Unit_sss;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, Buttons, ExtCtrls;
type
TForm_sss = class(TForm)
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label2: TLabel;
ListBox1: TListBox;
GroupBox1: TGroupBox;
Label3: TLabel;
GroupBox2: TGroupBox;
Label4: TLabel;
BitBtn1: TBitBtn;
ListBox2: TListBox;
Label5: TLabel;
SpinEdit2: TSpinEdit;
Label6: TLabel;
Button1: TButton;
RadioGroup1: TRadioGroup;
BitBtn2: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtn1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_sss: TForm_sss;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm_sss.FormCreate(Sender: TObject);
begin
ListBox1.Items:=Screen.Fonts;
end;
procedure TForm_sss.SpinEdit1Change(Sender: TObject);
begin
Label4.Font.Size:=SpinEdit1.Value;
end;
procedure TForm_sss.ListBox1DblClick(Sender: TObject);
var
i:integer;
begin
With ListBox1 do
if ItemIndex>=0 then begin
Label4.Font.Name:=ListBox1.Items[ItemIndex];
Label3.Caption:=Label4.Font.Name;
ListBox2.Items.Add(label3.Caption);
for i:=0 to ListBox2.Count-1-SpinEdit2.Value do
ListBox2.Items.Delete(i);
end;
end;
procedure TForm_sss.ListBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key in [VK_Return, VK_Space] then ListBox1DblClick(Sender);
end;
procedure TForm_sss.BitBtn1Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm_sss.Button1Click(Sender: TObject);
begin
Form1.Memo1.Font.Name:=ListBox1.Items[listbox1.ItemIndex];
Form1.Memo1.Font.Size:=SpinEdit1.Value;
Form_sss.Close;
end;
procedure TForm_sss.BitBtn2Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex=0 then
begin
if ListBox1.ItemIndex>=0 then
form1.memo1.font.Name:=listbox1.items[listbox1.ItemIndex] ;
form1.Memo1.Font.Size:=SpinEdit1.Value ;
end
else
begin
form1.memo1.SelAttributes.Name:=listbox1.items[listbox1.ItemIndex] ;
form1.memo1.SelAttributes.Size:=SpinEdit1.Value;
end;
form_sss.Close;
end;
end.
