نمایش سطرهای یک Grid به صورت یکی در میان
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
test1: Real;
RowNo: Integer;
begin
with (Sender as TDBGrid) do
begin
if (gdSelected in State) then
begin
// Farbe für die Zelle mit dem Focus
// color of the focused row
Canvas.Brush.Color := clblue;
end
else
begin
// Zeile erfahren
// get the actual row number
rowno := Query1.RecNo;
// gerade und ungerade Zeilen ermitteln
// odd or even ?
test1 := (RowNo / 2) - trunc(RowNo / 2);
// Zeile gerade...
// If it's an even one...
if test1 = 0 then
begin
farbe := clWhite
end
// ...Zeile ungerade
// ...else it's an odd one
else
begin
farbe := clYellow;
end;
Canvas.Brush.Color := farbe;
// Font-Farbe immer schwarz
// font color always black
Canvas.Font.Color := clBlack;
end;
Canvas.FillRect(Rect);
// Denn Text in der Zelle ausgeben
// manualy output the text
Canvas.TextOut(Rect.Left + 2, Rect.Top + 1, Column.Field.AsString);
end
end;
اضافه نمودن یک کاربر جدید داخل یک دیتابیس در SQLServer 2000
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
{* For Any Infromation Mail Me *
Mail : Mostafa@Touska.Co.ir0
...Add a user into a database in Sql Server 2000?
کنترل ولوم صدا با استفاده از کد نویسی
uses MMSystem;
type
TVolumeRec = record
case Integer of
0: (LongVolume: Longint) ;
1: (LeftVolume, RightVolume : Word) ;
end;
const DeviceIndex=5
{0:Wave
1:MIDI
2:CDAudio
3:Line-In
4:Microphone
5:Master
6:PC-loudspeaker}
procedure SetVolume(aVolume:Byte) ;
var Vol: TVolumeRec;
begin
Vol.LeftVolume := aVolume shl 8;
Vol.RightVolume:= Vol.LeftVolume;
auxSetVolume(UINT(DeviceIndex), Vol.LongVolume) ;
end;
function GetVolume:Cardinal;
var Vol: TVolumeRec;
begin
AuxGetVolume(UINT(DeviceIndex),@Vol.LongVolume) ;
Result:=(Vol.LeftVolume + Vol.RightVolume) shr 9;
end;
لینک اصلی
نحوه استفاده بررسی خالی بودن کنترل TImage
کامپوننت TImage برای نمایش تصاویر گرافیکی مورد استفاده قرار میگیرد(Ico,BMP,WMF,GIF,JPEG و مانند آن)خاصیت Picture مشخص کننده تصویری است که باید نمایش داده شود به منظور مقدار دادن به این خاصیت راههای زیادی وجود دارد: استفاده از خاصیت LoadFromFile که می توان به منظور خواندن یک فایل گرافیکی از هارد از آن استفاده کرد یا تابع Assign که می توان توسط آن تصاویر موجود در حافظه موقت(ClipBoard)
در بیشتر حالات شما تصویر خود را در زمان طراحی نرم افزار مقدار دهی میکنیدو این کار با مقدار دهی خاصیت Picture از Objectinspector امکان پذیر است
در صورتیکه میخواهید تصویر را در زمان اجرا حذف کنید مقدار خاصیت Picture را برابر با NIL قرار دهید.
و در صورتیکه بخواهید خالی بودن تصور را کنترل کنید از کد زیر استفاده کنید
if Image1.Picture.Graphic.Empty then
begin
...
end;
لینک اصلی
رنگ آمیزی کنترلهای تمکرز یافته(Focused Control)
بدین منظور میتوانید از کنترل TScreen و رویداد onActiveControlChange استفاده کنید
const
focusColor = clSkyBlue;
var
lastFocused : TWinControl;
originalColor : TColor;
توجه داشته باشید که کامپوننتی تحت عنوان TScreen برای قرار دادن روی فرم وجود ندارد و شما باید بصورت دستی رویدادها را تنظیم کنید
procedure TMainForm.FormCreate(Sender: TObject) ;
begin
Screen.OnActiveControlChange := ScreenActiveControlChange;
end;
procedure TMainForm.FormDestroy(Sender: TObject) ;
begin
Screen.OnActiveControlChange := nil;
end;
و پیاده سازی رویداد ذکر شده به صورت زیر است
procedure TMainForm.ScreenActiveControlChange(Sender: TObject) ;
var
doEnter, doExit : boolean;
previousActiveControl : TWinControl;
begin
if Screen.ActiveControl = nil then
begin
lastFocused := nil;
Exit;
end;
doEnter := true;
doExit := true;
//CheckBox
if Screen.ActiveControl is TButtonControl then doEnter := false;
previousActiveControl := lastFocused;
if previousActiveControl <> nil then
begin
//CheckBox
if previousActiveControl is TButtonControl then doExit := false;
end;
lastFocused := Screen.ActiveControl;
if doExit then ExitColor(previousActiveControl) ;
if doEnter then EnterColor(lastFocused) ;
end;
procedure TMainForm.EnterColor(Sender: TWinControl);
begin
if Sender <> nil then
begin
if IsPublishedProp(Sender,'Color') then
begin
originalColor := GetOrdProp(Sender,'Color');
SetOrdProp(Sender,'Color', focusColor);
end;
end;
end;
procedure TMainForm.ExitColor(Sender: TWinControl);
begin
if Sender <> nil then
begin
if IsPublishedProp(Sender,'Color') then
begin
SetOrdProp(Sender,'Color',originalColor);
end;
end;
end;
توضیح بیشتر برای کنترل یوزرها
لطفاً بیشتر توضیح بدهید که بدانیم . این user به چه شکل اضافه می شود آیا قبلاً دیتابیس باید در sql باشد. اگر برای کنترل یوزرها از یک جدول در sqlاستفاده می کنیم . اضافه کردن و حذف و دادن امکانات به یوزر مثل ثبت یک رکورد امکان دارد
با تشکر
داود
نقل قول:
نوشته شده توسط mahsa119
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
{* For Any Infromation Mail Me *
Mail : Mostafa@Touska.Co.ir0
...Add a user into a database in Sql Server 2000?
ایجاد میانبر از یک فایل در ویندوز
procedure CreateShortcut(SourceFileName, Title: string; Location:
ShortcutType; SubDirectory : string);
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory,
LinkName : string;
WFileName : WideString;
MyReg,
QuickLaunchReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
MySLink.SetPath(PChar(SourceFileName));
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\Cur rentVersion\Explorer');
try
LinkName := ChangeFileExt(SourceFileName, '.lnk');
LinkName := ExtractFileName(LinkName);
case Location of
_DESKTOP : Directory := MyReg.ReadString('Shell Folders', 'Desktop', '');
_STARTMENU : Directory := MyReg.ReadString('Shell Folders', 'Start Menu', '');
_SENDTO : Directory := MyReg.ReadString('Shell Folders', 'SendTo', '');
_QUICKLAUNCH:
begin
QuickLaunchReg := TRegIniFile.Create('Software\MicroSoft\Windows\Cur rentVersion\GrpConv');
try
Directory := QuickLaunchReg.ReadString('MapGroups', 'Quick Launch', '');
finally
QuickLaunchReg.Free;
end; {try..finally}
end; {case _QUICKLAUNCH}
end; {case}
if Directory <> '' then
begin
if SubDirectory <> '' then
WFileName := Directory + '\'+ SubDirectory +'\' + LinkName
else
WFileName := Directory + '\' + LinkName;
MyPFile.Save(PWChar(WFileName), False);
end; {Directory <> ''}
finally
MyReg.Free;
end; {try..finally}
end; {CreateShortcut}
minimize کردن کلیه پنجره ها
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function EnumWinProc(Wnd : HWND) : Boolean; Export; StdCall;
var
WinText : Array[0..255] of Char;
begin
GetWindowText(Wnd, WinText, 255);
Result := True;
if (StrPas(WinText) <> '') and
IsWindowVisible(Wnd) and
(Wnd<>Application.Handle) and
(Wnd<>Form1.Handle)
then
CloseWindow(Wnd);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWinProc, LongInt(Self));
end;
end.
1 ضمیمه
نمایش مجموع مقادیر در DbGrid
محاسبه و نمایش مجموع مقادیر فیلدهای DbGrid
برداشت از سایت
http://search.experts-exchange.com/
تعریف آرایه های ثابت (Constant) در Delphi
با این روش:
type
TShopItem = record
Name : string;
Price : currency;
end;
const
Days : array[0..6] of string =
(
'Sun', 'Mon', 'Tue', 'Wed',
'Thu', 'Fri', 'Sat'
) ;
CursorMode : array[boolean] of TCursor =
(
crHourGlass, crSQLWait
) ;
Items : array[1..3] of TShopItem =
(
(Name : 'Clock'; Price : 20.99),
(Name : 'Pencil'; Price : 15.75),
(Name : 'Board'; Price : 42.96)
) ;
2 ضمیمه
دو کد نمونه برای کار با آرایه هایی از کامپوننتها
