Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.

Кроме того, в предложенном выше варианте еще и запись удалять приходится…:)

Решалась же эта проблема следующим способом:

procedureCopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);

var

i: Integer;

bActive: Boolean;

SrcDatabase, DestDatabase: TDatabase;

iSrcMemSize, iDestMemSize: Integer;

pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;

bNeedAllFields: Boolean;

begin

SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);

try

DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);

try

bActive := SrcTable.Active;

SrcTable.FieldDefs.Update;

iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);

pSrcFldDes := AllocMem(iSrcMemSize);

ifpSrcFldDes = nil then begin

raiseEOutOfMemory.Create('Не хватает памяти!');

end;

try

SrcTable.Open;

Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));

SrcTable.Active := bActive;

FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);

withCrtTableDesc do begin

StrPcopy(szTblName, DestTable.TableName);

StrPcopy(szTblType, 'DBASE');

if(Length(cpyFields[0] ) = 0) or(cpyFields[0] = '*') then begin

bNeedAllFields := True;

SrcTable.FieldDefs.Update;

iFldCount := SrcTable.FieldDefs.Count;

end else begin

bNeedAllFields := False;

iFldCount := High(cpyFields) + 1;

end;

iDestMemSize := iFldCount * Sizeof(FLDDesc);

CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);

ifCrtTableDesc.pFLDDesc = nil then begin

raise EOutOfMemory.Create('Не хватает памяти!');

end;

end;

try

ifbNeedAllFields then begin

fori := 0 toCrtTableDesc.iFldCount - 1 do begin

Move(PFieldDescList(pSrcFldDes)^[i], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

end;

end else begin

fori:=0 toCrtTableDesc.iFldCount-1 do begin

Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo – 1], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

end;

end;

Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));

finally

FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);

end;

finally

FreeMem(pSrcFldDes, iSrcMemSize);

end;

finally

Session.CloseDatabase(DestDatabase);

end;

finally

Session.CloseDatabase(SrcDatabase);

end;

end;

VSпишет:

В книгах Калверта, Свана и других авторов можно найти похожий текст. Смысл текста — "Изменить цвет кнопок Button, BitBt нельзя, т.к. их рисует WINDOWS". Если нельзя, но ОЧЕНЬ НУЖНО, то можно.

Небольшой компонент ColorBtn, дает возможность использовать в кнопках цвет. Кроме того, представлено новое свойство — Frame3D, позволяющее получить более реалистичный вид нажатой кнопки. В отличие от API, при изменении значения свойства Frame3D, не требуется переоткрытие компонента.

unitColorBtn;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

typeTColorBtn = class(TButton)

private

{ Private declarations }

IsFocused: boolean;

FCanvas: TCanvas;

F3DFrame: boolean;

FButtonColor: TColor;

procedureSet3DFrame(Value: boolean);

procedureSetButtonColor(Value: TColor);

procedureCNDrawItem( var Message: TWMDrawItem); messageCN_DRAWITEM;

procedureWMLButtonDblClk( var Message: TWMLButtonDblClk); messageWM_LBUTTONDBLCLK;

procedureDrawButtonText( constCaption: string; TRC: TRect; State: TButtonState; BiDiFlags: Longint);

procedureCalcuateTextPosition( constCaption: string; varTRC: TRect; BiDiFlags: Longint);

protected

{ Protected declarations }

procedureCreateParams( varParams: TCreateParams); override;

procedureSetButtonStyle(ADefault: boolean); override;

public

{ Public declarations }

constructorCreate(AOwner: TComponent); override;

destructorDestroy; override;

published

{ Published declarations }

propertyButtonColor: TColor readFButtonColor writeSetButtonColor defaultclBtnFace;

propertyFrame3D: boolean readF3DFrame writeSet3DFrame defaultFalse;

end;

procedure Register;

implementation

{ TColorBtn }

constructorTColorBtn.Create(AOwner: TComponent);

begin

InheritedCreate(AOwner);

FCanvas:= TCanvas.Create;

FButtonColor:= clBtnFace;

F3DFrame:= False;

end;

destructorTColorBtn.Destroy;

begin

FCanvas.Free;

InheritedDestroy;

end;

procedureTColorBtn.CreateParams( varParams: TCreateParams);

begin

InheritedCreateParams(Params);

withParams doStyle:= Style orBS_OWNERDRAW;

end;

procedureTColorBtn.Set3DFrame(Value: boolean);

begin

ifF3DFrame <> Value thenF3DFrame:= Value;

end;

procedureTColorBtn.SetButtonColor(Value: TColor);

begin

ifFButtonColor <> Value then begin

FButtonColor:= Value;

Invalidate;

end;

end;

procedureTColorBtn.WMLButtonDblClk( var Message: TWMLButtonDblClk);

begin

Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));

end;

procedureTColorBtn.SetButtonStyle(ADefault: Boolean);

begin

ifIsFocused <> ADefault thenIsFocused:= ADefault;

end;

procedureTColorBtn.CNDrawItem( var Message: TWMDrawItem);

var

RC: TRect;Flags: Longint;

State: TButtonState;

IsDown, IsDefault: Boolean;

DrawItemStruct: TDrawItemStruct;

begin

DrawItemStruct:= Message.DrawItemStruct^;

FCanvas.Handle:= DrawItemStruct.HDC;

RC:= ClientRect;

withDrawItemStruct do begin

IsDown:= ItemState andODS_SELECTED <> 0;

IsDefault:= ItemState andODS_FOCUS <> 0;

if notEnabled thenState:= bsDisabled

else ifIsDown thenState:= bsDown

elseState:= bsUp;

end;

Flags:= DFCS_BUTTONPUSH orDFCS_ADJUSTRECT;

ifIsDown thenFlags:= Flags orDFCS_PUSHED;

ifDrawItemStruct.ItemState andODS_DISABLED <> 0 thenFlags:= Flags orDFCS_INACTIVE;

ifIsFocused orIsDefault then begin

FCanvas.Pen.Color:= clWindowFrame;

FCanvas.Pen.Width:= 1;

FCanvas.Brush.Style:= bsClear;

FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);