DBEngine
DBEngine
: Eryk
, Key Violation Application.OnException ...:
{Interface}
procedure HandleException(Sender: TObject; E: Exception);
...
{ Implementation}
procedure TForm1.HandleException(Sender: TObject; E: Exception);
var
err: DBIResult;
begin
if E is EDBEngineError then
begin
err := (E as EDBEngineError).errors[(E as EDBEngineError).errorcount -
1].errorcode;
if (err = DBIERR_KEYVIOL) then
showMessage(' Key violation!')
else if (err = DBIERR_LOCKED) then
showmessage(' ')
else if (err = DBIERR_FILELOCKED) then
showmessage(' - ')
else
showmessage(' DB')
end
else
showmessage('!: ' + E.Message);
end;
...'' :
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.onException:=HandleException;
end;
('DBIERR_etc.'), DBIERRS . DBIERRS.INT, :\DELPHI\DOC.
,
,
: ()
Qt OnEvent Kylix TApplication. Qt - (event hooks). OnEvent, , . Qt, .
, Object Pascal cdecl. , - Qt, Qt -. , , CLXDisplay API, Qt ( Qt.pas).
, Drag and Drop. , . TLabel . .
TForm1= class(TForm)
Label1: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
DropHook : QEvent_hookH;
function EventHandler(Handle : QObjectH; e : QEventH) : Boolean; cdecl;
end;
...
procedure TForm1.FormCreate(Sender: TObject);
var
M : TMethod;
begin
DropHook:=QEvent_hook_create(Label1.Handle);
EventFunc(M):=EventHandler;
Qt_hook_hook_events(DropHook, M);
end;
DropHook - QEvent_hookH, - . , . CLXDisplay API , . -, . QEvent_hook_create , ( - QLabel).
M EventHandler. . , , -
EventFunc = function(Handle : QObjectH; e : QEventH) : Boolean of object; cdecl;
-.
- Qt_hook_hook_events. - -, - . , "- / " Qt , .
. e, , , , , . , , Qt . , Qt . , Handle , Qt .
- . QEvent_hook_destroy.
. , Kylix ( Linux), Delphi 6 ( Windows). , , Qt (. ).
- , Qt. mime- , . , , . . , , - QClipboard_hook , QClipboard_dataChanged_Event. . .
procedure TForm1.ClipboardDataChanged;
var
QMS : QMimeSourceH;
S : WideString;
S1 : String;
i : Integer;
begin
QMS:=QClipboard_data(CB);
Memo1.Lines.Clear;
(* enumerating clipboard data formats *)
i:=0;
S1:=QMimeSource_format(QMS, i);
while S1<>'' do
begin
Memo1.Lines.Add(S1);
Inc(i);
S1:=QMimeSource_format(QMS, i);
end;
Label3.Caption:='';
(* if text data is available, we retrieve it *)
if QTextDrag_canDecode(QMS) then
begin
QTextDrag_Decode(QMS, @S);
Label3.Caption:=S;
end;
end;
CB . QClipboard_data QMimeSourceH, , . , QMimeSource_format. . - -, - . . , . Memo1. QTextDrag_canDecode , - , QTextDrag_Decode.
. , Qt . Windows ( Delphi 6). Qt ( Linux) CLXDisplay API, Delphi 6 ( Windows).
, - . ButtonPressed , Button1 , ButtonReleased , .
, , , , . : SomeEvent, - VCL. OnSomeEvent TSomeEvent. , OnSomeEvent , TSomeEvent. - , OnSomeEvent. . SomeEvent, , , OnSomeEvent, , -.
Qt library . Qt ( Qt "") . . , Qt. - . , , . , . - , . Object Pascal, Object Pascal Qt . Qt library -. - , . , , . . , , , .
CLXDisplay API Qt. QObject_connect. . - - . - PChar. , C++. "2". QObject_connect - -. - PChar, , C++ "1".
:
Qt QLineEdit, VisualCLX TEdit, textChanged, . QLabel, TLabel, setText, Label. textChanged QLineEdit setText QLabel, QLabel. , , QObject_connect :
QObject_connect(Edit1.Handle, PChar('2textChanged ( const QString & )'), Label2.Handle, PChar('1setText( const QString & )'));
- - , QEdit. - , C++ qlineedit.h, , , . - - (QLabel). - qlabel.h . , , . , Object Pascal, . , Delphi 6 .
QObject_disconnect. , Qt . QObject_disconnect . QObject_disconnect , QObject_connect. nil, QObject_connect (, , ), " " . ,
QObject_disconnect(SomeControl.Handle, PChar('2SomeSignal ()'), nil, nil);
, SomeSignal Qt , SomeControl.
CLXDisplay API . , , Object Pascal C++.
.Ru
{
There is no documented way to make a console application fullscreen.
The following code works for both NT and Win9x.
For win NT I used the undocumented SetConsoleDisplayMode and
GetConsoleDisplayMode functions.
}
{
function GetConsoleDisplayMode(var lpdwMode: DWORD): BOOL; stdcall;
external 'kernel32.dll';
// lpdwMode: address of variable for current value of display mode
}
function NT_GetConsoleDisplayMode(var lpdwMode: DWORD): Boolean;
type
TGetConsoleDisplayMode = function(var lpdwMode: DWORD): BOOL;
stdcall;
var
hKernel: THandle;
GetConsoleDisplayMode: TGetConsoleDisplayMode;
begin
Result := False;
hKernel := GetModuleHandle('kernel32.dll');
if (hKernel > 0) then
begin @GetConsoleDisplayMode :=
GetProcAddress(hKernel, 'GetConsoleDisplayMode');
if Assigned(GetConsoleDisplayMode) then
begin
Result := GetConsoleDisplayMode(lpdwMode);
end;
end;
end;
{
function SetConsoleDisplayMode(hOut: THandle; // standard output handle
dwNewMode: DWORD; // specifies the display mode
var lpdwOldMode: DWORD // address of variable for previous value of display mode
): BOOL; stdcall; external 'kernel32.dll';
}
function NT_SetConsoleDisplayMode(hOut: THandle; dwNewMode: DWORD;
var lpdwOldMode: DWORD): Boolean;
type
TSetConsoleDisplayMode = function(hOut: THandle; dwNewMode: DWORD;
var lpdwOldMode: DWORD): BOOL;
stdcall;
var
hKernel: THandle;
SetConsoleDisplayMode: TSetConsoleDisplayMode;
begin
Result := False;
hKernel := GetModuleHandle('kernel32.dll');
if (hKernel > 0) then
begin @SetConsoleDisplayMode :=
GetProcAddress(hKernel, 'SetConsoleDisplayMode');
if Assigned(SetConsoleDisplayMode) then
begin
Result := SetConsoleDisplayMode(hOut, dwNewMode, lpdwOldMode);
end;
end;
end;
function GetConsoleWindow: THandle;
var
S: AnsiString;
C: Char;
begin
Result := 0;
Setlength(S, MAX_PATH + 1);
if GetConsoleTitle(PChar(S), MAX_PATH) <> 0 then
begin
C := S[1];
S[1] := '$';
SetConsoleTitle(PChar(S));
Result := FindWindow(nil, PChar(S));
S[1] := C;
SetConsoleTitle(PChar(S));
end;
end;
function SetConsoleFullScreen(bFullScreen: Boolean): Boolean;
const
MAGIC_CONSOLE_TOGGLE = 57359;
var
dwOldMode: DWORD;
dwNewMode: DWORD;
hOut: THandle;
hConsole: THandle;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
dwNewMode := Ord(bFullScreen);
NT_GetConsoleDisplayMode(dwOldMode);
hOut := GetStdHandle(STD_OUTPUT_HANDLE);
Result := NT_SetConsoleDisplayMode(hOut, dwNewMode, dwOldMode);
end
else
begin
hConsole := GetConsoleWindow;
Result := hConsole <> 0;
if Result then
begin
if bFullScreen then
begin
SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0);
end
else
begin
// Better solution than keybd_event under Win9X ?
keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
AllocConsole;
try
SetConsoleFullScreen(True);
Write('Hi, you are in full screen mode now. Type something [Return]: ');
Readln(s);
SetConsoleFullScreen(False);
// ShowMessage(Format('You typed: "%s"', [s]));
finally
FreeConsole;
end;
end;
.
Windows-1251, KOI8-R, ISO-8859-5 DOS.
? , ,
, 160 - "", 150 ? "" . .
( ).
.
, , .
.
procedure TForm1.Button1Click(Sender: TObject);
var
code1, code2: TCode;
s: string;
c: char;
i: integer;
chars: array [char] of char;
str: array [TCode] of string;
begin
case ComboBox1.ItemIndex of
1: code1 := koi;
2: code1 := iso;
3: code1 := dos;
else code1 := win;
end;
case ComboBox2.ItemIndex of
1: code2 := koi;
2: code2 := iso;
3: code2 := dos;
else code2 := win;
end;
s := Memo1.Text;
Str[win] := '';
Str[koi] := '';
Str[iso] := '';
Str[dos] := ' "''""??';
for c := #0 to #255 do
Chars[c] := c;
for i := 1 to Length(Str[win]) do
Chars[Str[code2][i]] := Str[code1][i];
for i := 1 to Length(s) do
s[i] := Chars[s[i]];
Memo2.Text := s;
end;
- , (OVERRIDING) (REPLACING) ? .
:
TMyObject= class (TObject)
:
TOverrideObject = class (TMyObject)
, TMyObject Wiggle:
procedure Wiggle; virtual;
TOverrideObject Wiggle:
procedure Wiggle; override;
, , .
TList, MyObjects OverrideObjects TList.Items[n]. Items , Wiggle . :
if TObject(Items[1]) is TMyObject then
TMyObject(Items[1]).Wiggle
else
if TObject(Items[1]) is TOverrideObject then
TOverrideObject(Items[1]).Wiggle;
override :
TMyObject(Items[1]).Wiggle;
, Items[1] : ", - TMyObject, , , TOverrideObject; Wiggle TOverrideObject Wiggle, TOverrideObject.Wiggle, TMyObject.Wiggle."
, override, :
TMyObject(Items[1]).Wiggle;
"" , Items[1] - TOverrideObject; Wiggle, TMyObject.Wiggle, TOverrideObject.Wiggle (, , ).
, , virtual ( dynamic) , override -. - override. , - . "" , "" .
Delphi
Kuliba
C :
, Paint Brush, Delphi . . , , , . . , , , . XOR. , A B, A XOR B XOR B = A. , , , .
procedureTForm1.XORLine;
begin
Form1.Canvas.MoveTo(xo, yo);
Form1.Canvas.LineTo(lx, ly);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Color := clWhite;
Form1.Canvas.Pen.Color := clRed;
Form1.Canvas.Pen.Width := 3;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Form1.Tag := 1;
xo := X;
yo := Y;
lx := X;
ly := Y;
Form1.Canvas.Pen.Mode := pmNotXor;
XORLine;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
XORLine;
lx := X;
ly := Y;
XORLine;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Form1.Canvas.Pen.Mode := pmCopy;
Form1.Canvas.MoveTo(xo, yo);
Form1.Canvas.LineTo(X, Y);
end;
C :
. :
?
?
OnMouseDown, x y . OnMouseMove, OnMouseUp. .
TButton .
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end;
procedure TForm1.Button1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
.ru
, DBNavigator ?
, , . "TypInfo" :
var
PropInfo: PPropInfo;
begin
PropInfo := GetPropInfo(PTypeInfo(ActiveControl.ClassInfo), 'DataSource');
if (PropInfo <> nil)
and (PropInfo^.PropType^.Kind = tkClass)
and (GetTypeData(PropInfo^.PropType)^.ClassType = TDataSource) then
DBNavigator1.DataSource := TDataSource(GetOrdProp(ActiveControl, PropInfo));
end;
, ( , ), DataSource, TDataSource.
Delphi
Kuliba
TPageControl Drag and Drop
TPageControl Drag and Drop
//In the PageControl's OnMouseDown event handler:
procedure TForm1.PageControl1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PageControl1.BeginDrag(False);
end;
// In the PageControl's OnDragDrop event handler:
procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
const
TCM_GETITEMRECT = $130A;
var
i: Integer;
r: TRect;
begin
if not (Sender is TPageControl) then Exit;
with PageControl1 do
begin
for i := 0 to PageCount - 1 do
begin
Perform(TCM_GETITEMRECT, i, lParam(@r));
if PtInRect(r, Point(X, Y)) then
begin
if i <> ActivePage.PageIndex then
ActivePage.PageIndex := i;
Exit;
end;
end;
end;
end;
// In the PageControl's OnDragOver event handler:
procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
if Sender is TPageControl then
Accept := True;
end;
FAQ:
.
" " , , .
.
Drag & Drop ,
Memo1. Uses ShellAPI. private :
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;//
:
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
CFileName: array[0..MAX_PATH] of Char; // ,
begin
try
If DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH)> 0 then
// ?
begin
Form1.Caption:=CFileName; //
Memo1.Lines.LoadFromFile(CFileName); //
Msg.Result := 0;
end;
finally
DragFinish(Msg.Drop); //
end;
end;
, ,
,
:
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;
Vit
Vingrad.ru
, Drag and Drop, Docking
, Drag and Drop, Docking
C :
. :
Delphi
Delphi
( delphi.about.com )
, , . . .
, - . , ( ). .
Delphi . Name 'Shuffler'. Image (Image1) Timer (Timer1). Image (), Timer . Interval Timer , ( 1000 , 2000 - ).
. implementation :
var
Shuffler: TShuffler; // Delphi
DesktopBitmap : TBitmap;
gx, gy : Integer;
redRect : TBitmap;
rW, rH : Integer;
const
DELTA = 8; // 2^n
(integer) DELTA , ( ). DELTA 2^n, n - (integer) . DELTA . , DELTA 16 1024 x 768, 256 64x48.
DesktopBitmap - , - .
redRect , . redRect OnCreate.
gx, gy x y (Left, Top) redRect .
rW, rH . 1024x768 DELTA=16, rW 64 rH = 48.
OnCreate:
procedure TShuffler.FormCreate(Sender: TObject);
begin
rW := Screen.Width div DELTA;
rH := Screen.Height div DELTA;
redRect:=TBitmap.Create;
with redRect do begin
Width := rW;
Height := rH;
Canvas.Brush.Color := clRed;
Canvas.Brush.Style := bssolid;
Canvas.Rectangle(0,0,rW,rH);
Canvas.Font.Color := clNavy;
Canvas.Font.Style := Canvas.Font.Style + [fsBold];
Canvas.TextOut(2,2,'About');
Canvas.Font.Style := Canvas.Font.Style - [fsBold];
Canvas.TextOut(2,17,'Delphi');
Canvas.TextOut(2,32,'Programming');
end;
Timer1.Enabled := False;
Image1.Align := alClient;
Visible := False;
BorderStyle := bsNone;
Top := 0;
Left := 0;
Width := Screen.Width;
Height := Screen.Height;
InitScreen;
// SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,
SWP_NOSIZE + SWP_NOMOVE);
Visible := True;
Timer1.Interval := 10; // :=
Timer1.Enabled := True; // DrawScreen
end;
-, rW rH DELTA. , 800x600 DELTA 8, 8x8 100x75 (rW = 100, rH = 75).
-, redRect, , , . redRect () . - .
, . () API SetWindowPos , (OnTop), . InitScreen. OnTimer, DrawScreen.
InitScreen -
InitScreen, OnCreate, , redRect . , .
, GetDC GetDesktopWindow. API BitBt DesktopBitmap. GetDC(GetDesktopWindow) - GetDesktopWindow. DesktopBitmap Image1. - , Delphi.
redRect . Trunc(Random * DELTA) 0 DELTA. , redRect gx, gy, CopyRect Canvas. , Delphi, .
, MoveTo LineTo . , .
procedure InitScreen;
var i,j:integer;
begin
//
DesktopBitmap := TBitmap.Create;
with DesktopBitmap do begin
Width := Screen.Width;
Height := Screen.Height;
end;
BitBlt(DesktopBitmap.Canvas.Handle,
0,0,Screen.Width,Screen.Height,
GetDC(GetDesktopWindow),0,0,SrcCopy);
Shuffler.Image1.Picture.Bitmap := DesktopBitmap;
// redRect
Randomize;
gx := Trunc(Random * DELTA);
gy := Trunc(Random * DELTA);
Shuffler.Image1.Canvas.CopyRect(
Rect(rW * gx, rH * gy, rW * gx + rW, rH * gy + rH),
redRect.Canvas,
Rect(0,0,rW,rH));
//
for i:=0 to DELTA-1 do begin
Shuffler.Image1.Canvas.MoveTo(rW * i,0);
Shuffler.Image1.Canvas.LineTo(rW * i,Screen.Height);
Shuffler.Image1.Canvas.MoveTo(0, rH * i);
Shuffler.Image1.Canvas.LineTo(Screen.Width, rH * i);
end;
end;
Draw Screen
DrawScreen. OnTimer Timer.
procedure DrawScreen;
var
r1,r2:TRect;
Direction:integer;
begin
r1:=Rect(rW * gx , rH * gy, rW * gx + rW , rH * gy + rH);
Direction := Trunc(Random*4);
case Direction of
0: gx := Abs((gx + 1) MOD DELTA); //
1: gx := Abs((gx - 1) MOD DELTA); //
2: gy := Abs((gy + 1) MOD DELTA); //
3: gy := Abs((gy - 1) MOD DELTA); //
end; //case
r2 := Rect(rW * gx , rH * gy, rW * gx + rW , rH * gy + rH);
with Shuffler.Image1.Canvas do begin
CopyRect(r1, Shuffler.Image1.Canvas, r2);
CopyRect(r2, redRect.Canvas, redRect.Canvas.ClipRect);
end;
end;
, . redRect, 4 . r1 redRect, r2 , . CopyRect redRect redRect - .
, .
640x480, OnTimer, DELTA=4. 1024x768, , , . , ALT+F4. .
. - , " Screensaver Delphi".
"" "Ppuzzle". , , - DrawScreen, . , . , , . , redRect redRect.
.ru
?
?
. , , , .
. . TTable ( "Data Access" "BDE" - ). ! - , ! TTable - - . - .
, . DatabaseName "DBDEMOS" - . TableName "DBDEMOS", "biolife.db" - ( )
- , , . , , , .
TTable TDataSource - . . DataSet Table1. "" TDataSource.
- "Data Controls" TDBGrid. DataSource DataSource1. ? ! - Table1 Active True. !
. !
: ()
, Delphi, , Kylix ? Delphi Linux. , Kylix ? ObjectPascal VCL Linux/QT. , Delphi, Linux. Delphi Windows, QT Linux. , .
Kylix
Borland Kylix Delphi, VCL. Kylix " ". . , Delphi, Kylix . , Linux, , Kylix , . , Kylix ( - ): ObjectPascal, VCL ( ) .
Kylix ? , Delphi: , , Web- . , Delphi. : , ObjectPascal VCL, . , , Delphi, Kylix. .
Delphi . , Kylix " ". , , Kylix, , (runtime packages). , Kylix , DEPLOY, . , Delphi, ~ 400 . , Delphi . : , Delphi SysUtils, Classes, Forms . . (. . Windows API) 20-40 . Linux , C++ QT library.
, Kylix ? , .
, , Kylix, , Kylix , .
P.S. , , kylix - , .
2001 .
.
RuPipeline Components.
Pipeline Components.
. Pipeline components - COM-, pipeline, ASP. Pipeline pipeline component, . pipeline IDictionary, . IDictionary, -.
.
Pipeline IPipelineComponent, . .
, , IDictionary xml- . Properties Page Pipeline Editor. Pipeline Editor Microsoft.
, Delphi ActiveX Library. File|New -> Activex tabsheet -> ActiveX Library. Automation Object. DumpOrderToXml. SetXmlFilename GetXmlFilename. :
function SetXmlFilename(XmlFileName: WideString): HResult [dispid $00000001]; stdcall;
function GetXmlFileName(retval XmlFileName: WideString): HResult [dispid $00000002]; stdcall;
: COMMERCELib_TLB.pas, MSCSAspHelpLib_TLB.pas, MSCSCoreLib_TLB.pas, PIPELINELib_TLB.pas. tipe library editor, Delphi, . ComPUtil.pas PipeConsts.pas , .
Delphi TDumpOrderToXml. :
type
TDumpOrderToXml = class(TAutoObject, IDumpOrderToXml, IPipelineComponent, ISpecifyPropertyPages, IPersistStreamInit)
private
FXmlFileName: WideString;
protected
{ IDumpOrderToXml methods }
function GetXmlFileName(out XmlFileName: WideString): HResult; stdcall;
function SetXmlFilename(const XmlFileName: WideString): HResult; stdcall;
{ IPipelineComponent methods }
function EnableDesign(fEnable: Integer): HResult; stdcall;
function Execute(const pdispOrder, pdispContext: IDispatch;
lFlags: Integer; out plErrorLevel: Integer): HResult; stdcall;
{ ISpecifyPropertyPages methods }
function GetPages(out pages: TCAGUID): HResult; stdcall;
{ IPersistStreamInit methods }
function GetClassID(out classID: TCLSID): HResult; stdcall;
function IsDirty: HResult; stdcall;
function Load(const stm: IStream): HResult; stdcall;
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
function InitNew: HResult; stdcall;
end;
IDumpOrderToXml xml- . IPipelineComponent - , Execute. ISpecifyPropertyPage classid Property Page . IPersistStreamInit Pipeline Editor .pcf.
. GetXmlFilename SetXmlFilename - () () FXmlFileName. EnableDesing , . - . , S_OK. InitNew IsDirty. , , .
Save Load - xml-. ,
function TDumpOrderToXml.Save(const stm: IStream;
fClearDirty: BOOL): HResult;
var OleStream: TOleStream;
FileNameLen: Byte;
begin
OleStream := TOleStream.Create(stm);
try
FileNameLen := Length(FXmlFileName);
OleStream.Write(FileNameLen, 1);
OleStream.Write(FXmlFileName[1], FileNameLen * Sizeof(WideChar));
finally
OleStream.Free;
end;
Result := S_OK;
end;
function TDumpOrderToXml.Load(const stm: IStream): HResult;
var OleStream: TOleStream;
FileNameLen: Byte;
begin
OleStream := TOleStream.Create(stm);
try
OleStream.Read(FileNameLen, 1);
SetLength(FXmlFileName, FileNameLen);
OleStream.Read(FXmlFileName[1], FileNameLen * Sizeof(WideChar));
finally
OleStream.Free;
end;
Result := S_OK;
end;
GetClassID classid . .
function TDumpOrderToXml.GetClassID(out classID: TCLSID): HResult;
begin
classID := Factory.ClassID;
Result := S_OK;
end;
GetSizeMax , . 255 widechar-.
function TDumpOrderToXml.GetSizeMax(out cbSize: Largeint): HResult;
begin
cbSize := 255 * sizeof(WideChar) + 1;
Result := S_OK;
end;
Execute. IDictionary . c GetDictFromDispatch ComPUtil.pas. ExportDictionaryToXml, , xml- .
function TDumpOrderToXml.Execute(const pdispOrder, pdispContext: IDispatch;
lFlags: Integer; out plErrorLevel: Integer): HResult;
var
hFile: Integer;
tmpXML: WideString;
Order: IDictionary;
tmpOutXml: string;
begin
try
tmpXML := '';
if GetDictFromDispatch(pdispOrder, Order) = S_OK then
begin
ExportDictionaryToXML(Order, tmpXML);
tmpXML := '<SO>' + tmpXML + '</SO>';
end;
tmpOutXml := tmpXML;
hFile := FileCreate(string(FXmlFileName));
FileWrite(hFile, tmpOutXml[1], Length(tmpOutXML));
FileClose(hFile);
finally
Result := S_OK;
Order := nil;
end;
end;
, - ExportDictionaryToXml. . , dictionary . IDictionary, ISimpleList . dictionary IEnumVARIANT. , - IEnumVARIANT, .
Result := E_FAIL;
hr := InitKeyEnumInDict(Dict, Enum);
if hr = S_OK then
begin
repeat
hr := GetNextKeyInDict(Enum, Key);
if hr <> S_OK then Break;
hr := GetDictValueVariant(Dict, LPCWSTR(Key), ItemValue);
if hr <> S_OK then Break;
case VarType(ItemValue) of
...
else
Break;
end;
until hr <> S_OK;
end;
XmlStr := Res;
Result := S_OK;
case. , . :
Res := Res + Format('<%s>%s</%s>', [string(Key), string(ItemValue), string(Key)]);
varUnknown . , :
Res := Res + Format('<%s>IUnknown</%s>',[string(Key), string(Key)]);
varDispatch. , IDictionary, ISimpleList. , varUnknown:
if GetDictFromDispatch(ItemValue, NewDict) = S_OK then
begin
if ExportDictionaryToXML(NewDict, NewXml) = S_OK then
begin
Res := Res + Format('<%s type="Dictionary">%s</%s>',
[string(Key), string(NewXml), string(Key)]);
end
else
begin
Exit;
end;
end
else if GetSimpleListFromDispatch(ItemValue, NewList) = S_OK then
begin
if ExportSimpleListToXML(NewList, NewXml) = S_OK then
begin
Res := Res + Format('<%s type="SimpleList">%s</%s>',
[string(Key), string(NewXml), string(Key)]);
end
else
begin
Exit;
end;
end
else
begin
Res := Res + Format('<%s>IDispatch</%s>',
[string(Key), string(Key)]);
end;
IDictionary, . , ISimpleList - ExportSimpleListToXml. . , IDictionary, ExportDictioanryToXml:
Result := E_FAIL;
hr := GetNumItems(List, Count);
if hr <> S_OK then Exit;
for I := 0 to Count - 1 do
begin
if GetNthItem(List, I, NewDict) = S_OK then
begin
if ExportDictionaryToXML(NewDict, NewXml) = S_OK then
begin
Res := Res + Format('<LISTITEM%d>'#13#10'%s</LISTITEM%d>'#13#10,
[I, string(NewXml), I]);
end
else
begin
Exit;
end;
end;
end;
XmlStr := Res;
Result := S_OK;
Execute. , FXmlFilename Pipeline . Property Page. Textbox, Label, Button SaveDialog.
SaveDialog:
if SaveDialog1.Execute then
begin
Edit1.Text := SaveDialog1.FileName;
end;
Property Page, UpdatePropertyPage UpdateObject. textbox. , , textbox .
procedure TDumpToXMLPropertyPage.UpdatePropertyPage;
var StrXmlFilename: WideString;
begin
{ Update your controls from OleObject }
(OleObjects.First as IDumpOrderToXml).GetXmlFileName(StrXmlFilename);
Edit1.Text := StrXmlFilename;
end;
procedure TDumpToXMLPropertyPage.UpdateObject;
var StrXmlFilename: WideString;
begin
{ Update OleObject from your controls }
StrXmlFilename := Edit1.Text;
(OleObjects.First as IDumpOrderToXml).SetXmlFileName(StrXmlFilename);
end;
, Pipeline Editor , property-, GetPages .
function TDumpOrderToXml.GetPages(out pages: TCAGUID): HResult;
begin
pages.cElems := 1;
pages.pElems := CoTaskMemAlloc(sizeof(TGUID));
if pages.pElems = nil then
begin
Result := E_OUTOFMEMORY;
end
else
begin
pages.pElems^[0] := Class_DumpToXMLPropertyPage;
Result := S_OK;
end;
end;
, , guid- property-. - Class_DumpToXmlPropertyPage. guid , property page.
.dpr . DllRegisterServer, :
function DllRegisterServer: HResult;
begin
Result := ComServ.DllRegisterServer;
if Result = S_OK then
begin
{ Register DumpOrderToXml class }
Result := RegisterCATID(CLASS_DumpOrderToXml, CATID_MSCSPIPELINE_COMPONENT);
if Result >= 0 then
begin
Result := RegisterCATID(CLASS_DumpOrderToXml, CATID_MSCSPIPELINE_ANYSTAGE);
end;
{ Here you should register others pipeline components }
end;
end;
, pipeline component, pipeline stage.
. dll. : regsvr32 testpipelines.dll
.ru
Screensaver Delphi
Screensaver Delphi
: Dave Murray
, .
: Delphi ( )
:
FormShow - , ,
FormHide - ,
DeactivateScrSaver - , ,
.
, fsStayOnTop. , . {$D "Programname Screensaver"} (*.dpr).
, , SCR \WINDOWS\SYSTEM .
var
crs : TPoint; { }
procedure TScrForm.FormShow(Sender: TObject);
{starts the screensaver}
begin
WindowState := wsMaximized; { }
GetCursorPos(crs); { }
Application.OnMessage := DeactivateScrSaver; { /}
ShowCursor(false); { }
{ ...}
//
end; { TScrForm.FormShow}
procedure TScrForm.FormHide(Sender: TObject);
{ }
begin
Application.OnMessage := nil; { }
{ ...}
//
ShowCursor(true); { }
end; {procedure TScrForm.FormHide}
procedure TScrForm.DeactivateScrSaver(var Msg : TMsg; var Handled : boolean);
{ }
var
done : boolean;
begin
if Msg.message = WM_MOUSEMOVE then { }
done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
(Abs(HIWORD(Msg.lParam) - crs.y) > 5)
else {key / mouse ?}
done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP) or
(Msg.message = WM_SYSKEYDOWN) or (Msg.message = WM_SYSKEYUP) or
(Msg.message = WM_ACTIVATE) or (Msg.message = WM_NCACTIVATE) or
(Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN) or
(Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);
if done then
Close;
end; {procedure TScrForm.DeactivateScrSaver}
.ru
: Ido Kanner
Windows freecell, . , .
.
OwnerDraw true.
, OnDrawItem.
:
...
ACanvas.TextOut(1,ARect.Top+1,'I am in the MainMenuDrawbar');
...
, , - API DrawMenuBar.
Delphi 2,3 WM_MESUREITEM WM_DRAWITEM, .
.ru
,
,
C :
. :
procedureTForm1.Button1Click(Sender: TObject);
const
count = 100;
var
i: integer;
x, y: integer;
bm, bm1, bm2: TBitMap;
p1, p2, p: PByteArray;
c: integer;
k: integer;
begin
bm := TBitMap.Create;
bm1 := TBitMap.Create;
bm2 := TBitMap.Create;
bm1.LoadFromFile('Bitmap1.bmp');
bm2.LoadFromFile('Bitmap2.bmp');
if bm1.Height < bm2.Height then
begin
bm.Height := bm1.Height;
bm2.Height := bm1.Height;
end
else
begin
bm.Height := bm2.Height;
bm1.Height := bm2.Height;
end;
if bm1.Width < bm2.Width then
begin
bm.Width := bm1.Width;
bm2.Width := bm1.Width;
end
else
begin
bm.Width := bm2.Width;
bm1.Width := bm2.Width;
end;
bm.PixelFormat := pf24bit;
bm1.PixelFormat := pf24bit;
bm2.PixelFormat := pf24bit;
Form1.Canvas.Draw(0, 0, bm1);
for i := 1 to count - 1 do
begin
for y := 0 to bm.Height - 1 do
begin
p := bm.ScanLine[y];
p1 := bm1.ScanLine[y];
p2 := bm2.ScanLine[y];
for x := 0 to bm.Width * 3 - 1 do
p^[x] := round((p1^[x] * (count - i) + p2^[x] * i) / count);
end;
Form1.Canvas.Draw(0, 0, bm);
Form1.Caption := IntToStr(round(i / count * 100)) + '%';
Application.ProcessMessages;
if Application.Terminated then
break;
end;
Form1.Canvas.Draw(0, 0, bm2);
Form1.Caption := 'done';
bm1.Destroy; bm2.Destroy; bm.Destroy;
end;
DB2 Create Trigger
DB2 Create Trigger
, p pp. p "create trigger". pp p pp, - p .
BDE?
BDE?
: . .
! BDE alias! Table, Query, Database - ! - BDE. .. BDE , , , , SQL . BDE BDE Admin , API, . BDE : ODBC, DAO, ADO, RDO - API COM (, , ADO , ). ( ), :
1)
2)
3) SQL
4)
5) .
6) API Table, Query
: HALCYON, ( );
vkDBF- 6/5 .( Free)
: Vit
Vingrad.ru
, , database desktop Alias', ? Delphi DB Desktop ?
, BDE Alias', DB Desktop Database Administrator! , TTabl/TQuery , , , exe , , BDE. BIOS - - -, , . - , , , ( !) . - , , . BDE - Borland Database Engine - , - - , DB Desktop - "", , . TTable/TQuery BDE - API . BDE :
1)
2) DLL BDE
3) (Paradox, MS SQL Server, InterBase ..)
4) (DB Desktop, BDE Administrator)
5) SQL Link - -
1 2 - , 3 - . 4 5 - , BDE .
- , BDE, , , - BDE , - BDE , , - - , - , Install Shield "" BDE, , , BDE .
:
VitMDI Child ?
MDI Child ?
OnClose Action caFree. , MDI Child caMinimize. , Action := caNone,
Delphi ( MoveTo LineTo) ?
Delphi ( MoveTo LineTo) ?
, Windows. VCL GDI. .
select
select Grid , ?
TTable, BDE fetch , Grid. , SQL- - .. BDE - . , SQL- . , .
SQL- , BDE .
, TTable TQuery . TQuery , .. - SQL-.
TTable- , , . TTable TDBGrid Ctrl-End
SELECT * FROM TABLE ORDER BY INDEXFIELD DESC
DBGrid " ". , DESC INDEXFIELD, (ORDER BY) . , . , Ctrl-End TTable , DESC . TTable . Delphi C/S , TTable SQL- SQL Monitor.
. http://www.ibase.ru/devinfo/bde.htm
Borland Interbase / Firebird FAQ
Borland Interbase / Firebird Q&A, 2.02 31 1999
17 1999 .
Borland Interbase / Firebird
- - . (Epsylon Technologies)
Borland.
E-mail mailto:delphi@demo.ru
www: http://www.ibase.ru/
: 953-13-34
: Borland International, , Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, WWW-, , Delphi , ESUNIX1, mers.com.
C:
?
?
. , . :
1) Windows
2) : TApplication, TMouse, TScreen ..
3) TForm + + .
.
? "Close", ? , . - - . .. . - "" , . - , . "" . , .
, , - . .. .
WinAPI , - .
PS. - VB - VBRunxx.DLL. MS VC++ MFC. - - BPL - . 10 - - , . , .
: Vit
Vingrad.ru
SELECT VIEW ORDER BY?
SELECT VIEW ORDER BY?
, . view "" , .
Borland Interbase / Firebird FAQ
Borland Interbase / Firebird Q&A, 2.02 31 1999
17 1999 .
Borland Interbase / Firebird
- - . (Epsylon Technologies)
Borland.
E-mail mailto:delphi@demo.ru
www: http://www.ibase.ru/
: 953-13-34
: Borland International, , Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, WWW-, , Delphi , ESUNIX1, mers.com.
C:
Access Violation?
Access Violation?
"Access Violation" , . , :
1) .
var e:TEdit;
begin
e.text:='Hello world!';
end;
e , .
2) :
var e:TEdit;
begin
...
e.free;
...
e.text:='Hello world';
end;
, :
if e<>nil then e.text:='Hello world!';
if assigned(e) then e.text:='Hello world!';
:
if e<>nil then e.free;
- , Free Nil. Free nil:
e.free;
e:=nil;
3) "Index out of bound", Access Violation, . - 10 , :
a[20]:=something;
, , - , ! i:=10 Access Violation.
3) onCreate - -
4) onDestroy - -
Vit
Vingrad.ru
3DNow
3DNow
{$ifndef ver80} // 32-
function 3DNowSupport: Boolean; assembler;
asm
push ebx
mov @Result, True
mov eax, $80000000
dw $A20F
cmp eax, $80000000
jbe @NOEXTENDED // 3DNow
mov eax, $80000001
dw $A20F
test edx, $80000000
jnz @EXIT // 3DNow
@NOEXTENDED:
mov @Result, False
@EXIT:
pop ebx
end;
{$endif}
Each function listed below returns information about lock status or acquires or releases a lock at the table or record level.
DbiAcqPersistTableLock:
Acquires an exclusive persistent lock on the table preventing other users from using the table
or creating a table of the same name.
DbiAcqTableLock:
Acquires a table-level lock on the table associated with the given cursor.
DbiGetRecord:
Record positioning functions have a lock parameter.
DbiIsRecordLocked:
Checks the lock status of the current record.
DbiIsTableLocked:
Returns the number of locks of a specified type acquired on the table associated with the
given session.
DbiIsTableShared:
Determines whether the table is physically shared or not.
DbiOpenLockList:
Creates an in-memory table containing a list of locks acquired on the table.
DbiOpenUserList:
Creates an in-memory table containing a list of users sharing the same network file.
DbiRelPersistTableLock:
Releases the persistent table lock on the specified table.
DbiRelRecordLock:
Releases the record lock on either the current record of the cursor or only the locks acquired
in the current session.
DbiRelTableLock:
Releases table locks of the specified type associated with the current session (the session in
which the cursor was created).
DbiSetLockRetry:
Sets the table and record lock retry time for the current session.
Delphi Knowledge Base
Each function listed below returns information about a cursor, or performs a task that performs a cursor-related task such as positioning of a cursor, linking of cursors, creating and closing cursors, counting of records associated with a cursor, filtering, setting and comparing bookmarks, and refreshing all buffers associated with a cursor.
DbiActivateFilter:
Activates a filter.
DbiAddFilter:
Adds a filter to a table, but does not activate the filter (the record set is not yet altered).
DbiApplyDelayedUpdates:
When cached updates cursor layer is active, writes all modifications made to cached data to the
underlying database.
DbiBeginDelayedUpdates:
Creates a cached updates cursor layer so that users can make extended changes to temporarily
cached table data without writing to the actual table, thereby minimizing resource locking.
DbiBeginLinkMode:
Converts a cursor to a link cursor. Given an open cursor, prepares for linked access. Returns a
new cursor.
DbiCloneCursor:
Creates a new cursor (clone cursor) which has the same result set as the given cursor
(source cursor).
DbiCloseCursor:
Closes a previously opened cursor.
DbiCompareBookMarks:
Compares the relative positions of two bookmarks in the result set associated with the cursor.
DbiDeactivateFilter:
Temporarily stops the specified filter from affecting the record set by turning the filter off.
DbiDropFilter:
Deactivates and removes a filter from memory, and frees all resources.
DbiEndDelayedUpdates:
Closes a cached updates cursor layer ending the cached updates mode.
DbiEndLinkMode:
Ends linked cursor mode, and returns the original cursor.
DbiExtractKey:
Retrieves the key value for the current record of the given cursor or from the supplied record buffer.
DbiForceRecordReread:
Rereads a single record from the server on demand, refreshing one row only, rather than clearing
the cache.
DbiForceReread:
Refreshes all buffers associated with the cursor, if necessary.
DbiFormFullName:
Returns the fully qualified table name.
DbiGetBookMark:
Saves the current position of a cursor to the client-supplied buffer called a bookmark.
DbiGetCursorForTable:
Finds the cursor for the given table.
DbiGetCursorProps:
Returns the properties of the cursor.
DbiGetExactRecordCount:
Retrieves the current exact number of records associated with the cursor. NEW FUNCTION BDE 4.0
DbiGetFieldDescs:
Retrieves a list of descriptors for all the fields in the table associated with the cursor.
DbiGetLinkStatus:
Returns the link status of the cursor.
DbiGetNextRecord:
Retrieves the next record in the table associated with the cursor.
DbiGetPriorRecord:
Retrieves the previous record in the table associated with the given cursor.
DbiGetProp:
Returns a property of an object.
DbiGetRecord:
Retrieves the current record, if any, in the table associated with the cursor.
DbiGetRecordCount:
Retrieves the current number of records associated with the cursor.
DbiGetRecordForKey:
Finds and retrieves a record matching a key and positions the cursor on that record.
DbiGetRelativeRecord:
Positions the cursor on a record in the table relative to the current position of the cursor.
DbiGetSeqNo:
Retrieves the sequence number of the current record in the table associated with the cursor.
DbiLinkDetail:
Establishes a link between two tables such that the detail table has its record set limited to the
set of records matching the linking key values of the master table cursor.
DbiLinkDetailToExp:
Links the detail cursor to the master cursor using an expression.
DbiMakePermanent:
Changes a temporary table created by DbiCreateTempTable into a permanent table.
DbiOpenTable:
Opens the given table for access and associates a cursor handle with the opened table.
DbiResetRange:
Removes the specified table's limited range previously established by the function DbiSetRange.
DbiSaveChanges:
Forces all updated records associated with the cursor to disk.
DbiSetFieldMap:
Sets a field map of the table associated with the given cursor.
DbiSetProp:
Sets the specified property of an object to a given value.
DbiSetRange:
Sets a range on the result set associated with the cursor.
DbiSetToBegin:
Positions the cursor to BOF (just before the first record).
DbiSetToBookMark:
Positions the cursor to the location saved in the specified bookmark.
DbiSetToCursor:
Sets the position of one cursor (the destination cursor) to that of another (the source cursor).
DbiSetToEnd:
Positions the cursor to EOF (just after the last record).
DbiSetToKey:
Positions an index-based cursor on a key value.
DbiSetToRecordNo:
Positions the cursor of a dBASE table to the given physical record number.
DbiSetToSeqNo:
Positions the cursor to the specified sequence number of a Paradox table.
DbiUnlinkDetail:
Removes a link between two cursors.
Delphi Knowledge Base
,
,
C :
. :
TCP/IP?
TCP/IP?
"ping 127.0.0.1" .
ping 127.0.0.1?
127.0.0.1 - localhost - TCP/IP () , TCP/IP , , , () (, , , , , ).
: Vit
Vingrad.ru
uses Registry;
function TCPIPInstalled: boolean;
var
Reg: TRegistry;
RKeys: TStrings;
begin
Result:=False;
try
Reg := TRegistry.Create;
RKeys := TStringList.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\Enum\Network\MSTCP', False) Then
begin
reg.GetKeyNames(RKeys);
Result := RKeys.Count > 0;
end;
finally
Reg.free;
RKeys.free;
end;
.ru
Personal Oracle BDE
Personal Oracle BDE
Personl Oracle ( Oracle) . ( Personal Oracle Windows 95 , Oracle Windows NT - , ) Oracle. SQLNet Easy Configuration ( Oracle 8 - Oracle Net8 Easy Config) Oracle ( , BDE, alias, , BDE). .
- , Oracle (IPX/SPX, TCP/IP .). - . Personal Oracle IP- 127.0.0.1 ( , TCP Loopback Address, URL http://localhost/). - . Personal Oracle ORCL. , , .
Oracle TNSNAMES.ORA, .
SQL Plus . SYSTEM MANAGER ( ). , , . , SQL Plus , , . SQL Plus . , Oracle Net8 Easy Config .
, , , , , , , .
, , BDE. Server Name Oracle ( , BDE Administrator TNSNAMES.ORA). BDE BDE Administrator SQL Explorer.
"Vendor initialization failed", , , Vendor Init Oracle, . Windows\System, BDE Windows 95 Bin , Oracle, , PATH. , Oracle 8 8.0.4; 8.0.4.
.ru
: Eber Irigoyen
, , : .
//
procedure TForm1.Button1Click(Sender: TObject);
begin
WNetConnectionDialog(Handle,RESOURCETYPE_DISK)
end;
//
procedure TForm1.Button1Click(Sender: TObject);
begin
WNetConnectionDialog(Handle,RESOURCETYPE_PRINT)
end;
//
procedure TForm1.Button2Click(Sender: TObject);
var
NetResource: TNetResource;
begin
{ TNetResource }
NetResource.dwType := RESOURCETYPE_DISK;
NetResource.lpLocalName := 'S:';
NetResource.lpRemoteName := '\\myserver\public';
NetResource.lpProvider := '';
{ , TNetResource }
If ( WNetAddConnection2(NetResource,
'', {Password (if needed) or empty}
'', {User name (if needed) or empty}
CONNECT_UPDATE_PROFILE)<>NO_ERROR) Then
Raise Excepcion.Create('unable to map drive')
//
//ERROR_ACCESS_DENIED, ERROR_ALREADY_ASSIGNED, ..
end;
// ...
procedure TForm1.Button2Click(Sender: TObject);
begin
if WNetCancelConnection2( 'S:',0,TRUE) <> NO_ERROR then
Raise Exception.create('Error disconnecting map drive');
//
//ERROR_DEVICE_IN_USE, ERROR_NOT_CONNECTED, ..
end;
.ru
( LPT ) WIN API 16 WIN API 32 :
1.
WNetAddConnection(NetResourse,Password,LocalName:PChar):longint;
NetResourse - ( '\\P166\c')
Password - ( , )
LocalName - , ( 'F:')
WNetAddConnection('\\P166\C','','F:');
. , :
NO_ERROR - -
ERROR_ACCESS_DENIED -
ERROR_ALREADY_ASSIGNED - . - .
ERROR_BAD_DEV_TYPE - .
ERROR_BAD_DEVICE - LocalName
ERROR_BAD_NET_NAME -
ERROR_EXTENDED_ERROR - (. WNetGetLastError )
ERROR_INVALID_PASSWORD -
ERROR_NO_NETWORK -
2.
WNetCancelConnection(LocalName:PChar;ForseMode:Boolean):Longint;
LocalName - , ( 'F:')
ForseMode - :
False - . , (, )
True - . , ( )
. , :
NO_ERROR - -
ERROR_DEVICE_IN_USE -
ERROR_EXTENDED_ERROR - (. WNetGetLastError )
ERROR_NOT_CONNECTED - -
ERROR_OPEN_FILES - ForseMode=false
: ForseMode=false ERROR_OPEN_FILES , - , ForseMode=true
:
DB
DB
TField DisplayText (DataAware), TDBGrid'. .. TDBGrid . , , DisplayFormat ( ). .
-, TField OnGetText. , DisplayText , OnGetText.
, :
, ( FFF) FFFOnGetText OnGetText.
- , .
:
procedure FFFOnGetText(Sender: TField; var Text: string; DisplayText: Boolean);
begin
if DisplayText then Text := AnsiUpperCase(Text);
end;
, FFF DBGrid', , .
. . FFF, , .
TDBEdit .
.
:
. FindFirst, FindNext, FindClose, TSearchRec .
:
Var SearchRec:TSearchRec;
...
If FindFirst('c:\Windows\*.*', faAnyFile, SearchRec)=0 then
repeat
{
SearchRec.name -
ExpandFileName(SearchRec.name) - }
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
:
1) "." ".." - " ", .
2) FindFirst , . .
3) FindFirst - , - ( , ) , .
4) SearchRec FindFirst FindNext, , FindClose(SearchRec) - , .
5)FindFirst/FindNext - , Swap Windows...
DBmemo. " " ( ), -, " " ( ):
( , , - [: "the", "of", "and"])
, , "hang",46 "PC",22.
, , , , "hang" 11, 46 22, "PC" - 91, 22 15.
c - , , 22 ( AND), 11, 15, 22, 46 91 ( OR). .
(, "hang","kaput"), , .
, (, "hang" "hanged"), , , , , (, "hang" , 4 "hang").
, , , , , . ( Nexus, Lycos WebCrawler, ).
.
()?
, , ,
! Locate.
Category
"Cod". :
Table1.Locate('Category','Cod',[loCaseInsensitive]);
"" ,
.
? - , -
, (. ).
? :
Table1.Locate('Category','Cod123',[loCaseInsensitive]);
, Locate - Boolean
, .
if Table1.Locate('Category','Cod123',[loCaseInsensitive]) then
showmessage('Record is located seccessful!')
else
showmessage('Record is not found!');
, .
,
Table1.Locate('Category','Co',[])
,
Table1.Locate('Category','Co',[loPartialKey])
'Cod'.
? ,
. .
DBGrid DBNavigator (
). -
:
Table1.active:=false; //
Table1.tablename:='items.db';//
Table1.active:=true; //
, , .
, ItemNo=1 Discount=50,
Locate :
Table1.Locate('ItemNo;Discount',VarArrayOf([1,50]),[]);
:
1) 6/7 - "Uses Variants;"
2) - ;
3) - - . ?
: VarArrayOf([1,'', True, 3.14])
OX
OX
.
. , OX,
. OX x,
.
, .
function F(x: double): double;
begin
result := sin(x);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
left = -10;
right = 10;
var
x1, x2: double;
y1, y2: double;
k, b: double;
x, y: double;
d1, d2: double;
begin
x1 := left;
y1 := f(x1);
repeat
x2 := x1 + 0.1;
y2 := f(x2);
if y1 * y2 < 0 then begin
repeat
y1 := f(x1);
y2 := f(x2);
k := (y1 - y2) / (x1 - x2);
b := y1 - k * x1;
x := -b / k;
y := k * x + b;
d1 := sqr(x1 - x) + sqr(y1 - y);
d2 := sqr(x2 - x) + sqr(y2 - y);
if d1 > d2 then begin
d1 := d2;
x1 := x;
end else x2 := x;
until d1 < 1E-20;
ListBox1.Items.Add(FloatToStr(x1));
end;
x1 := x2;
y1 := y2;
until x2 > right;
end;
keyfields:='name;name_1;n_dom;n_kw';
keyvalues:=VarArrayOf([combobox1.Text,combobox2.Text, edit2.Text, edit3.text]);
if dmod.qrfiz.Locate(keyfields,keyvalues,[])=false then
dmod.qrfiz.Locate('id',id1,[]);
delphi.about.com
, - . Delphi, ADOExpress , , BDE.
ADO- Delphi
: , , .
, ADODataset ( ).
Locate
, . Locate , . , Locate , 'Zoom' 'Name'. Locate True - .
AdoTable1.Locate('Name','Zoom',[]);
{......}
var ffield, fvalue: string;
opts : TLocateOptions;
ffield := 'Name';
fvalue := 'zoom';
opts := [loCaseInsensitive];
if not AdoTable1.Locate(ffield, fvalue, opts) then
ShowMessage(fvalue + ' not found in ' + ffield);
Lookup
Lookup , . Lookup , , , . , Lookup (Null) .
LookupRes
var LookupRes: Variant;
LookupRes := ADOTable1.Lookup
('Name', 'Zoom', 'Author; Description');
if not VarIsNull(LookupRes) then
ShowMessage(VarToStr(LookupRes[0])) //
Locate Lookup, , , . , Locate , .
. . , . / . , Type, . , , OLE Object. , , , .
BDE ( ADO) Delphi , . Goto, GoToKey, GoToNearest, Find, FindKey, Find Nearest, .. , Delphi, : Searching for records based on indexed fields. ADO . Seek.
Seek
ADO Seek . , Access, , .
Seek ( ) ( ) . Seek , , . Seek boolean, : True False .
GetIndexNames TADOTable (: combo box) .
ADOTable1.GetIndexNames(ComboBox1.Items);
IndexName TADOTable. IndexFieldNames . IndexFieldNames, .
Seek :
function Seek(const KeyValues: Variant; SeekOption: TSeekOption = soFirstEQ): Boolean;
KeyValues Variant. , , .
SeekOption KeyValues.
SeekOption
soFirstEQ , , ,
soLastEQ , .
soAfterEQ , , , .
soAfter , .
soBeforeEQ , , , .
soBefore , .
1: Seek (server-side). Seek , CursorLocation clUseClient. Supports , Seek.
2: Seek , Seek . , Seek .
3: Seek TADOQuery.
, , BOF EOF ( ). , ComboBox, , Edit1.
var strIndex: string;
strIndex := ComboBox1.Text; //
if ADOTable1.Supports(coSeek) then begin
with ADOTable1 do begin
Close;
IndexName := strIndex;
CursorLocation := clUseServer;
Open;
Seek (Edit1.Text, soFirstEQ);
end;
if ADOTable1.EOF then
ShowMessage ('Record value NOT found');
end
.ru
TQuery
TQuery
TQuery , TTable (FindKey, GotoKey GotoNearest). : , TQuery, ?
. , , . : () (). , , , . . .
, TQuery:
var
pb: TProgressBar;
begin
...
function SeqSearch(AQuery: TQuery; AField, AValue: String): Boolean;
begin
with AQuery do
begin
First;
while (not Eof) and (not (FieldByName(AField).AsString = AValue)) do
Next;
SeqSearch := not Eof;
end;
end;
:
AQuery: TQuery; TQuery, .
AField: String; , .
AValue: String; . String, .
(True) (False).
. bb-. :
, ...
, ...
.
, , , . , , (success), (failure, , .. ).
, , . : // . . , 0 , . , RecordCount TQuery. , . . , , . , , . , . .
, :
function Locate(AQuery: TQuery; AField, AValue: string): Boolean;
var
Hi, Lo: Integer;
begin
with AQuery do
begin
First;
{ }
Hi := RecordCount;
{ }
Lo := 0;
{ ,
}
MoveBy(RecordCount div 2);
while (Hi - Lo) > 1 do
begin
{ , }
if (FieldByName(AField).AsString > AValue) then
begin
{ }
Hi := Hi - ((Hi - Lo) div 2);
MoveBy(((Hi - Lo) div 2) * -1);
end
{ , }
else
begin
{ }
Lo := Lo + ((Hi - Lo) div 2);
MoveBy((Hi - Lo) div 2);
end;
end;
{ }
if (FieldByName(AField).AsString > AValue) then
Prior;
Locate := (FieldByName(AField).AsString = AValue)
end;
end;
, .
, SeqSearch, .
, , Boolean , , . , . , TBookmark , , .
? -, , , . 1,000 , . , 1,000, 90,000. , .
TQuery? . : , , . , , .. TQuery SQL-, ORDER BY. . . , (1,000 ), .
( 'Find') TQuery?
, , , , . "", OnClick SearchName.
: FindSearch : Boolean True.
function LookForString(target, source: string): boolean;
{ pos
source target }
begin
LookForString := pos(target, source);
end;
procedure SearchName(searchtype: string; stringtofind: string);
var
OldCursor: TCursor;
CurrentPos: TBookmark;
found: boolean;
begin
if Form1.Query1.State = dsEdit then
Form1.Query1.Post;
if StringToFind = '' then
exit;
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
with Form1 do
begin
CurrentPos := Query1.GetBookmark;
Query1.DisableControls;
found := false;
if searchtype <> 'prev' then { }
begin
if searchtype = 'first' then
Query1.First
else if not Query1.EOF then
Query1.Next;
while (not Query1.EOF) and (not found) do
begin
if LookForString(StringToFind, MemberName) <> 0 then
found := true;
if not found then
Query1.Next;
end;
end
else
begin { prev }
if not Query1.BOF then
Query1.Prior;
while (not Query1.BOF) and (not found) do
begin
if LookForString(StringToFind, MemberName) <> 0 then
found := true;
if not found then
Query1.Prior;
end;
end;
Screen.Cursor := OldCursor;
if found then
begin
FindSearch := false;
ChangeFindCaption;
UpdateStatusLabel;
end
else
begin
MessageDlg(' .', mtInformation,
[mbOK], 0);
Query1.GotoBookmark(CurrentPos);
end;
Query1.EnableControls;
Query1.FreeBookmark(CurrentPos);
end; { Form1 }
end;
procedure TForm1.FindButtonClick(Sender: TObject);
begin
if FindSearch then
SearchName('first', Page0Edit.Text)
else
SearchName('next', Page0Edit.Text);
end;
:
, . ( Paradox DBase). , 10 TQuery. TTable.MoveBy (- , ?!). Borland (2656), Paradox Engine BDE. C. Delphi:
usesBDE;
...
procedure MoveToRec(RecNo: longint; taSingle: TDBDataSet);
//
var
ErrorCode: DBIResult;
CursorProps: CurProps;
begin
ErrorCode := DbiGetCursorProps(taSingle.Handle, CursorProps);
if ErrorCode = DBIERR_NONE then
begin
case TTable(taSingle).TableType of
ttParadox: ErrorCode := DbiSetToSeqNo(taSingle.Handle, RecNo);
ttDBase: ErrorCode := DbiSetToRecordNo(taSingle.Handle, RecNo);
end; { case..}
taSingle.Resync([rmCenter]);
end { if..}
end; { procedure MoveToRec }
? () .
Delphi 1. , .
. , , , EditBox. EditBox, FindNearest TTable. c Text EditBox.
. 1/3 OnTimer ( ). ( 1/3 ).
backspace .
EditBox ( ), , ListBox. , :
procedureEdit1OnChange(...);
var
i: integer;
begin
if not updating then
exit;
{ - -
}
updating := false;
Table1.FindNearest([Edit1.text]);
ListBox1.clear;
i := 0;
while (i < 5) and (not (table1.eof)) do
begin
listbox.items.add(Table1.fields[0].asString);
inc(i);
table1.next;
end;
listbox1.itemindex := 0;
end;
-, . . DisplayProperties :
DisplayProperties(Form1,{ }
Outline1.Lines, { TStrings-}
0); {0 - "", }
DisplayProperties(AObj: TObject; AList: TStrings; iIndentLevel: Integer);
var
Indent: string;
ATypeInfo: PTypeInfo;
ATypeData: PTypeData;
APropTypeData: PTypeData;
APropInfo: PPropInfo;
APropList: PPropList;
iProp: Integer;
iCnt: Integer;
iCntProperties: SmallInt;
ASecondObj: TObject;
procedure AddLine(sLine: string);
begin
AList.Add(Indent + #160 + IntToStr(iProp) + ': ' + APropInfo^.Name
+ ' (' + APropInfo^.PropType^.Name + ')' + sLine);
end;
begin
try
Indent := GetIndentSpace(iIndentLevel);
ATypeInfo := AObj.ClassInfo;
ATypeData := GetTypeData(ATypeInfo);
iCntProperties := ATypeData^.PropCount;
GetMem(APropList, SizeOf(TPropInfo) * iCntProperties);
GetPropInfos(ATypeInfo, APropList);
for iProp := 0 to ATypeData^.PropCount - 1 do
begin
APropInfo := APropList^[iProp];
case APropInfo^.PropType^.Kind of
tkInteger:
AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));
tkChar:
AddLine(' := ' + chr(GetOrdProp(AObj, APropInfo)));
tkEnumeration:
begin
APropTypeData := GetTypeData(APropInfo^.PropType);
if APropTypeData^.BaseType^.Name <> APropInfo^.PropType^.Name then
AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)))
else
AddLine(' := ' + APropTypeData^.NameList);
end;
tkFloat:
AddLine(' := ' + FloatToStr(GetFloatProp(AObj, APropInfo)));
tkString:
AddLine(' := "' + GetStrProp(AObj, APropInfo) + '"');
tkSet:
begin
AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));
end;
tkClass:
begin
ASecondObj := TObject(GetOrdProp(AObj, APropInfo));
if ASecondObj = nil then
AddLine(' := NIL')
else
begin
AddLine('');
DisplayProperties(ASecondObj, AList, iIndentLevel + 1);
end;
end;
tkMethod:
begin
AddLine('');
end;
else
AddLine(' := >><<');
end;
end;
except { }
on e: Exception do ShowMessage(e.Message);
end;
FreeMem(APropList, SizeOf(TPropInfo) * iCntProperties);
end;
function GetIndentSpace(iIndentLevel: Integer): string;
var iCnt: Integer;
begin
Result := '';
for iCnt := 0 to iIndentLevel - 1 do
Result := Result + #9;
end;
- Thomas von Stetten
Delphi
Kuliba
/ System Tray
/ System Tray
: Ruslan Abu Zant
, , , . System Tray ?
procedure hideStartbutton(visi: boolean);
var
Tray, Child: hWnd;
C: array[0..127] of Char;
S: string;
begin
Tray := FindWindow('Shell_TrayWnd', nil);
Child := GetWindow(Tray, GW_CHILD);
while Child <> 0 do
begin
if GetClassName(Child, C, SizeOf(C)) > 0 then
begin
S := StrPAS(C);
if UpperCase(S) = 'TRAYNOTIFYWND' then
begin
if Visi then
ShowWindow(Child, 1)
else
ShowWindow(Child, 0);
end;
end;
Child := GetWindow(Child, GW_HWNDNEXT);
end;
end;
, ,
hideStartbutton(true);
hideStartbutton(false);
!!
.ru
StatusBar
StatusBar
. , MouseMove, , . MouseMove statusbar.
{ CommCtrl uses. }
{ }
private
procedure AppShowHint(var HintStr: string; var CanShow: boolean;
var HintInfo: THintInfo);
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := AppShowHint;
end;
procedure TForm1.AppShowHint(var HintStr: string; var CanShow: boolean;
var HintInfo: THintInfo);
const
PanelHints: array [0..6] of string =
('Cursor position', 'Ascii char', 'Bookmarks', 'Caps lock',
'Insert/Overwrite', 'File size', 'File name');
var
x: integer;
R: TRect;
begin
if HintInfo.HintControl = StatusBar1 then
begin
for x := 0 to StatusBar1.Panels.Count-1 do
begin
SendMessage(StatusBar1.Handle, SB_GETRECT, x, Longint(@R));
if PtInRect(R, HintInfo.CursorPos) then
begin
HintStr := PanelHints[x];
InflateRect(R, 3, 3);
{ CursorRect
, . }
HintInfo.CursorRect := R;
break;
end;
end;
end;
end;
.ru
?
?
( delphi.about.com )
Display Device Modes
Windows , , , . .
API EnumDisplaySettings, , ChangeDisplaySettings -.
-
, , , EnumDisplaySettings. , True.
TDevMode, . TDevMode , . , (dmPelsWidth, dmPelsHeight), ( ), (dmBitsPerPel), (dmDisplayFrequency) .
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
DevMode : TDevMode;
begin
i:=0;
while EnumDisplaySettings(nil,i,DevMode) do begin
with Devmode do
ListBox1.Items.Add
(Format('%dx%d %d Colors',
[dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));
Inc(i);
end;
end;
-
, . ChangeDisplaySettings. Windows.
procedure TForm1.Button1Click(Sender: TObject);
var
DevMode : TDeviceMode;
liRetValue : Longint;
begin
if EnumDisplaySettings
(nil,Listbox1.ItemIndex,Devmode) then
liRetValue := ChangeDisplaySettings
(DevMode, CDS_UPDATEREGISTRY);
SendMessage(HWND_BROADCAST,
WM_DISPLAYCHANGE,
SPI_SETNONCLIENTMETRICS,
0);
end;
ChangeDisplaySettings long integer. , .
: -, . .
: ( ) .
: SendMessage , -.
WM_DISPLAYCHANGE. , , , ..
...
type
TForm1 = class(TForm)
ListBox1: TListBox;
...
private
procedure WMDisplayChange(var Message:TMessage);
message WM_DISPLAYCHANGE;
...
procedure
TForm1.WMDisplayChange(var Message: TMessage);
begin
ShowMessage('Changes in display detected!');
inherited;
end;
.ru
