چند کد و فانکشن جالب ...

[Mahmood_M]

1. به دست آوردن نوع فرمت درایو ( NTFS یا FAT ) :

function GetHardDiskPartitionType(const DriveLetter: Char): string;
var
NotUsed: DWORD;
VolumeFlags: DWORD;
VolumeInfo: array[0..MAX_PATH] of Char;
VolumeSerialNumber: DWORD;
PartitionType: array[0..32] of Char;
begin
GetVolumeInformation(PChar(DriveLetter + ':\'),
nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
VolumeFlags, PartitionType, 32);
Result := PartitionType;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetHardDiskPartitionType('c'));
ShowMessage(GetHardDiskPartitionType('a'));
end;

2. تنظیم صدای یک میکروفون و قطع صدای آن :

function SetMicrophoneVolume(bValue: Word): Boolean;
var
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
vol: TMIXERCONTROLDETAILS_UNSIGNED;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
begin

nMixerDevs := mixerGetNumDevs();
if (nMixerDevs < 1) then
begin
Exit;
end;

intRet := mixerOpen(@hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then
begin
mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
mxl.cbStruct := SizeOf(mxl);

intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);

end;
end;

3. تبدیل فایل فلش به فایل اجرایی ( Exe ) :


function Swf2Exe(S, D, F: string): string;
var
SourceStream, DestinyStream, LinkStream: TFileStream;
flag: Cardinal;
SwfFileSize: Integer;
begin
Result := 'something error';
DestinyStream := TFileStream.Create(D, fmCreate);
try
LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(LinkStream, 0);
finally
LinkStream.Free;
end;

SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(SourceStream, 0);
flag := $FA123456;
DestinyStream.WriteBuffer(flag, SizeOf(Integer));
SwfFileSize := SourceStream.Size;
DestinyStream.WriteBuffer(SwfFileSize, SizeOf(Integer));
Result := '';
finally
SourceStream.Free;
end;
finally
DestinyStream.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Swf2Exe('c:\ٍExample.swf', 'c:\EXeFile.exe',
'c:\Program Files\Macromedia\Flash MX\Players\SAFlashPlayer.exe');
end;


و اما یک سئوال :
من از برنامه Rave Report برای گزارش گیری استفاده می کنم ...
آیا برای اجرای این فایل گزارش گیری در برنامه خودم و بر روی سیستمی که دلفی ندارد باید از فایل جانبی ای استفاده کنم ؟
چون گزارش گیریهای من در کامپیوترهای دیگه که دلفی نداره اجرا نمی شه ...
اگه جوابم رو بدید ممنون می شم ...
در ضمن شما می تونید کد ها و تابع های خودتون رو توی این تاپیک بزارید.

[Mahmood_M]

اینم کدش :

uses
Commctrl;

procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowBalloonTip(Button1, 1, 'Title',
'Balloon tooltip,http://kingron.myetang.com; updated by Calin', clBlue, clNavy);
end;

[Mahmood_M]

function KillApp(const sCapt: PChar) : boolean;
var AppHandle:THandle;
begin
AppHandle:=FindWindow(Nil, sCapt) ;
Result:=PostMessage(AppHandle, WM_QUIT, 0, 0) ;
end;

طرز استفاده :

if not KillApp('Window caption') then ShowMessage('App not closed') ;

[babak_delphi]

میشه نحوه استفاده از این Hint رو دقیق توضیح بدین

ممنون میشم

[babak_delphi]

قطعا با این نوع نمایش در نرم افزارها آشنا شده اید.(خط پر شونده در نوار وضعیت)



type
THackControl = class(TControl);


procedure TfrmWebsite.FormCreate(Sender: TObject);
var
PanelRect: TRect;
begin

// Place progressbar on the statusbar



THackControl(ProgressBar1).SetParent(StatusBar1);

// Retreive the rectancle of the statuspanel (in my case the second)




SendMessage(StatusBar1.Handle, SB_GETRECT, 1, Integer(@PanelRect));

// Position the progressbar over the panel on the statusbar




with PanelRect do

ProgressBar1.SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

[babak_delphi]

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
x: Integer;
find: Boolean = False;
implementation
{$R *.dfm}
//Suchenbutton:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
a: string;
begin
Memo1.Lines.Add('');
Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
find := True;
x := 2;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
find := True;
x := 2;
Memo1.SetFocus;//delphi-center.blogfa.com
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit1.Text);
break;
end;
end;
end;
if find = False then ShowMessage('SuchString nicht gefunden')
else
find := False;
end;
//Weitersuchenbutton:
procedure TForm1.Button2Click(Sender: TObject);
var//delphi-center.blogfa.com
i: Integer;
a: string;
d: Integer;
begin
d := 0;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
if CheckBox1.Checked = True then
begin
if a = edit1.Text then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end
else
begin
if lowercase(a) = lowercase(edit1.Text) then
begin
d := d + 1;
if d = x then
begin
find := True;
x := x + 1;//delphi-center.blogfa.com
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 1;
Memo1.SelLength := Length(edit1.Text);
break;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
end;
end;
end;
end;
if find = False then ShowMessage('SuchString nicht gefunden')
else
find := False;
end;

--------------------
من دوتا کد بالا رو از این سایت ورداشتم :
http://www.delphi-center.blogfa.com/
برید ببینید
سایت بدی نیست.

[shaghayegh_6113]

سلام
میشه بگید کدی که برای Hint نوشته شده رو چه طور میتونم برای Hint یک Image هم به کار ببرم ( این کد برای TWinControl کار می کنه و هر کاری کردم نتونستم برای Image که از نوع TGraphicControl به کار ببرمش )
ممنون

[vcldeveloper]

میشه بگید کدی که برای Hint نوشته شده رو چه طور میتونم برای Hint یک Image هم به کار ببرم
کد فوق نیاز به Handle کنترلی داره که باید Hint براش نمایش داده بشه. کنترل های مشتق شده از TGraphicControl همچین هندلی ندارند. می تونید یک Panel روی فرم قرار بدید و Image را روی Panel قرار بدید و بجای Image، اون Panel را به تابع پاس بدید:


ShowBalloonTip(Panel1, 1, 'Title','Balloon tooltip', clBlue, clNavy);

[hastifakher]

سلام
از چه تابعی میشه استفاده کرد که یک عدد اعشاری را به حروف تبدیل کند؟؟

[MNosouhi]

var i:Real;
begin
i:=1.25;
Caption:=FloatToStr(i)
end;