Наверх

Перекодировка текста

begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
CharToOem(Src, Str); //API функция для перевода текста

Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

procedure DosToWin;
var Src, Str:PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
OemToChar(Src, Str);                //API функция для перевода текста

Наверх

Открытие и закрытие привода CD-ROM

unit DriveTools;
interface
uses

Наверх

В некоторых случаях (например, при работе в полноэкранном режиме, показе своей презентации или экранной заставки ...) бывает полезно заблокировать перечисленные комбинации клавиш. Они блокируются при работе системы в режиме "экранная заставка" , который в свою очередь несложно включить и выключить:

// Включение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
// Выключение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

Кстати, SystemParametersInfo имеет еще кучу полезных ключей SPI_****, подробности см. в win32.hlp

Наверх

Как изменить изображение на кнопке ПУСК?

{ объявляем глобальные переменные }
var

OldBitmap := SendMessage(StartButton,

Наверх

Как изменить обои на рабочем столе?

program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath:String;bTile:boolean);
var

Наверх

В uses пpописываешь модуль Registry и дальше так:

var
R:TRegistry;
No:String;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', False) {если false то пытается откpыть не создавая}
No:=R.ReadString('VersionNumber');
if No=..... then ...... else ......
end;

Кроме того, обязательно посмотрите на список функций WinAPI, имена которых начинаются с Get.... Например, GetComputerName, GetVersionEx, GetSystemInfo, SystemParametersInfo.

Наверх

Как скопировать экран в TCanvas?

var bmp: TBitmap; DC: HDC; begin bmp:=TBitmap.Create; bmp.Height:=Screen.Height; bmp.Width:=Screen.Width; DC:=GetDC(0);  //Дескpиптоp экpана bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY); bmp.SaveToFile('Screen.bmp'); ReleaseDC(0, DC); end;

Наверх

Процесс получения иконок из .EXE, .DLL или .ICO файлов полностью идентичен. 
Различие только в том, что в .ICO файле может храниться только одна иконка, а в 
.EXE и .DLL несколько. Для получения иконок из файлов, в модуле ShellAPI, есть 
функция:
function ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word): HIcon;
где
Inst - указатель на приложение вызвавшее функцию, FileName - имя файла
из которого необходимо получить иконку, IconIndex - номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть следующая иконка.
В данном примере в компонент Image1 выводится иконка запущенного файла.
USES ShellAPI; 
procedure TForm1.FormCreate(Sender: TObject); 
VAR A: ARRAY [0..78] OF Char; 
begin 

{Получение имени запущенного файла}
StrPCopy(A, ParamStr(0));
{Вывод на экран нулевой иконки из файла}
Image1.Picture.Icon.Handle := ExtractIcon(HInstance, A, 0); 
end;

Наверх

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end; 

Наверх

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms,Dialogs,ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;
oldBitmap : HBitmap;
iinfo : TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);

image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.

Наверх

//Use the registry to register your own filetype. uses registry; 

procedure TForm1.RegisterFileType(prefix:String; exepfad:String); 
var reg:TRegistry; 
begin 
reg:=TRegistry.Create; 
reg.RootKey:=HKEY_CLASSES_ROOT;
//create a new key --> .pci 
reg.OpenKey('.'+prefix,True);
//create a new value for this key --> pcifile 
reg.WriteString('',prefix+'file');
reg.CloseKey; //create a new key --> pcifile 
reg.CreateKey(prefix+'file'); 
//create a new key pcifile\DefaultIcon 
reg.OpenKey(prefix+'file\DefaultIcon',True);
//and create a value where the icon is stored --> c:\project1.exe,0 reg.WriteString('',exepfad+',0');
reg.CloseKey; 
reg.OpenKey(prefix+'file\shell\open\command',True);
//create value where exefile is stored --> c:\project1.exe "%1" 
reg.WriteString('',exepfad+' "%1"'); reg.CloseKey; 
reg.Free;
end;
procedure TForm1.Button1Click(Sender: TObject); 
begin 
RegisterFileType('pci','c:\project1.exe'); 
end; 

Наверх

64-битное кодирование/декодирование

Const
Base64Table='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Base64Decode(cStr:string):string;
var ResStr:string;
DecStr:string; RecodeLine   : array [1..76] of byte; f1,f2 : word; l:integer; begin l :=length(cStr); ResStr:=''; for f1:=1 to l do if cStr[f1]='=' then RecodeLine[f1]:=0